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-2025, 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,                % +Tests
   45	    run_tests/2,                % +Tests, +Options
   46	    load_test_files/1,          % +Options
   47	    running_tests/0,            % Prints currently running test
   48	    current_test/5,             % ?Unit,?Test,?Line,?Body,?Options
   49	    current_test_unit/2,        % ?Unit,?Options
   50	    test_report/1               % +What
   51	  ]).

   59:- autoload(library(statistics), [call_time/2]).   60:- autoload(library(apply),
   61            [maplist/3, include/3, maplist/2, foldl/4, partition/4]).   62:- autoload(library(lists), [member/2, append/2, flatten/2, append/3]).   63:- autoload(library(option), [ option/3, option/2, select_option/3 ]).   64:- autoload(library(ordsets), [ord_intersection/3]).   65:- autoload(library(error), [must_be/2, domain_error/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:- if(exists_source(library(time))).   70:- autoload(library(time), [call_with_time_limit/2]).   71:- endif.   72
   73:- public
   74    unit_module/2.   75
   76:- meta_predicate
   77    valid_options(1, +),
   78    count(0, -).   79
   80		 /*******************************
   81		 *    CONDITIONAL COMPILATION   *
   82		 *******************************/
   83
   84swi     :- catch(current_prolog_flag(dialect, swi),     _, fail).
   85sicstus :- catch(current_prolog_flag(dialect, sicstus), _, fail).
   86
   87throw_error(Error_term,Impldef) :-
   88    throw(error(Error_term,context(Impldef,_))).
   89
   90:- set_prolog_flag(generate_debug_info, false).   91current_test_flag(optimise, Value) =>
   92    current_prolog_flag(optimise, Value).
   93current_test_flag(occurs_check, Value) =>
   94    (   current_prolog_flag(plunit_occurs_check, Value0)
   95    ->  Value = Value0
   96    ;   current_prolog_flag(occurs_check, Value)
   97    ).
   98current_test_flag(Name, Value), atom(Name) =>
   99    atom_concat(plunit_, Name, Flag),
  100    current_prolog_flag(Flag, Value).
  101current_test_flag(Name, Value), var(Name) =>
  102    global_test_option(Opt, _, _Type, _Default),
  103    functor(Opt, Name, 1),
  104    current_test_flag(Name, Value).
  105
  106set_test_flag(Name, Value) :-
  107    Opt =.. [Name, Value],
  108    global_test_option(Opt),
  109    !,
  110    atom_concat(plunit_, Name, Flag),
  111    set_prolog_flag(Flag, Value).
  112set_test_flag(Name, _) :-
  113    domain_error(test_flag, Name).
  114
  115current_test_flags(Flags) :-
  116    findall(Flag, current_test_flag(Flag), Flags).
  117
  118current_test_flag(Opt) :-
  119    current_test_flag(Name, Value),
  120    Opt =.. [Name, Value].
  121
  122% ensure expansion to avoid tracing
  123goal_expansion(forall(C,A),
  124	       \+ (C, \+ A)).
  125goal_expansion(current_module(Module,File),
  126	       module_property(Module, file(File))).
  127
  128
  129		 /*******************************
  130		 *            IMPORTS           *
  131		 *******************************/
  132
  133:- initialization init_flags.  134
  135init_flags :-
  136    (   global_test_option(Option, _Value, Type, Default),
  137	Default \== (-),
  138	Option =.. [Name,_],
  139	atom_concat(plunit_, Name, Flag),
  140        flag_type(Type, FlagType),
  141	create_prolog_flag(Flag, Default, [type(FlagType), keep(true)]),
  142	fail
  143    ;   true
  144    ).
  145
  146flag_type(boolean, FlagType) => FlagType = boolean.
  147flag_type(Type, FlagType), Type = oneof(Atoms), maplist(atom, Atoms) =>
  148    FlagType = Type.
  149flag_type(oneof(_), FlagType) => FlagType = term.
  150flag_type(positive_integer, FlagType) => FlagType = integer.
  151flag_type(number, FlagType) => FlagType = float.

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

format(+Mode)

Currently one of tty or log. tty uses terminal control to overwrite successful tests, allowing the user to see the currently running tests and output from failed tests. This is the default of the output is a tty. log prints a full log of the executed tests and their result and is intended for non-interactive usage.

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.

show_blocked(+Bool)

Show individual blocked tests during the report.

occurs_check(+Mode)

Defines the default for the occurs_check flag during testing.

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.

jobs(Num)

Number of jobs to use for concurrent testing. Default is one, implying sequential testing.

timeout(+Seconds)

Set timeout for each individual test. This acts as a default that may be overuled at the level of units or individual tests. A timeout of 0 or negative is handled as inifinite.

  203set_test_options(Options) :-
  204    flatten([Options], List),
  205    maplist(set_test_option, List).
  206
  207set_test_option(sto(true)) =>
  208    print_message(warning, plunit(sto(true))).
  209set_test_option(jobs(Jobs)) =>
  210    must_be(positive_integer, Jobs),
  211    set_test_option_flag(jobs(Jobs)).
  212set_test_option(Option),
  213  compound(Option), global_test_option(Option) =>
  214    set_test_option_flag(Option).
  215set_test_option(Option) =>
  216    domain_error(option, Option).
  217
  218global_test_option(Opt) :-
  219    global_test_option(Opt, Value, Type, _Default),
  220    must_be(Type, Value).
  221
  222global_test_option(load(Load), Load, oneof([never,always,normal]), normal).
  223global_test_option(output(Cond), Cond, oneof([always,on_failure]), on_failure).
  224global_test_option(format(Feedback), Feedback, oneof([tty,log]), tty).
  225global_test_option(silent(Silent), Silent, boolean, false).
  226global_test_option(show_blocked(Blocked), Blocked, boolean, false).
  227global_test_option(run(When), When, oneof([manual,make,make(all)]), make).
  228global_test_option(occurs_check(Mode), Mode, oneof([false,true,error]), -).
  229global_test_option(cleanup(Bool), Bool, boolean, true).
  230global_test_option(jobs(Count), Count, positive_integer, 1).
  231global_test_option(timeout(Number), Number, number, 3600).
  232
  233set_test_option_flag(Option) :-
  234    Option =.. [Name, Value],
  235    set_test_flag(Name, Value).

 loading_tests

True if tests must be loaded.

  241loading_tests :-
  242    current_test_flag(load, Load),
  243    (   Load == always
  244    ->  true
  245    ;   Load == normal,
  246	\+ current_test_flag(optimise, true)
  247    ).
  248
  249		 /*******************************
  250		 *            MODULE            *
  251		 *******************************/
  252
  253:- thread_local
  254    loading_unit/4.                 % Unit, Module, File, OldSource
  255:- dynamic
  256    current_unit/4,                 % Unit, Module, Context, Options
  257    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).

  265begin_tests(Unit) :-
  266    begin_tests(Unit, []).
  267
  268begin_tests(Unit, Options) :-
  269    must_be(atom, Unit),
  270    map_sto_option(Options, Options1),
  271    valid_options(test_set_option, Options1),
  272    make_unit_module(Unit, Name),
  273    source_location(File, Line),
  274    begin_tests(Unit, Name, File:Line, Options1).
  275
  276map_sto_option(Options0, Options) :-
  277    select_option(sto(Mode), Options0, Options1),
  278    !,
  279    map_sto(Mode, Flag),
  280    Options = [occurs_check(Flag)|Options1].
  281map_sto_option(Options, Options).
  282
  283map_sto(rational_trees, Flag) => Flag = false.
  284map_sto(finite_trees, Flag)   => Flag = true.
  285map_sto(Mode, _) => domain_error(sto, Mode).
  286
  287
  288:- if(swi).  289begin_tests(Unit, Name, File:Line, Options) :-
  290    loading_tests,
  291    !,
  292    '$set_source_module'(Context, Context),
  293    (   current_unit(Unit, Name, Context, Options)
  294    ->  true
  295    ;   retractall(current_unit(Unit, Name, _, _)),
  296	assert(current_unit(Unit, Name, Context, Options))
  297    ),
  298    '$set_source_module'(Old, Name),
  299    '$declare_module'(Name, test, Context, File, Line, false),
  300    discontiguous(Name:'unit test'/4),
  301    '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
  302    discontiguous(Name:'unit body'/2),
  303    asserta(loading_unit(Unit, Name, File, Old)).
  304begin_tests(Unit, Name, File:_Line, _Options) :-
  305    '$set_source_module'(Old, Old),
  306    asserta(loading_unit(Unit, Name, File, Old)).
  307
  308:- else.  309
  310% we cannot use discontiguous as a goal in SICStus Prolog.
  311
  312user:term_expansion((:- begin_tests(Set)),
  313		    [ (:- begin_tests(Set)),
  314		      (:- discontiguous(test/2)),
  315		      (:- discontiguous('unit body'/2)),
  316		      (:- discontiguous('unit test'/4))
  317		    ]).
  318
  319begin_tests(Unit, Name, File:_Line, Options) :-
  320    loading_tests,
  321    !,
  322    (   current_unit(Unit, Name, _, Options)
  323    ->  true
  324    ;   retractall(current_unit(Unit, Name, _, _)),
  325	assert(current_unit(Unit, Name, -, Options))
  326    ),
  327    asserta(loading_unit(Unit, Name, File, -)).
  328begin_tests(Unit, Name, File:_Line, _Options) :-
  329    asserta(loading_unit(Unit, Name, File, -)).
  330
  331:- endif.

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  340end_tests(Unit) :-
  341    loading_unit(StartUnit, _, _, _),
  342    !,
  343    (   Unit == StartUnit
  344    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  345	'$set_source_module'(_, Old)
  346    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  347    ).
  348end_tests(Unit) :-
  349    throw_error(context_error(plunit_close(Unit, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  354:- if(swi).  355
  356unit_module(Unit, Module) :-
  357    atom_concat('plunit_', Unit, Module).
  358
  359make_unit_module(Unit, Module) :-
  360    unit_module(Unit, Module),
  361    (   current_module(Module),
  362	\+ current_unit(_, Module, _, _),
  363	predicate_property(Module:H, _P),
  364	\+ predicate_property(Module:H, imported_from(_M))
  365    ->  throw_error(permission_error(create, plunit, Unit),
  366		    'Existing module')
  367    ;  true
  368    ).
  369
  370:- else.  371
  372:- dynamic
  373    unit_module_store/2.  374
  375unit_module(Unit, Module) :-
  376    unit_module_store(Unit, Module),
  377    !.
  378
  379make_unit_module(Unit, Module) :-
  380    prolog_load_context(module, Module),
  381    assert(unit_module_store(Unit, Module)).
  382
  383:- endif.  384
  385		 /*******************************
  386		 *           EXPANSION          *
  387		 *******************************/

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

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

  394expand_test(Name, Options0, Body,
  395	    [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
  396	      ('unit body'(Id, Vars) :- !, Body)
  397	    ]) :-
  398    source_location(_File, Line),
  399    prolog_load_context(module, Module),
  400    (   prolog_load_context(variable_names, Bindings)
  401    ->  true
  402    ;   Bindings = []
  403    ),
  404    atomic_list_concat([Name, '@line ', Line], Id),
  405    term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
  406    term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
  407    ord_intersection(OptionVars, BodyVars, VarList),
  408    Vars =.. [vars|VarList],
  409    (   is_list(Options0)           % allow for single option without list
  410    ->  Options1 = Options0
  411    ;   Options1 = [Options0]
  412    ),
  413    maplist(expand_option(Bindings), Options1, Options2),
  414    join_true_options(Options2, Options3),
  415    map_sto_option(Options3, Options4),
  416    valid_options(test_option, Options4),
  417    valid_test_mode(Options4, Options).
  418
  419expand_option(_, Var, _) :-
  420    var(Var),
  421    !,
  422    throw_error(instantiation_error,_).
  423expand_option(Bindings, Cmp, true(Cond)) :-
  424    cmp(Cmp),
  425    !,
  426    var_cmp(Bindings, Cmp, Cond).
  427expand_option(_, error(X), throws(error(X, _))) :- !.
  428expand_option(_, exception(X), throws(X)) :- !. % SICStus 4 compatibility
  429expand_option(_, error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
  430expand_option(_, true, true(true)) :- !.
  431expand_option(_, O, O).
  432
  433cmp(_ == _).
  434cmp(_ = _).
  435cmp(_ =@= _).
  436cmp(_ =:= _).
  437
  438var_cmp(Bindings, Expr, cmp(Name, Expr)) :-
  439    arg(_, Expr, Var),
  440    var(Var),
  441    member(Name=V, Bindings),
  442    V == Var,
  443    !.
  444var_cmp(_, Expr, Expr).
  445
  446join_true_options(Options0, Options) :-
  447    partition(true_option, Options0, True, Rest),
  448    True \== [],
  449    !,
  450    maplist(arg(1), True, Conds0),
  451    flatten(Conds0, Conds),
  452    Options = [true(Conds)|Rest].
  453join_true_options(Options, Options).
  454
  455true_option(true(_)).
  456
  457valid_test_mode(Options0, Options) :-
  458    include(test_mode, Options0, Tests),
  459    (   Tests == []
  460    ->  Options = [true([true])|Options0]
  461    ;   Tests = [_]
  462    ->  Options = Options0
  463    ;   throw_error(plunit(incompatible_options, Tests), _)
  464    ).
  465
  466test_mode(true(_)).
  467test_mode(all(_)).
  468test_mode(set(_)).
  469test_mode(fail).
  470test_mode(throws(_)).

 expand(+Term, -Clauses) is semidet

  475expand(end_of_file, _) :-
  476    loading_unit(Unit, _, _, _),
  477    !,
  478    end_tests(Unit),                % warn?
  479    fail.
  480expand((:-end_tests(_)), _) :-
  481    !,
  482    fail.
  483expand(_Term, []) :-
  484    \+ loading_tests.
  485expand((test(Name) :- Body), Clauses) :-
  486    !,
  487    expand_test(Name, [], Body, Clauses).
  488expand((test(Name, Options) :- Body), Clauses) :-
  489    !,
  490    expand_test(Name, Options, Body, Clauses).
  491expand(test(Name), _) :-
  492    !,
  493    throw_error(existence_error(body, test(Name)), _).
  494expand(test(Name, _Options), _) :-
  495    !,
  496    throw_error(existence_error(body, test(Name)), _).
  497
  498:- multifile
  499    system:term_expansion/2.  500
  501system:term_expansion(Term, Expanded) :-
  502    (   loading_unit(_, _, File, _)
  503    ->  source_location(ThisFile, _),
  504	(   File == ThisFile
  505	->  true
  506	;   source_file_property(ThisFile, included_in(File, _))
  507	),
  508	expand(Term, Expanded)
  509    ).
  510
  511
  512		 /*******************************
  513		 *             OPTIONS          *
  514		 *******************************/

 valid_options(:Pred, +Options) is det

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

Errors

- type_error or instantiation_error.

  523valid_options(Pred, Options) :-
  524    must_be(list, Options),
  525    verify_options(Options, Pred).
  526
  527verify_options([], _).
  528verify_options([H|T], Pred) :-
  529    (   call(Pred, H)
  530    ->  verify_options(T, Pred)
  531    ;   throw_error(domain_error(Pred, H), _)
  532    ).
  533
  534valid_options(Pred, Options0, Options, Rest) :-
  535    must_be(list, Options0),
  536    partition(Pred, Options0, Options, Rest).

 test_option(+Option) is semidet

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

  542test_option(Option) :-
  543    test_set_option(Option),
  544    !.
  545test_option(true(_)).
  546test_option(fail).
  547test_option(throws(_)).
  548test_option(all(_)).
  549test_option(set(_)).
  550test_option(nondet).
  551test_option(fixme(_)).
  552test_option(forall(X)) :-
  553    must_be(callable, X).
  554test_option(timeout(Seconds)) :-
  555    must_be(number, Seconds).

 test_option(+Option) is semidet

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

  562test_set_option(blocked(X)) :-
  563    must_be(ground, X).
  564test_set_option(condition(X)) :-
  565    must_be(callable, X).
  566test_set_option(setup(X)) :-
  567    must_be(callable, X).
  568test_set_option(cleanup(X)) :-
  569    must_be(callable, X).
  570test_set_option(occurs_check(V)) :-
  571    must_be(oneof([false,true,error]), V).
  572test_set_option(concurrent(V)) :-
  573    must_be(boolean, V),
  574    print_message(informational, plunit(concurrent)).
  575test_set_option(timeout(Seconds)) :-
  576    must_be(number, Seconds).
  577
  578		 /*******************************
  579		 *             UTIL		*
  580		 *******************************/
  581
  582:- meta_predicate
  583       reify_tmo(0, -, +),
  584       reify(0, -),
  585       capture_output(0,-),
  586       capture_output(0,-,+),
  587       got_messages(0,-).

 reify_tmo(:Goal, -Result, +Options) is det

  591:- if(current_predicate(call_with_time_limit/2)).  592reify_tmo(Goal, Result, Options) :-
  593    option(timeout(Time), Options),
  594    Time > 0,
  595    !,
  596    reify(call_with_time_limit(Time, Goal), Result0),
  597    (   Result0 = throw(time_limit_exceeded)
  598    ->  Result = throw(time_limit_exceeded(Time))
  599    ;   Result = Result0
  600    ).
  601:- endif.  602reify_tmo(Goal, Result, _Options) :-
  603    reify(Goal, Result).

 reify(:Goal, -Result) is det

Call Goal and unify Result with one of true, false or throw(E).

  610reify(Goal, Result) :-
  611    (   catch(Goal, E, true)
  612    ->  (   var(E)
  613	->  Result = true
  614	;   Result = throw(E)
  615	)
  616    ;   Result = false
  617    ).

 capture_output(:Goal, -Output) is semidet

 capture_output(:Goal, -Output, +Options) is semidet

Arguments:

Output

- is a pair Msgs-String, where Msgs is a boolean that is true if there were messages that require a non-zero exit status and Output contains the output as a string.

  626capture_output(Goal, Output) :-
  627    current_test_flag(output, OutputMode),
  628    capture_output(Goal, Output, [output(OutputMode)]).
  629
  630capture_output(Goal, Msgs-Output, Options) :-
  631    option(output(How), Options, always),
  632    (   How == always
  633    ->  call(Goal),
  634        Msgs = false                % irrelavant
  635    ;   with_output_to(string(Output), got_messages(Goal, Msgs),
  636                       [ capture([user_output, user_error]),
  637                         color(true)
  638                       ])
  639    ).

 got_messages(:Goal, -Result)

  643got_messages(Goal, Result) :-
  644    (   current_prolog_flag(on_warning, status)
  645    ;   current_prolog_flag(on_error, status)
  646    ), !,
  647    nb_delete(plunit_got_message),
  648    setup_call_cleanup(
  649        asserta(( user:thread_message_hook(_Term, Kind, _Lines) :-
  650                      got_message(Kind), fail), Ref),
  651        Goal,
  652        erase(Ref)),
  653    (   nb_current(plunit_got_message, true)
  654    ->  Result = true
  655    ;   Result = false
  656    ).
  657got_messages(Goal, false) :-
  658    call(Goal).
  659
  660:- public got_message/1.  661got_message(warning) :-
  662    current_prolog_flag(on_warning, status), !,
  663    nb_setval(plunit_got_message, true).
  664got_message(error) :-
  665    current_prolog_flag(on_error, status), !,
  666    nb_setval(plunit_got_message, true).
  667
  668
  669		 /*******************************
  670		 *        RUNNING TOPLEVEL      *
  671		 *******************************/
  672
  673:- dynamic
  674    output_streams/2,               % Output, Error
  675    test_count/1,                   % Count
  676    passed/5,                       % Unit, Test, Line, Det, Time
  677    failed/5,                       % Unit, Test, Line, Reason, Time
  678    timeout/5,                      % Unit, Test, Line, Limit, Time
  679    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  680    blocked/4,                      % Unit, Test, Line, Reason
  681    fixme/5,                        % Unit, Test, Line, Reason, Status
  682    running/5,                      % Unit, Test, Line, STO, Thread
  683    forall_failures/2.              % Nth, Failures

 run_tests is semidet

 run_tests(+TestSet) is semidet

 run_tests(+TestSet, +Options) 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.

The predicate run_tests/2 is synchronized. Concurrent testing may be achieved using the relevant options. See set_test_options/1. Options are passed to set_test_options/1. In addition the following options are processed:

summary(-Summary)

Unify Summary do a dict holding the keys below. The value of these keys is an integer describing the number of tests. If this option is given, run_tests/2 does not fail if some tests failed.

• total
• passed
• failed
• timeout
• blocked

Arguments:

TestSet

- 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. If TestSet is all, all known tests are executed.

  715run_tests :-
  716    run_tests(all).
  717
  718run_tests(Set) :-
  719    run_tests(Set, []).
  720
  721run_tests(all, Options) :-
  722    !,
  723    findall(Unit, current_test_unit(Unit,_), Units),
  724    run_tests(Units, Options).
  725run_tests(Set, Options) :-
  726    valid_options(global_test_option, Options, Global, Rest),
  727    current_test_flags(Old),
  728    setup_call_cleanup(
  729	set_test_options(Global),
  730	( flatten([Set], List),
  731	  maplist(runnable_tests, List, Units),
  732	  with_mutex(plunit, run_tests_sync(Units, Rest))
  733	),
  734	set_test_options(Old)).
  735
  736run_tests_sync(Units0, Options) :-
  737    cleanup,
  738    count_tests(Units0, Units, Count),
  739    asserta(test_count(Count)),
  740    save_output_state,
  741    setup_call_cleanup(
  742        setup_trap_assertions(Ref),
  743        call_time(setup_jobs_and_run_units(Count, Units, Summary, Options),
  744                  Time),
  745        report_and_cleanup(Ref, Time, Options)),
  746    (   option(summary(Summary), Options)
  747    ->  true
  748    ;   test_summary_passed(Summary) % fail if some test failed
  749    ).
  750
  751setup_jobs_and_run_units(Count, Units, Summary, Options) :-
  752    setup_call_cleanup(
  753        setup_jobs(Count),
  754        ( run_units(Units, Options),
  755          test_summary(_All, Summary)
  756        ),
  757        cleanup_jobs).

 report_and_cleanup(+Ref, +Time, +Options)

Undo changes to the environment (trapping assertions), report the results and cleanup.

  764report_and_cleanup(Ref, Time, Options) :-
  765    cleanup_trap_assertions(Ref),
  766    report(Time, Options),
  767    cleanup_after_test.

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  774run_units(Units, _Options) :-
  775    maplist(schedule_unit, Units),
  776    job_wait(_).

 runnable_tests(+Spec, -Plan) is det

Change a Unit+Test spec into a plain Unit:Tests lists, where blocked tests or tests whose condition fails are already removed. Each test in Tests is a term @(Test,Line), which serves as a unique identifier of the test.

  785:- det(runnable_tests/2).  786runnable_tests(Spec, Unit:RunnableTests) :-
  787    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  788    (   option(blocked(Reason), UnitOptions)
  789    ->  info(plunit(blocked(unit(Unit, Reason)))),
  790        RunnableTests = []
  791    ;   \+ condition(Module, unit(Unit), UnitOptions)
  792    ->  RunnableTests = []
  793    ;   var(Tests)
  794    ->  findall(TestID,
  795                runnable_test(Unit, _Test, Module, TestID),
  796                RunnableTests)
  797    ;   flatten([Tests], TestList),
  798        findall(TestID,
  799                ( member(Test, TestList),
  800                  runnable_test(Unit,Test,Module, TestID)
  801                ),
  802                RunnableTests)
  803    ).
  804
  805runnable_test(Unit, Name, Module, @(Test,Line)) :-
  806    current_test(Unit, Name, Line, _Body, TestOptions),
  807    (   option(blocked(Reason), TestOptions)
  808    ->  Test = blocked(Name, Reason)
  809    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  810        Test = Name
  811    ).
  812
  813unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  814    Unit = Unit0,
  815    Tests = Tests0,
  816    (   current_unit(Unit, Module, _Supers, Options)
  817    ->  true
  818    ;   throw_error(existence_error(unit_test, Unit), _)
  819    ).
  820unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  821    Unit = Unit0,
  822    (   current_unit(Unit, Module, _Supers, Options)
  823    ->  true
  824    ;   throw_error(existence_error(unit_test, Unit), _)
  825    ).

 count_tests(+Units0, -Units, -Count) is det

Count the number of tests to run. A forall(Generator, Test) counts as a single test. During the execution, the concrete tests of the forall are considered "sub tests".

  833count_tests(Units0, Units, Count) :-
  834    count_tests(Units0, Units, 0, Count).
  835
  836count_tests([], T, C0, C) =>
  837    T = [],
  838    C = C0.
  839count_tests([_:[]|T0], T, C0, C) =>
  840    count_tests(T0, T, C0, C).
  841count_tests([Unit:Tests|T0], T, C0, C) =>
  842    partition(is_blocked, Tests, Blocked, Use),
  843    maplist(assert_blocked(Unit), Blocked),
  844    (   Use == []
  845    ->  count_tests(T0, T, C0, C)
  846    ;   length(Use, N),
  847        C1 is C0+N,
  848        T = [Unit:Use|T1],
  849        count_tests(T0, T1, C1, C)
  850    ).
  851
  852is_blocked(@(blocked(_,_),_)) => true.
  853is_blocked(_) => fail.
  854
  855assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  856    assert(blocked(Unit, Test, Line, Reason)).

 run_unit(+Unit) is det

Run a single test unit. Unit is a term Unit:Tests, where Tests is a list of tests to run.

  863run_unit(_Unit:[]) =>
  864    true.
  865run_unit(Unit:Tests) =>
  866    unit_module(Unit, Module),
  867    unit_options(Unit, UnitOptions),
  868    (   setup(Module, unit(Unit), UnitOptions)
  869    ->  begin_unit(Unit),
  870        call_time(run_unit_2(Unit, Tests), Time),
  871        test_summary(Unit, Summary),
  872	end_unit(Unit, Summary.put(time, Time)),
  873        cleanup(Module, UnitOptions)
  874    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  875    ).
  876
  877begin_unit(Unit) :-
  878    job_info(begin(unit(Unit))),
  879    job_feedback(informational, begin(Unit)).
  880
  881end_unit(Unit, Summary) :-
  882    job_info(end(unit(Unit, Summary))),
  883    job_feedback(informational, end(Unit, Summary)).
  884
  885run_unit_2(Unit, Tests) :-
  886    forall(member(Test, Tests),
  887	   run_test(Unit, Test)).
  888
  889
  890unit_options(Unit, Options) :-
  891    current_unit(Unit, _Module, _Supers, Options).
  892
  893
  894cleanup :-
  895    set_flag(plunit_test, 1),
  896    retractall(output_streams(_,_)),
  897    retractall(test_count(_)),
  898    retractall(passed(_, _, _, _, _)),
  899    retractall(failed(_, _, _, _, _)),
  900    retractall(timeout(_, _, _, _, _)),
  901    retractall(failed_assertion(_, _, _, _, _, _, _)),
  902    retractall(blocked(_, _, _, _)),
  903    retractall(fixme(_, _, _, _, _)),
  904    retractall(running(_,_,_,_,_)),
  905    retractall(forall_failures(_,_)).
  906
  907cleanup_after_test :-
  908    (   current_test_flag(cleanup, true)
  909    ->  cleanup
  910    ;   true
  911    ).

 run_tests_in_files(+Files:list) is det

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

  918run_tests_in_files(Files) :-
  919    findall(Unit, unit_in_files(Files, Unit), Units),
  920    (   Units == []
  921    ->  true
  922    ;   run_tests(Units)
  923    ).
  924
  925unit_in_files(Files, Unit) :-
  926    is_list(Files),
  927    !,
  928    member(F, Files),
  929    absolute_file_name(F, Source,
  930		       [ file_type(prolog),
  931			 access(read),
  932			 file_errors(fail)
  933		       ]),
  934    unit_file(Unit, Source).
  935
  936
  937		 /*******************************
  938		 *         HOOKING MAKE/0       *
  939		 *******************************/

 make_run_tests(+Files)

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

  945make_run_tests(Files) :-
  946    current_test_flag(run, When),
  947    (   When == make
  948    ->  run_tests_in_files(Files)
  949    ;   When == make(all)
  950    ->  run_tests
  951    ;   true
  952    ).
  953
  954		 /*******************************
  955		 *      ASSERTION HANDLING      *
  956		 *******************************/
  957
  958:- if(swi).  959
  960:- dynamic prolog:assertion_failed/2.  961
  962setup_trap_assertions(Ref) :-
  963    asserta((prolog:assertion_failed(Reason, Goal) :-
  964		    test_assertion_failed(Reason, Goal)),
  965	    Ref).
  966
  967cleanup_trap_assertions(Ref) :-
  968    erase(Ref).
  969
  970test_assertion_failed(Reason, Goal) :-
  971    thread_self(Me),
  972    running(Unit, Test, Line, Progress, Me),
  973    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  974	assertion_location(Stack, AssertLoc)
  975    ->  true
  976    ;   AssertLoc = unknown
  977    ),
  978    report_failed_assertion(Unit:Test, Line, AssertLoc,
  979			    Progress, Reason, Goal),
  980    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  981				   Progress, Reason, Goal)).
  982
  983assertion_location(Stack, File:Line) :-
  984    append(_, [AssertFrame,CallerFrame|_], Stack),
  985    prolog_stack_frame_property(AssertFrame,
  986				predicate(prolog_debug:assertion/1)),
  987    !,
  988    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  989
  990report_failed_assertion(UnitTest, Line, AssertLoc,
  991			Progress, Reason, Goal) :-
  992    print_message(
  993	error,
  994	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  995				Progress, Reason, Goal))).
  996
  997:- else.  998
  999setup_trap_assertions(_).
 1000cleanup_trap_assertions(_).
 1001
 1002:- endif. 1003
 1004
 1005		 /*******************************
 1006		 *         RUNNING A TEST       *
 1007		 *******************************/

 run_test(+Unit, +Test) is det

