View source with raw comments or as raw
    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	  ]).

Unit Testing

Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit https://www.swi-prolog.org/pldoc/package/plunit. */

   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:
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.
 1576test_summary(Unit, Summary) :-
 1577    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1578    count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
 1579    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1580    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1581    count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme),
 1582    test_count(Total),
 1583    Summary = plunit{total:Total,
 1584		     passed:Passed,
 1585		     failed:Failed,
 1586		     timeout:Timeout,
 1587		     blocked:Blocked,
 1588		     fixme:Fixme}.
 1589
 1590test_summary_passed(Summary) :-
 1591    _{failed: 0} :< Summary.
 report(+Time, +Options) is det
Print a summary of the tests that ran.
 1597report(Time, _Options) :-
 1598    test_summary(_, Summary),
 1599    print_message(silent, plunit(Summary)),
 1600    _{ passed:Passed,
 1601       failed:Failed,
 1602       timeout:Timeout,
 1603       blocked:Blocked,
 1604       fixme:Fixme
 1605     } :< Summary,
 1606    (   Passed+Failed+Timeout+Blocked+Fixme =:= 0
 1607    ->  info(plunit(no_tests))
 1608    ;   Failed+Timeout =:= 0
 1609    ->  report_blocked(Blocked),
 1610	report_fixme,
 1611        test_count(Total),
 1612	info(plunit(all_passed(Total, Passed, Time)))
 1613    ;   report_blocked(Blocked),
 1614	report_fixme,
 1615	report_failed(Failed),
 1616	report_timeout(Timeout),
 1617	info(plunit(passed(Passed))),
 1618        info(plunit(total_time(Time)))
 1619    ).
 1620
 1621report_blocked(0) =>
 1622    true.
 1623report_blocked(Blocked) =>
 1624    findall(blocked(Unit:Name, File:Line, Reason),
 1625	    ( blocked(Unit, Name, Line, Reason),
 1626	      unit_file(Unit, File)
 1627	    ),
 1628	    BlockedTests),
 1629    info(plunit(blocked(Blocked, BlockedTests))).
 1630
 1631report_failed(Failed) :-
 1632    print_message(error, plunit(failed(Failed))).
 1633
 1634report_timeout(Count) :-
 1635    print_message(warning, plunit(timeout(Count))).
 1636
 1637report_fixme :-
 1638    report_fixme(_,_,_).
 1639
 1640report_fixme(TuplesF, TuplesP, TuplesN) :-
 1641    fixme(failed, TuplesF, Failed),
 1642    fixme(passed, TuplesP, Passed),
 1643    fixme(nondet, TuplesN, Nondet),
 1644    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1645
 1646
 1647fixme(How, Tuples, Count) :-
 1648    findall(fixme(Unit, Name, Line, Reason, How),
 1649	    fixme(Unit, Name, Line, Reason, How), Tuples),
 1650    length(Tuples, Count).
 1651
 1652report_failure(Unit, Name, Progress, Line, Error,
 1653	       Time, Output, _Options) =>
 1654    test_count(Total),
 1655    job_feedback(error, failed(Unit:Name, Progress/Total, Line,
 1656			       Error, Time, Output)).
 test_report(+What) is det
Produce reports on test results after the run. Currently only supports fixme for What.
 1664test_report(fixme) :-
 1665    !,
 1666    report_fixme(TuplesF, TuplesP, TuplesN),
 1667    append([TuplesF, TuplesP, TuplesN], Tuples),
 1668    print_message(informational, plunit(fixme(Tuples))).
 1669test_report(What) :-
 1670    throw_error(domain_error(report_class, What), _).
 1671
 1672
 1673		 /*******************************
 1674		 *             INFO             *
 1675		 *******************************/
 unit_file(+Unit, -File) is det
unit_file(?Unit, ?File) is nondet
True when the test unit Unit is defined in File.
 1682unit_file(Unit, File), nonvar(Unit) =>
 1683    unit_file_(Unit, File),
 1684    !.
 1685unit_file(Unit, File) =>
 1686    unit_file_(Unit, File).
 1687
 1688unit_file_(Unit, File) :-
 1689    current_unit(Unit, Module, _Context, _Options),
 1690    module_property(Module, file(File)).
 1691unit_file_(Unit, PlFile) :-
 1692    test_file_for(TestFile, PlFile),
 1693    module_property(Module, file(TestFile)),
 1694    current_unit(Unit, Module, _Context, _Options).
 1695
 1696
 1697		 /*******************************
 1698		 *             FILES            *
 1699		 *******************************/
 load_test_files(+Options) is det
