plunit.pl

View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2022, University of Amsterdam
    7			      VU University Amsterdam
    8			      CWI, Amsterdam
    9			      SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(plunit,
   39	  [ set_test_options/1,         % +Options
   40	    begin_tests/1,              % +Name
   41	    begin_tests/2,              % +Name, +Options
   42	    end_tests/1,                % +Name
   43	    run_tests/0,                % Run all tests
   44	    run_tests/1,                % Run named test-set
   45	    load_test_files/1,          % +Options
   46	    running_tests/0,            % Prints currently running test
   47	    current_test/5,             % ?Unit,?Test,?Line,?Body,?Options
   48	    current_test_unit/2,        % ?Unit,?Options
   49	    test_report/1               % +What
   50	  ]).   51
   52/** <module> Unit Testing
   53
   54Unit testing environment for SWI-Prolog and   SICStus Prolog. For usage,
   55please visit https://www.swi-prolog.org/pldoc/package/plunit.
   56*/
   57
   58:- autoload(library(statistics), [call_time/2]).   59:- autoload(library(apply), [maplist/3,include/3]).   60:- autoload(library(lists), [member/2,append/2]).   61:- autoload(library(option), [option/3,option/2]).   62:- autoload(library(ordsets), [ord_intersection/3]).   63:- autoload(library(pairs), [group_pairs_by_key/2,pairs_values/2]).   64:- autoload(library(error), [must_be/2]).   65:- autoload(library(thread), [concurrent_forall/2]).   66:- autoload(library(aggregate), [aggregate_all/3]).   67:- autoload(library(streams), [with_output_to/3]).   68:- autoload(library(ansi_term), [ansi_format/3]).   69
   70:- meta_predicate valid_options(+, 1).   71
   72
   73		 /*******************************
   74		 *    CONDITIONAL COMPILATION   *
   75		 *******************************/
   76
   77:- discontiguous
   78    user:term_expansion/2.   79
   80:- dynamic
   81    include_code/1.   82
   83including :-
   84    include_code(X),
   85    !,
   86    X == true.
   87including.
   88
   89if_expansion((:- if(G)), []) :-
   90    (   including
   91    ->  (   catch(G, E, (print_message(error, E), fail))
   92	->  asserta(include_code(true))
   93	;   asserta(include_code(false))
   94	)
   95    ;   asserta(include_code(else_false))
   96    ).
   97if_expansion((:- else), []) :-
   98    (   retract(include_code(X))
   99    ->  (   X == true
  100	->  X2 = false
  101	;   X == false
  102	->  X2 = true
  103	;   X2 = X
  104	),
  105	asserta(include_code(X2))
  106    ;   throw_error(context_error(no_if),_)
  107    ).
  108if_expansion((:- endif), []) :-
  109    retract(include_code(_)),
  110    !.
  111
  112if_expansion(_, []) :-
  113    \+ including.
  114
  115user:term_expansion(In, Out) :-
  116    prolog_load_context(module, plunit),
  117    if_expansion(In, Out).
  118
  119swi     :- catch(current_prolog_flag(dialect, swi), _, fail), !.
  120swi     :- catch(current_prolog_flag(dialect, yap), _, fail).
  121sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
  122
  123
  124:- if(swi).  125throw_error(Error_term,Impldef) :-
  126    throw(error(Error_term,context(Impldef,_))).
  127
  128:- set_prolog_flag(generate_debug_info, false).  129current_test_flag(Name, Value) :-
  130    current_prolog_flag(Name, Value).
  131
  132set_test_flag(Name, Value) :-
  133    create_prolog_flag(Name, Value, []).
  134
  135% ensure expansion to avoid tracing
  136goal_expansion(forall(C,A),
  137	       \+ (C, \+ A)).
  138goal_expansion(current_module(Module,File),
  139	       module_property(Module, file(File))).
  140
  141:- if(current_prolog_flag(dialect, yap)).  142
  143'$set_predicate_attribute'(_, _, _).
  144
  145:- endif.  146:- endif.  147
  148:- if(sicstus).  149throw_error(Error_term,Impldef) :-
  150    throw(error(Error_term,i(Impldef))). % SICStus 3 work around
  151
  152% SWI-Compatibility
  153:- op(700, xfx, =@=).  154
  155'$set_source_module'(_, _).
  156
  157%!  current_test_flag(?Name, ?Value) is nondet.
  158%
  159%   Query  flags  that  control  the    testing   process.  Emulates
  160%   SWI-Prologs flags.
  161
  162:- dynamic test_flag/2. % Name, Val
  163
  164current_test_flag(optimise, Val) :-
  165    current_prolog_flag(compiling, Compiling),
  166    (   Compiling == debugcode ; true % TBD: Proper test
  167    ->  Val = false
  168    ;   Val = true
  169    ).
  170current_test_flag(Name, Val) :-
  171    test_flag(Name, Val).
  172
  173
  174%!  set_test_flag(+Name, +Value) is det.
  175
  176set_test_flag(Name, Val) :-
  177    var(Name),
  178    !,
  179    throw_error(instantiation_error, set_test_flag(Name,Val)).
  180set_test_flag( Name, Val ) :-
  181    retractall(test_flag(Name,_)),
  182    asserta(test_flag(Name, Val)).
  183
  184:- op(1150, fx, thread_local).  185
  186user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :-
  187    prolog_load_context(module, plunit).
  188
  189:- endif.  190
  191		 /*******************************
  192		 *            IMPORTS           *
  193		 *******************************/
  194
  195:- initialization
  196   (   current_test_flag(test_options, _)
  197   ->  true
  198   ;   set_test_flag(test_options,
  199                     [ run(make),       % run tests on make/0
  200                       sto(false),
  201                       output(on_failure)
  202                     ])
  203   ).  204
  205%!  set_test_options(+Options)
  206%
  207%   Specifies how to deal with test suites.  Defined options are:
  208%
  209%    - load(+Load)
  210%      Whether or not the tests must be loaded.  Values are
  211%      `never`, `always`, `normal` (only if not optimised)
  212%
  213%    - run(+When)
  214%      When the tests are run.  Values are `manual`, `make`
  215%      or make(all).
  216%
  217%    - silent(+Bool)
  218%      If `true` (default `false`), report successful tests
  219%      using message level `silent`, only printing errors and
  220%      warnings.
  221%
  222%    - output(+When)
  223%      If `always`, emit all output as it is produced, if `never`,
  224%      suppress all output and if `on_failure`, emit the output
  225%      if the test fails.
  226%
  227%    - sto(+Bool)
  228%      How to test whether code is subject to occurs check
  229%      (STO).  If `false` (default), STO is not considered.
  230%      If `true` and supported by the hosting Prolog, code
  231%      is run in all supported unification mode and reported
  232%      if the results are inconsistent.
  233%
  234%    - cleanup(+Bool)
  235%      If `true` (default =false), cleanup report at the end
  236%      of run_tests/1.  Used to improve cooperation with
  237%      memory debuggers such as dmalloc.
  238%
  239%    - concurrent(+Bool)
  240%      If `true` (default `false`), run all tests in a unit
  241%      concurrently.
  242
  243set_test_options(Options) :-
  244    valid_options(Options, global_test_option),
  245    set_test_flag(test_options, Options).
  246
  247global_test_option(load(Load)) :-
  248    must_be(oneof([never,always,normal]), Load).
  249global_test_option(output(Cond)) :-
  250    must_be(oneof([always,never, on_failure]), Cond).
  251global_test_option(run(When)) :-
  252    must_be(oneof([manual,make,make(all)]), When).
  253global_test_option(silent(Bool)) :-
  254    must_be(boolean, Bool).
  255global_test_option(sto(Bool)) :-
  256    must_be(boolean, Bool).
  257global_test_option(cleanup(Bool)) :-
  258    must_be(boolean, Bool).
  259global_test_option(concurrent(Bool)) :-
  260    must_be(boolean, Bool).
  261
  262
  263%!  loading_tests
  264%
  265%   True if tests must be loaded.
  266
  267loading_tests :-
  268    current_test_flag(test_options, Options),
  269    option(load(Load), Options, normal),
  270    (   Load == always
  271    ->  true
  272    ;   Load == normal,
  273	\+ current_test_flag(optimise, true)
  274    ).
  275
  276		 /*******************************
  277		 *            MODULE            *
  278		 *******************************/
  279
  280:- dynamic
  281    loading_unit/4,                 % Unit, Module, File, OldSource
  282    current_unit/4,                 % Unit, Module, Context, Options
  283    test_file_for/2.                % ?TestFile, ?PrologFile
  284
  285%!  begin_tests(+UnitName:atom) is det.
  286%!  begin_tests(+UnitName:atom, Options) is det.
  287%
  288%   Start a test-unit. UnitName is the  name   of  the test set. the
  289%   unit is ended by :- end_tests(UnitName).
  290
  291begin_tests(Unit) :-
  292    begin_tests(Unit, []).
  293
  294begin_tests(Unit, Options) :-
  295    must_be(atom, Unit),
  296    valid_options(Options, test_set_option),
  297    make_unit_module(Unit, Name),
  298    source_location(File, Line),
  299    begin_tests(Unit, Name, File:Line, Options).
  300
  301:- if(swi).  302begin_tests(Unit, Name, File:Line, Options) :-
  303    loading_tests,
  304    !,
  305    '$set_source_module'(Context, Context),
  306    (   current_unit(Unit, Name, Context, Options)
  307    ->  true
  308    ;   retractall(current_unit(Unit, Name, _, _)),
  309	assert(current_unit(Unit, Name, Context, Options))
  310    ),
  311    '$set_source_module'(Old, Name),
  312    '$declare_module'(Name, test, Context, File, Line, false),
  313    discontiguous(Name:'unit test'/4),
  314    '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
  315    discontiguous(Name:'unit body'/2),
  316    asserta(loading_unit(Unit, Name, File, Old)).
  317begin_tests(Unit, Name, File:_Line, _Options) :-
  318    '$set_source_module'(Old, Old),
  319    asserta(loading_unit(Unit, Name, File, Old)).
  320
  321:- else.  322
  323% we cannot use discontiguous as a goal in SICStus Prolog.
  324
  325user:term_expansion((:- begin_tests(Set)),
  326		    [ (:- begin_tests(Set)),
  327		      (:- discontiguous(test/2)),
  328		      (:- discontiguous('unit body'/2)),
  329		      (:- discontiguous('unit test'/4))
  330		    ]).
  331
  332begin_tests(Unit, Name, File:_Line, Options) :-
  333    loading_tests,
  334    !,
  335    (   current_unit(Unit, Name, _, Options)
  336    ->  true
  337    ;   retractall(current_unit(Unit, Name, _, _)),
  338	assert(current_unit(Unit, Name, -, Options))
  339    ),
  340    asserta(loading_unit(Unit, Name, File, -)).
  341begin_tests(Unit, Name, File:_Line, _Options) :-
  342    asserta(loading_unit(Unit, Name, File, -)).
  343
  344:- endif.  345
  346%!  end_tests(+Name) is det.
  347%
  348%   Close a unit-test module.
  349%
  350%   @tbd    Run tests/clean module?
  351%   @tbd    End of file?
  352
  353end_tests(Unit) :-
  354    loading_unit(StartUnit, _, _, _),
  355    !,
  356    (   Unit == StartUnit
  357    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  358	'$set_source_module'(_, Old)
  359    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  360    ).
  361end_tests(Unit) :-
  362    throw_error(context_error(plunit_close(Unit, -)), _).
  363
  364%!  make_unit_module(+Name, -ModuleName) is det.
  365%!  unit_module(+Name, -ModuleName) is det.
  366
  367:- if(swi).  368
  369unit_module(Unit, Module) :-
  370    atom_concat('plunit_', Unit, Module).
  371
  372make_unit_module(Unit, Module) :-
  373    unit_module(Unit, Module),
  374    (   current_module(Module),
  375	\+ current_unit(_, Module, _, _),
  376	predicate_property(Module:H, _P),
  377	\+ predicate_property(Module:H, imported_from(_M))
  378    ->  throw_error(permission_error(create, plunit, Unit),
  379		    'Existing module')
  380    ;  true
  381    ).
  382
  383:- else.  384
  385:- dynamic
  386    unit_module_store/2.  387
  388unit_module(Unit, Module) :-
  389    unit_module_store(Unit, Module),
  390    !.
  391
  392make_unit_module(Unit, Module) :-
  393    prolog_load_context(module, Module),
  394    assert(unit_module_store(Unit, Module)).
  395
  396:- endif.  397
  398		 /*******************************
  399		 *           EXPANSION          *
  400		 *******************************/
  401
  402%!  expand_test(+Name, +Options, +Body, -Clause) is det.
  403%
  404%   Expand test(Name, Options) :-  Body  into   a  clause  for
  405%   'unit test'/4 and 'unit body'/2.
  406
  407expand_test(Name, Options0, Body,
  408	    [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
  409	      ('unit body'(Id, Vars) :- !, Body)
  410	    ]) :-
  411    source_location(_File, Line),
  412    prolog_load_context(module, Module),
  413    atomic_list_concat([Name, '@line ', Line], Id),
  414    term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
  415    term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
  416    ord_intersection(OptionVars, BodyVars, VarList),
  417    Vars =.. [vars|VarList],
  418    (   is_list(Options0)           % allow for single option without list
  419    ->  Options1 = Options0
  420    ;   Options1 = [Options0]
  421    ),
  422    maplist(expand_option, Options1, Options2),
  423    valid_options(Options2, test_option),
  424    valid_test_mode(Options2, Options).
  425
  426expand_option(Var, _) :-
  427    var(Var),
  428    !,
  429    throw_error(instantiation_error,_).
  430expand_option(A == B, true(A==B)) :- !.
  431expand_option(A = B, true(A=B)) :- !.
  432expand_option(A =@= B, true(A=@=B)) :- !.
  433expand_option(A =:= B, true(A=:=B)) :- !.
  434expand_option(error(X), throws(error(X, _))) :- !.
  435expand_option(exception(X), throws(X)) :- !. % SICStus 4 compatibility
  436expand_option(error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
  437expand_option(true, true(true)) :- !.
  438expand_option(O, O).
  439
  440valid_test_mode(Options0, Options) :-
  441    include(test_mode, Options0, Tests),
  442    (   Tests == []
  443    ->  Options = [true(true)|Options0]
  444    ;   Tests = [_]
  445    ->  Options = Options0
  446    ;   throw_error(plunit(incompatible_options, Tests), _)
  447    ).
  448
  449test_mode(true(_)).
  450test_mode(all(_)).
  451test_mode(set(_)).
  452test_mode(fail).
  453test_mode(throws(_)).
  454
  455
  456%!  expand(+Term, -Clauses) is semidet.
  457
  458expand(end_of_file, _) :-
  459    loading_unit(Unit, _, _, _),
  460    !,
  461    end_tests(Unit),                % warn?
  462    fail.
  463expand((:-end_tests(_)), _) :-
  464    !,
  465    fail.
  466expand(_Term, []) :-
  467    \+ loading_tests.
  468expand((test(Name) :- Body), Clauses) :-
  469    !,
  470    expand_test(Name, [], Body, Clauses).
  471expand((test(Name, Options) :- Body), Clauses) :-
  472    !,
  473    expand_test(Name, Options, Body, Clauses).
  474expand(test(Name), _) :-
  475    !,
  476    throw_error(existence_error(body, test(Name)), _).
  477expand(test(Name, _Options), _) :-
  478    !,
  479    throw_error(existence_error(body, test(Name)), _).
  480
  481:- if(swi).  482:- multifile
  483    system:term_expansion/2.  484:- endif.  485
  486system:term_expansion(Term, Expanded) :-
  487    (   loading_unit(_, _, File, _)
  488    ->  source_location(ThisFile, _),
  489	(   File == ThisFile
  490	->  true
  491	;   source_file_property(ThisFile, included_in(File, _))
  492	),
  493	expand(Term, Expanded)
  494    ).
  495
  496
  497		 /*******************************
  498		 *             OPTIONS          *
  499		 *******************************/
  500
  501:- if(swi).  502:- else.  503must_be(list, X) :-
  504    !,
  505    (   is_list(X)
  506    ->  true
  507    ;   is_not(list, X)
  508    ).
  509must_be(Type, X) :-
  510    (   call(Type, X)
  511    ->  true
  512    ;   is_not(Type, X)
  513    ).
  514
  515is_not(Type, X) :-
  516    (   ground(X)
  517    ->  throw_error(type_error(Type, X), _)
  518    ;   throw_error(instantiation_error, _)
  519    ).
  520:- endif.  521
  522%!  valid_options(+Options, :Pred) is det.
  523%
  524%   Verify Options to be a list of valid options according to
  525%   Pred.
  526%
  527%   @throws =type_error= or =instantiation_error=.
  528
  529valid_options(Options, Pred) :-
  530    must_be(list, Options),
  531    verify_options(Options, Pred).
  532
  533verify_options([], _).
  534verify_options([H|T], Pred) :-
  535    (   call(Pred, H)
  536    ->  verify_options(T, Pred)
  537    ;   throw_error(domain_error(Pred, H), _)
  538    ).
  539
  540
  541%!  test_option(+Option) is semidet.
  542%
  543%   True if Option is a valid option for test(Name, Options).
  544
  545test_option(Option) :-
  546    test_set_option(Option),
  547    !.
  548test_option(true(_)).
  549test_option(fail).
  550test_option(throws(_)).
  551test_option(all(_)).
  552test_option(set(_)).
  553test_option(nondet).
  554test_option(fixme(_)).
  555test_option(forall(X)) :-
  556    must_be(callable, X).
  557
  558%!  test_option(+Option) is semidet.
  559%
  560%   True if Option is a valid option for :- begin_tests(Name,
  561%   Options).
  562
  563test_set_option(blocked(X)) :-
  564    must_be(ground, X).
  565test_set_option(condition(X)) :-
  566    must_be(callable, X).
  567test_set_option(setup(X)) :-
  568    must_be(callable, X).
  569test_set_option(cleanup(X)) :-
  570    must_be(callable, X).
  571test_set_option(sto(V)) :-
  572    nonvar(V), member(V, [finite_trees, rational_trees]).
  573test_set_option(concurrent(V)) :-
  574    must_be(boolean, V).
  575
  576		 /*******************************
  577		 *             UTIL		*
  578		 *******************************/
  579
  580:- meta_predicate
  581       reify(0, -),
  582       capture_output(0,-,+).  583
  584%!  reify(:Goal, -Result) is det.
  585
  586reify(Goal, Result) :-
  587    (   catch(Goal, E, true)
  588    ->  (   var(E)
  589	->  Result = true
  590	;   Result = throw(E)
  591	)
  592    ;   Result = false
  593    ).
  594
  595capture_output(Goal, Output, Options) :-
  596    option(output(How), Options, always),
  597    (   How == always
  598    ->  call(Goal)
  599    ;   with_output_to(string(Output), Goal,
  600                       [ capture([user_output, user_error])])
  601    ).
  602
  603
  604		 /*******************************
  605		 *        RUNNING TOPLEVEL      *
  606		 *******************************/
  607
  608:- thread_local
  609    test_count/1,                   % Count
  610    passed/5,                       % Unit, Test, Line, Det, Time
  611    failed/5,                       % Unit, Test, Line, Reason, Time
  612    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  613    blocked/4,                      % Unit, Test, Line, Reason
  614    sto/4,                          % Unit, Test, Line, Results
  615    fixme/5.                        % Unit, Test, Line, Reason, Status
  616
  617:- dynamic
  618    running/5.                      % Unit, Test, Line, STO, Thread
  619
  620%!  run_tests is semidet.
  621%!  run_tests(+TestSet) is semidet.
  622%
  623%   Run  tests  and  report  about    the   results.  The  predicate
  624%   run_tests/0 runs all known  tests  that   are  not  blocked. The
  625%   predicate run_tests/1 takes a  specification   of  tests to run.
  626%   This  is  either  a  single   specification    or   a   list  of
  627%   specifications. Each single specification is  either the name of
  628%   a test-unit or a term <test-unit>:<test>, denoting a single test
  629%   within a unit.
  630
  631run_tests :-
  632    findall(Unit, current_test_unit(Unit,_), Units),
  633    run_tests(Units).
  634
  635run_tests(Set) :-
  636    cleanup,
  637    count_tests(Set, Count),
  638    asserta(test_count(Count)),
  639    setup_call_cleanup(
  640	setup_trap_assertions(Ref),
  641	run_unit_and_check_errors(Set),
  642	report_and_cleanup(Ref)).
  643
  644report_and_cleanup(Ref) :-
  645    cleanup_trap_assertions(Ref),
  646    report,
  647    cleanup_after_test.
  648
  649run_unit_and_check_errors(Set) :-
  650    run_unit(Set),
  651    all_tests_passed(_).
  652
  653run_unit([]) :- !.
  654run_unit([H|T]) :-
  655    !,
  656    run_unit(H),
  657    run_unit(T).
  658run_unit(Spec) :-
  659    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  660    (   option(blocked(Reason), UnitOptions)
  661    ->  info(plunit(blocked(unit(Unit, Reason))))
  662    ;   condition(Module, unit(Unit), UnitOptions)
  663    ->  (   setup(Module, unit(Unit), UnitOptions)
  664        ->  info(plunit(begin(Spec))),
  665            call_time(run_unit_2(Unit, Tests, Module, UnitOptions), Time),
  666            test_summary(Unit, Summary),
  667            info(plunit(end(Spec, Summary.put(time, Time)))),
  668            cleanup(Module, UnitOptions)
  669        )
  670    ;   true
  671    ).
  672
  673%!  count_tests(+Spec, -Count) is det.
  674%
  675%   Count the number of tests to run.
  676
  677count_tests(Spec, Count) :-
  678    count_tests(Spec, 0, Count).
  679
  680count_tests([], Count, Count) :-
  681    !.
  682count_tests([H|T], Count0, Count) :-
  683    !,
  684    count_tests(H, Count0, Count1),
  685    count_tests(T, Count1, Count).
  686count_tests(Spec, Count0, Count) :-
  687    unit_from_spec(Spec, Unit, Tests, _Module, UnitOptions),
  688    (   option(blocked(_Reason), UnitOptions)
  689    ->  Count = Count0
  690    ;   var(Tests)
  691    ->  count(( current_test(Unit,_,_,_,TestOptions),
  692                \+ option(blocked(_), TestOptions)), N),
  693	Count is Count0+N
  694    ;   atom(Tests),
  695	current_test(Unit,Tests,_,_,_)
  696    ->  Count is Count0+1
  697    ;   is_list(Tests)
  698    ->  count((member(T, Tests), current_test(Unit,T,_,_,_)), N),
  699	Count is Count0+N
  700    ;   Count = Count0
  701    ).
  702
  703
  704
  705
  706:- if(current_prolog_flag(threads, true)).  707run_unit_2(Unit, Tests, Module, UnitOptions) :-
  708    option(concurrent(true), UnitOptions, false),
  709    current_test_flag(test_options, GlobalOptions),
  710    option(concurrent(true), GlobalOptions),
  711    !,
  712    concurrent_forall((Module:'unit test'(Name, Line, Options, Body),
  713		       matching_test(Name, Tests)),
  714		      run_test(Unit, Name, Line, Options, Body)).
  715:- endif.  716run_unit_2(Unit, Tests, Module, _UnitOptions) :-
  717    forall(( Module:'unit test'(Name, Line, Options, Body),
  718	     matching_test(Name, Tests)),
  719	   run_test(Unit, Name, Line, Options, Body)).
  720
  721
  722unit_from_spec(Unit, Unit, _, Module, Options) :-
  723    atom(Unit),
  724    !,
  725    (   current_unit(Unit, Module, _Supers, Options)
  726    ->  true
  727    ;   throw_error(existence_error(unit_test, Unit), _)
  728    ).
  729unit_from_spec(Unit:Tests, Unit, Tests, Module, Options) :-
  730    atom(Unit),
  731    !,
  732    (   current_unit(Unit, Module, _Supers, Options)
  733    ->  true
  734    ;   throw_error(existence_error(unit_test, Unit), _)
  735    ).
  736
  737
  738matching_test(X, X) :- !.
  739matching_test(Name, Set) :-
  740    is_list(Set),
  741    memberchk(Name, Set).
  742
  743cleanup :-
  744    thread_self(Me),
  745    set_flag(plunit_test, 1),
  746    retractall(test_count(_)),
  747    retractall(passed(_, _, _, _, _)),
  748    retractall(failed(_, _, _, _, _)),
  749    retractall(failed_assertion(_, _, _, _, _, _, _)),
  750    retractall(blocked(_, _, _, _)),
  751    retractall(sto(_, _, _, _)),
  752    retractall(fixme(_, _, _, _, _)),
  753    retractall(running(_,_,_,_,Me)).
  754
  755cleanup_after_test :-
  756    current_test_flag(test_options, Options),
  757    option(cleanup(Cleanup), Options, false),
  758    (   Cleanup == true
  759    ->  cleanup
  760    ;   true
  761    ).
  762
  763
  764%!  run_tests_in_files(+Files:list) is det.
  765%
  766%   Run all test-units that appear in the given Files.
  767
  768run_tests_in_files(Files) :-
  769    findall(Unit, unit_in_files(Files, Unit), Units),
  770    (   Units == []
  771    ->  true
  772    ;   run_tests(Units)
  773    ).
  774
  775unit_in_files(Files, Unit) :-
  776    is_list(Files),
  777    !,
  778    member(F, Files),
  779    absolute_file_name(F, Source,
  780		       [ file_type(prolog),
  781			 access(read),
  782			 file_errors(fail)
  783		       ]),
  784    unit_file(Unit, Source).
  785
  786
  787		 /*******************************
  788		 *         HOOKING MAKE/0       *
  789		 *******************************/
  790
  791%!  make_run_tests(+Files)
  792%
  793%   Called indirectly from make/0 after Files have been reloaded.
  794
  795make_run_tests(Files) :-
  796    current_test_flag(test_options, Options),
  797    option(run(When), Options, manual),
  798    (   When == make
  799    ->  run_tests_in_files(Files)
  800    ;   When == make(all)
  801    ->  run_tests
  802    ;   true
  803    ).
  804
  805:- if(swi).  806
  807unification_capability(sto_error_incomplete).
  808% can detect some (almost all) STO runs
  809unification_capability(rational_trees).
  810unification_capability(finite_trees).
  811
  812set_unification_capability(Cap) :-
  813    cap_to_flag(Cap, Flag),
  814    set_prolog_flag(occurs_check, Flag).
  815
  816current_unification_capability(Cap) :-
  817    current_prolog_flag(occurs_check, Flag),
  818    cap_to_flag(Cap, Flag),
  819    !.
  820
  821cap_to_flag(sto_error_incomplete, error).
  822cap_to_flag(rational_trees, false).
  823cap_to_flag(finite_trees, true).
  824
  825:- else.  826:- if(sicstus).  827
  828unification_capability(rational_trees).
  829set_unification_capability(rational_trees).
  830current_unification_capability(rational_trees).
  831
  832:- else.  833
  834unification_capability(_) :-
  835    fail.
  836
  837:- endif.  838:- endif.  839
  840		 /*******************************
  841		 *      ASSERTION HANDLING      *
  842		 *******************************/
  843
  844:- if(swi).  845
  846:- dynamic prolog:assertion_failed/2.  847
  848setup_trap_assertions(Ref) :-
  849    asserta((prolog:assertion_failed(Reason, Goal) :-
  850		    test_assertion_failed(Reason, Goal)),
  851	    Ref).
  852
  853cleanup_trap_assertions(Ref) :-
  854    erase(Ref).
  855
  856test_assertion_failed(Reason, Goal) :-
  857    thread_self(Me),
  858    running(Unit, Test, Line, STO, Me),
  859    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  860	assertion_location(Stack, AssertLoc)
  861    ->  true
  862    ;   AssertLoc = unknown
  863    ),
  864    current_test_flag(test_options, Options),
  865    report_failed_assertion(Unit, Test, Line, AssertLoc,
  866			    STO, Reason, Goal, Options),
  867    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  868				   STO, Reason, Goal)).
  869
  870assertion_location(Stack, File:Line) :-
  871    append(_, [AssertFrame,CallerFrame|_], Stack),
  872    prolog_stack_frame_property(AssertFrame,
  873				predicate(prolog_debug:assertion/1)),
  874    !,
  875    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  876
  877report_failed_assertion(Unit, Test, Line, AssertLoc,
  878			STO, Reason, Goal, _Options) :-
  879    print_message(
  880	error,
  881	plunit(failed_assertion(Unit, Test, Line, AssertLoc,
  882				STO, Reason, Goal))).
  883
  884:- else.  885
  886setup_trap_assertions(_).
  887cleanup_trap_assertions(_).
  888
  889:- endif.  890
  891
  892		 /*******************************
  893		 *         RUNNING A TEST       *
  894		 *******************************/
  895
  896%!  run_test(+Unit, +Name, +Line, +Options, +Body) is det.
  897%
  898%   Run a single test.
  899
  900run_test(Unit, Name, Line, Options, Body) :-
  901    option(forall(Generator), Options),
  902    !,
  903    unit_module(Unit, Module),
  904    term_variables(Generator, Vars),
  905    forall(Module:Generator,
  906	   run_test_once(Unit, @(Name,Vars), Line, Options, Body)).
  907run_test(Unit, Name, Line, Options, Body) :-
  908    run_test_once(Unit, Name, Line, Options, Body).
  909
  910run_test_once(Unit, Name, Line, Options, Body) :-
  911    current_test_flag(test_options, GlobalOptions),
  912    option(sto(false), GlobalOptions, false),
  913    !,
  914    current_unification_capability(Type),
  915    begin_test(Unit, Name, Line, Type),
  916    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
  917                   Output, GlobalOptions),
  918    end_test(Unit, Name, Line, Type),
  919    report_result(Result, Output, Options).
  920run_test_once(Unit, Name, Line, Options, Body) :-
  921    current_unit(Unit, _Module, _Supers, UnitOptions),
  922    option(sto(Type), UnitOptions),
  923    \+ option(sto(_), Options),
  924    !,
  925    current_unification_capability(Cap0),
  926    call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body),
  927		 set_unification_capability(Cap0)).
  928run_test_once(Unit, Name, Line, Options, Body) :-
  929    current_unification_capability(Cap0),
  930    call_cleanup(run_test_cap(Unit, Name, Line, Options, Body),
  931		 set_unification_capability(Cap0)).
  932
  933run_test_cap(Unit, Name, Line, Options, Body) :-
  934    current_test_flag(test_options, GlobalOptions),
  935    (   option(sto(Type), Options)
  936    ->  unification_capability(Type),
  937	set_unification_capability(Type),
  938	begin_test(Unit, Name, Line, Type),
  939	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
  940                       Output, GlobalOptions),
  941	end_test(Unit, Name, Line, Type),
  942	report_result(Result, Output, Options)
  943    ;   findall(Key-(r(Type,Result,Output)),
  944                capture_output(test_caps(Type, Unit, Name, Line,
  945                                         Options, Body, Result, Key),
  946                               Output, GlobalOptions),
  947                Pairs0),
  948        keysort(Pairs0, Pairs),
  949	group_pairs_by_key(Pairs, Keyed),
  950	(   Keyed == []
  951	->  true
  952	;   Keyed = [_-Results]
  953	->  Results = [r(_Type,Result,Output)|_],
  954	    report_result(Result, Output, Options)          % consistent results
  955	;   pairs_values(Pairs, ResultByType),
  956	    report_result(sto(Unit, Name, Line, ResultByType), "", Options)
  957	)
  958    ).
  959
  960%!  test_caps(-Type, +Unit, +Name, +Line, +Options, +Body, -Result, -Key) is nondet.
  961
  962test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :-
  963    unification_capability(Type),
  964    set_unification_capability(Type),
  965    begin_test(Unit, Name, Line, Type),
  966    run_test_6(Unit, Name, Line, Options, Body, Result),
  967    end_test(Unit, Name, Line, Type),
  968    result_to_key(Result, Key),
  969    Key \== setup_failed,
  970    Key \== condition_failed.
  971
  972:- det(result_to_key/2).  973result_to_key(blocked(_, _, _, _), blocked).
  974result_to_key(failure(_, _, _, How0, _), failure(How1)) :-
  975    ( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ).
  976result_to_key(success(_, _, _, Determinism, _), success(Determinism)).
  977result_to_key(setup_failed(_,_,_), setup_failed).
  978result_to_key(condition_failed(_,_,_), condition_failed).
  979
  980:- det(report_result/3).  981report_result(Result, Output, Options) :-
  982    current_test_flag(test_options, GlobalOptions),
  983    print_test_output(Result, Output, GlobalOptions),
  984    report_result(Result, Options).
  985
  986report_result(blocked(Unit, Name, Line, Reason), _) :-
  987    !,
  988    assert(blocked(Unit, Name, Line, Reason)).
  989report_result(failure(Unit, Name, Line, How, Time), Options) :-
  990    !,
  991    failure(Unit, Name, Line, How, Time, Options).
  992report_result(success(Unit, Name, Line, Determinism, Time), Options) :-
  993    !,
  994    success(Unit, Name, Line, Determinism, Time, Options).
  995report_result(setup_failed(_Unit, _Name, _Line), _Options).
  996report_result(condition_failed(_Unit, _Name, _Line), _Options).
  997report_result(sto(Unit, Name, Line, ResultByType), Options) :-
  998    assert(sto(Unit, Name, Line, ResultByType)),
  999    print_message(error, plunit(sto(Unit, Name, Line))),
 1000    report_sto_results(ResultByType, Options).
 1001
 1002report_sto_results([], _).
 1003report_sto_results([r(Type,Result,Output)|T], Options) :-
 1004    print_test_output(Result, Output, Options),
 1005    print_message(error, plunit(sto(Type, Result))),
 1006    report_sto_results(T, Options).
 1007
 1008print_test_output(Result, Output, Options) :-
 1009    Output \== "",
 1010    option(output(on_failure), Options),
 1011    result_to_key(Result, Key),
 1012    Key \= success(_),
 1013    !,
 1014    ansi_format(code, '~N~s', [Output]).     % Use print_message(test(output), Output)?
 1015print_test_output(_, _, _).
 1016
 1017
 1018%!  run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1019%
 1020%   6th step  of the  tests.  Deals  with tests  that must  be ignored
 1021%   (blocked, conditions fails), setup and cleanup at the test level.
 1022%   Result is one of:
 1023%
 1024%     - blocked(Unit, Name, Line, Reason)
 1025%     - condition_failed(Unit, Name, Line)
 1026%     - failure(Unit, Name, Line, How, Time)
 1027%       How is one of:
 1028%       - succeeded
 1029%       - Exception
 1030%       - cmp_error(Cmp, E)
 1031%       - wrong_answer(Cmp)
 1032%       - failed
 1033%       - no_exception
 1034%       - wrong_error(Expect, E)
 1035%       - wrong_answer(Expected, Bindings)
 1036%     - success(Unit, Name, Line, Determinism, Time)
 1037%     - setup_failed(Unit, Name, Line)
 1038
 1039run_test_6(Unit, Name, Line, Options, _Body,
 1040	   blocked(Unit, Name, Line, Reason)) :-
 1041    option(blocked(Reason), Options),
 1042    !.
 1043run_test_6(Unit, Name, Line, Options, _Body, Result) :-
 1044    unit_module(Unit, Module),
 1045    \+ condition(Module, test(Unit,Name,Line), Options),
 1046    !,
 1047    Result = condition_failed(Unit, Name, Line).
 1048run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1049    option(setup(_Setup), Options),
 1050    !,
 1051    (   unit_module(Unit, Module),
 1052        setup(Module, test(Unit,Name,Line), Options)
 1053    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1054        cleanup(Module, Options)
 1055    ;   Result = setup_failed(Unit, Name, Line)
 1056    ).
 1057run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1058    unit_module(Unit, Module),
 1059    run_test_7(Unit, Name, Line, Options, Body, Result),
 1060    cleanup(Module, Options).
 1061
 1062%!  run_test_7(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1063%
 1064%   This step  deals with the expected  outcome of the test.   It runs
 1065%   the  actual test  and then  compares  the result  to the  outcome.
 1066%   There are  two main categories:  dealing with a single  result and
 1067%   all results.
 1068
 1069run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1070    option(true(Cmp), Options),			   % expected success
 1071    !,
 1072    unit_module(Unit, Module),
 1073    call_time(reify(call_det(Module:Body, Det), Result0), Time),
 1074    (   Result0 == true
 1075    ->  (   catch(Module:Cmp, E, true)
 1076        ->  (  var(E)
 1077            ->  Result = success(Unit, Name, Line, Det, Time)
 1078            ;   Result = failure(Unit, Name, Line, cmp_error(Cmp, E), Time)
 1079            )
 1080        ;   Result = failure(Unit, Name, Line, wrong_answer(Cmp), Time)
 1081        )
 1082    ;   Result0 == false
 1083    ->  Result = failure(Unit, Name, Line, failed, Time)
 1084    ;   Result0 = throw(E2)
 1085    ->  Result = failure(Unit, Name, Line, E2, Time)
 1086    ).
 1087run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1088    option(fail, Options),                         % expected failure
 1089    !,
 1090    unit_module(Unit, Module),
 1091    call_time(reify(Module:Body, Result0), Time),
 1092    (   Result0 == true
 1093    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1094    ;   Result0 == false
 1095    ->  Result = success(Unit, Name, Line, true, Time)
 1096    ;   Result0 = throw(E)
 1097    ->  Result = failure(Unit, Name, Line, E, Time)
 1098    ).
 1099run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1100    option(throws(Expect), Options),		   % Expected error
 1101    !,
 1102    unit_module(Unit, Module),
 1103    call_time(reify(Module:Body, Result0), Time),
 1104    (   Result0 == true
 1105    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1106    ;   Result0 == false
 1107    ->  Result = failure(Unit, Name, Line, failed, Time)
 1108    ;   Result0 = throw(E)
 1109    ->  (   match_error(Expect, E)
 1110        ->  Result = success(Unit, Name, Line, true, Time)
 1111        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1112        )
 1113    ).
 1114run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1115    option(all(Answer), Options),                  % all(Bindings)
 1116    !,
 1117    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1118run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1119    option(set(Answer), Options),                  % set(Bindings)
 1120    !,
 1121    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
 1122
 1123
 1124%!  non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)
 1125%
 1126%   Run tests on non-deterministic predicates.
 1127
 1128nondet_test(Expected, Unit, Name, Line, _Options, Body, Result) :-
 1129    unit_module(Unit, Module),
 1130    result_vars(Expected, Vars),
 1131    (   call_time(reify(findall(Vars, Module:Body, Bindings), Result0), Time)
 1132    ->  (   Result0 == true
 1133        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1134            ->  Result = success(Unit, Name, Line, true, Time)
 1135            ;   Result = failure(Unit, Name, Line, wrong_answer(Expected, Bindings), Time)
 1136            )
 1137        ;   Result0 = throw(E)
 1138        ->  Result = failure(Unit, Name, Line, E, Time)
 1139        )
 1140    ).
 1141
 1142%!  result_vars(+Expected, -Vars) is det.
 1143%
 1144%   Create a term v(V1, ...) containing all variables at the left
 1145%   side of the comparison operator on Expected.
 1146
 1147result_vars(Expected, Vars) :-
 1148    arg(1, Expected, CmpOp),
 1149    arg(1, CmpOp, Vars).
 1150
 1151%!  nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet.
 1152%
 1153%   Compare list/set results for non-deterministic predicates.
 1154%
 1155%   @tbd    Properly report errors
 1156%   @bug    Sort should deal with equivalence on the comparison
 1157%           operator.
 1158
 1159nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1160    cmp(Cmp, _Vars, Op, Values),
 1161    cmp_list(Values, Bindings, Op).
 1162nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1163    cmp(Cmp, _Vars, Op, Values0),
 1164    sort(Bindings0, Bindings),
 1165    sort(Values0, Values),
 1166    cmp_list(Values, Bindings, Op).
 1167
 1168cmp_list([], [], _Op).
 1169cmp_list([E0|ET], [V0|VT], Op) :-
 1170    call(Op, E0, V0),
 1171    cmp_list(ET, VT, Op).
 1172
 1173%!  cmp(+CmpTerm, -Left, -Op, -Right) is det.
 1174
 1175cmp(Var  == Value, Var,  ==, Value).
 1176cmp(Var =:= Value, Var, =:=, Value).
 1177cmp(Var  =  Value, Var,  =,  Value).
 1178:- if(swi). 1179cmp(Var =@= Value, Var, =@=, Value).
 1180:- else. 1181:- if(sicstus). 1182cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1183:- endif. 1184:- endif. 1185
 1186
 1187%!  call_det(:Goal, -Det) is nondet.
 1188%
 1189%   True if Goal succeeded.  Det is unified to =true= if Goal left
 1190%   no choicepoints and =false= otherwise.
 1191
 1192:- if((swi|sicstus)). 1193call_det(Goal, Det) :-
 1194    call_cleanup(Goal,Det0=true),
 1195    ( var(Det0) -> Det = false ; Det = true ).
 1196:- else. 1197call_det(Goal, true) :-
 1198    call(Goal).
 1199:- endif. 1200
 1201%!  match_error(+Expected, +Received) is semidet.
 1202%
 1203%   True if the Received errors matches the expected error. Matching
 1204%   is based on subsumes_term/2.
 1205
 1206match_error(Expect, Rec) :-
 1207    subsumes_term(Expect, Rec).
 1208
 1209%!  setup(+Module, +Context, +Options) is semidet.
 1210%
 1211%   Call the setup handler and  fail  if   it  cannot  run  for some
 1212%   reason. The condition handler is  similar,   but  failing is not
 1213%   considered an error.  Context is one of
 1214%
 1215%    - unit(Unit)
 1216%      If it is the setup handler for a unit
 1217%    - test(Unit,Name,Line)
 1218%      If it is the setup handler for a test
 1219
 1220setup(Module, Context, Options) :-
 1221    option(setup(Setup), Options),
 1222    !,
 1223    (   catch(call_ex(Module, Setup), E, true)
 1224    ->  (   var(E)
 1225	->  true
 1226	;   print_message(error, plunit(error(setup, Context, E))),
 1227	    fail
 1228	)
 1229    ;   print_message(error, error(goal_failed(Setup), _)),
 1230	fail
 1231    ).
 1232setup(_,_,_).
 1233
 1234%!  condition(+Module, +Context, +Options) is semidet.
 1235%
 1236%   Evaluate the test or test unit condition.
 1237
 1238condition(Module, Context, Options) :-
 1239    option(condition(Cond), Options),
 1240    !,
 1241    (   catch(call_ex(Module, Cond), E, true)
 1242    ->  (   var(E)
 1243	->  true
 1244	;   print_message(error, plunit(error(condition, Context, E))),
 1245	    fail
 1246	)
 1247    ;   fail
 1248    ).
 1249condition(_, _, _).
 1250
 1251
 1252%!  call_ex(+Module, +Goal)
 1253%
 1254%   Call Goal in Module after applying goal expansion.
 1255
 1256call_ex(Module, Goal) :-
 1257    Module:(expand_goal(Goal, GoalEx),
 1258		GoalEx).
 1259
 1260%!  cleanup(+Module, +Options) is det.
 1261%
 1262%   Call the cleanup handler and succeed.   Failure  or error of the
 1263%   cleanup handler is reported, but tests continue normally.
 1264
 1265cleanup(Module, Options) :-
 1266    option(cleanup(Cleanup), Options, true),
 1267    (   catch(call_ex(Module, Cleanup), E, true)
 1268    ->  (   var(E)
 1269	->  true
 1270	;   print_message(warning, E)
 1271	)
 1272    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1273    ).
 1274
 1275success(Unit, Name, Line, Det, Time, Options) :-
 1276    memberchk(fixme(Reason), Options),
 1277    !,
 1278    (   (   Det == true
 1279	;   memberchk(nondet, Options)
 1280	)
 1281    ->  progress(Unit, Name, fixme(passed), Time),
 1282	Ok = passed
 1283    ;   progress(Unit, Name, fixme(nondet), Time),
 1284	Ok = nondet
 1285    ),
 1286    flush_output(user_error),
 1287    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1288success(Unit, Name, Line, _, Time, Options) :-
 1289    failed_assertion(Unit, Name, Line, _,_,_,_),
 1290    !,
 1291    failure(Unit, Name, Line, assertion, Time, Options).
 1292success(Unit, Name, Line, Det, Time, Options) :-
 1293    assert(passed(Unit, Name, Line, Det, Time)),
 1294    (   (   Det == true
 1295	;   memberchk(nondet, Options)
 1296	)
 1297    ->  progress(Unit, Name, passed, Time)
 1298    ;   unit_file(Unit, File),
 1299	print_message(warning, plunit(nondet(File, Line, Name)))
 1300    ).
 1301
 1302%!  failure(+Unit, +Name, +Line, +How, +Time, +Options) is det.
 1303%
 1304%   Test failed.  Report the error.
 1305
 1306failure(Unit, Name, Line, _, Time, Options) :-
 1307    memberchk(fixme(Reason), Options),
 1308    !,
 1309    progress(Unit, Name, fixme(failed), Time),
 1310    assert(fixme(Unit, Name, Line, Reason, failed)).
 1311failure(Unit, Name, Line, E, Time, Options) :-
 1312    report_failure(Unit, Name, Line, E, Time, Options),
 1313    progress(Unit, Name, failed, Time),
 1314    assert_cyclic(failed(Unit, Name, Line, E, Time)).
 1315
 1316%!  assert_cyclic(+Term) is det.
 1317%
 1318%   Assert  a  possibly  cyclic  unit   clause.  Current  SWI-Prolog
 1319%   assert/1 does not handle cyclic terms,  so we emulate this using
 1320%   the recorded database.
 1321%
 1322%   @tbd    Implement cycle-safe assert and remove this.
 1323
 1324:- if(swi). 1325assert_cyclic(Term) :-
 1326    acyclic_term(Term),
 1327    !,
 1328    assert(Term).
 1329assert_cyclic(Term) :-
 1330    Term =.. [Functor|Args],
 1331    recorda(cyclic, Args, Id),
 1332    functor(Term, _, Arity),
 1333    length(NewArgs, Arity),
 1334    Head =.. [Functor|NewArgs],
 1335    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1336:- else. 1337:- if(sicstus). 1338:- endif. 1339assert_cyclic(Term) :-
 1340    assert(Term).
 1341:- endif. 1342
 1343
 1344		 /*******************************
 1345		 *            REPORTING         *
 1346		 *******************************/
 1347
 1348%!  begin_test(Unit, Test, Line, STO) is det.
 1349%!  end_test(Unit, Test, Line, STO) is det.
 1350%
 1351%   Maintain running/5 and report a test has started/is ended using
 1352%   a =silent= message:
 1353%
 1354%       * plunit(begin(Unit:Test, File:Line, STO))
 1355%       * plunit(end(Unit:Test, File:Line, STO))
 1356%
 1357%   @see message_hook/3 for intercepting these messages
 1358
 1359begin_test(Unit, Test, Line, STO) :-
 1360    thread_self(Me),
 1361    assert(running(Unit, Test, Line, STO, Me)),
 1362    unit_file(Unit, File),
 1363    print_message(silent, plunit(begin(Unit:Test, File:Line, STO))).
 1364
 1365end_test(Unit, Test, Line, STO) :-
 1366    thread_self(Me),
 1367    retractall(running(_,_,_,_,Me)),
 1368    unit_file(Unit, File),
 1369    print_message(silent, plunit(end(Unit:Test, File:Line, STO))).
 1370
 1371%!  running_tests is det.
 1372%
 1373%   Print the currently running test.
 1374
 1375running_tests :-
 1376    running_tests(Running),
 1377    print_message(informational, plunit(running(Running))).
 1378
 1379running_tests(Running) :-
 1380    findall(running(Unit:Test, File:Line, STO, Thread),
 1381	    (   running(Unit, Test, Line, STO, Thread),
 1382		unit_file(Unit, File)
 1383	    ), Running).
 1384
 1385
 1386%!  current_test(?Unit, ?Test, ?Line, ?Body, ?Options) is nondet.
 1387%
 1388%   True when a test with the specified properties is loaded.
 1389
 1390current_test(Unit, Test, Line, Body, Options) :-
 1391    current_unit(Unit, Module, _Supers, _UnitOptions),
 1392    Module:'unit test'(Test, Line, Options, Body).
 1393
 1394%!  current_test_unit(?Unit, ?Options) is nondet.
 1395%
 1396%   True when a Unit is a current unit test declared with Options.
 1397
 1398current_test_unit(Unit, UnitOptions) :-
 1399    current_unit(Unit, _Module, _Supers, UnitOptions).
 1400
 1401
 1402:- meta_predicate count(0, -). 1403count(Goal, Count) :-
 1404    aggregate_all(count, Goal, Count).
 1405
 1406%!  test_summary(?Unit, -Summary) is det.
 1407%
 1408%   True if there are no failures, otherwise false.
 1409
 1410test_summary(Unit, Summary) :-
 1411    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1412    count(failed_assertion(Unit, _0Test, _0Line,
 1413			   _ALoc, _STO, _0Reason, _Goal), FailedAssertion),
 1414    count(sto(Unit, _0Test, _0Line, _Results), STO),
 1415    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1416    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1417    Summary = plunit{passed:Passed,
 1418		     failed:Failed,
 1419		     failed_assertions:FailedAssertion,
 1420		     blocked:Blocked,
 1421		     sto:STO}.
 1422
 1423all_tests_passed(Unit) :-
 1424    test_summary(Unit, Summary),
 1425    test_summary_passed(Summary).
 1426
 1427test_summary_passed(Summary) :-
 1428    _{failed: 0, failed_assertions: 0, sto: 0} :< Summary.
 1429
 1430%!  report is det.
 1431%
 1432%   Print a summary of the tests that ran.
 1433
 1434report :-
 1435    test_summary(_, Summary),
 1436    print_message(silent, plunit(Summary)),
 1437    _{ passed:Passed,
 1438       failed:Failed,
 1439       failed_assertions:FailedAssertion,
 1440       blocked:Blocked,
 1441       sto:STO
 1442     } :< Summary,
 1443    (   Passed+Failed+FailedAssertion+Blocked+STO =:= 0
 1444    ->  info(plunit(no_tests))
 1445    ;   Failed+FailedAssertion+Blocked+STO =:= 0
 1446    ->  report_fixme,
 1447	info(plunit(all_passed(Passed)))
 1448    ;   report_blocked,
 1449	report_fixme,
 1450	report_failed_assertions,
 1451	report_failed,
 1452	report_sto,
 1453	info(plunit(passed(Passed)))
 1454    ).
 1455
 1456number_of_clauses(F/A,N) :-
 1457    (   current_predicate(F/A)
 1458    ->  functor(G,F,A),
 1459	findall(t, G, Ts),
 1460	length(Ts, N)
 1461    ;   N = 0
 1462    ).
 1463
 1464report_blocked :-
 1465    number_of_clauses(blocked/4,N),
 1466    N > 0,
 1467    !,
 1468    info(plunit(blocked(N))),
 1469    (   blocked(Unit, Name, Line, Reason),
 1470	unit_file(Unit, File),
 1471	print_message(informational,
 1472		      plunit(blocked(File:Line, Name, Reason))),
 1473	fail ; true
 1474    ).
 1475report_blocked.
 1476
 1477report_failed :-
 1478    number_of_clauses(failed/5, N),
 1479    info(plunit(failed(N))).
 1480
 1481report_failed_assertions :-
 1482    number_of_clauses(failed_assertion/7, N),
 1483    info(plunit(failed_assertions(N))).
 1484
 1485report_sto :-
 1486    number_of_clauses(sto/4, N),
 1487    info(plunit(sto(N))).
 1488
 1489report_fixme :-
 1490    report_fixme(_,_,_).
 1491
 1492report_fixme(TuplesF, TuplesP, TuplesN) :-
 1493    fixme(failed, TuplesF, Failed),
 1494    fixme(passed, TuplesP, Passed),
 1495    fixme(nondet, TuplesN, Nondet),
 1496    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1497
 1498
 1499fixme(How, Tuples, Count) :-
 1500    findall(fixme(Unit, Name, Line, Reason, How),
 1501	    fixme(Unit, Name, Line, Reason, How), Tuples),
 1502    length(Tuples, Count).
 1503
 1504
 1505report_failure(Unit, Name, _, assertion, Time, _) :-
 1506    !,
 1507    progress(Unit, Name, assertion, Time).
 1508report_failure(Unit, Name, Line, Error, _Time, _Options) :-
 1509    print_message(error, plunit(failed(Unit, Name, Line, Error))).
 1510
 1511
 1512%!  test_report(+What) is det.
 1513%
 1514%   Produce reports on test  results  after   the  run.  Currently  only
 1515%   supports `fixme` for What.
 1516
 1517test_report(fixme) :-
 1518    !,
 1519    report_fixme(TuplesF, TuplesP, TuplesN),
 1520    append([TuplesF, TuplesP, TuplesN], Tuples),
 1521    print_message(informational, plunit(fixme(Tuples))).
 1522test_report(What) :-
 1523    throw_error(domain_error(report_class, What), _).
 1524
 1525
 1526		 /*******************************
 1527		 *             INFO             *
 1528		 *******************************/
 1529
 1530%!  current_test_set(?Unit) is nondet.
 1531%
 1532%   True if Unit is a currently loaded test-set.
 1533
 1534current_test_set(Unit) :-
 1535    current_unit(Unit, _Module, _Context, _Options).
 1536
 1537%!  unit_file(+Unit, -File) is det.
 1538%!  unit_file(-Unit, +File) is nondet.
 1539
 1540unit_file(Unit, File) :-
 1541    current_unit(Unit, Module, _Context, _Options),
 1542    current_module(Module, File).
 1543unit_file(Unit, PlFile) :-
 1544    nonvar(PlFile),
 1545    test_file_for(TestFile, PlFile),
 1546    current_module(Module, TestFile),
 1547    current_unit(Unit, Module, _Context, _Options).
 1548
 1549
 1550		 /*******************************
 1551		 *             FILES            *
 1552		 *******************************/
 1553
 1554%!  load_test_files(+Options) is det.
 1555%
 1556%   Load .plt test-files related to loaded source-files.
 1557
 1558load_test_files(_Options) :-
 1559    (   source_file(File),
 1560	file_name_extension(Base, Old, File),
 1561	Old \== plt,
 1562	file_name_extension(Base, plt, TestFile),
 1563	exists_file(TestFile),
 1564	(   test_file_for(TestFile, File)
 1565	->  true
 1566	;   load_files(TestFile,
 1567		       [ if(changed),
 1568			 imports([])
 1569		       ]),
 1570	    asserta(test_file_for(TestFile, File))
 1571	),
 1572	fail ; true
 1573    ).
 1574
 1575
 1576
 1577		 /*******************************
 1578		 *           MESSAGES           *
 1579		 *******************************/
 1580
 1581%!  info(+Term)
 1582%
 1583%   Runs print_message(Level, Term), where Level  is one of =silent=
 1584%   or =informational= (default).
 1585
 1586info(Term) :-
 1587    message_level(Level),
 1588    print_message(Level, Term).
 1589
 1590progress(Unit, Name, Result, Time) :-
 1591    flag(plunit_test, N, N+1),
 1592    test_count(Total),
 1593    print_message(information, plunit(progress(Unit, Name, Result, N/Total, Time))).
 1594
 1595message_level(Level) :-
 1596    current_test_flag(test_options, Options),
 1597    option(silent(Silent), Options, false),
 1598    (   Silent == false
 1599    ->  Level = informational
 1600    ;   Level = silent
 1601    ).
 1602
 1603locationprefix(File:Line) -->
 1604    !,
 1605    [ url(File:Line), ':\n\t' ].
 1606locationprefix(test(Unit,_Test,Line)) -->
 1607    !,
 1608    { unit_file(Unit, File) },
 1609    locationprefix(File:Line).
 1610locationprefix(unit(Unit)) -->
 1611    !,
 1612    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1613locationprefix(FileLine) -->
 1614    { throw_error(type_error(locationprefix,FileLine), _) }.
 1615
 1616:- discontiguous
 1617    message//1. 1618:- '$hide'(message//1). 1619
 1620message(error(context_error(plunit_close(Name, -)), _)) -->
 1621    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1622message(error(context_error(plunit_close(Name, Start)), _)) -->
 1623    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1624message(plunit(nondet(File, Line, Name))) -->
 1625    locationprefix(File:Line),
 1626    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1627message(error(plunit(incompatible_options, Tests), _)) -->
 1628    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1629
 1630					% Unit start/end
 1631:- if(swi). 1632message(plunit(progress(_Unit, _Name, Result, _N_T, _Time))) -->
 1633    [ at_same_line ], result(Result), [flush].
 1634message(plunit(begin(Unit))) -->
 1635    [ 'PL-Unit: ~w '-[Unit], flush ].
 1636message(plunit(end(_Unit, Summary))) -->
 1637    [ at_same_line ],
 1638    (   {test_summary_passed(Summary)}
 1639    ->  [ ' passed' ]
 1640    ;   [ ansi(error, '**FAILED', []) ]
 1641    ),
 1642    [ ' ~3f sec'-[Summary.time.cpu] ].
 1643:- else. 1644message(plunit(begin(Unit))) -->
 1645    [ 'PL-Unit: ~w '-[Unit]/*, flush-[]*/ ].
 1646message(plunit(end(_Unit, _Summary))) -->
 1647    [ ' done'-[] ].
 1648:- endif. 1649message(plunit(blocked(unit(Unit, Reason)))) -->
 1650    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1651message(plunit(running([]))) -->
 1652    !,
 1653    [ 'PL-Unit: no tests running' ].
 1654message(plunit(running([One]))) -->
 1655    !,
 1656    [ 'PL-Unit: running ' ],
 1657    running(One).
 1658message(plunit(running(More))) -->
 1659    !,
 1660    [ 'PL-Unit: running tests:', nl ],
 1661    running(More).
 1662message(plunit(fixme([]))) --> !.
 1663message(plunit(fixme(Tuples))) -->
 1664    !,
 1665    fixme_message(Tuples).
 1666
 1667					% Blocked tests
 1668message(plunit(blocked(1))) -->
 1669    !,
 1670    [ 'one test is blocked:'-[] ].
 1671message(plunit(blocked(N))) -->
 1672    [ '~D tests are blocked:'-[N] ].
 1673message(plunit(blocked(Pos, Name, Reason))) -->
 1674    locationprefix(Pos),
 1675    test_name(Name),
 1676    [ ': ~w'-[Reason] ].
 1677
 1678					% fail/success
 1679message(plunit(no_tests)) -->
 1680    !,
 1681    [ 'No tests to run' ].
 1682message(plunit(all_passed(1))) -->
 1683    !,
 1684    [ 'test passed' ].
 1685message(plunit(all_passed(Count))) -->
 1686    !,
 1687    [ 'All ~D tests passed'-[Count] ].
 1688message(plunit(passed(Count))) -->
 1689    !,
 1690    [ '~D tests passed'-[Count] ].
 1691message(plunit(failed(0))) -->
 1692    !,
 1693    [].
 1694message(plunit(failed(1))) -->
 1695    !,
 1696    [ '1 test failed'-[] ].
 1697message(plunit(failed(N))) -->
 1698    [ '~D tests failed'-[N] ].
 1699message(plunit(failed_assertions(0))) -->
 1700    !,
 1701    [].
 1702message(plunit(failed_assertions(1))) -->
 1703    !,
 1704    [ '1 assertion failed'-[] ].
 1705message(plunit(failed_assertions(N))) -->
 1706    [ '~D assertions failed'-[N] ].
 1707message(plunit(sto(0))) -->
 1708    !,
 1709    [].
 1710message(plunit(sto(N))) -->
 1711    [ '~D test results depend on unification mode'-[N] ].
 1712message(plunit(fixme(0,0,0))) -->
 1713    [].
 1714message(plunit(fixme(Failed,0,0))) -->
 1715    !,
 1716    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1717message(plunit(fixme(Failed,Passed,0))) -->
 1718    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1719message(plunit(fixme(Failed,Passed,Nondet))) -->
 1720    { TotalPassed is Passed+Nondet },
 1721    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1722      [Failed, TotalPassed, Nondet] ].
 1723message(plunit(failed(Unit, Name, Line, Failure))) -->
 1724    { unit_file(Unit, File) },
 1725    locationprefix(File:Line),
 1726    test_name(Name),
 1727    [': '-[] ],
 1728    failure(Failure).
 1729:- if(swi). 1730message(plunit(failed_assertion(Unit, Name, Line, AssertLoc,
 1731				_STO, Reason, Goal))) -->
 1732    { unit_file(Unit, File) },
 1733    locationprefix(File:Line),
 1734    test_name(Name),
 1735    [ ': assertion'-[] ],
 1736    assertion_location(AssertLoc, File),
 1737    assertion_reason(Reason), ['\n\t'],
 1738    assertion_goal(Unit, Goal).
 1739
 1740assertion_location(File:Line, File) -->
 1741    [ ' at line ~w'-[Line] ].
 1742assertion_location(File:Line, _) -->
 1743    [ ' at ', url(File:Line) ].
 1744assertion_location(unknown, _) -->
 1745    [].
 1746
 1747assertion_reason(fail) -->
 1748    !,
 1749    [ ' failed'-[] ].
 1750assertion_reason(Error) -->
 1751    { message_to_string(Error, String) },
 1752    [ ' raised "~w"'-[String] ].
 1753
 1754assertion_goal(Unit, Goal) -->
 1755    { unit_module(Unit, Module),
 1756      unqualify(Goal, Module, Plain)
 1757    },
 1758    [ 'Assertion: ~p'-[Plain] ].
 1759
 1760unqualify(Var, _, Var) :-
 1761    var(Var),
 1762    !.
 1763unqualify(M:Goal, Unit, Goal) :-
 1764    nonvar(M),
 1765    unit_module(Unit, M),
 1766    !.
 1767unqualify(M:Goal, _, Goal) :-
 1768    callable(Goal),
 1769    predicate_property(M:Goal, imported_from(system)),
 1770    !.
 1771unqualify(Goal, _, Goal).
 1772
 1773result(passed)        --> ['.'-[]].
 1774result(nondet)        --> ['+'-[]].
 1775result(fixme(passed)) --> ['*'-[]].
 1776result(fixme(failed)) --> ['!'-[]].
 1777result(failed)        --> ['-'-[]].
 1778result(assertion)     --> ['A'-[]].
 1779
 1780:- endif. 1781					% Setup/condition errors
 1782message(plunit(error(Where, Context, Exception))) -->
 1783    locationprefix(Context),
 1784    { message_to_string(Exception, String) },
 1785    [ 'error in ~w: ~w'-[Where, String] ].
 1786
 1787					% STO messages
 1788message(plunit(sto(Unit, Name, Line))) -->
 1789    { unit_file(Unit, File) },
 1790    locationprefix(File:Line),
 1791    test_name(Name),
 1792    [' is subject to occurs check (STO): '-[] ].
 1793message(plunit(sto(Type, Result))) -->
 1794    sto_type(Type),
 1795    sto_result(Result).
 1796
 1797					% Interrupts (SWI)
 1798:- if(swi). 1799message(interrupt(begin)) -->
 1800    { thread_self(Me),
 1801      running(Unit, Test, Line, STO, Me),
 1802      !,
 1803      unit_file(Unit, File)
 1804    },
 1805    [ 'Interrupted test '-[] ],
 1806    running(running(Unit:Test, File:Line, STO, Me)),
 1807    [nl],
 1808    '$messages':prolog_message(interrupt(begin)).
 1809message(interrupt(begin)) -->
 1810    '$messages':prolog_message(interrupt(begin)).
 1811:- endif. 1812
 1813test_name(@(Name,Bindings)) -->
 1814    !,
 1815    [ 'test ~w (forall bindings = ~p)'-[Name, Bindings] ].
 1816test_name(Name) -->
 1817    !,
 1818    [ 'test ~w'-[Name] ].
 1819
 1820sto_type(sto_error_incomplete) -->
 1821    [ 'Finite trees (error checking): ' ].
 1822sto_type(rational_trees) -->
 1823    [ 'Rational trees: ' ].
 1824sto_type(finite_trees) -->
 1825    [ 'Finite trees: ' ].
 1826
 1827sto_result(success(_Unit, _Name, _Line, Det, Time)) -->
 1828    det(Det),
 1829    [ ' success in ~3f seconds'-[Time.cpu] ].
 1830sto_result(failure(_Unit, _Name, _Line, How, _Time)) -->
 1831    failure(How).
 1832
 1833det(true) -->
 1834    [ 'deterministic' ].
 1835det(false) -->
 1836    [ 'non-deterministic' ].
 1837
 1838running(running(Unit:Test, File:Line, STO, Thread)) -->
 1839    thread(Thread),
 1840    [ '~q:~q at '-[Unit, Test], url(File:Line) ],
 1841    current_sto(STO).
 1842running([H|T]) -->
 1843    ['\t'], running(H),
 1844    (   {T == []}
 1845    ->  []
 1846    ;   [nl], running(T)
 1847    ).
 1848
 1849thread(main) --> !.
 1850thread(Other) -->
 1851    [' [~w] '-[Other] ].
 1852
 1853current_sto(sto_error_incomplete) -->
 1854    [ ' (STO: error checking)' ].
 1855current_sto(rational_trees) -->
 1856    [].
 1857current_sto(finite_trees) -->
 1858    [ ' (STO: occurs check enabled)' ].
 1859
 1860:- if(swi). 1861write_term(T, OPS) -->
 1862    ['~@'-[write_term(T,OPS)]].
 1863:- else. 1864write_term(T, _OPS) -->
 1865    ['~q'-[T]].
 1866:- endif. 1867
 1868expected_got_ops_(Ex, E, OPS, Goals) -->
 1869    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 1870    ['    Got:      '-[]], write_term(E,  OPS), [nl],
 1871    ( { Goals = [] } -> []
 1872    ; ['       with: '-[]], write_term(Goals, OPS), [nl]
 1873    ).
 1874
 1875
 1876failure(Var) -->
 1877    { var(Var) },
 1878    !,
 1879    [ 'Unknown failure?' ].
 1880failure(succeeded(Time)) -->
 1881    !,
 1882    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 1883failure(wrong_error(Expected, Error)) -->
 1884    !,
 1885    { copy_term(Expected-Error, Ex-E, Goals),
 1886      numbervars(Ex-E-Goals, 0, _),
 1887      write_options(OPS)
 1888    },
 1889    [ 'wrong error'-[], nl ],
 1890    expected_got_ops_(Ex, E, OPS, Goals).
 1891failure(wrong_answer(Cmp)) -->
 1892    { Cmp =.. [Op,Answer,Expected],
 1893      !,
 1894      copy_term(Expected-Answer, Ex-A, Goals),
 1895      numbervars(Ex-A-Goals, 0, _),
 1896      write_options(OPS)
 1897    },
 1898    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 1899    expected_got_ops_(Ex, A, OPS, Goals).
 1900failure(wrong_answer(CmpExpected, Bindings)) -->
 1901    { (   CmpExpected = all(Cmp)
 1902      ->  Cmp =.. [_Op1,_,Expected],
 1903	  Got = Bindings,
 1904	  Type = all
 1905      ;   CmpExpected = set(Cmp),
 1906	  Cmp =.. [_Op2,_,Expected0],
 1907	  sort(Expected0, Expected),
 1908	  sort(Bindings, Got),
 1909	  Type = set
 1910      )
 1911    },
 1912    [ 'wrong "~w" answer:'-[Type] ],
 1913    [ nl, '    Expected: ~q'-[Expected] ],
 1914    [ nl, '       Found: ~q'-[Got] ].
 1915:- if(swi). 1916failure(cmp_error(_Cmp, Error)) -->
 1917    { message_to_string(Error, Message) },
 1918    [ 'Comparison error: ~w'-[Message] ].
 1919failure(Error) -->
 1920    { Error = error(_,_),
 1921      !,
 1922      message_to_string(Error, Message)
 1923    },
 1924    [ 'received error: ~w'-[Message] ].
 1925:- endif. 1926failure(Why) -->
 1927    [ '~p'-[Why] ].
 1928
 1929fixme_message([]) --> [].
 1930fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 1931    { unit_file(Unit, File) },
 1932    fixme_message(File:Line, Reason, How),
 1933    (   {T == []}
 1934    ->  []
 1935    ;   [nl],
 1936	fixme_message(T)
 1937    ).
 1938
 1939fixme_message(Location, Reason, failed) -->
 1940    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 1941fixme_message(Location, Reason, passed) -->
 1942    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 1943fixme_message(Location, Reason, nondet) -->
 1944    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 1945
 1946
 1947write_options([ numbervars(true),
 1948		quoted(true),
 1949		portray(true),
 1950		max_depth(100),
 1951		attributes(portray)
 1952	      ]).
 1953
 1954:- if(swi). 1955
 1956:- multifile
 1957    prolog:message/3,
 1958    user:message_hook/3. 1959
 1960prolog:message(Term) -->
 1961    message(Term).
 1962
 1963%       user:message_hook(+Term, +Kind, +Lines)
 1964
 1965user:message_hook(make(done(Files)), _, _) :-
 1966    make_run_tests(Files),
 1967    fail.                           % give other hooks a chance
 1968
 1969:- endif. 1970
 1971:- if(sicstus). 1972
 1973user:generate_message_hook(Message) -->
 1974    message(Message),
 1975    [nl].                           % SICStus requires nl at the end
 1976
 1977%!  user:message_hook(+Severity, +Message, +Lines) is semidet.
 1978%
 1979%   Redefine printing some messages. It appears   SICStus has no way
 1980%   to get multiple messages at the same   line, so we roll our own.
 1981%   As there is a lot pre-wired and   checked in the SICStus message
 1982%   handling we cannot reuse the lines. Unless I miss something ...
 1983
 1984user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 1985    format(user_error, '% PL-Unit: ~w ', [Unit]),
 1986    flush_output(user_error).
 1987user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 1988    format(user, ' done~n', []).
 1989
 1990:- endif.