Run a single test.

 1013run_test(Unit, @(Test,Line)) :-
 1014    unit_module(Unit, Module),
 1015    Module:'unit test'(Test, Line, TestOptions, Body),
 1016    unit_options(Unit, UnitOptions),
 1017    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).

 run_test(+Unit, +Name, +Line, +UnitOptions, +Options, +Body)

Deals with forall(Generator, Test)

 1023run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1024    option(forall(Generator), Options),
 1025    !,
 1026    unit_module(Unit, Module),
 1027    start_test(Unit, @(Name,Line), Nth),
 1028    State = state(0),
 1029    call_time(forall(Module:Generator,            % may become concurrent
 1030                     (   incr_forall(State, I),
 1031                         run_test_once6(Unit, Name,
 1032                                        forall(Generator, Nth-I), Line,
 1033                                        UnitOptions, Options, Body)
 1034                     )),
 1035                     Time),
 1036    arg(1, State, Generated),
 1037    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1038run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1039    start_test(Unit, @(Name,Line), Nth),
 1040    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1041
 1042start_test(_Unit, _TestID, Nth) :-
 1043    flag(plunit_test, Nth, Nth+1).
 1044
 1045incr_forall(State, I) :-
 1046    arg(1, State, I0),
 1047    I is I0+1,
 1048    nb_setarg(1, State, I).

 run_test_once6(+Unit, +Name, +Progress, +Line, +UnitOptions, +Options, +Body)