Load .plt test-files related to loaded source-files. Options is currently ignored.
 1706load_test_files(_Options) :-
 1707    State = state(0,0),
 1708    (   source_file(File),
 1709	file_name_extension(Base, Old, File),
 1710	Old \== plt,
 1711	file_name_extension(Base, plt, TestFile),
 1712	exists_file(TestFile),
 1713        inc_arg(1, State),
 1714	(   test_file_for(TestFile, File)
 1715	->  true
 1716	;   load_files(TestFile,
 1717		       [ if(changed),
 1718			 imports([])
 1719		       ]),
 1720            inc_arg(2, State),
 1721	    asserta(test_file_for(TestFile, File))
 1722	),
 1723        fail
 1724    ;   State = state(Total, Loaded),
 1725        print_message(informational, plunit(test_files(Total, Loaded)))
 1726    ).
 1727
 1728inc_arg(Arg, State) :-
 1729    arg(Arg, State, N0),
 1730    N is N0+1,
 1731    nb_setarg(Arg, State, N).
 1732
 1733
 1734		 /*******************************
 1735		 *           MESSAGES           *
 1736		 *******************************/
 info(+Term)
Runs print_message(Level, Term), where Level is one of silent or informational (default).
 1743info(Term) :-
 1744    message_level(Level),
 1745    print_message(Level, Term).
 progress(+UnitTest, +Progress, +Result, +Time) is det
