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-2023, 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), !.
   85swi     :- catch(current_prolog_flag(dialect, yap), _, fail).
   86sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
   87
   88throw_error(Error_term,Impldef) :-
   89    throw(error(Error_term,context(Impldef,_))).
   90
   91:- set_prolog_flag(generate_debug_info, false).   92current_test_flag(optimise, Value) =>
   93    current_prolog_flag(optimise, Value).
   94current_test_flag(occurs_check, Value) =>
   95    (   current_prolog_flag(plunit_occurs_check, Value0)
   96    ->  Value = Value0
   97    ;   current_prolog_flag(occurs_check, Value)
   98    ).
   99current_test_flag(Name, Value), atom(Name) =>
  100    atom_concat(plunit_, Name, Flag),
  101    current_prolog_flag(Flag, Value).
  102current_test_flag(Name, Value), var(Name) =>
  103    global_test_option(Opt, _, _Type, _Default),
  104    functor(Opt, Name, 1),
  105    current_test_flag(Name, Value).
  106
  107set_test_flag(Name, Value) :-
  108    Opt =.. [Name, Value],
  109    global_test_option(Opt),
  110    !,
  111    atom_concat(plunit_, Name, Flag),
  112    set_prolog_flag(Flag, Value).
  113set_test_flag(Name, _) :-
  114    domain_error(test_flag, Name).
  115
  116current_test_flags(Flags) :-
  117    findall(Flag, current_test_flag(Flag), Flags).
  118
  119current_test_flag(Opt) :-
  120    current_test_flag(Name, Value),
  121    Opt =.. [Name, Value].
  122
  123% ensure expansion to avoid tracing
  124goal_expansion(forall(C,A),
  125	       \+ (C, \+ A)).
  126goal_expansion(current_module(Module,File),
  127	       module_property(Module, file(File))).
  128
  129
  130		 /*******************************
  131		 *            IMPORTS           *
  132		 *******************************/
  133
  134:- initialization init_flags.  135
  136init_flags :-
  137    (   global_test_option(Option, _Value, _Type, Default),
  138	Default \== (-),
  139	Option =.. [Name,_],
  140	atom_concat(plunit_, Name, Flag),
  141	create_prolog_flag(Flag, Default, [keep(true)]),
  142	fail
  143    ;   true
  144    ).

 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.

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

 loading_tests

