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	  ]).

   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'(_, _).

 current_test_flag(?Name, ?Value) is nondet

Query flags that control the testing process. Emulates SWI-Prologs flags.

  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).

 set_test_flag(+Name, +Value) is det

  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   ).

 set_test_options(+Options)

Specifies how to deal with test suites. Defined options are:

load(+Load)

Whether or not the tests must be loaded. Values are never, always, normal (only if not optimised)

run(+When)

When the tests are run. Values are manual, make or make(all).

silent(+Bool)

If true (default false), report successful tests using message level silent, only printing errors and warnings.

output(+When)

If always, emit all output as it is produced, if never, suppress all output and if on_failure, emit the output if the test fails.

sto(+Bool)

How to test whether code is subject to occurs check (STO). If false (default), STO is not considered. If true and supported by the hosting Prolog, code is run in all supported unification mode and reported if the results are inconsistent.

cleanup(+Bool)

If true (default =false), cleanup report at the end of run_tests/1. Used to improve cooperation with memory debuggers such as dmalloc.

concurrent(+Bool)

If true (default false), run all tests in a unit concurrently.

  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).

 loading_tests

True if tests must be loaded.

  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

 begin_tests(+UnitName:atom) is det

 begin_tests(+UnitName:atom, Options) is det

Start a test-unit. UnitName is the name of the test set. the unit is ended by :- end_tests(UnitName).

  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.

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  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, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  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		 *******************************/

 expand_test(+Name, +Options, +Body, -Clause) is det

Expand test(Name, Options) :- Body into a clause for 'unit test'/4 and 'unit body'/2.

  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(_)).

 expand(+Term, -Clauses) is semidet

  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.

 valid_options(+Options, :Pred) is det

Verify Options to be a list of valid options according to Pred.

throws

- type_error or instantiation_error.

  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    ).

 test_option(+Option) is semidet

True if Option is a valid option for test(Name, Options).

  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).

 test_option(+Option) is semidet

True if Option is a valid option for :- begin_tests(Name, Options).

  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,-,+).

 reify(:Goal, -Result) is det

  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

 run_tests is semidet

 run_tests(+TestSet) is semidet

Run tests and report about the results. The predicate run_tests/0 runs all known tests that are not blocked. The predicate run_tests/1 takes a specification of tests to run. This is either a single specification or a list of specifications. Each single specification is either the name of a test-unit or a term <test-unit>:<test>, denoting a single test within a unit.

  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    ).

 count_tests(+Spec, -Count) is det

Count the number of tests to run.

  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    ).

 run_tests_in_files(+Files:list) is det

Run all test-units that appear in the given Files.

  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		 *******************************/

 make_run_tests(+Files)

Called indirectly from make/0 after Files have been reloaded.

  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		 *******************************/

 run_test(+Unit, +Name, +Line, +Options, +Body) is det

Run a single test.

  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    ).

 test_caps(-Type, +Unit, +Name, +Line, +Options, +Body, -Result, -Key) is nondet

  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(_, _, _).

 run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det

6th step of the tests. Deals with tests that must be ignored (blocked, conditions fails), setup and cleanup at the test level. Result is one of:

blocked(Unit, Name, Line, Reason)

condition_failed(Unit, Name, Line)

failure(Unit, Name, Line, How, Time)

How is one of:

• succeeded
• Exception
• cmp_error(Cmp, E)
• wrong_answer(Cmp)
• failed
• no_exception
• wrong_error(Expect, E)
• wrong_answer(Expected, Bindings)

success(Unit, Name, Line, Determinism, Time)

setup_failed(Unit, Name, Line)

 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).

 run_test_7(+Unit, +Name, +Line, +Options, :Body, -Result) is det

This step deals with the expected outcome of the test. It runs the actual test and then compares the result to the outcome. There are two main categories: dealing with a single result and all results.

 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).

 non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)

Run tests on non-deterministic predicates.

 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    ).

 result_vars(+Expected, -Vars) is det

Create a term v(V1, ...) containing all variables at the left side of the comparison operator on Expected.

 1147result_vars(Expected, Vars) :-
 1148    arg(1, Expected, CmpOp),
 1149    arg(1, CmpOp, Vars).

 nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet

Compare list/set results for non-deterministic predicates.

bug

- Sort should deal with equivalence on the comparison operator.

To be done

- Properly report errors

 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).

 cmp(+CmpTerm, -Left, -Op, -Right) is det

 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.

 call_det(:Goal, -Det) is nondet

True if Goal succeeded. Det is unified to true if Goal left no choicepoints and false otherwise.

 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.

 match_error(+Expected, +Received) is semidet

True if the Received errors matches the expected error. Matching is based on subsumes_term/2.

 1206match_error(Expect, Rec) :-
 1207    subsumes_term(Expect, Rec).

 setup(+Module, +Context, +Options) is semidet

Call the setup handler and fail if it cannot run for some reason. The condition handler is similar, but failing is not considered an error. Context is one of

unit(Unit)

If it is the setup handler for a unit

test(Unit, Name, Line)

If it is the setup handler for a test

 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(_,_,_).

 condition(+Module, +Context, +Options) is semidet

Evaluate the test or test unit condition.

 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(_, _, _).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1256call_ex(Module, Goal) :-
 1257    Module:(expand_goal(Goal, GoalEx),
 1258		GoalEx).

 cleanup(+Module, +Options) is det

Call the cleanup handler and succeed. Failure or error of the cleanup handler is reported, but tests continue normally.

 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    ).

 failure(+Unit, +Name, +Line, +How, +Time, +Options) is det

Test failed. Report the error.

 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)).

 assert_cyclic(+Term) is det

Assert a possibly cyclic unit clause. Current SWI-Prolog assert/1 does not handle cyclic terms, so we emulate this using the recorded database.

To be done

- Implement cycle-safe assert and remove this.

 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		 *******************************/

 begin_test(Unit, Test, Line, STO) is det

 end_test(Unit, Test, Line, STO) is det

Maintain running/5 and report a test has started/is ended using a silent message:

• plunit(begin(Unit:Test, File:Line, STO))
• plunit(end(Unit:Test, File:Line, STO))

See also

- message_hook/3 for intercepting these messages

 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))).

 running_tests is det

Print the currently running test.

 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).

 current_test(?Unit, ?Test, ?Line, ?Body, ?Options) is nondet

True when a test with the specified properties is loaded.

 1390current_test(Unit, Test, Line, Body, Options) :-
 1391    current_unit(Unit, Module, _Supers, _UnitOptions),
 1392    Module:'unit test'(Test, Line, Options, Body).

 current_test_unit(?Unit, ?Options) is nondet

True when a Unit is a current unit test declared with Options.

 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).

 test_summary(?Unit, -Summary) is det

True if there are no failures, otherwise false.

 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.

 report is det

Print a summary of the tests that ran.

 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))).

 test_report(+What) is det

Produce reports on test results after the run. Currently only supports fixme for What.

 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		 *******************************/

 current_test_set(?Unit) is nondet

True if Unit is a currently loaded test-set.

 1534current_test_set(Unit) :-
 1535    current_unit(Unit, _Module, _Context, _Options).

 unit_file(+Unit, -File) is det

unit_file(-Unit, +File) is nondet

 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		 *******************************/