Test Unit:Name completed in Time. Result is the result and is one of
passed
failed
assertion
nondet
fixme(passed)
fixme(nondet)
fixme(failed)
forall(end,Nth,FTotal)
Pseudo result for completion of a forall(Gen,Test) set. Mapped to forall(FTotal, FFailed)
 1762progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) =>
 1763    (   retract(forall_failures(Nth, FFailed))
 1764    ->  true
 1765    ;   FFailed = 0
 1766    ),
 1767    test_count(Total),
 1768    job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)).
 1769progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) =>
 1770    with_mutex(plunit_forall_counter,
 1771               update_forall_failures(Nth, Result)),
 1772    test_count(Total),
 1773    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1774progress(UnitTest, Progress, Result, Time) =>
 1775    test_count(Total),
 1776    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1777
 1778update_forall_failures(_Nth, passed) =>
 1779    true.
 1780update_forall_failures(Nth, _) =>
 1781    (   retract(forall_failures(Nth, Failed0))
 1782    ->  true
 1783    ;   Failed0 = 0
 1784    ),
 1785    Failed is Failed0+1,
 1786    asserta(forall_failures(Nth, Failed)).
 1787
 1788message_level(Level) :-
 1789    (   current_test_flag(silent, true)
 1790    ->  Level = silent
 1791    ;   Level = informational
 1792    ).
 1793
 1794locationprefix(File:Line) -->
 1795    !,
 1796    [ url(File:Line), ':'-[], nl, '    ' ].
 1797locationprefix(test(Unit,_Test,Line)) -->
 1798    !,
 1799    { unit_file(Unit, File) },
 1800    locationprefix(File:Line).
 1801locationprefix(unit(Unit)) -->
 1802    !,
 1803    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1804locationprefix(FileLine) -->
 1805    { throw_error(type_error(locationprefix,FileLine), _) }.
 1806
 1807:- discontiguous
 1808    message//1. 1809:- '$hide'(message//1). 1810
 1811message(error(context_error(plunit_close(Name, -)), _)) -->
 1812    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1813message(error(context_error(plunit_close(Name, Start)), _)) -->
 1814    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1815message(plunit(nondet(File, Line, Name))) -->
 1816    locationprefix(File:Line),
 1817    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1818message(error(plunit(incompatible_options, Tests), _)) -->
 1819    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1820message(plunit(sto(true))) -->
 1821    [ 'Option sto(true) is ignored.  See `occurs_check` option.'-[] ].
 1822message(plunit(test_files(Total, Loaded))) -->
 1823    [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ].
 1824
 1825					% Unit start/end
 1826message(plunit(jobs(1))) -->
 1827    !.
 1828message(plunit(jobs(N))) -->
 1829    [ 'Testing with ~D parallel jobs'-[N] ].
 1830message(plunit(begin(_Unit))) -->
 1831    { tty_feedback },
 1832    !.
 1833message(plunit(begin(Unit))) -->
 1834    [ 'Start unit: ~w~n'-[Unit], flush ].
 1835message(plunit(end(_Unit, _Summary))) -->
 1836    { tty_feedback },
 1837    !.
 1838message(plunit(end(Unit, Summary))) -->
 1839    (   {test_summary_passed(Summary)}
 1840    ->  [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
 1841    ;   [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
 1842    ).
 1843message(plunit(blocked(unit(Unit, Reason)))) -->
 1844    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1845message(plunit(running([]))) -->
 1846    !,
 1847    [ 'PL-Unit: no tests running' ].
 1848message(plunit(running([One]))) -->
 1849    !,
 1850    [ 'PL-Unit: running ' ],
 1851    running(One).
 1852message(plunit(running(More))) -->
 1853    !,
 1854    [ 'PL-Unit: running tests:', nl ],
 1855    running(More).
 1856message(plunit(fixme([]))) --> !.
 1857message(plunit(fixme(Tuples))) -->
 1858    !,
 1859    fixme_message(Tuples).
 1860message(plunit(total_time(Time))) -->
 1861    [ 'Test run completed'-[] ],
 1862    test_time(Time).
 1863
 1864					% Blocked tests
 1865message(plunit(blocked(1, Tests))) -->
 1866    !,
 1867    [ 'one test is blocked'-[] ],
 1868    blocked_tests(Tests).
 1869message(plunit(blocked(N, Tests))) -->
 1870    [ '~D tests are blocked'-[N] ],
 1871    blocked_tests(Tests).
 1872
 1873blocked_tests(Tests) -->
 1874    { current_test_flag(show_blocked, true) },
 1875    !,
 1876    [':'-[]],
 1877    list_blocked(Tests).
 1878blocked_tests(_) -->
 1879    [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []),
 1880      ' for details)'-[]
 1881    ].
 1882
 1883list_blocked([]) --> !.
 1884list_blocked([blocked(Unit:Test, Pos, Reason)|T]) -->
 1885    [nl],
 1886    locationprefix(Pos),
 1887    test_name(Unit:Test, -),
 1888    [ ': ~w'-[Reason] ],
 1889    list_blocked(T).
 1890
 1891					% fail/success
 1892message(plunit(no_tests)) -->
 1893    !,
 1894    [ 'No tests to run' ].
 1895message(plunit(all_passed(1, 1, Time))) -->
 1896    !,
 1897    [ 'test passed' ],
 1898    test_time(Time).
 1899message(plunit(all_passed(Total, Total, Time))) -->
 1900    !,
 1901    [ 'All ~D tests passed'-[Total] ],
 1902    test_time(Time).
 1903message(plunit(all_passed(Total, Count, Time))) -->
 1904    !,
 1905    { SubTests is Count-Total },
 1906    [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ],
 1907    test_time(Time).
 1908
 1909test_time(Time) -->
 1910    { var(Time) }, !.
 1911test_time(Time) -->
 1912    [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ].
 1913
 1914message(plunit(passed(Count))) -->
 1915    !,
 1916    [ '~D tests passed'-[Count] ].
 1917message(plunit(failed(0))) -->
 1918    !,
 1919    [].
 1920message(plunit(failed(1))) -->
 1921    !,
 1922    [ '1 test failed'-[] ].
 1923message(plunit(failed(N))) -->
 1924    [ '~D tests failed'-[N] ].
 1925message(plunit(timeout(0))) -->
 1926    !,
 1927    [].
 1928message(plunit(timeout(N))) -->
 1929    [ '~D tests timed out'-[N] ].
 1930message(plunit(fixme(0,0,0))) -->
 1931    [].
 1932message(plunit(fixme(Failed,0,0))) -->
 1933    !,
 1934    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1935message(plunit(fixme(Failed,Passed,0))) -->
 1936    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1937message(plunit(fixme(Failed,Passed,Nondet))) -->
 1938    { TotalPassed is Passed+Nondet },
 1939    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1940      [Failed, TotalPassed, Nondet] ].
 1941
 1942message(plunit(begin(Unit:Test, _Location, Progress))) -->
 1943    { tty_columns(SummaryWidth, _Margin),
 1944      test_name_summary(Unit:Test, SummaryWidth, NameS),
 1945      progress_string(Progress, ProgressS)
 1946    },
 1947    (   { tty_feedback,
 1948	  tty_clear_to_eol(CE)
 1949	}
 1950    ->  [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS,
 1951					     CE], flush ]
 1952    ;   { jobs(_) }
 1953    ->  [ '[~w] ~w ..'-[ProgressS, NameS] ]
 1954    ;   [ '[~w] ~w ..'-[ProgressS, NameS], flush ]
 1955    ).
 1956message(plunit(end(_UnitTest, _Location, _Progress))) -->
 1957    [].
 1958message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
 1959    { Status = forall(_,_)
 1960    ; Status == assertion
 1961    },
 1962    !.
 1963message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
 1964    { jobs(_),
 1965      !,
 1966      tty_columns(SummaryWidth, Margin),
 1967      test_name_summary(Unit:Test, SummaryWidth, NameS),
 1968      progress_string(Progress, ProgressS),
 1969      progress_tag(Status, Tag, _Keep, Style)
 1970    },
 1971    [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|',
 1972	   [ProgressS, NameS, Tag, Time.wall, Margin]) ].
 1973message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
 1974    { tty_columns(_SummaryWidth, Margin),
 1975      progress_tag(Status, Tag, _Keep, Style)
 1976    },
 1977    [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
 1978			 [Tag, Time.wall, Margin]) ],
 1979    (   { tty_feedback }
 1980    ->  [flush]
 1981    ;   []
 1982    ).
 1983message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
 1984    { unit_file(Unit, File) },
 1985    locationprefix(File:Line),
 1986    test_name(Unit:Test, Progress),
 1987    [': '-[] ],
 1988    failure(Failure),
 1989    test_output(Output).
 1990message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
 1991    { unit_file(Unit, File) },
 1992    locationprefix(File:Line),
 1993    test_name(Unit:Test, Progress),
 1994    [': '-[] ],
 1995    timeout(Limit),
 1996    test_output(Output).
 1997:- if(swi). 1998message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
 1999				Progress, Reason, Goal))) -->
 2000    { unit_file(Unit, File) },
 2001    locationprefix(File:Line),
 2002    test_name(Unit:Test, Progress),
 2003    [ ': assertion'-[] ],
 2004    assertion_location(AssertLoc, File),
 2005    assertion_reason(Reason), ['\n\t'],
 2006    assertion_goal(Unit, Goal).
 2007
 2008assertion_location(File:Line, File) -->
 2009    [ ' at line ~w'-[Line] ].
 2010assertion_location(File:Line, _) -->
 2011    [ ' at ', url(File:Line) ].
 2012assertion_location(unknown, _) -->
 2013    [].
 2014
 2015assertion_reason(fail) -->
 2016    !,
 2017    [ ' failed'-[] ].
 2018assertion_reason(Error) -->
 2019    { message_to_string(Error, String) },
 2020    [ ' raised "~w"'-[String] ].
 2021
 2022assertion_goal(Unit, Goal) -->
 2023    { unit_module(Unit, Module),
 2024      unqualify(Goal, Module, Plain)
 2025    },
 2026    [ 'Assertion: ~p'-[Plain] ].
 2027
 2028unqualify(Var, _, Var) :-
 2029    var(Var),
 2030    !.
 2031unqualify(M:Goal, Unit, Goal) :-
 2032    nonvar(M),
 2033    unit_module(Unit, M),
 2034    !.
 2035unqualify(M:Goal, _, Goal) :-
 2036    callable(Goal),
 2037    predicate_property(M:Goal, imported_from(system)),
 2038    !.
 2039unqualify(Goal, _, Goal).
 2040
 2041test_output("") --> [].
 2042test_output(Output) -->
 2043    [ ansi(code, '~s', [Output]) ].
 2044
 2045:- endif. 2046					% Setup/condition errors
 2047message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
 2048    locationprefix(Context),
 2049    { message_to_string(Exception, String) },
 2050    [ 'error in ~w: ~w'-[Where, String] ].
 2051message(plunit(error(Where, Context, _Output, false))) -->
 2052    locationprefix(Context),
 2053    [ 'setup failed in ~w'-[Where] ].
 2054
 2055                                        % delayed output
 2056message(plunit(test_output(_, Output))) -->
 2057    [ '~s'-[Output] ].
 2058					% Interrupts (SWI)
 2059:- if(swi). 2060message(interrupt(begin)) -->
 2061    { thread_self(Me),
 2062      running(Unit, Test, Line, Progress, Me),
 2063      !,
 2064      unit_file(Unit, File),
 2065      restore_output_state
 2066    },
 2067    [ 'Interrupted test '-[] ],
 2068    running(running(Unit:Test, File:Line, Progress, Me)),
 2069    [nl],
 2070    '$messages':prolog_message(interrupt(begin)).
 2071message(interrupt(begin)) -->
 2072    '$messages':prolog_message(interrupt(begin)).
 2073:- endif. 2074
 2075message(concurrent) -->
 2076    [ 'concurrent(true) at the level of units is currently ignored.', nl,
 2077      'See set_test_options/1 with jobs(Count) for concurrent testing.'
 2078    ].
 2079
 2080test_name(Name, forall(Bindings, _Nth-I)) -->
 2081    !,
 2082    test_name(Name, -),
 2083    [ ' (~d-th forall bindings = '-[I],
 2084      ansi(code, '~p', [Bindings]), ')'-[]
 2085    ].
 2086test_name(Name, _) -->
 2087    !,
 2088    [ 'test ', ansi(code, '~q', [Name]) ].
 2089
 2090running(running(Unit:Test, File:Line, _Progress, Thread)) -->
 2091    thread(Thread),
 2092    [ '~q:~q at '-[Unit, Test], url(File:Line) ].
 2093running([H|T]) -->
 2094    ['\t'], running(H),
 2095    (   {T == []}
 2096    ->  []
 2097    ;   [nl], running(T)
 2098    ).
 2099
 2100thread(main) --> !.
 2101thread(Other) -->
 2102    [' [~w] '-[Other] ].
 2103
 2104:- if(swi). 2105write_term(T, OPS) -->
 2106    ['~W'-[T,OPS] ].
 2107:- else. 2108write_term(T, _OPS) -->
 2109    ['~q'-[T]].
 2110:- endif. 2111
 2112expected_got_ops_(Ex, E, OPS, Goals) -->
 2113    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 2114    ['    Got:      '-[]], write_term(E,  OPS), [],
 2115    ( { Goals = [] } -> []
 2116    ; [nl, '       with: '-[]], write_term(Goals, OPS), []
 2117    ).
 2118
 2119
 2120failure(List) -->
 2121    { is_list(List) },
 2122    !,
 2123    [ nl ],
 2124    failures(List).
 2125failure(Var) -->
 2126    { var(Var) },
 2127    !,
 2128    [ 'Unknown failure?' ].
 2129failure(succeeded(Time)) -->
 2130    !,
 2131    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 2132failure(wrong_error(Expected, Error)) -->
 2133    !,
 2134    { copy_term(Expected-Error, Ex-E, Goals),
 2135      numbervars(Ex-E-Goals, 0, _),
 2136      write_options(OPS)
 2137    },
 2138    [ 'wrong error'-[], nl ],
 2139    expected_got_ops_(Ex, E, OPS, Goals).
 2140failure(wrong_answer(cmp(Var, Cmp))) -->
 2141    { Cmp =.. [Op,Answer,Expected],
 2142      !,
 2143      copy_term(Expected-Answer, Ex-A, Goals),
 2144      numbervars(Ex-A-Goals, 0, _),
 2145      write_options(OPS)
 2146    },
 2147    [ 'wrong answer for ', ansi(code, '~w', [Var]),
 2148      ' (compared using ~w)'-[Op], nl ],
 2149    expected_got_ops_(Ex, A, OPS, Goals).
 2150failure(wrong_answer(Cmp)) -->
 2151    { Cmp =.. [Op,Answer,Expected],
 2152      !,
 2153      copy_term(Expected-Answer, Ex-A, Goals),
 2154      numbervars(Ex-A-Goals, 0, _),
 2155      write_options(OPS)
 2156    },
 2157    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 2158    expected_got_ops_(Ex, A, OPS, Goals).
 2159failure(wrong_answer(CmpExpected, Bindings)) -->
 2160    { (   CmpExpected = all(Cmp)
 2161      ->  Cmp =.. [_Op1,_,Expected],
 2162	  Got = Bindings,
 2163	  Type = all
 2164      ;   CmpExpected = set(Cmp),
 2165	  Cmp =.. [_Op2,_,Expected0],
 2166	  sort(Expected0, Expected),
 2167	  sort(Bindings, Got),
 2168	  Type = set
 2169      )
 2170    },
 2171    [ 'wrong "~w" answer:'-[Type] ],
 2172    [ nl, '    Expected: ~q'-[Expected] ],
 2173    [ nl, '       Found: ~q'-[Got] ].
 2174:- if(swi). 2175failure(cmp_error(_Cmp, Error)) -->
 2176    { message_to_string(Error, Message) },
 2177    [ 'Comparison error: ~w'-[Message] ].
 2178failure(throw(Error)) -->
 2179    { Error = error(_,_),
 2180      !,
 2181      message_to_string(Error, Message)
 2182    },
 2183    [ 'received error: ~w'-[Message] ].
 2184:- endif. 2185failure(Why) -->
 2186    [ '~p'-[Why] ].
 2187
 2188failures([]) -->
 2189    !.
 2190failures([H|T]) -->
 2191    !,
 2192    failure(H), [nl],
 2193    failures(T).
 2194
 2195timeout(Limit) -->
 2196    [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
 2197
 2198fixme_message([]) --> [].
 2199fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 2200    { unit_file(Unit, File) },
 2201    fixme_message(File:Line, Reason, How),
 2202    (   {T == []}
 2203    ->  []
 2204    ;   [nl],
 2205	fixme_message(T)
 2206    ).
 2207
 2208fixme_message(Location, Reason, failed) -->
 2209    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 2210fixme_message(Location, Reason, passed) -->
 2211    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 2212fixme_message(Location, Reason, nondet) -->
 2213    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 2214
 2215
 2216write_options([ numbervars(true),
 2217		quoted(true),
 2218		portray(true),
 2219		max_depth(100),
 2220		attributes(portray)
 2221	      ]).
 test_name_summary(+Term, +MaxLen, -Summary) is det
Given the test id, generate string that summarizes this in MaxLen characters.
 2228test_name_summary(Term, MaxLen, Summary) :-
 2229    summary_string(Term, Text),
 2230    atom_length(Text, Len),
 2231    (   Len =< MaxLen
 2232    ->  Summary = Text
 2233    ;   End is MaxLen//2,
 2234        Pre is MaxLen - End - 2,
 2235        sub_string(Text, 0, Pre, _, PreText),
 2236        sub_string(Text, _, End, 0, PostText),
 2237        format(string(Summary), '~w..~w', [PreText,PostText])
 2238    ).
 2239
 2240summary_string(Unit:Test, String) =>
 2241    summary_string(Test, String1),
 2242    atomics_to_string([Unit, String1], :, String).
 2243summary_string(@(Name,Vars), String) =>
 2244    format(string(String), '~W (using ~W)',
 2245           [ Name, [numbervars(true), quoted(false)],
 2246             Vars, [numbervars(true), portray(true), quoted(true)]
 2247           ]).
 2248summary_string(Name, String) =>
 2249    term_string(Name, String, [numbervars(true), quoted(false)]).
 progress_string(+Progress, -S) is det
True when S is a string representation for the test progress.
 2255progress_string(forall(_Vars, N-I)/Total, S) =>
 2256    format(string(S), '~w-~w/~w', [N,I,Total]).
 2257progress_string(Progress, S) =>
 2258    term_string(Progress, S).
 progress_tag(+Status, -Tag, -Keep, -Style) is det
Given a progress status, determine the status tag, whether we must preserve the line and the Style we must use to print the status line.
 2266progress_tag(passed,        Tag, Keep, Style) =>
 2267    Tag = passed, Keep = false, Style = comment.
 2268progress_tag(fixme(passed), Tag, Keep, Style) =>
 2269    Tag = passed, Keep = false, Style = comment.
 2270progress_tag(fixme(_),      Tag, Keep, Style) =>
 2271    Tag = fixme, Keep = true, Style = warning.
 2272progress_tag(nondet,        Tag, Keep, Style) =>
 2273    Tag = '**NONDET', Keep = true, Style = warning.
 2274progress_tag(timeout(_Limit), Tag, Keep, Style) =>
 2275    Tag = '**TIMEOUT', Keep = true, Style = warning.
 2276progress_tag(assertion,     Tag, Keep, Style) =>
 2277    Tag = '**FAILED', Keep = true, Style = error.
 2278progress_tag(failed,        Tag, Keep, Style) =>
 2279    Tag = '**FAILED', Keep = true, Style = error.
 2280progress_tag(forall(_,0),   Tag, Keep, Style) =>
 2281    Tag = passed, Keep = false, Style = comment.
 2282progress_tag(forall(_,_),   Tag, Keep, Style) =>
 2283    Tag = '**FAILED', Keep = true, Style = error.
 2284
 2285
 2286		 /*******************************
 2287		 *           OUTPUT		*
 2288		 *******************************/
 2289
 2290save_output_state :-
 2291    stream_property(Output, alias(user_output)),
 2292    stream_property(Error, alias(user_error)),
 2293    asserta(output_streams(Output, Error)).
 2294
 2295restore_output_state :-
 2296    output_streams(Output, Error),
 2297    !,
 2298    set_stream(Output, alias(user_output)),
 2299    set_stream(Error, alias(user_error)).
 2300restore_output_state.
 2301
 2302
 2303
 2304		 /*******************************
 2305		 *      CONCURRENT STATUS       *
 2306		 *******************************/
 2307
 2308/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2309This part deals with interactive feedback   when we are running multiple
 2310threads. The terminal window cannot work on   top  of the Prolog message
 2311infrastructure and (thus) we have to use more low-level means.
 2312- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2313
 2314:- dynamic
 2315       jobs/1,			% Count
 2316       job_window/1,		% Count
 2317       job_status_line/3.	% Job, Format, Args
 2318
 2319job_feedback(_, jobs(Jobs)) :-
 2320    retractall(jobs(_)),
 2321    Jobs > 1,
 2322    asserta(jobs(Jobs)),
 2323    tty_feedback,
 2324    !,
 2325    retractall(job_window(_)),
 2326    asserta(job_window(Jobs)),
 2327    retractall(job_status_line(_,_,_)),
 2328    jobs_redraw.
 2329job_feedback(_, jobs(Jobs)) :-
 2330    !,
 2331    retractall(job_window(_)),
 2332    info(plunit(jobs(Jobs))).
 2333job_feedback(_, Msg) :-
 2334    job_window(_),
 2335    !,
 2336    with_mutex(plunit_feedback, job_feedback(Msg)).
 2337job_feedback(Level, Msg) :-
 2338    print_message(Level, plunit(Msg)).
 2339
 2340job_feedback(begin(Unit:Test, _Location, Progress)) =>
 2341    tty_columns(SummaryWidth, _Margin),
 2342    test_name_summary(Unit:Test, SummaryWidth, NameS),
 2343    progress_string(Progress, ProgressS),
 2344    tty_clear_to_eol(CE),
 2345    job_format(comment, '\r[~w] ~w ..~w',
 2346	       [ProgressS, NameS, CE]),
 2347    flush_output.
 2348job_feedback(end(_UnitTest, _Location, _Progress)) =>
 2349    true.
 2350job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
 2351    (   hide_progress(Status)
 2352    ->  true
 2353    ;   tty_columns(_SummaryWidth, Margin),
 2354	progress_tag(Status, Tag, _Keep, Style),
 2355	job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2356		   [Tag, Time.wall, Margin])
 2357    ).
 2358job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
 2359    tty_columns(_SummaryWidth, Margin),
 2360    progress_tag(failed, Tag, _Keep, Style),
 2361    job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2362	       [Tag, Time.wall, Margin]),
 2363    print_test_output(Error, Output),
 2364    (   (   Error = timeout(_)	% Status line suffices
 2365	;   Error == assertion	% We will get an failed test later
 2366	)
 2367    ->  true
 2368    ;   print_message(Style, plunit(failed(UnitTest, Progress, Line,
 2369					   Error, Time, "")))
 2370    ),
 2371    jobs_redraw.
 2372job_feedback(begin(_Unit)) => true.
 2373job_feedback(end(_Unit, _Summary)) => true.
 2374
 2375hide_progress(assertion).
 2376hide_progress(forall(_,_)).
 2377hide_progress(failed).
 2378hide_progress(timeout(_)).
 2379
 2380print_test_output(_, "") => true.
 2381print_test_output(assertion, Output) =>
 2382    print_message(debug, plunit(test_output(error, Output))).
 2383print_test_output(_, Output) =>
 2384    print_message(debug, plunit(test_output(informational, Output))).
 jobs_redraw is det