True if tests must be loaded.

  232loading_tests :-
  233    current_test_flag(load, Load),
  234    (   Load == always
  235    ->  true
  236    ;   Load == normal,
  237	\+ current_test_flag(optimise, true)
  238    ).
  239
  240		 /*******************************
  241		 *            MODULE            *
  242		 *******************************/
  243
  244:- dynamic
  245    loading_unit/4,                 % Unit, Module, File, OldSource
  246    current_unit/4,                 % Unit, Module, Context, Options
  247    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).

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

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  330end_tests(Unit) :-
  331    loading_unit(StartUnit, _, _, _),
  332    !,
  333    (   Unit == StartUnit
  334    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  335	'$set_source_module'(_, Old)
  336    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  337    ).
  338end_tests(Unit) :-
  339    throw_error(context_error(plunit_close(Unit, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  344:- if(swi).  345
  346unit_module(Unit, Module) :-
  347    atom_concat('plunit_', Unit, Module).
  348
  349make_unit_module(Unit, Module) :-
  350    unit_module(Unit, Module),
  351    (   current_module(Module),
  352	\+ current_unit(_, Module, _, _),
  353	predicate_property(Module:H, _P),
  354	\+ predicate_property(Module:H, imported_from(_M))
  355    ->  throw_error(permission_error(create, plunit, Unit),
  356		    'Existing module')
  357    ;  true
  358    ).
  359
  360:- else.  361
  362:- dynamic
  363    unit_module_store/2.  364
  365unit_module(Unit, Module) :-
  366    unit_module_store(Unit, Module),
  367    !.
  368
  369make_unit_module(Unit, Module) :-
  370    prolog_load_context(module, Module),
  371    assert(unit_module_store(Unit, Module)).
  372
  373:- endif.  374
  375		 /*******************************
  376		 *           EXPANSION          *
  377		 *******************************/

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

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

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

 expand(+Term, -Clauses) is semidet

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

 valid_options(:Pred, +Options) is det

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

Errors

- type_error or instantiation_error.

  513valid_options(Pred, Options) :-
  514    must_be(list, Options),
  515    verify_options(Options, Pred).
  516
  517verify_options([], _).
  518verify_options([H|T], Pred) :-
  519    (   call(Pred, H)
  520    ->  verify_options(T, Pred)
  521    ;   throw_error(domain_error(Pred, H), _)
  522    ).
  523
  524valid_options(Pred, Options0, Options, Rest) :-
  525    must_be(list, Options0),
  526    partition(Pred, Options0, Options, Rest).

 test_option(+Option) is semidet

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

  532test_option(Option) :-
  533    test_set_option(Option),
  534    !.
  535test_option(true(_)).
  536test_option(fail).
  537test_option(throws(_)).
  538test_option(all(_)).
  539test_option(set(_)).
  540test_option(nondet).
  541test_option(fixme(_)).
  542test_option(forall(X)) :-
  543    must_be(callable, X).
  544test_option(timeout(Seconds)) :-
  545    must_be(number, Seconds).

 test_option(+Option) is semidet

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

  552test_set_option(blocked(X)) :-
  553    must_be(ground, X).
  554test_set_option(condition(X)) :-
  555    must_be(callable, X).
  556test_set_option(setup(X)) :-
  557    must_be(callable, X).
  558test_set_option(cleanup(X)) :-
  559    must_be(callable, X).
  560test_set_option(occurs_check(V)) :-
  561    must_be(oneof([false,true,error]), V).
  562test_set_option(concurrent(V)) :-
  563    must_be(boolean, V),
  564    print_message(informational, plunit(concurrent)).
  565test_set_option(timeout(Seconds)) :-
  566    must_be(number, Seconds).
  567
  568		 /*******************************
  569		 *             UTIL		*
  570		 *******************************/
  571
  572:- meta_predicate
  573       reify_tmo(0, -, +),
  574       reify(0, -),
  575       capture_output(0,-),
  576       capture_output(0,-,+),
  577       got_messages(0,-).

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

  581:- if(current_predicate(call_with_time_limit/2)).  582reify_tmo(Goal, Result, Options) :-
  583    option(timeout(Time), Options),
  584    Time > 0,
  585    !,
  586    reify(call_with_time_limit(Time, Goal), Result0),
  587    (   Result0 = throw(time_limit_exceeded)
  588    ->  Result = throw(time_limit_exceeded(Time))
  589    ;   Result = Result0
  590    ).
  591:- endif.  592reify_tmo(Goal, Result, _Options) :-
  593    reify(Goal, Result).

 reify(:Goal, -Result) is det

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

  600reify(Goal, Result) :-
  601    (   catch(Goal, E, true)
  602    ->  (   var(E)
  603	->  Result = true
  604	;   Result = throw(E)
  605	)
  606    ;   Result = false
  607    ).

 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.

  616capture_output(Goal, Output) :-
  617    current_test_flag(output, OutputMode),
  618    capture_output(Goal, Output, [output(OutputMode)]).
  619
  620capture_output(Goal, Msgs-Output, Options) :-
  621    option(output(How), Options, always),
  622    (   How == always
  623    ->  call(Goal),
  624        Msgs = false                % irrelavant
  625    ;   with_output_to(string(Output), got_messages(Goal, Msgs),
  626                       [ capture([user_output, user_error]),
  627                         color(true)
  628                       ])
  629    ).

 got_messages(:Goal, -Result)

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

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

 report_and_cleanup(+Ref, +Time, +Options)

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

  750report_and_cleanup(Ref, Time, Options) :-
  751    cleanup_trap_assertions(Ref),
  752    report(Time, Options),
  753    cleanup_after_test.

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  760run_units(Units, _Options) :-
  761    maplist(schedule_unit, Units),
  762    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.

  771:- det(runnable_tests/2).  772runnable_tests(Spec, Unit:RunnableTests) :-
  773    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  774    (   option(blocked(Reason), UnitOptions)
  775    ->  info(plunit(blocked(unit(Unit, Reason)))),
  776        RunnableTests = []
  777    ;   \+ condition(Module, unit(Unit), UnitOptions)
  778    ->  RunnableTests = []
  779    ;   var(Tests)
  780    ->  findall(TestID,
  781                runnable_test(Unit, _Test, Module, TestID),
  782                RunnableTests)
  783    ;   flatten([Tests], TestList),
  784        findall(TestID,
  785                ( member(Test, TestList),
  786                  runnable_test(Unit,Test,Module, TestID)
  787                ),
  788                RunnableTests)
  789    ).
  790
  791runnable_test(Unit, Name, Module, @(Test,Line)) :-
  792    current_test(Unit, Name, Line, _Body, TestOptions),
  793    (   option(blocked(Reason), TestOptions)
  794    ->  Test = blocked(Name, Reason)
  795    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  796        Test = Name
  797    ).
  798
  799unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  800    Unit = Unit0,
  801    Tests = Tests0,
  802    (   current_unit(Unit, Module, _Supers, Options)
  803    ->  true
  804    ;   throw_error(existence_error(unit_test, Unit), _)
  805    ).
  806unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  807    Unit = Unit0,
  808    (   current_unit(Unit, Module, _Supers, Options)
  809    ->  true
  810    ;   throw_error(existence_error(unit_test, Unit), _)
  811    ).

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

  819count_tests(Units0, Units, Count) :-
  820    count_tests(Units0, Units, 0, Count).
  821
  822count_tests([], T, C0, C) =>
  823    T = [],
  824    C = C0.
  825count_tests([_:[]|T0], T, C0, C) =>
  826    count_tests(T0, T, C0, C).
  827count_tests([Unit:Tests|T0], T, C0, C) =>
  828    partition(is_blocked, Tests, Blocked, Use),
  829    maplist(assert_blocked(Unit), Blocked),
  830    (   Use == []
  831    ->  count_tests(T0, T, C0, C)
  832    ;   length(Use, N),
  833        C1 is C0+N,
  834        T = [Unit:Use|T1],
  835        count_tests(T0, T1, C1, C)
  836    ).
  837
  838is_blocked(@(blocked(_,_),_)) => true.
  839is_blocked(_) => fail.
  840
  841assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  842    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.

  849run_unit(_Unit:[]) =>
  850    true.
  851run_unit(Unit:Tests) =>
  852    unit_module(Unit, Module),
  853    unit_options(Unit, UnitOptions),
  854    (   setup(Module, unit(Unit), UnitOptions)
  855    ->  begin_unit(Unit),
  856        call_time(run_unit_2(Unit, Tests), Time),
  857        test_summary(Unit, Summary),
  858	end_unit(Unit, Summary.put(time, Time)),
  859        cleanup(Module, UnitOptions)
  860    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  861    ).
  862
  863begin_unit(Unit) :-
  864    job_info(begin(unit(Unit))),
  865    job_feedback(informational, begin(Unit)).
  866
  867end_unit(Unit, Summary) :-
  868    job_info(end(unit(Unit, Summary))),
  869    job_feedback(informational, end(Unit, Summary)).
  870
  871run_unit_2(Unit, Tests) :-
  872    forall(member(Test, Tests),
  873	   run_test(Unit, Test)).
  874
  875
  876unit_options(Unit, Options) :-
  877    current_unit(Unit, _Module, _Supers, Options).
  878
  879
  880cleanup :-
  881    set_flag(plunit_test, 1),
  882    retractall(output_streams(_,_)),
  883    retractall(test_count(_)),
  884    retractall(passed(_, _, _, _, _)),
  885    retractall(failed(_, _, _, _, _)),
  886    retractall(timeout(_, _, _, _, _)),
  887    retractall(failed_assertion(_, _, _, _, _, _, _)),
  888    retractall(blocked(_, _, _, _)),
  889    retractall(fixme(_, _, _, _, _)),
  890    retractall(running(_,_,_,_,_)),
  891    retractall(forall_failures(_,_)).
  892
  893cleanup_after_test :-
  894    (   current_test_flag(cleanup, true)
  895    ->  cleanup
  896    ;   true
  897    ).

 run_tests_in_files(+Files:list) is det

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

  904run_tests_in_files(Files) :-
  905    findall(Unit, unit_in_files(Files, Unit), Units),
  906    (   Units == []
  907    ->  true
  908    ;   run_tests(Units)
  909    ).
  910
  911unit_in_files(Files, Unit) :-
  912    is_list(Files),
  913    !,
  914    member(F, Files),
  915    absolute_file_name(F, Source,
  916		       [ file_type(prolog),
  917			 access(read),
  918			 file_errors(fail)
  919		       ]),
  920    unit_file(Unit, Source).
  921
  922
  923		 /*******************************
  924		 *         HOOKING MAKE/0       *
  925		 *******************************/

 make_run_tests(+Files)

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

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

 run_test(+Unit, +Test) is det

Run a single test.

  999run_test(Unit, @(Test,Line)) :-
 1000    unit_module(Unit, Module),
 1001    Module:'unit test'(Test, Line, TestOptions, Body),
 1002    unit_options(Unit, UnitOptions),
 1003    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).

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

Deals with forall(Generator, Test)

 1009run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1010    option(forall(Generator), Options),
 1011    !,
 1012    unit_module(Unit, Module),
 1013    term_variables(Generator, Vars),
 1014    start_test(Unit, @(Name,Line), Nth),
 1015    State = state(0),
 1016    call_time(forall(Module:Generator,            % may become concurrent
 1017                     (   incr_forall(State, I),
 1018                         run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
 1019                                        UnitOptions, Options, Body)
 1020                     )),
 1021                     Time),
 1022    arg(1, State, Generated),
 1023    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1024run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1025    start_test(Unit, @(Name,Line), Nth),
 1026    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1027
 1028start_test(_Unit, _TestID, Nth) :-
 1029    flag(plunit_test, Nth, Nth+1).
 1030
 1031incr_forall(State, I) :-
 1032    arg(1, State, I0),
 1033    I is I0+1,
 1034    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).

 1041run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1042    current_test_flag(timeout, DefTimeOut),
 1043    current_test_flag(occurs_check, DefOccurs),
 1044    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1045    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1046    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1047
 1048inherit_option(Name, Options0, Chain, Default, Options) :-
 1049    Term =.. [Name,_Value],
 1050    (   option(Term, Options0)
 1051    ->  Options = Options0
 1052    ;   member(Opts, Chain),
 1053        option(Term, Opts)
 1054    ->  Options = [Term|Options0]
 1055    ;   Default == (-)
 1056    ->  Options = Options0
 1057    ;   Opt =.. [Name,Default],
 1058	Options = [Opt|Options0]
 1059    ).

 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.

 1066run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1067    option(occurs_check(Occurs), Options),
 1068    !,
 1069    begin_test(Unit, Name, Line, Progress),
 1070    current_prolog_flag(occurs_check, Old),
 1071    setup_call_cleanup(
 1072	set_prolog_flag(occurs_check, Occurs),
 1073	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1074		       Output),
 1075	set_prolog_flag(occurs_check, Old)),
 1076    end_test(Unit, Name, Line, Progress),
 1077    report_result(Result, Progress, Output, Options).
 1078run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1079    begin_test(Unit, Name, Line, Progress),
 1080    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1081		   Output),
 1082    end_test(Unit, Name, Line, Progress),
 1083    report_result(Result, Progress, Output, Options).

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

 1087:- det(report_result/4). 1088report_result(failure(Unit, Name, Line, How, Time),
 1089	      Progress, Output, Options) :-
 1090    !,
 1091    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1092report_result(success(Unit, Name, Line, Determinism, Time),
 1093	      Progress, Output, Options) :-
 1094    !,
 1095    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1096report_result(setup_failed(_Unit, _Name, _Line),
 1097	      _Progress, _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)

 1119run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1120    option(setup(_Setup), Options),
 1121    !,
 1122    (   unit_module(Unit, Module),
 1123        setup(Module, test(Unit,Name,Line), Options)
 1124    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1125        cleanup(Module, Options)
 1126    ;   Result = setup_failed(Unit, Name, Line)
 1127    ).
 1128run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1129    unit_module(Unit, Module),
 1130    run_test_7(Unit, Name, Line, Options, Body, Result),
 1131    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.

 1140run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1141    option(true(Cmp), Options),			   % expected success
 1142    !,
 1143    unit_module(Unit, Module),
 1144    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1145    (   Result0 == true
 1146    ->  cmp_true(Cmp, Module, CmpResult),
 1147	(   CmpResult == []
 1148	->  Result = success(Unit, Name, Line, Det, Time)
 1149	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1150	)
 1151    ;   Result0 == false
 1152    ->  Result = failure(Unit, Name, Line, failed, Time)
 1153    ;   Result0 = throw(E2)
 1154    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1155    ).
 1156run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1157    option(fail, Options),                         % expected failure
 1158    !,
 1159    unit_module(Unit, Module),
 1160    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1161    (   Result0 == true
 1162    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1163    ;   Result0 == false
 1164    ->  Result = success(Unit, Name, Line, true, Time)
 1165    ;   Result0 = throw(E)
 1166    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1167    ).
 1168run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1169    option(throws(Expect), Options),		   % Expected error
 1170    !,
 1171    unit_module(Unit, Module),
 1172    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1173    (   Result0 == true
 1174    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1175    ;   Result0 == false
 1176    ->  Result = failure(Unit, Name, Line, failed, Time)
 1177    ;   Result0 = throw(E)
 1178    ->  (   match_error(Expect, E)
 1179        ->  Result = success(Unit, Name, Line, true, Time)
 1180        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1181        )
 1182    ).
 1183run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1184    option(all(Answer), Options),                  % all(Bindings)
 1185    !,
 1186    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1187run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1188    option(set(Answer), Options),                  % set(Bindings)
 1189    !,
 1190    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.

 1196nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1197    unit_module(Unit, Module),
 1198    result_vars(Expected, Vars),
 1199    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1200                            Result0, Options), Time)
 1201    ->  (   Result0 == true
 1202        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1203            ->  Result = success(Unit, Name, Line, true, Time)
 1204            ;   Result = failure(Unit, Name, Line,
 1205				 [wrong_answer(Expected, Bindings)], Time)
 1206            )
 1207        ;   Result0 = throw(E)
 1208        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1209        )
 1210    ).
 1211
 1212cmp_true([], _, L) =>
 1213    L = [].
 1214cmp_true([Cmp|T], Module, L) =>
 1215    E = error(Formal,_),
 1216    cmp_goal(Cmp, Goal),
 1217    (   catch(Module:Goal, E, true)
 1218    ->  (   var(Formal)
 1219	->  cmp_true(T, Module, L)
 1220	;   L = [cmp_error(Cmp,E)|L1],
 1221	    cmp_true(T, Module, L1)
 1222	)
 1223    ;   L = [wrong_answer(Cmp)|L1],
 1224	cmp_true(T, Module, L1)
 1225    ).
 1226
 1227cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1228cmp_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.

 1236result_vars(Expected, Vars) :-
 1237    arg(1, Expected, CmpOp),
 1238    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

 1248nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1249    cmp(Cmp, _Vars, Op, Values),
 1250    cmp_list(Values, Bindings, Op).
 1251nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1252    cmp(Cmp, _Vars, Op, Values0),
 1253    sort(Bindings0, Bindings),
 1254    sort(Values0, Values),
 1255    cmp_list(Values, Bindings, Op).
 1256
 1257cmp_list([], [], _Op).
 1258cmp_list([E0|ET], [V0|VT], Op) :-
 1259    call(Op, E0, V0),
 1260    cmp_list(ET, VT, Op).

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

 1264cmp(Var  == Value, Var,  ==, Value).
 1265cmp(Var =:= Value, Var, =:=, Value).
 1266cmp(Var  =  Value, Var,  =,  Value).
 1267:- if(swi). 1268cmp(Var =@= Value, Var, =@=, Value).
 1269:- else. 1270:- if(sicstus). 1271cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1272:- endif. 1273:- endif.

 call_det(:Goal, -Det) is nondet

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

 1281:- if((swi;sicstus)). 1282call_det(Goal, Det) :-
 1283    call_cleanup(Goal,Det0=true),
 1284    ( var(Det0) -> Det = false ; Det = true ).
 1285:- else. 1286call_det(Goal, true) :-
 1287    call(Goal).
 1288:- endif.

 match_error(+Expected, +Received) is semidet

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

 1295match_error(Expect, Rec) :-
 1296    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

 1309setup(Module, Context, Options) :-
 1310    option(setup(Setup), Options),
 1311    !,
 1312    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1313    (   Result == true
 1314    ->  true
 1315    ;   print_message(error,
 1316		      plunit(error(setup, Context, Output, Result))),
 1317	fail
 1318    ).
 1319setup(_,_,_).

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