Inherit the timeout and occurs_check option (Global -> Unit -> Test).

 1055run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1056    current_test_flag(timeout, DefTimeOut),
 1057    current_test_flag(occurs_check, DefOccurs),
 1058    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1059    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1060    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1061
 1062inherit_option(Name, Options0, Chain, Default, Options) :-
 1063    Term =.. [Name,_Value],
 1064    (   option(Term, Options0)
 1065    ->  Options = Options0
 1066    ;   member(Opts, Chain),
 1067        option(Term, Opts)
 1068    ->  Options = [Term|Options0]
 1069    ;   Default == (-)
 1070    ->  Options = Options0
 1071    ;   Opt =.. [Name,Default],
 1072	Options = [Opt|Options0]
 1073    ).

 run_test_once(+Unit, +Name, +Progress, +Line, +Options, +Body)

Deal with occurs_check, i.e., running the test multiple times with different unification settings wrt. the occurs check.

 1080run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1081    option(occurs_check(Occurs), Options),
 1082    !,
 1083    begin_test(Unit, Name, Line, Progress),
 1084    setup_call_cleanup(
 1085	push_prolog_flag(occurs_check, Occurs),
 1086	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1087		       Output),
 1088	pop_prolog_flag(occurs_check)),
 1089    end_test(Unit, Name, Line, Progress),
 1090    report_result(Result, Progress, Output, Options).
 1091run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1092    begin_test(Unit, Name, Line, Progress),
 1093    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1094		   Output),
 1095    end_test(Unit, Name, Line, Progress),
 1096    report_result(Result, Progress, Output, Options).

 report_result(+Result, +Progress, +Output, +Options) is det

 1100:- det(report_result/4). 1101report_result(failure(Unit, Name, Line, How, Time),
 1102	      Progress, Output, Options) =>
 1103    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1104report_result(success(Unit, Name, Line, Determinism, Time),
 1105	      Progress, Output, Options) =>
 1106    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1107report_result(setup_failed(Unit, Name, Line, Time, Output, Result),
 1108	      Progress, _Output, Options) =>
 1109    failure(Unit, Name, Progress, Line,
 1110            setup_failed(Result), Time, Output, Options).

 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:

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

