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(time), [call_with_time_limit/2]).   69:- autoload(library(ansi_term), [ansi_format/3]).   70
   71:- meta_predicate
   72    valid_options(1, +),
   73    count(0, -).   74
   75		 /*******************************
   76		 *    CONDITIONAL COMPILATION   *
   77		 *******************************/
   78
   79swi     :- catch(current_prolog_flag(dialect, swi), _, fail), !.
   80swi     :- catch(current_prolog_flag(dialect, yap), _, fail).
   81sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
   82
   83throw_error(Error_term,Impldef) :-
   84    throw(error(Error_term,context(Impldef,_))).
   85
   86:- set_prolog_flag(generate_debug_info, false).   87current_test_flag(optimise, Value) =>
   88    current_prolog_flag(optimise, Value).
   89current_test_flag(occurs_check, Value) =>
   90    (   current_prolog_flag(plunit_occurs_check, Value0)
   91    ->  Value = Value0
   92    ;   current_prolog_flag(occurs_check, Value)
   93    ).
   94current_test_flag(Name, Value), atom(Name) =>
   95    atom_concat(plunit_, Name, Flag),
   96    current_prolog_flag(Flag, Value).
   97current_test_flag(Name, Value), var(Name) =>
   98    global_test_option(Opt, _, _Type, _Default),
   99    functor(Opt, Name, 1),
  100    current_test_flag(Name, Value).
  101
  102set_test_flag(Name, Value) :-
  103    Opt =.. [Name, Value],
  104    global_test_option(Opt),
  105    !,
  106    atom_concat(plunit_, Name, Flag),
  107    set_prolog_flag(Flag, Value).
  108set_test_flag(Name, _) :-
  109    domain_error(test_flag, Name).
  110
  111current_test_flags(Flags) :-
  112    findall(Flag, current_test_flag(Flag), Flags).
  113
  114current_test_flag(Opt) :-
  115    current_test_flag(Name, Value),
  116    Opt =.. [Name, Value].
  117
  118% ensure expansion to avoid tracing
  119goal_expansion(forall(C,A),
  120	       \+ (C, \+ A)).
  121goal_expansion(current_module(Module,File),
  122	       module_property(Module, file(File))).
  123
  124
  125		 /*******************************
  126		 *            IMPORTS           *
  127		 *******************************/
  128
  129:- initialization init_flags.  130
  131init_flags :-
  132    (   global_test_option(Option, _Value, _Type, Default),
  133	Default \== (-),
  134	Option =.. [Name,_],
  135	atom_concat(plunit_, Name, Flag),
  136	create_prolog_flag(Flag, Default, [keep(true)]),
  137	fail
  138    ;   true
  139    ).

 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.

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

 loading_tests