Evaluate the test or test unit condition.

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

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1344call_ex(Module, Goal) :-
 1345    Module:(expand_goal(Goal, GoalEx),
 1346	    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.

 1353cleanup(Module, Options) :-
 1354    option(cleanup(Cleanup), Options, true),
 1355    (   catch(call_ex(Module, Cleanup), E, true)
 1356    ->  (   var(E)
 1357	->  true
 1358	;   print_message(warning, E)
 1359	)
 1360    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1361    ).
 1362
 1363success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1364    memberchk(fixme(Reason), Options),
 1365    !,
 1366    (   (   Det == true
 1367	;   memberchk(nondet, Options)
 1368	)
 1369    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1370	Ok = passed
 1371    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1372	Ok = nondet
 1373    ),
 1374    flush_output(user_error),
 1375    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1376success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1377    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1378    !,
 1379    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1380success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1381    Output = true-_,
 1382    !,
 1383    failure(Unit, Name, Progress, Line, message, Time, Output, Options).
 1384success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1385    assert(passed(Unit, Name, Line, Det, Time)),
 1386    (   (   Det == true
 1387	;   memberchk(nondet, Options)
 1388	)
 1389    ->  progress(Unit:Name, Progress, passed, Time)
 1390    ;   unit_file(Unit, File),
 1391	print_message(warning, plunit(nondet(File, Line, Name)))
 1392    ).

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

Test failed. Report the error.

 1399failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1400  memberchk(fixme(Reason), Options) =>
 1401    assert(fixme(Unit, Name, Line, Reason, failed)),
 1402    progress(Unit:Name, Progress, fixme(failed), Time).
 1403failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1404	Output, Options) =>
 1405    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1406    progress(Unit:Name, Progress, timeout(Limit), Time),
 1407    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1408failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1409    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1410    progress(Unit:Name, Progress, failed, Time),
 1411    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.

 1421:- if(swi). 1422assert_cyclic(Term) :-
 1423    acyclic_term(Term),
 1424    !,
 1425    assert(Term).
 1426assert_cyclic(Term) :-
 1427    Term =.. [Functor|Args],
 1428    recorda(cyclic, Args, Id),
 1429    functor(Term, _, Arity),
 1430    length(NewArgs, Arity),
 1431    Head =.. [Functor|NewArgs],
 1432    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1433:- else. 1434:- if(sicstus). 1435:- endif. 1436assert_cyclic(Term) :-
 1437    assert(Term).
 1438:- endif. 1439
 1440
 1441		 /*******************************
 1442		 *             JOBS             *
 1443		 *******************************/
 1444
 1445:- if(current_prolog_flag(threads, true)). 1446
 1447:- dynamic
 1448       job_data/2,		% Queue, Threads
 1449       scheduled_unit/1. 1450
 1451schedule_unit(_:[]) :-
 1452    !.
 1453schedule_unit(UnitAndTests) :-
 1454    UnitAndTests = Unit:_Tests,
 1455    job_data(Queue, _),
 1456    !,
 1457    assertz(scheduled_unit(Unit)),
 1458    thread_send_message(Queue, unit(UnitAndTests)).
 1459schedule_unit(Unit) :-
 1460    run_unit(Unit).

 setup_jobs(+Count) is det

