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

 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.

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

 loading_tests

True if tests must be loaded.

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

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

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

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

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

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

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

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

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

 expand(+Term, -Clauses) is semidet

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

 valid_options(:Pred, +Options) is det

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

Errors

- type_error or instantiation_error.

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

 test_option(+Option) is semidet

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

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

 test_option(+Option) is semidet

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

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

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

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

 reify(:Goal, -Result) is det

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

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

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

 report_and_cleanup(+Ref, +Time, +Options)

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

  711report_and_cleanup(Ref, Time, Options) :-
  712    cleanup_trap_assertions(Ref),
  713    report(Time, Options),
  714    cleanup_after_test.

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  721run_units(Units, _Options) :-
  722    maplist(schedule_unit, Units),
  723    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.

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

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

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

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

 run_tests_in_files(+Files:list) is det

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

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

 make_run_tests(+Files)

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

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

 run_test(+Unit, +Test) is det

Run a single test.

  960run_test(Unit, @(Test,Line)) :-
  961    unit_module(Unit, Module),
  962    Module:'unit test'(Test, Line, TestOptions, Body),
  963    unit_options(Unit, UnitOptions),
  964    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).

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

Deals with forall(Generator, Test)

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

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

 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.

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

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

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

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

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

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

 1197result_vars(Expected, Vars) :-
 1198    arg(1, Expected, CmpOp),
 1199    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

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

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

 1225cmp(Var  == Value, Var,  ==, Value).
 1226cmp(Var =:= Value, Var, =:=, Value).
 1227cmp(Var  =  Value, Var,  =,  Value).
 1228:- if(swi). 1229cmp(Var =@= Value, Var, =@=, Value).
 1230:- else. 1231:- if(sicstus). 1232cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1233:- endif. 1234:- endif.

 call_det(:Goal, -Det) is nondet

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

 1242:- if((swi;sicstus)). 1243call_det(Goal, Det) :-
 1244    call_cleanup(Goal,Det0=true),
 1245    ( var(Det0) -> Det = false ; Det = true ).
 1246:- else. 1247call_det(Goal, true) :-
 1248    call(Goal).
 1249:- endif.

 match_error(+Expected, +Received) is semidet

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

 1256match_error(Expect, Rec) :-
 1257    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

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

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

Evaluate the test or test unit condition.

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

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1305call_ex(Module, Goal) :-
 1306    Module:(expand_goal(Goal, GoalEx),
 1307	    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.

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

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

Test failed. Report the error.

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

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

 setup_jobs(+Count) is det

Setup threads for concurrent testing.

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

 job_wait(?Unit) is det

Wait for all test jobs to finish.

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

 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

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

 running_tests is det

Print the currently running test.

 1540running_tests :-
 1541    running_tests(Running),
 1542    print_message(informational, plunit(running(Running))).
 1543
 1544running_tests(Running) :-
 1545    test_count(Total),
 1546    findall(running(Unit:Test, File:Line, Progress/Total, Thread),
 1547	    (   running(Unit, Test, Line, Progress, Thread),
 1548		unit_file(Unit, File)
 1549	    ), Running).

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

True when a test with the specified properties is loaded.

 1556current_test(Unit, Test, Line, Body, Options) :-
 1557    current_unit(Unit, Module, _Supers, _UnitOptions),
 1558    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.

 1564current_test_unit(Unit, UnitOptions) :-
 1565    current_unit(Unit, _Module, _Supers, UnitOptions).
 1566
 1567
 1568count(Goal, Count) :-
 1569    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.