How is one of:

• succeeded
• Exception
• time_limit_exceeded(Limit)
• 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)

 1132run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1133    option(setup(Setup), Options),
 1134    !,
 1135    unit_module(Unit, Module),
 1136    capture_output(call_time(reify(call_ex(Module, Setup), SetupResult),
 1137                             Time),
 1138                   Output),
 1139    (   SetupResult == true
 1140    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1141        cleanup(Module, Options)
 1142    ;   Result = setup_failed(Unit, Name, Line, Time, Output, SetupResult)
 1143    ).
 1144run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1145    unit_module(Unit, Module),
 1146    run_test_7(Unit, Name, Line, Options, Body, Result),
 1147    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.

 1156run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1157    option(true(Cmp), Options),			   % expected success
 1158    !,
 1159    unit_module(Unit, Module),
 1160    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1161    (   Result0 == true
 1162    ->  cmp_true(Cmp, Module, CmpResult),
 1163	(   CmpResult == []
 1164	->  Result = success(Unit, Name, Line, Det, Time)
 1165	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1166	)
 1167    ;   Result0 == false
 1168    ->  Result = failure(Unit, Name, Line, failed, Time)
 1169    ;   Result0 = throw(E2)
 1170    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1171    ).
 1172run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1173    option(fail, Options),                         % expected failure
 1174    !,
 1175    unit_module(Unit, Module),
 1176    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1177    (   Result0 == true
 1178    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1179    ;   Result0 == false
 1180    ->  Result = success(Unit, Name, Line, true, Time)
 1181    ;   Result0 = throw(E)
 1182    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1183    ).
 1184run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1185    option(throws(Expect), Options),		   % Expected error
 1186    !,
 1187    unit_module(Unit, Module),
 1188    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1189    (   Result0 == true
 1190    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1191    ;   Result0 == false
 1192    ->  Result = failure(Unit, Name, Line, failed, Time)
 1193    ;   Result0 = throw(E)
 1194    ->  (   match_error(Expect, E)
 1195        ->  Result = success(Unit, Name, Line, true, Time)
 1196        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1197        )
 1198    ).
 1199run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1200    option(all(Answer), Options),                  % all(Bindings)
 1201    !,
 1202    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1203run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1204    option(set(Answer), Options),                  % set(Bindings)
 1205    !,
 1206    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.

 1212nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1213    unit_module(Unit, Module),
 1214    result_vars(Expected, Vars),
 1215    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1216                            Result0, Options), Time)
 1217    ->  (   Result0 == true
 1218        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1219            ->  Result = success(Unit, Name, Line, true, Time)
 1220            ;   Result = failure(Unit, Name, Line,
 1221				 [wrong_answer(Expected, Bindings)], Time)
 1222            )
 1223        ;   Result0 = throw(E)
 1224        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1225        )
 1226    ).
 1227
 1228cmp_true([], _, L) =>
 1229    L = [].
 1230cmp_true([Cmp|T], Module, L) =>
 1231    E = error(Formal,_),
 1232    cmp_goal(Cmp, Goal),
 1233    (   catch(Module:Goal, E, true)
 1234    ->  (   var(Formal)
 1235	->  cmp_true(T, Module, L)
 1236	;   L = [cmp_error(Cmp,E)|L1],
 1237	    cmp_true(T, Module, L1)
 1238	)
 1239    ;   L = [wrong_answer(Cmp)|L1],
 1240	cmp_true(T, Module, L1)
 1241    ).
 1242
 1243cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1244cmp_goal(Expr, Goal) => Goal = Expr.

 result_vars(+Expected, -Vars) is det

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

 1252result_vars(Expected, Vars) :-
 1253    arg(1, Expected, CmpOp),
 1254    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

 1264nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1265    cmp(Cmp, _Vars, Op, Values),
 1266    cmp_list(Values, Bindings, Op).
 1267nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1268    cmp(Cmp, _Vars, Op, Values0),
 1269    sort(Bindings0, Bindings),
 1270    sort(Values0, Values),
 1271    cmp_list(Values, Bindings, Op).
 1272
 1273cmp_list([], [], _Op).
 1274cmp_list([E0|ET], [V0|VT], Op) :-
 1275    call(Op, E0, V0),
 1276    cmp_list(ET, VT, Op).

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

 1280cmp(Var  == Value, Var,  ==, Value).
 1281cmp(Var =:= Value, Var, =:=, Value).
 1282cmp(Var  =  Value, Var,  =,  Value).
 1283:- if(swi). 1284cmp(Var =@= Value, Var, =@=, Value).
 1285:- else. 1286:- if(sicstus). 1287cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1288:- endif. 1289:- endif.

 call_det(:Goal, -Det) is nondet

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

 1297:- if((swi;sicstus)). 1298call_det(Goal, Det) :-
 1299    call_cleanup(Goal,Det0=true),
 1300    ( var(Det0) -> Det = false ; Det = true ).
 1301:- else. 1302call_det(Goal, true) :-
 1303    call(Goal).
 1304:- endif.

 match_error(+Expected, +Received) is semidet

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

 1311match_error(Expect, Rec) :-
 1312    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

 1325setup(Module, Context, Options) :-
 1326    option(setup(Setup), Options),
 1327    !,
 1328    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1329    (   Result == true
 1330    ->  true
 1331    ;   print_message(error,
 1332		      plunit(error(setup, Context, Output, Result))),
 1333	fail
 1334    ).
 1335setup(_,_,_).

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