Setup threads for concurrent testing.

 1466setup_jobs(Count) :-
 1467    (   current_test_flag(jobs, Jobs0),
 1468	integer(Jobs0)
 1469    ->  true
 1470    ;   current_prolog_flag(cpu_count, Jobs0)
 1471    ),
 1472    Jobs is min(Count, Jobs0),
 1473    Jobs > 1,
 1474    !,
 1475    message_queue_create(Q, [alias(plunit_jobs)]),
 1476    length(TIDs, Jobs),
 1477    foldl(create_plunit_job(Q), TIDs, 1, _),
 1478    asserta(job_data(Q, TIDs)),
 1479    job_feedback(informational, jobs(Jobs)).
 1480setup_jobs(_) :-
 1481    job_feedback(informational, jobs(1)).
 1482
 1483create_plunit_job(Q, TID, N, N1) :-
 1484    N1 is N + 1,
 1485    atom_concat(plunit_job_, N, Alias),
 1486    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1487
 1488plunit_job(Queue) :-
 1489    repeat,
 1490    (   catch(thread_get_message(Queue, Job,
 1491				 [ timeout(10)
 1492				 ]),
 1493	      error(_,_), fail)
 1494    ->  job(Job),
 1495	fail
 1496    ;   !
 1497    ).
 1498
 1499job(unit(Unit:Tests)) =>
 1500    run_unit(Unit:Tests).
 1501job(test(Unit, Test)) =>
 1502    run_test(Unit, Test).
 1503
 1504cleanup_jobs :-
 1505    retract(job_data(Queue, TIDSs)),
 1506    !,
 1507    message_queue_destroy(Queue),
 1508    maplist(thread_join, TIDSs).
 1509cleanup_jobs.

 job_wait(?Unit) is det