Redraw the job window.
 2390jobs_redraw :-
 2391    job_window(N),
 2392    !,
 2393    tty_columns(_, Width),
 2394    tty_header_line(Width),
 2395    forall(between(1,N,Line), job_redraw_worker(Line)),
 2396    tty_header_line(Width).
 2397jobs_redraw.
 2398
 2399job_redraw_worker(Line) :-
 2400    (   job_status_line(Line, Fmt, Args)
 2401    ->  ansi_format(comment, Fmt, Args)
 2402    ;   true
 2403    ),
 2404    nl.
 job_format(+Style, +Fmt, +Args) is det
 job_format(+Job, +Style, +Fmt, +Args, +Save) is det
Point should be below the status window. Format Fmt+Args in the line Job using Style and return to the position below the window.
 2412job_format(Style, Fmt, Args) :-
 2413    job_self(Job),
 2414    job_format(Job, Style, Fmt, Args, true).
 job_finish(+Style, +Fmt, +Args) is det
 job_finish(+Job, +Style, +Fmt, +Args) is det
Complete the status line for Job. This redraws the original status line when we are using a job window.
 2422job_finish(Style, Fmt, Args) :-
 2423    job_self(Job),
 2424    job_finish(Job, Style, Fmt, Args).
 2425
 2426:- det(job_finish/4). 2427job_finish(Job, Style, Fmt, Args) :-
 2428    retract(job_status_line(Job, Fmt0, Args0)),
 2429    !,
 2430    string_concat(Fmt0, Fmt, Fmt1),
 2431    append(Args0, Args, Args1),
 2432    job_format(Job, Style, Fmt1, Args1, false).
 2433
 2434:- det(job_format/5). 2435job_format(Job, Style, Fmt, Args, Save) :-
 2436    job_window(Jobs),
 2437    Up is Jobs+2-Job,
 2438    flush_output(user_output),
 2439    tty_up_and_clear(Up),
 2440    ansi_format(Style, Fmt, Args),
 2441    (   Save == true
 2442    ->  retractall(job_status_line(Job, _, _)),
 2443	asserta(job_status_line(Job, Fmt, Args))
 2444    ;   true
 2445    ),
 2446    tty_down_and_home(Up),
 2447    flush_output(user_output).
 2448
 2449:- det(job_self/1). 2450job_self(Job) :-
 2451    job_window(N),
 2452    N > 1,
 2453    thread_self(Me),
 2454    split_string(Me, '_', '', [_,_,S]),
 2455    number_string(Job, S).
 feedback is semidet