Evaluate the test or test unit condition.

 1341condition(Module, Context, Options) :-
 1342    option(condition(Cond), Options),
 1343    !,
 1344    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1345    (   Result == true
 1346    ->  true
 1347    ;   Result == false
 1348    ->  fail
 1349    ;   print_message(error,
 1350		      plunit(error(condition, Context, Output, Result))),
 1351	fail
 1352    ).
 1353condition(_, _, _).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1360call_ex(Module, Goal) :-
 1361    Module:(expand_goal(Goal, GoalEx),
 1362	    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.

 1369cleanup(Module, Options) :-
 1370    option(cleanup(Cleanup), Options, true),
 1371    (   catch(call_ex(Module, Cleanup), E, true)
 1372    ->  (   var(E)
 1373	->  true
 1374	;   print_message(warning, E)
 1375	)
 1376    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1377    ).
 1378
 1379success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1380    option(fixme(Reason), Options),
 1381    !,
 1382    (   (   Det == true
 1383	;   memberchk(nondet, Options)
 1384	)
 1385    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1386	Ok = passed
 1387    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1388	Ok = nondet
 1389    ),
 1390    flush_output(user_error),
 1391    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1392success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1393    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1394    !,
 1395    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1396success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1397    Output = true-_,
 1398    !,
 1399    failure(Unit, Name, Progress, Line, message, Time, Output, Options).
 1400success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1401    assert(passed(Unit, Name, Line, Det, Time)),
 1402    (   (   Det == true
 1403	;   memberchk(nondet, Options)
 1404	)
 1405    ->  progress(Unit:Name, Progress, passed, Time)
 1406    ;   unit_file(Unit, File),
 1407	print_message(warning, plunit(nondet(File:Line, Unit:Name, Progress)))
 1408    ).

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

Test failed. Report the error.

 1415failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1416  memberchk(fixme(Reason), Options) =>
 1417    assert(fixme(Unit, Name, Line, Reason, failed)),
 1418    progress(Unit:Name, Progress, fixme(failed), Time).
 1419failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1420	Output, Options) =>
 1421    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1422    progress(Unit:Name, Progress, timeout(Limit), Time),
 1423    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1424failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1425    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1426    progress(Unit:Name, Progress, failed, Time),
 1427    report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).

 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.

 1437:- if(swi). 1438assert_cyclic(Term) :-
 1439    acyclic_term(Term),
 1440    !,
 1441    assert(Term).
 1442assert_cyclic(Term) :-
 1443    Term =.. [Functor|Args],
 1444    recorda(cyclic, Args, Id),
 1445    functor(Term, _, Arity),
 1446    length(NewArgs, Arity),
 1447    Head =.. [Functor|NewArgs],
 1448    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1449:- else. 1450:- if(sicstus). 1451:- endif. 1452assert_cyclic(Term) :-
 1453    assert(Term).
 1454:- endif. 1455
 1456
 1457		 /*******************************
 1458		 *             JOBS             *
 1459		 *******************************/
 1460
 1461:- if(current_prolog_flag(threads, true)). 1462
 1463:- dynamic
 1464       job_data/2,		% Queue, Threads
 1465       scheduled_unit/1. 1466
 1467schedule_unit(_:[]) :-
 1468    !.
 1469schedule_unit(UnitAndTests) :-
 1470    UnitAndTests = Unit:_Tests,
 1471    job_data(Queue, _),
 1472    !,
 1473    assertz(scheduled_unit(Unit)),
 1474    thread_send_message(Queue, unit(UnitAndTests)).
 1475schedule_unit(Unit) :-
 1476    run_unit(Unit).

 setup_jobs(+Count) is det