Wait for all test jobs to finish.

 1515job_wait(Unit) :-
 1516    thread_wait(\+ scheduled_unit(Unit),
 1517		[ wait_preds([scheduled_unit/1]),
 1518		  timeout(1)
 1519		]),
 1520    !.
 1521job_wait(Unit) :-
 1522    job_data(_Queue, TIDs),
 1523    member(TID, TIDs),
 1524    thread_property(TID, status(running)),
 1525    !,
 1526    job_wait(Unit).
 1527job_wait(_).
 1528
 1529
 1530job_info(begin(unit(Unit))) =>
 1531    print_message(silent, plunit(begin(Unit))).
 1532job_info(end(unit(Unit, Summary))) =>
 1533    retractall(scheduled_unit(Unit)),
 1534    print_message(silent, plunit(end(Unit, Summary))).
 1535
 1536:- else.			% No jobs
 1537
 1538schedule_unit(Unit) :-
 1539    run_unit(Unit).
 1540
 1541setup_jobs(_) :-
 1542    print_message(silent, plunit(jobs(1))).
 1543cleanup_jobs.
 1544job_wait(_).
 1545job_info(_).
 1546
 1547:- endif. 1548
 1549
 1550
 1551		 /*******************************
 1552		 *            REPORTING         *
 1553		 *******************************/

 begin_test(+Unit, +Test, +Line, +Progress) is det

 end_test(+Unit, +Test, +Line, +Progress) is det

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

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

See also

- message_hook/3 for intercepting these messages

 1566begin_test(Unit, Test, Line, Progress) :-
 1567    thread_self(Me),
 1568    assert(running(Unit, Test, Line, Progress, Me)),
 1569    unit_file(Unit, File),
 1570    test_count(Total),
 1571    job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
 1572
 1573end_test(Unit, Test, Line, Progress) :-
 1574    thread_self(Me),
 1575    retractall(running(_,_,_,_,Me)),
 1576    unit_file(Unit, File),
 1577    test_count(Total),
 1578    job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).