True if tests must be loaded.

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

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

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  325end_tests(Unit) :-
  326    loading_unit(StartUnit, _, _, _),
  327    !,
  328    (   Unit == StartUnit
  329    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  330	'$set_source_module'(_, Old)
  331    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  332    ).
  333end_tests(Unit) :-
  334    throw_error(context_error(plunit_close(Unit, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

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

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

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

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

 expand(+Term, -Clauses) is semidet

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

 valid_options(:Pred, +Options) is det

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

Errors

- type_error or instantiation_error.

  508valid_options(Pred, Options) :-
  509    must_be(list, Options),
  510    verify_options(Options, Pred).
  511
  512verify_options([], _).
  513verify_options([H|T], Pred) :-
  514    (   call(Pred, H)
  515    ->  verify_options(T, Pred)
  516    ;   throw_error(domain_error(Pred, H), _)
  517    ).
  518
  519valid_options(Pred, Options0, Options, Rest) :-
  520    must_be(list, Options0),
  521    partition(Pred, Options0, Options, Rest).

 test_option(+Option) is semidet

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

  527test_option(Option) :-
  528    test_set_option(Option),
  529    !.
  530test_option(true(_)).
  531test_option(fail).
  532test_option(throws(_)).
  533test_option(all(_)).
  534test_option(set(_)).
  535test_option(nondet).
  536test_option(fixme(_)).
  537test_option(forall(X)) :-
  538    must_be(callable, X).
  539test_option(timeout(Seconds)) :-
  540    must_be(number, Seconds).

 test_option(+Option) is semidet

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

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

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

  575reify_tmo(Goal, Result, Options) :-
  576    option(timeout(Time), Options),
  577    Time > 0,
  578    !,
  579    reify(call_with_time_limit(Time, Goal), Result0),
  580    (   Result0 = throw(time_limit_exceeded)
  581    ->  Result = throw(time_limit_exceeded(Time))
  582    ;   Result = Result0
  583    ).
  584reify_tmo(Goal, Result, _Options) :-
  585    reify(Goal, Result).

 reify(:Goal, -Result) is det

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

  592reify(Goal, Result) :-
  593    (   catch(Goal, E, true)
  594    ->  (   var(E)
  595	->  Result = true
  596	;   Result = throw(E)
  597	)
  598    ;   Result = false
  599    ).
  600
  601capture_output(Goal, Output) :-
  602    current_test_flag(output, OutputMode),
  603    capture_output(Goal, Output, [output(OutputMode)]).
  604
  605capture_output(Goal, Output, Options) :-
  606    option(output(How), Options, always),
  607    (   How == always
  608    ->  call(Goal)
  609    ;   with_output_to(string(Output), Goal,
  610                       [ capture([user_output, user_error]),
  611                         color(true)
  612                       ])
  613    ).
  614
  615
  616		 /*******************************
  617		 *        RUNNING TOPLEVEL      *
  618		 *******************************/
  619
  620:- dynamic
  621    output_streams/2,               % Output, Error
  622    test_count/1,                   % Count
  623    passed/5,                       % Unit, Test, Line, Det, Time
  624    failed/5,                       % Unit, Test, Line, Reason, Time
  625    timeout/5,                      % Unit, Test, Line, Limit, Time
  626    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  627    blocked/4,                      % Unit, Test, Line, Reason
  628    fixme/5,                        % Unit, Test, Line, Reason, Status
  629    running/5,                      % Unit, Test, Line, STO, Thread
  630    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.

  662run_tests :-
  663    run_tests(all).
  664
  665run_tests(Set) :-
  666    run_tests(Set, []).
  667
  668run_tests(all, Options) :-
  669    !,
  670    findall(Unit, current_test_unit(Unit,_), Units),
  671    run_tests(Units, Options).
  672run_tests(Set, Options) :-
  673    valid_options(global_test_option, Options, Global, Rest),
  674    current_test_flags(Old),
  675    setup_call_cleanup(
  676	set_test_options(Global),
  677	( flatten([Set], List),
  678	  maplist(runnable_tests, List, Units),
  679	  with_mutex(plunit, run_tests_sync(Units, Rest))
  680	),
  681	set_test_options(Old)).
  682
  683run_tests_sync(Units0, Options) :-
  684    cleanup,
  685    count_tests(Units0, Units, Count),
  686    asserta(test_count(Count)),
  687    save_output_state,
  688    setup_call_cleanup(
  689	setup_jobs(Count),
  690	setup_call_cleanup(
  691	    setup_trap_assertions(Ref),
  692	    ( call_time(run_units(Units, Options), Time),
  693              test_summary(_All, Summary)
  694            ),
  695	    report_and_cleanup(Ref, Time, Options)),
  696	cleanup_jobs),
  697    (   option(summary(Summary), Options)
  698    ->  true
  699    ;   test_summary_passed(Summary) % fail if some test failed
  700    ).

 report_and_cleanup(+Ref, +Time, +Options)

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

  707report_and_cleanup(Ref, Time, Options) :-
  708    cleanup_trap_assertions(Ref),
  709    report(Time, Options),
  710    cleanup_after_test.

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  717run_units(Units, _Options) :-
  718    maplist(schedule_unit, Units),
  719    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.

  728:- det(runnable_tests/2).  729runnable_tests(Spec, Unit:RunnableTests) :-
  730    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  731    (   option(blocked(Reason), UnitOptions)
  732    ->  info(plunit(blocked(unit(Unit, Reason)))),
  733        RunnableTests = []
  734    ;   \+ condition(Module, unit(Unit), UnitOptions)
  735    ->  RunnableTests = []
  736    ;   var(Tests)
  737    ->  findall(TestID,
  738                runnable_test(Unit, _Test, Module, TestID),
  739                RunnableTests)
  740    ;   flatten([Tests], TestList),
  741        findall(TestID,
  742                ( member(Test, TestList),
  743                  runnable_test(Unit,Test,Module, TestID)
  744                ),
  745                RunnableTests)
  746    ).
  747
  748runnable_test(Unit, Name, Module, @(Test,Line)) :-
  749    current_test(Unit, Name, Line, _Body, TestOptions),
  750    (   option(blocked(Reason), TestOptions)
  751    ->  Test = blocked(Name, Reason)
  752    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  753        Test = Name
  754    ).
  755
  756unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  757    Unit = Unit0,
  758    Tests = Tests0,
  759    (   current_unit(Unit, Module, _Supers, Options)
  760    ->  true
  761    ;   throw_error(existence_error(unit_test, Unit), _)
  762    ).
  763unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  764    Unit = Unit0,
  765    (   current_unit(Unit, Module, _Supers, Options)
  766    ->  true
  767    ;   throw_error(existence_error(unit_test, Unit), _)
  768    ).

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

  776count_tests(Units0, Units, Count) :-
  777    count_tests(Units0, Units, 0, Count).
  778
  779count_tests([], T, C0, C) =>
  780    T = [],
  781    C = C0.
  782count_tests([_:[]|T0], T, C0, C) =>
  783    count_tests(T0, T, C0, C).
  784count_tests([Unit:Tests|T0], T, C0, C) =>
  785    partition(is_blocked, Tests, Blocked, Use),
  786    maplist(assert_blocked(Unit), Blocked),
  787    (   Use == []
  788    ->  count_tests(T0, T, C0, C)
  789    ;   length(Use, N),
  790        C1 is C0+N,
  791        T = [Unit:Use|T1],
  792        count_tests(T0, T1, C1, C)
  793    ).
  794
  795is_blocked(@(blocked(_,_),_)) => true.
  796is_blocked(_) => fail.
  797
  798assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  799    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.

  806run_unit(_Unit:[]) =>
  807    true.
  808run_unit(Unit:Tests) =>
  809    unit_module(Unit, Module),
  810    unit_options(Unit, UnitOptions),
  811    (   setup(Module, unit(Unit), UnitOptions)
  812    ->  begin_unit(Unit),
  813        call_time(run_unit_2(Unit, Tests), Time),
  814        test_summary(Unit, Summary),
  815	end_unit(Unit, Summary.put(time, Time)),
  816        cleanup(Module, UnitOptions)
  817    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  818    ).
  819
  820begin_unit(Unit) :-
  821    job_info(begin(unit(Unit))),
  822    job_feedback(informational, begin(Unit)).
  823
  824end_unit(Unit, Summary) :-
  825    job_info(end(unit(Unit, Summary))),
  826    job_feedback(informational, end(Unit, Summary)).
  827
  828run_unit_2(Unit, Tests) :-
  829    forall(member(Test, Tests),
  830	   run_test(Unit, Test)).
  831
  832
  833unit_options(Unit, Options) :-
  834    current_unit(Unit, _Module, _Supers, Options).
  835
  836
  837cleanup :-
  838    set_flag(plunit_test, 1),
  839    retractall(output_streams(_,_)),
  840    retractall(test_count(_)),
  841    retractall(passed(_, _, _, _, _)),
  842    retractall(failed(_, _, _, _, _)),
  843    retractall(timeout(_, _, _, _, _)),
  844    retractall(failed_assertion(_, _, _, _, _, _, _)),
  845    retractall(blocked(_, _, _, _)),
  846    retractall(fixme(_, _, _, _, _)),
  847    retractall(running(_,_,_,_,_)),
  848    retractall(forall_failures(_,_)).
  849
  850cleanup_after_test :-
  851    (   current_test_flag(cleanup, true)
  852    ->  cleanup
  853    ;   true
  854    ).

 run_tests_in_files(+Files:list) is det

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

  861run_tests_in_files(Files) :-
  862    findall(Unit, unit_in_files(Files, Unit), Units),
  863    (   Units == []
  864    ->  true
  865    ;   run_tests(Units)
  866    ).
  867
  868unit_in_files(Files, Unit) :-
  869    is_list(Files),
  870    !,
  871    member(F, Files),
  872    absolute_file_name(F, Source,
  873		       [ file_type(prolog),
  874			 access(read),
  875			 file_errors(fail)
  876		       ]),
  877    unit_file(Unit, Source).
  878
  879
  880		 /*******************************
  881		 *         HOOKING MAKE/0       *
  882		 *******************************/

 make_run_tests(+Files)

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

  888make_run_tests(Files) :-
  889    current_test_flag(run, When),
  890    (   When == make
  891    ->  run_tests_in_files(Files)
  892    ;   When == make(all)
  893    ->  run_tests
  894    ;   true
  895    ).
  896
  897		 /*******************************
  898		 *      ASSERTION HANDLING      *
  899		 *******************************/
  900
  901:- if(swi).  902
  903:- dynamic prolog:assertion_failed/2.  904
  905setup_trap_assertions(Ref) :-
  906    asserta((prolog:assertion_failed(Reason, Goal) :-
  907		    test_assertion_failed(Reason, Goal)),
  908	    Ref).
  909
  910cleanup_trap_assertions(Ref) :-
  911    erase(Ref).
  912
  913test_assertion_failed(Reason, Goal) :-
  914    thread_self(Me),
  915    running(Unit, Test, Line, Progress, Me),
  916    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  917	assertion_location(Stack, AssertLoc)
  918    ->  true
  919    ;   AssertLoc = unknown
  920    ),
  921    report_failed_assertion(Unit:Test, Line, AssertLoc,
  922			    Progress, Reason, Goal),
  923    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  924				   Progress, Reason, Goal)).
  925
  926assertion_location(Stack, File:Line) :-
  927    append(_, [AssertFrame,CallerFrame|_], Stack),
  928    prolog_stack_frame_property(AssertFrame,
  929				predicate(prolog_debug:assertion/1)),
  930    !,
  931    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  932
  933report_failed_assertion(UnitTest, Line, AssertLoc,
  934			Progress, Reason, Goal) :-
  935    print_message(
  936	error,
  937	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  938				Progress, Reason, Goal))).
  939
  940:- else.  941
  942setup_trap_assertions(_).
  943cleanup_trap_assertions(_).
  944
  945:- endif.  946
  947
  948		 /*******************************
  949		 *         RUNNING A TEST       *
  950		 *******************************/

 run_test(+Unit, +Test) is det