provide feedback using the tty format, which reuses the current output line if the test is successful.
 2462tty_feedback :-
 2463    has_tty,
 2464    current_test_flag(format, tty).
 2465
 2466has_tty :-
 2467    stream_property(user_output, tty(true)).
 2468
 2469tty_columns(SummaryWidth, Margin) :-
 2470    tty_width(W),
 2471    Margin is W-8,
 2472    SummaryWidth is max(20,Margin-34).
 2473
 2474tty_width(W) :-
 2475    current_predicate(tty_size/2),
 2476    catch(tty_size(_Rows, Cols), error(_,_), fail),
 2477    Cols > 25,
 2478    !,
 2479    W = Cols.
 2480tty_width(80).
 2481
 2482tty_header_line(Width) :-
 2483    ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
 2484
 2485:- if(current_predicate(tty_get_capability/3)). 2486tty_clear_to_eol(S) :-
 2487    tty_get_capability(ce, string, S),
 2488    !.
 2489:- endif. 2490tty_clear_to_eol('\e[K').
 2491
 2492tty_up_and_clear(Lines) :-
 2493    format(user_output, '\e[~dA\r\e[K', [Lines]).
 2494
 2495tty_down_and_home(Lines) :-
 2496    format(user_output, '\e[~dB\r', [Lines]).
 2497
 2498:- if(swi). 2499
 2500:- multifile
 2501    prolog:message/3,
 2502    user:message_hook/3. 2503
 2504prolog:message(Term) -->
 2505    message(Term).
 2506
 2507%       user:message_hook(+Term, +Kind, +Lines)
 2508
 2509user:message_hook(make(done(Files)), _, _) :-
 2510    make_run_tests(Files),
 2511    fail.                           % give other hooks a chance
 2512
 2513:- endif. 2514
 2515:- if(sicstus). 2516
 2517user:generate_message_hook(Message) -->
 2518    message(Message),
 2519    [nl].                           % SICStus requires nl at the end
 user:message_hook(+Severity, +Message, +Lines) is semidet
Redefine printing some messages. It appears SICStus has no way to get multiple messages at the same line, so we roll our own. As there is a lot pre-wired and checked in the SICStus message handling we cannot reuse the lines. Unless I miss something ...
 2528user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 2529    format(user_error, '% PL-Unit: ~w ', [Unit]),
 2530    flush_output(user_error).
 2531user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 2532    format(user, ' done~n', []).
 2533
 2534:- endif.