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-2024, 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:- dynamic
  254    loading_unit/4,                 % Unit, Module, File, OldSource
  255    current_unit/4,                 % Unit, Module, Context, Options
  256    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).

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

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

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

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

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

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

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

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

 expand(+Term, -Clauses) is semidet

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

 valid_options(:Pred, +Options) is det

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

Errors

- type_error or instantiation_error.

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

 test_option(+Option) is semidet

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

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

 test_option(+Option) is semidet

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

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

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

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

 reify(:Goal, -Result) is det

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

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

 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.

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

 got_messages(:Goal, -Result)

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

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

 report_and_cleanup(+Ref, +Time, +Options)

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

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

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  773run_units(Units, _Options) :-
  774    maplist(schedule_unit, Units),
  775    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.

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

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

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

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

 run_tests_in_files(+Files:list) is det

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

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

 make_run_tests(+Files)

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

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

 run_test(+Unit, +Test) is det

Run a single test.

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

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

Deals with forall(Generator, Test)

 1022run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1023    option(forall(Generator), Options),
 1024    !,
 1025    unit_module(Unit, Module),
 1026    term_variables(Generator, Vars),
 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, forall(Vars, Nth-I), Line,
 1032                                        UnitOptions, Options, Body)
 1033                     )),
 1034                     Time),
 1035    arg(1, State, Generated),
 1036    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1037run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1038    start_test(Unit, @(Name,Line), Nth),
 1039    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1040
 1041start_test(_Unit, _TestID, Nth) :-
 1042    flag(plunit_test, Nth, Nth+1).
 1043
 1044incr_forall(State, I) :-
 1045    arg(1, State, I0),
 1046    I is I0+1,
 1047    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).

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

 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.

 1079run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1080    option(occurs_check(Occurs), Options),
 1081    !,
 1082    begin_test(Unit, Name, Line, Progress),
 1083    current_prolog_flag(occurs_check, Old),
 1084    setup_call_cleanup(
 1085	set_prolog_flag(occurs_check, Occurs),
 1086	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1087		       Output),
 1088	set_prolog_flag(occurs_check, Old)),
 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    memberchk(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, Name)))
 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		 *******************************/