Run a single test.

  956run_test(Unit, @(Test,Line)) :-
  957    unit_module(Unit, Module),
  958    Module:'unit test'(Test, Line, TestOptions, Body),
  959    unit_options(Unit, UnitOptions),
  960    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).

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

Deals with forall(Generator, Test)

  966run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
  967    option(forall(Generator), Options),
  968    !,
  969    unit_module(Unit, Module),
  970    term_variables(Generator, Vars),
  971    start_test(Unit, @(Name,Line), Nth),
  972    State = state(0),
  973    call_time(forall(Module:Generator,            % may become concurrent
  974                     (   incr_forall(State, I),
  975                         run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
  976                                        UnitOptions, Options, Body)
  977                     )),
  978                     Time),
  979    arg(1, State, Generated),
  980    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
  981run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
  982    start_test(Unit, @(Name,Line), Nth),
  983    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
  984
  985start_test(_Unit, _TestID, Nth) :-
  986    flag(plunit_test, Nth, Nth+1).
  987
  988incr_forall(State, I) :-
  989    arg(1, State, I0),
  990    I is I0+1,
  991    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).

  998run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
  999    current_test_flag(timeout, DefTimeOut),
 1000    current_test_flag(occurs_check, DefOccurs),
 1001    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1002    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1003    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1004
 1005inherit_option(Name, Options0, Chain, Default, Options) :-
 1006    Term =.. [Name,_Value],
 1007    (   option(Term, Options0)
 1008    ->  Options = Options0
 1009    ;   member(Opts, Chain),
 1010        option(Term, Opts)
 1011    ->  Options = [Term|Options0]
 1012    ;   Default == (-)
 1013    ->  Options = Options0
 1014    ;   Opt =.. [Name,Default],
 1015	Options = [Opt|Options0]
 1016    ).

 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.

 1023run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1024    option(occurs_check(Occurs), Options),
 1025    !,
 1026    begin_test(Unit, Name, Line, Progress),
 1027    current_prolog_flag(occurs_check, Old),
 1028    setup_call_cleanup(
 1029	set_prolog_flag(occurs_check, Occurs),
 1030	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1031		       Output),
 1032	set_prolog_flag(occurs_check, Old)),
 1033    end_test(Unit, Name, Line, Progress),
 1034    report_result(Result, Progress, Output, Options).
 1035run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1036    begin_test(Unit, Name, Line, Progress),
 1037    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1038		   Output),
 1039    end_test(Unit, Name, Line, Progress),
 1040    report_result(Result, Progress, Output, Options).

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

 1044:- det(report_result/4). 1045report_result(failure(Unit, Name, Line, How, Time),
 1046	      Progress, Output, Options) :-
 1047    !,
 1048    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1049report_result(success(Unit, Name, Line, Determinism, Time),
 1050	      Progress, Output, Options) :-
 1051    !,
 1052    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1053report_result(setup_failed(_Unit, _Name, _Line),
 1054	      _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)

 1076run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1077    option(setup(_Setup), Options),
 1078    !,
 1079    (   unit_module(Unit, Module),
 1080        setup(Module, test(Unit,Name,Line), Options)
 1081    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1082        cleanup(Module, Options)
 1083    ;   Result = setup_failed(Unit, Name, Line)
 1084    ).
 1085run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1086    unit_module(Unit, Module),
 1087    run_test_7(Unit, Name, Line, Options, Body, Result),
 1088    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.

 1097run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1098    option(true(Cmp), Options),			   % expected success
 1099    !,
 1100    unit_module(Unit, Module),
 1101    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1102    (   Result0 == true
 1103    ->  cmp_true(Cmp, Module, CmpResult),
 1104	(   CmpResult == []
 1105	->  Result = success(Unit, Name, Line, Det, Time)
 1106	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1107	)
 1108    ;   Result0 == false
 1109    ->  Result = failure(Unit, Name, Line, failed, Time)
 1110    ;   Result0 = throw(E2)
 1111    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1112    ).
 1113run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1114    option(fail, Options),                         % expected failure
 1115    !,
 1116    unit_module(Unit, Module),
 1117    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1118    (   Result0 == true
 1119    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1120    ;   Result0 == false
 1121    ->  Result = success(Unit, Name, Line, true, Time)
 1122    ;   Result0 = throw(E)
 1123    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1124    ).
 1125run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1126    option(throws(Expect), Options),		   % Expected error
 1127    !,
 1128    unit_module(Unit, Module),
 1129    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1130    (   Result0 == true
 1131    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1132    ;   Result0 == false
 1133    ->  Result = failure(Unit, Name, Line, failed, Time)
 1134    ;   Result0 = throw(E)
 1135    ->  (   match_error(Expect, E)
 1136        ->  Result = success(Unit, Name, Line, true, Time)
 1137        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1138        )
 1139    ).
 1140run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1141    option(all(Answer), Options),                  % all(Bindings)
 1142    !,
 1143    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1144run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1145    option(set(Answer), Options),                  % set(Bindings)
 1146    !,
 1147    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.

 1153nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1154    unit_module(Unit, Module),
 1155    result_vars(Expected, Vars),
 1156    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1157                            Result0, Options), Time)
 1158    ->  (   Result0 == true
 1159        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1160            ->  Result = success(Unit, Name, Line, true, Time)
 1161            ;   Result = failure(Unit, Name, Line,
 1162				 [wrong_answer(Expected, Bindings)], Time)
 1163            )
 1164        ;   Result0 = throw(E)
 1165        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1166        )
 1167    ).
 1168
 1169cmp_true([], _, L) =>
 1170    L = [].
 1171cmp_true([Cmp|T], Module, L) =>
 1172    E = error(Formal,_),
 1173    cmp_goal(Cmp, Goal),
 1174    (   catch(Module:Goal, E, true)
 1175    ->  (   var(Formal)
 1176	->  cmp_true(T, Module, L)
 1177	;   L = [cmp_error(Cmp,E)|L1],
 1178	    cmp_true(T, Module, L1)
 1179	)
 1180    ;   L = [wrong_answer(Cmp)|L1],
 1181	cmp_true(T, Module, L1)
 1182    ).
 1183
 1184cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1185cmp_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.

 1193result_vars(Expected, Vars) :-
 1194    arg(1, Expected, CmpOp),
 1195    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

 1205nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1206    cmp(Cmp, _Vars, Op, Values),
 1207    cmp_list(Values, Bindings, Op).
 1208nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1209    cmp(Cmp, _Vars, Op, Values0),
 1210    sort(Bindings0, Bindings),
 1211    sort(Values0, Values),
 1212    cmp_list(Values, Bindings, Op).
 1213
 1214cmp_list([], [], _Op).
 1215cmp_list([E0|ET], [V0|VT], Op) :-
 1216    call(Op, E0, V0),
 1217    cmp_list(ET, VT, Op).

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

 1221cmp(Var  == Value, Var,  ==, Value).
 1222cmp(Var =:= Value, Var, =:=, Value).
 1223cmp(Var  =  Value, Var,  =,  Value).
 1224:- if(swi). 1225cmp(Var =@= Value, Var, =@=, Value).
 1226:- else. 1227:- if(sicstus). 1228cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1229:- endif. 1230:- endif.

 call_det(:Goal, -Det) is nondet

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

 1238:- if((swi;sicstus)). 1239call_det(Goal, Det) :-
 1240    call_cleanup(Goal,Det0=true),
 1241    ( var(Det0) -> Det = false ; Det = true ).
 1242:- else. 1243call_det(Goal, true) :-
 1244    call(Goal).
 1245:- endif.

 match_error(+Expected, +Received) is semidet

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

 1252match_error(Expect, Rec) :-
 1253    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

 1266setup(Module, Context, Options) :-
 1267    option(setup(Setup), Options),
 1268    !,
 1269    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1270    (   Result == true
 1271    ->  true
 1272    ;   print_message(error,
 1273		      plunit(error(setup, Context, Output, Result))),
 1274	fail
 1275    ).
 1276setup(_,_,_).

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