Setup threads for concurrent testing.

 1482setup_jobs(Count) :-
 1483    (   current_test_flag(jobs, Jobs0),
 1484	integer(Jobs0)
 1485    ->  true
 1486    ;   current_prolog_flag(cpu_count, Jobs0)
 1487    ),
 1488    Jobs is min(Count, Jobs0),
 1489    Jobs > 1,
 1490    !,
 1491    message_queue_create(Q, [alias(plunit_jobs)]),
 1492    length(TIDs, Jobs),
 1493    foldl(create_plunit_job(Q), TIDs, 1, _),
 1494    asserta(job_data(Q, TIDs)),
 1495    job_feedback(informational, jobs(Jobs)).
 1496setup_jobs(_) :-
 1497    job_feedback(informational, jobs(1)).
 1498
 1499create_plunit_job(Q, TID, N, N1) :-
 1500    N1 is N + 1,
 1501    atom_concat(plunit_job_, N, Alias),
 1502    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1503
 1504plunit_job(Queue) :-
 1505    repeat,
 1506    (   catch(thread_get_message(Queue, Job,
 1507				 [ timeout(10)
 1508				 ]),
 1509	      error(_,_), fail)
 1510    ->  job(Job),
 1511	fail
 1512    ;   !
 1513    ).
 1514
 1515job(unit(Unit:Tests)) =>
 1516    run_unit(Unit:Tests).
 1517job(test(Unit, Test)) =>
 1518    run_test(Unit, Test).
 1519
 1520cleanup_jobs :-
 1521    retract(job_data(Queue, TIDSs)),
 1522    !,
 1523    message_queue_destroy(Queue),
 1524    maplist(thread_join, TIDSs).
 1525cleanup_jobs.

 job_wait(?Unit) is det