Evaluate the test or test unit condition.

 1282condition(Module, Context, Options) :-
 1283    option(condition(Cond), Options),
 1284    !,
 1285    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1286    (   Result == true
 1287    ->  true
 1288    ;   Result == false
 1289    ->  fail
 1290    ;   print_message(error,
 1291		      plunit(error(condition, Context, Output, Result))),
 1292	fail
 1293    ).
 1294condition(_, _, _).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1301call_ex(Module, Goal) :-
 1302    Module:(expand_goal(Goal, GoalEx),
 1303	    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.

 1310cleanup(Module, Options) :-
 1311    option(cleanup(Cleanup), Options, true),
 1312    (   catch(call_ex(Module, Cleanup), E, true)
 1313    ->  (   var(E)
 1314	->  true
 1315	;   print_message(warning, E)
 1316	)
 1317    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1318    ).
 1319
 1320success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1321    memberchk(fixme(Reason), Options),
 1322    !,
 1323    (   (   Det == true
 1324	;   memberchk(nondet, Options)
 1325	)
 1326    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1327	Ok = passed
 1328    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1329	Ok = nondet
 1330    ),
 1331    flush_output(user_error),
 1332    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1333success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1334    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1335    !,
 1336    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1337success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1338    assert(passed(Unit, Name, Line, Det, Time)),
 1339    (   (   Det == true
 1340	;   memberchk(nondet, Options)
 1341	)
 1342    ->  progress(Unit:Name, Progress, passed, Time)
 1343    ;   unit_file(Unit, File),
 1344	print_message(warning, plunit(nondet(File, Line, Name)))
 1345    ).

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

Test failed. Report the error.

 1352failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1353  memberchk(fixme(Reason), Options) =>
 1354    assert(fixme(Unit, Name, Line, Reason, failed)),
 1355    progress(Unit:Name, Progress, fixme(failed), Time).
 1356failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1357	Output, Options) =>
 1358    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1359    progress(Unit:Name, Progress, timeout(Limit), Time),
 1360    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1361failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1362    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1363    progress(Unit:Name, Progress, failed, Time),
 1364    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.

 1374:- if(swi). 1375assert_cyclic(Term) :-
 1376    acyclic_term(Term),
 1377    !,
 1378    assert(Term).
 1379assert_cyclic(Term) :-
 1380    Term =.. [Functor|Args],
 1381    recorda(cyclic, Args, Id),
 1382    functor(Term, _, Arity),
 1383    length(NewArgs, Arity),
 1384    Head =.. [Functor|NewArgs],
 1385    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1386:- else. 1387:- if(sicstus). 1388:- endif. 1389assert_cyclic(Term) :-
 1390    assert(Term).
 1391:- endif. 1392
 1393
 1394		 /*******************************
 1395		 *             JOBS             *
 1396		 *******************************/
 1397
 1398:- if(current_prolog_flag(threads, true)). 1399
 1400:- dynamic
 1401       job_data/2,		% Queue, Threads
 1402       scheduled_unit/1. 1403
 1404schedule_unit(_:[]) :-
 1405    !.
 1406schedule_unit(UnitAndTests) :-
 1407    UnitAndTests = Unit:_Tests,
 1408    job_data(Queue, _),
 1409    !,
 1410    assertz(scheduled_unit(Unit)),
 1411    thread_send_message(Queue, unit(UnitAndTests)).
 1412schedule_unit(Unit) :-
 1413    run_unit(Unit).

 setup_jobs(+Count) is det