Wait for all test jobs to finish.

 1531job_wait(Unit) :-
 1532    thread_wait(\+ scheduled_unit(Unit),
 1533		[ wait_preds([scheduled_unit/1]),
 1534		  timeout(1)
 1535		]),
 1536    !.
 1537job_wait(Unit) :-
 1538    job_data(_Queue, TIDs),
 1539    member(TID, TIDs),
 1540    thread_property(TID, status(running)),
 1541    !,
 1542    job_wait(Unit).
 1543job_wait(_).
 1544
 1545
 1546job_info(begin(unit(Unit))) =>
 1547    print_message(silent, plunit(begin(Unit))).
 1548job_info(end(unit(Unit, Summary))) =>
 1549    retractall(scheduled_unit(Unit)),
 1550    print_message(silent, plunit(end(Unit, Summary))).
 1551
 1552:- else.			% No jobs
 1553
 1554schedule_unit(Unit) :-
 1555    run_unit(Unit).
 1556
 1557setup_jobs(_) :-
 1558    print_message(silent, plunit(jobs(1))).
 1559cleanup_jobs.
 1560job_wait(_).
 1561job_info(_).
 1562
 1563:- endif. 1564
 1565
 1566
 1567		 /*******************************
 1568		 *            REPORTING         *
 1569		 *******************************/