Setup threads for concurrent testing.

 1419setup_jobs(Count) :-
 1420    (   current_test_flag(jobs, Jobs0),
 1421	integer(Jobs0)
 1422    ->  true
 1423    ;   current_prolog_flag(cpu_count, Jobs0)
 1424    ),
 1425    Jobs is min(Count, Jobs0),
 1426    Jobs > 1,
 1427    !,
 1428    message_queue_create(Q, [alias(plunit_jobs)]),
 1429    length(TIDs, Jobs),
 1430    foldl(create_plunit_job(Q), TIDs, 1, _),
 1431    asserta(job_data(Q, TIDs)),
 1432    job_feedback(informational, jobs(Jobs)).
 1433setup_jobs(_) :-
 1434    job_feedback(informational, jobs(1)).
 1435
 1436create_plunit_job(Q, TID, N, N1) :-
 1437    N1 is N + 1,
 1438    atom_concat(plunit_job_, N, Alias),
 1439    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1440
 1441plunit_job(Queue) :-
 1442    repeat,
 1443    (   catch(thread_get_message(Queue, Job,
 1444				 [ timeout(10)
 1445				 ]),
 1446	      error(_,_), fail)
 1447    ->  job(Job),
 1448	fail
 1449    ;   !
 1450    ).
 1451
 1452job(unit(Unit:Tests)) =>
 1453    run_unit(Unit:Tests).
 1454job(test(Unit, Test)) =>
 1455    run_test(Unit, Test).
 1456
 1457cleanup_jobs :-
 1458    retract(job_data(Queue, TIDSs)),
 1459    !,
 1460    message_queue_destroy(Queue),
 1461    maplist(thread_join, TIDSs).
 1462cleanup_jobs.

 job_wait(?Unit) is det

Wait for all test jobs to finish.

 1468job_wait(Unit) :-
 1469    thread_wait(\+ scheduled_unit(Unit),
 1470		[ wait_preds([scheduled_unit/1]),
 1471		  timeout(1)
 1472		]),
 1473    !.
 1474job_wait(Unit) :-
 1475    job_data(_Queue, TIDs),
 1476    member(TID, TIDs),
 1477    thread_property(TID, status(running)),
 1478    !,
 1479    job_wait(Unit).
 1480job_wait(_).
 1481
 1482
 1483job_info(begin(unit(_Unit))) =>
 1484    true.
 1485job_info(end(unit(Unit, _Summary))) =>
 1486    retractall(scheduled_unit(Unit)).
 1487
 1488:- else.			% No jobs
 1489
 1490schedule_unit(Unit) :-
 1491    run_unit(Unit).
 1492
 1493setup_jobs(_) :-
 1494    print_message(silent, plunit(jobs(1))).
 1495cleanup_jobs.
 1496job_wait(_).
 1497job_info(_).
 1498
 1499:- endif. 1500
 1501
 1502
 1503		 /*******************************
 1504		 *            REPORTING         *
 1505		 *******************************/

 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

 1518begin_test(Unit, Test, Line, Progress) :-
 1519    thread_self(Me),
 1520    assert(running(Unit, Test, Line, Progress, Me)),
 1521    unit_file(Unit, File),
 1522    test_count(Total),
 1523    job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
 1524
 1525end_test(Unit, Test, Line, Progress) :-
 1526    thread_self(Me),
 1527    retractall(running(_,_,_,_,Me)),
 1528    unit_file(Unit, File),
 1529    test_count(Total),
 1530    job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).

 running_tests is det

Print the currently running test.

 1536running_tests :-
 1537    running_tests(Running),
 1538    print_message(informational, plunit(running(Running))).
 1539
 1540running_tests(Running) :-
 1541    test_count(Total),
 1542    findall(running(Unit:Test, File:Line, Progress/Total, Thread),
 1543	    (   running(Unit, Test, Line, Progress, Thread),
 1544		unit_file(Unit, File)
 1545	    ), Running).

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

True when a test with the specified properties is loaded.

 1552current_test(Unit, Test, Line, Body, Options) :-
 1553    current_unit(Unit, Module, _Supers, _UnitOptions),
 1554    Module:'unit test'(Test, Line, Options, Body).

 current_test_unit(?Unit, ?Options) is nondet

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

 1560current_test_unit(Unit, UnitOptions) :-
 1561    current_unit(Unit, _Module, _Supers, UnitOptions).
 1562
 1563
 1564count(Goal, Count) :-
 1565    aggregate_all(count, Goal, Count).

 test_summary(?Unit, -Summary) is det

True when Summary is a dict that reports the main statistics about the executed tests.

 1572test_summary(Unit, Summary) :-
 1573    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1574    count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
 1575    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1576    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1577    count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme),
 1578    test_count(Total),
 1579    Summary = plunit{total:Total,
 1580		     passed:Passed,
 1581		     failed:Failed,
 1582		     timeout:Timeout,
 1583		     blocked:Blocked,
 1584		     fixme:Fixme}.
 1585
 1586test_summary_passed(Summary) :-
 1587    _{failed: 0} :< Summary.