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:- public
   74    unit_module/2.   75
   76:- meta_predicate
   77    valid_options(1, +),
   78    count(0, -).   79
   80		 /*******************************
   81		 *    CONDITIONAL COMPILATION   *
   82		 *******************************/
   83
   84swi     :- catch(current_prolog_flag(dialect, swi),     _, fail).
   85sicstus :- catch(current_prolog_flag(dialect, sicstus), _, fail).
   86
   87throw_error(Error_term,Impldef) :-
   88    throw(error(Error_term,context(Impldef,_))).
   89
   90:- set_prolog_flag(generate_debug_info, false).   91current_test_flag(optimise, Value) =>
   92    current_prolog_flag(optimise, Value).
   93current_test_flag(occurs_check, Value) =>
   94    (   current_prolog_flag(plunit_occurs_check, Value0)
   95    ->  Value = Value0
   96    ;   current_prolog_flag(occurs_check, Value)
   97    ).
   98current_test_flag(Name, Value), atom(Name) =>
   99    atom_concat(plunit_, Name, Flag),
  100    current_prolog_flag(Flag, Value).
  101current_test_flag(Name, Value), var(Name) =>
  102    global_test_option(Opt, _, _Type, _Default),
  103    functor(Opt, Name, 1),
  104    current_test_flag(Name, Value).
  105
  106set_test_flag(Name, Value) :-
  107    Opt =.. [Name, Value],
  108    global_test_option(Opt),
  109    !,
  110    atom_concat(plunit_, Name, Flag),
  111    set_prolog_flag(Flag, Value).
  112set_test_flag(Name, _) :-
  113    domain_error(test_flag, Name).
  114
  115current_test_flags(Flags) :-
  116    findall(Flag, current_test_flag(Flag), Flags).
  117
  118current_test_flag(Opt) :-
  119    current_test_flag(Name, Value),
  120    Opt =.. [Name, Value].
  121
  122% ensure expansion to avoid tracing
  123goal_expansion(forall(C,A),
  124	       \+ (C, \+ A)).
  125goal_expansion(current_module(Module,File),
  126	       module_property(Module, file(File))).
  127
  128
  129		 /*******************************
  130		 *            IMPORTS           *
  131		 *******************************/
  132
  133:- initialization init_flags.  134
  135init_flags :-
  136    (   global_test_option(Option, _Value, Type, Default),
  137	Default \== (-),
  138	Option =.. [Name,_],
  139	atom_concat(plunit_, Name, Flag),
  140        flag_type(Type, FlagType),
  141	create_prolog_flag(Flag, Default, [type(FlagType), keep(true)]),
  142	fail
  143    ;   true
  144    ).
  145
  146flag_type(boolean, FlagType) => FlagType = boolean.
  147flag_type(Type, FlagType), Type = oneof(Atoms), maplist(atom, Atoms) =>
  148    FlagType = Type.
  149flag_type(oneof(_), FlagType) => FlagType = term.
  150flag_type(positive_integer, FlagType) => FlagType = integer.
  151flag_type(number, FlagType) => FlagType = float.
 set_test_options(+Options)
Specifies how to deal with test suites. Defined options are:
load(+Load)
Whether or not the tests must be loaded. Values are never, always, normal (only if not optimised)
run(+When)
When the tests are run. Values are manual, make or make(all).
format(+Mode)
Currently one of tty or log. tty uses terminal control to overwrite successful tests, allowing the user to see the currently running tests and output from failed tests. This is the default of the output is a tty. log prints a full log of the executed tests and their result and is intended for non-interactive usage.
output(+When)
If always, emit all output as it is produced, if never, suppress all output and if on_failure, emit the output if the test fails.
show_blocked(+Bool)
Show individual blocked tests during the report.
occurs_check(+Mode)
Defines the default for the occurs_check flag during testing.
cleanup(+Bool)
If true (default =false), cleanup report at the end of run_tests/1. Used to improve cooperation with memory debuggers such as dmalloc.
jobs(Num)
Number of jobs to use for concurrent testing. Default is one, implying sequential testing.
timeout(+Seconds)
Set timeout for each individual test. This acts as a default that may be overuled at the level of units or individual tests. A timeout of 0 or negative is handled as inifinite.
  203set_test_options(Options) :-
  204    flatten([Options], List),
  205    maplist(set_test_option, List).
  206
  207set_test_option(sto(true)) =>
  208    print_message(warning, plunit(sto(true))).
  209set_test_option(jobs(Jobs)) =>
  210    must_be(positive_integer, Jobs),
  211    set_test_option_flag(jobs(Jobs)).
  212set_test_option(Option),
  213  compound(Option), global_test_option(Option) =>
  214    set_test_option_flag(Option).
  215set_test_option(Option) =>
  216    domain_error(option, Option).
  217
  218global_test_option(Opt) :-
  219    global_test_option(Opt, Value, Type, _Default),
  220    must_be(Type, Value).
  221
  222global_test_option(load(Load), Load, oneof([never,always,normal]), normal).
  223global_test_option(output(Cond), Cond, oneof([always,on_failure]), on_failure).
  224global_test_option(format(Feedback), Feedback, oneof([tty,log]), tty).
  225global_test_option(silent(Silent), Silent, boolean, false).
  226global_test_option(show_blocked(Blocked), Blocked, boolean, false).
  227global_test_option(run(When), When, oneof([manual,make,make(all)]), make).
  228global_test_option(occurs_check(Mode), Mode, oneof([false,true,error]), -).
  229global_test_option(cleanup(Bool), Bool, boolean, true).
  230global_test_option(jobs(Count), Count, positive_integer, 1).
  231global_test_option(timeout(Number), Number, number, 3600).
  232
  233set_test_option_flag(Option) :-
  234    Option =.. [Name, Value],
  235    set_test_flag(Name, Value).
 loading_tests
True if tests must be loaded.
  241loading_tests :-
  242    current_test_flag(load, Load),
  243    (   Load == always
  244    ->  true
  245    ;   Load == normal,
  246	\+ current_test_flag(optimise, true)
  247    ).
  248
  249		 /*******************************
  250		 *            MODULE            *
  251		 *******************************/
  252
  253:- dynamic
  254    loading_unit/4,                 % Unit, Module, File, OldSource
  255    current_unit/4,                 % Unit, Module, Context, Options
  256    test_file_for/2.                % ?TestFile, ?PrologFile
 begin_tests(+UnitName:atom) is det
 begin_tests(+UnitName:atom, Options) is det
Start a test-unit. UnitName is the name of the test set. the unit is ended by :- end_tests(UnitName).
  264begin_tests(Unit) :-
  265    begin_tests(Unit, []).
  266
  267begin_tests(Unit, Options) :-
  268    must_be(atom, Unit),
  269    map_sto_option(Options, Options1),
  270    valid_options(test_set_option, Options1),
  271    make_unit_module(Unit, Name),
  272    source_location(File, Line),
  273    begin_tests(Unit, Name, File:Line, Options1).
  274
  275map_sto_option(Options0, Options) :-
  276    select_option(sto(Mode), Options0, Options1),
  277    !,
  278    map_sto(Mode, Flag),
  279    Options = [occurs_check(Flag)|Options1].
  280map_sto_option(Options, Options).
  281
  282map_sto(rational_trees, Flag) => Flag = false.
  283map_sto(finite_trees, Flag)   => Flag = true.
  284map_sto(Mode, _) => domain_error(sto, Mode).
  285
  286
  287:- if(swi).  288begin_tests(Unit, Name, File:Line, Options) :-
  289    loading_tests,
  290    !,
  291    '$set_source_module'(Context, Context),
  292    (   current_unit(Unit, Name, Context, Options)
  293    ->  true
  294    ;   retractall(current_unit(Unit, Name, _, _)),
  295	assert(current_unit(Unit, Name, Context, Options))
  296    ),
  297    '$set_source_module'(Old, Name),
  298    '$declare_module'(Name, test, Context, File, Line, false),
  299    discontiguous(Name:'unit test'/4),
  300    '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
  301    discontiguous(Name:'unit body'/2),
  302    asserta(loading_unit(Unit, Name, File, Old)).
  303begin_tests(Unit, Name, File:_Line, _Options) :-
  304    '$set_source_module'(Old, Old),
  305    asserta(loading_unit(Unit, Name, File, Old)).
  306
  307:- else.  308
  309% we cannot use discontiguous as a goal in SICStus Prolog.
  310
  311user:term_expansion((:- begin_tests(Set)),
  312		    [ (:- begin_tests(Set)),
  313		      (:- discontiguous(test/2)),
  314		      (:- discontiguous('unit body'/2)),
  315		      (:- discontiguous('unit test'/4))
  316		    ]).
  317
  318begin_tests(Unit, Name, File:_Line, Options) :-
  319    loading_tests,
  320    !,
  321    (   current_unit(Unit, Name, _, Options)
  322    ->  true
  323    ;   retractall(current_unit(Unit, Name, _, _)),
  324	assert(current_unit(Unit, Name, -, Options))
  325    ),
  326    asserta(loading_unit(Unit, Name, File, -)).
  327begin_tests(Unit, Name, File:_Line, _Options) :-
  328    asserta(loading_unit(Unit, Name, File, -)).
  329
  330:- endif.
 end_tests(+Name) is det
Close a unit-test module.
To be done
- Run tests/clean module?
- End of file?
  339end_tests(Unit) :-
  340    loading_unit(StartUnit, _, _, _),
  341    !,
  342    (   Unit == StartUnit
  343    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  344	'$set_source_module'(_, Old)
  345    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  346    ).
  347end_tests(Unit) :-
  348    throw_error(context_error(plunit_close(Unit, -)), _).
 make_unit_module(+Name, -ModuleName) is det
 unit_module(+Name, -ModuleName) is det
  353:- if(swi).  354
  355unit_module(Unit, Module) :-
  356    atom_concat('plunit_', Unit, Module).
  357
  358make_unit_module(Unit, Module) :-
  359    unit_module(Unit, Module),
  360    (   current_module(Module),
  361	\+ current_unit(_, Module, _, _),
  362	predicate_property(Module:H, _P),
  363	\+ predicate_property(Module:H, imported_from(_M))
  364    ->  throw_error(permission_error(create, plunit, Unit),
  365		    'Existing module')
  366    ;  true
  367    ).
  368
  369:- else.  370
  371:- dynamic
  372    unit_module_store/2.  373
  374unit_module(Unit, Module) :-
  375    unit_module_store(Unit, Module),
  376    !.
  377
  378make_unit_module(Unit, Module) :-
  379    prolog_load_context(module, Module),
  380    assert(unit_module_store(Unit, Module)).
  381
  382:- endif.  383
  384		 /*******************************
  385		 *           EXPANSION          *
  386		 *******************************/
 expand_test(+Name, +Options, +Body, -Clause) is det
Expand test(Name, Options) :- Body into a clause for 'unit test'/4 and 'unit body'/2.
  393expand_test(Name, Options0, Body,
  394	    [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
  395	      ('unit body'(Id, Vars) :- !, Body)
  396	    ]) :-
  397    source_location(_File, Line),
  398    prolog_load_context(module, Module),
  399    (   prolog_load_context(variable_names, Bindings)
  400    ->  true
  401    ;   Bindings = []
  402    ),
  403    atomic_list_concat([Name, '@line ', Line], Id),
  404    term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
  405    term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
  406    ord_intersection(OptionVars, BodyVars, VarList),
  407    Vars =.. [vars|VarList],
  408    (   is_list(Options0)           % allow for single option without list
  409    ->  Options1 = Options0
  410    ;   Options1 = [Options0]
  411    ),
  412    maplist(expand_option(Bindings), Options1, Options2),
  413    join_true_options(Options2, Options3),
  414    map_sto_option(Options3, Options4),
  415    valid_options(test_option, Options4),
  416    valid_test_mode(Options4, Options).
  417
  418expand_option(_, Var, _) :-
  419    var(Var),
  420    !,
  421    throw_error(instantiation_error,_).
  422expand_option(Bindings, Cmp, true(Cond)) :-
  423    cmp(Cmp),
  424    !,
  425    var_cmp(Bindings, Cmp, Cond).
  426expand_option(_, error(X), throws(error(X, _))) :- !.
  427expand_option(_, exception(X), throws(X)) :- !. % SICStus 4 compatibility
  428expand_option(_, error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
  429expand_option(_, true, true(true)) :- !.
  430expand_option(_, O, O).
  431
  432cmp(_ == _).
  433cmp(_ = _).
  434cmp(_ =@= _).
  435cmp(_ =:= _).
  436
  437var_cmp(Bindings, Expr, cmp(Name, Expr)) :-
  438    arg(_, Expr, Var),
  439    var(Var),
  440    member(Name=V, Bindings),
  441    V == Var,
  442    !.
  443var_cmp(_, Expr, Expr).
  444
  445join_true_options(Options0, Options) :-
  446    partition(true_option, Options0, True, Rest),
  447    True \== [],
  448    !,
  449    maplist(arg(1), True, Conds0),
  450    flatten(Conds0, Conds),
  451    Options = [true(Conds)|Rest].
  452join_true_options(Options, Options).
  453
  454true_option(true(_)).
  455
  456valid_test_mode(Options0, Options) :-
  457    include(test_mode, Options0, Tests),
  458    (   Tests == []
  459    ->  Options = [true([true])|Options0]
  460    ;   Tests = [_]
  461    ->  Options = Options0
  462    ;   throw_error(plunit(incompatible_options, Tests), _)
  463    ).
  464
  465test_mode(true(_)).
  466test_mode(all(_)).
  467test_mode(set(_)).
  468test_mode(fail).
  469test_mode(throws(_)).
 expand(+Term, -Clauses) is semidet
  474expand(end_of_file, _) :-
  475    loading_unit(Unit, _, _, _),
  476    !,
  477    end_tests(Unit),                % warn?
  478    fail.
  479expand((:-end_tests(_)), _) :-
  480    !,
  481    fail.
  482expand(_Term, []) :-
  483    \+ loading_tests.
  484expand((test(Name) :- Body), Clauses) :-
  485    !,
  486    expand_test(Name, [], Body, Clauses).
  487expand((test(Name, Options) :- Body), Clauses) :-
  488    !,
  489    expand_test(Name, Options, Body, Clauses).
  490expand(test(Name), _) :-
  491    !,
  492    throw_error(existence_error(body, test(Name)), _).
  493expand(test(Name, _Options), _) :-
  494    !,
  495    throw_error(existence_error(body, test(Name)), _).
  496
  497:- multifile
  498    system:term_expansion/2.  499
  500system:term_expansion(Term, Expanded) :-
  501    (   loading_unit(_, _, File, _)
  502    ->  source_location(ThisFile, _),
  503	(   File == ThisFile
  504	->  true
  505	;   source_file_property(ThisFile, included_in(File, _))
  506	),
  507	expand(Term, Expanded)
  508    ).
  509
  510
  511		 /*******************************
  512		 *             OPTIONS          *
  513		 *******************************/
 valid_options(:Pred, +Options) is det
Verify Options to be a list of valid options according to Pred.
Errors
- type_error or instantiation_error.
  522valid_options(Pred, Options) :-
  523    must_be(list, Options),
  524    verify_options(Options, Pred).
  525
  526verify_options([], _).
  527verify_options([H|T], Pred) :-
  528    (   call(Pred, H)
  529    ->  verify_options(T, Pred)
  530    ;   throw_error(domain_error(Pred, H), _)
  531    ).
  532
  533valid_options(Pred, Options0, Options, Rest) :-
  534    must_be(list, Options0),
  535    partition(Pred, Options0, Options, Rest).
 test_option(+Option) is semidet
True if Option is a valid option for test(Name, Options).
  541test_option(Option) :-
  542    test_set_option(Option),
  543    !.
  544test_option(true(_)).
  545test_option(fail).
  546test_option(throws(_)).
  547test_option(all(_)).
  548test_option(set(_)).
  549test_option(nondet).
  550test_option(fixme(_)).
  551test_option(forall(X)) :-
  552    must_be(callable, X).
  553test_option(timeout(Seconds)) :-
  554    must_be(number, Seconds).
 test_option(+Option) is semidet
True if Option is a valid option for :- begin_tests(Name, Options).
  561test_set_option(blocked(X)) :-
  562    must_be(ground, X).
  563test_set_option(condition(X)) :-
  564    must_be(callable, X).
  565test_set_option(setup(X)) :-
  566    must_be(callable, X).
  567test_set_option(cleanup(X)) :-
  568    must_be(callable, X).
  569test_set_option(occurs_check(V)) :-
  570    must_be(oneof([false,true,error]), V).
  571test_set_option(concurrent(V)) :-
  572    must_be(boolean, V),
  573    print_message(informational, plunit(concurrent)).
  574test_set_option(timeout(Seconds)) :-
  575    must_be(number, Seconds).
  576
  577		 /*******************************
  578		 *             UTIL		*
  579		 *******************************/
  580
  581:- meta_predicate
  582       reify_tmo(0, -, +),
  583       reify(0, -),
  584       capture_output(0,-),
  585       capture_output(0,-,+),
  586       got_messages(0,-).
 reify_tmo(:Goal, -Result, +Options) is det
  590:- if(current_predicate(call_with_time_limit/2)).  591reify_tmo(Goal, Result, Options) :-
  592    option(timeout(Time), Options),
  593    Time > 0,
  594    !,
  595    reify(call_with_time_limit(Time, Goal), Result0),
  596    (   Result0 = throw(time_limit_exceeded)
  597    ->  Result = throw(time_limit_exceeded(Time))
  598    ;   Result = Result0
  599    ).
  600:- endif.  601reify_tmo(Goal, Result, _Options) :-
  602    reify(Goal, Result).
 reify(:Goal, -Result) is det
Call Goal and unify Result with one of true, false or throw(E).
  609reify(Goal, Result) :-
  610    (   catch(Goal, E, true)
  611    ->  (   var(E)
  612	->  Result = true
  613	;   Result = throw(E)
  614	)
  615    ;   Result = false
  616    ).
 capture_output(:Goal, -Output) is semidet
 capture_output(:Goal, -Output, +Options) is semidet
Arguments:
Output- is a pair Msgs-String, where Msgs is a boolean that is true if there were messages that require a non-zero exit status and Output contains the output as a string.
  625capture_output(Goal, Output) :-
  626    current_test_flag(output, OutputMode),
  627    capture_output(Goal, Output, [output(OutputMode)]).
  628
  629capture_output(Goal, Msgs-Output, Options) :-
  630    option(output(How), Options, always),
  631    (   How == always
  632    ->  call(Goal),
  633        Msgs = false                % irrelavant
  634    ;   with_output_to(string(Output), got_messages(Goal, Msgs),
  635                       [ capture([user_output, user_error]),
  636                         color(true)
  637                       ])
  638    ).
 got_messages(:Goal, -Result)
  642got_messages(Goal, Result) :-
  643    (   current_prolog_flag(on_warning, status)
  644    ;   current_prolog_flag(on_error, status)
  645    ), !,
  646    nb_delete(plunit_got_message),
  647    setup_call_cleanup(
  648        asserta(( user:thread_message_hook(_Term, Kind, _Lines) :-
  649                      got_message(Kind), fail), Ref),
  650        Goal,
  651        erase(Ref)),
  652    (   nb_current(plunit_got_message, true)
  653    ->  Result = true
  654    ;   Result = false
  655    ).
  656got_messages(Goal, false) :-
  657    call(Goal).
  658
  659:- public got_message/1.  660got_message(warning) :-
  661    current_prolog_flag(on_warning, status), !,
  662    nb_setval(plunit_got_message, true).
  663got_message(error) :-
  664    current_prolog_flag(on_error, status), !,
  665    nb_setval(plunit_got_message, true).
  666
  667
  668		 /*******************************
  669		 *        RUNNING TOPLEVEL      *
  670		 *******************************/
  671
  672:- dynamic
  673    output_streams/2,               % Output, Error
  674    test_count/1,                   % Count
  675    passed/5,                       % Unit, Test, Line, Det, Time
  676    failed/5,                       % Unit, Test, Line, Reason, Time
  677    timeout/5,                      % Unit, Test, Line, Limit, Time
  678    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  679    blocked/4,                      % Unit, Test, Line, Reason
  680    fixme/5,                        % Unit, Test, Line, Reason, Status
  681    running/5,                      % Unit, Test, Line, STO, Thread
  682    forall_failures/2.              % Nth, Failures
 run_tests is semidet
 run_tests(+TestSet) is semidet
 run_tests(+TestSet, +Options) is semidet
Run tests and report about the results. The predicate run_tests/0 runs all known tests that are not blocked. The predicate run_tests/1 takes a specification of tests to run.

The predicate run_tests/2 is synchronized. Concurrent testing may be achieved using the relevant options. See set_test_options/1. Options are passed to set_test_options/1. In addition the following options are processed:

summary(-Summary)
Unify Summary do a dict holding the keys below. The value of these keys is an integer describing the number of tests. If this option is given, run_tests/2 does not fail if some tests failed.
  • total
  • passed
  • failed
  • timeout
  • blocked
Arguments:
TestSet- is either a single specification or a list of specifications. Each single specification is either the name of a test-unit or a term <test-unit>:<test>, denoting a single test within a unit. If TestSet is all, all known tests are executed.
  714run_tests :-
  715    run_tests(all).
  716
  717run_tests(Set) :-
  718    run_tests(Set, []).
  719
  720run_tests(all, Options) :-
  721    !,
  722    findall(Unit, current_test_unit(Unit,_), Units),
  723    run_tests(Units, Options).
  724run_tests(Set, Options) :-
  725    valid_options(global_test_option, Options, Global, Rest),
  726    current_test_flags(Old),
  727    setup_call_cleanup(
  728	set_test_options(Global),
  729	( flatten([Set], List),
  730	  maplist(runnable_tests, List, Units),
  731	  with_mutex(plunit, run_tests_sync(Units, Rest))
  732	),
  733	set_test_options(Old)).
  734
  735run_tests_sync(Units0, Options) :-
  736    cleanup,
  737    count_tests(Units0, Units, Count),
  738    asserta(test_count(Count)),
  739    save_output_state,
  740    setup_call_cleanup(
  741	setup_jobs(Count),
  742	setup_call_cleanup(
  743	    setup_trap_assertions(Ref),
  744	    ( call_time(run_units(Units, Options), Time),
  745              test_summary(_All, Summary)
  746            ),
  747	    report_and_cleanup(Ref, Time, Options)),
  748	cleanup_jobs),
  749    (   option(summary(Summary), Options)
  750    ->  true
  751    ;   test_summary_passed(Summary) % fail if some test failed
  752    ).
 report_and_cleanup(+Ref, +Time, +Options)
Undo changes to the environment (trapping assertions), report the results and cleanup.
  759report_and_cleanup(Ref, Time, Options) :-
  760    cleanup_trap_assertions(Ref),
  761    report(Time, Options),
  762    cleanup_after_test.
 run_units_and_check_errors(+Units, +Options) is semidet
Run all test units and succeed if all tests passed.
  769run_units(Units, _Options) :-
  770    maplist(schedule_unit, Units),
  771    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.
  780:- det(runnable_tests/2).  781runnable_tests(Spec, Unit:RunnableTests) :-
  782    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  783    (   option(blocked(Reason), UnitOptions)
  784    ->  info(plunit(blocked(unit(Unit, Reason)))),
  785        RunnableTests = []
  786    ;   \+ condition(Module, unit(Unit), UnitOptions)
  787    ->  RunnableTests = []
  788    ;   var(Tests)
  789    ->  findall(TestID,
  790                runnable_test(Unit, _Test, Module, TestID),
  791                RunnableTests)
  792    ;   flatten([Tests], TestList),
  793        findall(TestID,
  794                ( member(Test, TestList),
  795                  runnable_test(Unit,Test,Module, TestID)
  796                ),
  797                RunnableTests)
  798    ).
  799
  800runnable_test(Unit, Name, Module, @(Test,Line)) :-
  801    current_test(Unit, Name, Line, _Body, TestOptions),
  802    (   option(blocked(Reason), TestOptions)
  803    ->  Test = blocked(Name, Reason)
  804    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  805        Test = Name
  806    ).
  807
  808unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  809    Unit = Unit0,
  810    Tests = Tests0,
  811    (   current_unit(Unit, Module, _Supers, Options)
  812    ->  true
  813    ;   throw_error(existence_error(unit_test, Unit), _)
  814    ).
  815unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  816    Unit = Unit0,
  817    (   current_unit(Unit, Module, _Supers, Options)
  818    ->  true
  819    ;   throw_error(existence_error(unit_test, Unit), _)
  820    ).
 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".
  828count_tests(Units0, Units, Count) :-
  829    count_tests(Units0, Units, 0, Count).
  830
  831count_tests([], T, C0, C) =>
  832    T = [],
  833    C = C0.
  834count_tests([_:[]|T0], T, C0, C) =>
  835    count_tests(T0, T, C0, C).
  836count_tests([Unit:Tests|T0], T, C0, C) =>
  837    partition(is_blocked, Tests, Blocked, Use),
  838    maplist(assert_blocked(Unit), Blocked),
  839    (   Use == []
  840    ->  count_tests(T0, T, C0, C)
  841    ;   length(Use, N),
  842        C1 is C0+N,
  843        T = [Unit:Use|T1],
  844        count_tests(T0, T1, C1, C)
  845    ).
  846
  847is_blocked(@(blocked(_,_),_)) => true.
  848is_blocked(_) => fail.
  849
  850assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  851    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.
  858run_unit(_Unit:[]) =>
  859    true.
  860run_unit(Unit:Tests) =>
  861    unit_module(Unit, Module),
  862    unit_options(Unit, UnitOptions),
  863    (   setup(Module, unit(Unit), UnitOptions)
  864    ->  begin_unit(Unit),
  865        call_time(run_unit_2(Unit, Tests), Time),
  866        test_summary(Unit, Summary),
  867	end_unit(Unit, Summary.put(time, Time)),
  868        cleanup(Module, UnitOptions)
  869    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  870    ).
  871
  872begin_unit(Unit) :-
  873    job_info(begin(unit(Unit))),
  874    job_feedback(informational, begin(Unit)).
  875
  876end_unit(Unit, Summary) :-
  877    job_info(end(unit(Unit, Summary))),
  878    job_feedback(informational, end(Unit, Summary)).
  879
  880run_unit_2(Unit, Tests) :-
  881    forall(member(Test, Tests),
  882	   run_test(Unit, Test)).
  883
  884
  885unit_options(Unit, Options) :-
  886    current_unit(Unit, _Module, _Supers, Options).
  887
  888
  889cleanup :-
  890    set_flag(plunit_test, 1),
  891    retractall(output_streams(_,_)),
  892    retractall(test_count(_)),
  893    retractall(passed(_, _, _, _, _)),
  894    retractall(failed(_, _, _, _, _)),
  895    retractall(timeout(_, _, _, _, _)),
  896    retractall(failed_assertion(_, _, _, _, _, _, _)),
  897    retractall(blocked(_, _, _, _)),
  898    retractall(fixme(_, _, _, _, _)),
  899    retractall(running(_,_,_,_,_)),
  900    retractall(forall_failures(_,_)).
  901
  902cleanup_after_test :-
  903    (   current_test_flag(cleanup, true)
  904    ->  cleanup
  905    ;   true
  906    ).
 run_tests_in_files(+Files:list) is det
Run all test-units that appear in the given Files.
  913run_tests_in_files(Files) :-
  914    findall(Unit, unit_in_files(Files, Unit), Units),
  915    (   Units == []
  916    ->  true
  917    ;   run_tests(Units)
  918    ).
  919
  920unit_in_files(Files, Unit) :-
  921    is_list(Files),
  922    !,
  923    member(F, Files),
  924    absolute_file_name(F, Source,
  925		       [ file_type(prolog),
  926			 access(read),
  927			 file_errors(fail)
  928		       ]),
  929    unit_file(Unit, Source).
  930
  931
  932		 /*******************************
  933		 *         HOOKING MAKE/0       *
  934		 *******************************/
 make_run_tests(+Files)
Called indirectly from make/0 after Files have been reloaded.
  940make_run_tests(Files) :-
  941    current_test_flag(run, When),
  942    (   When == make
  943    ->  run_tests_in_files(Files)
  944    ;   When == make(all)
  945    ->  run_tests
  946    ;   true
  947    ).
  948
  949		 /*******************************
  950		 *      ASSERTION HANDLING      *
  951		 *******************************/
  952
  953:- if(swi).  954
  955:- dynamic prolog:assertion_failed/2.  956
  957setup_trap_assertions(Ref) :-
  958    asserta((prolog:assertion_failed(Reason, Goal) :-
  959		    test_assertion_failed(Reason, Goal)),
  960	    Ref).
  961
  962cleanup_trap_assertions(Ref) :-
  963    erase(Ref).
  964
  965test_assertion_failed(Reason, Goal) :-
  966    thread_self(Me),
  967    running(Unit, Test, Line, Progress, Me),
  968    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  969	assertion_location(Stack, AssertLoc)
  970    ->  true
  971    ;   AssertLoc = unknown
  972    ),
  973    report_failed_assertion(Unit:Test, Line, AssertLoc,
  974			    Progress, Reason, Goal),
  975    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  976				   Progress, Reason, Goal)).
  977
  978assertion_location(Stack, File:Line) :-
  979    append(_, [AssertFrame,CallerFrame|_], Stack),
  980    prolog_stack_frame_property(AssertFrame,
  981				predicate(prolog_debug:assertion/1)),
  982    !,
  983    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  984
  985report_failed_assertion(UnitTest, Line, AssertLoc,
  986			Progress, Reason, Goal) :-
  987    print_message(
  988	error,
  989	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  990				Progress, Reason, Goal))).
  991
  992:- else.  993
  994setup_trap_assertions(_).
  995cleanup_trap_assertions(_).
  996
  997:- endif.  998
  999
 1000		 /*******************************
 1001		 *         RUNNING A TEST       *
 1002		 *******************************/
 run_test(+Unit, +Test) is det
Run a single test.
 1008run_test(Unit, @(Test,Line)) :-
 1009    unit_module(Unit, Module),
 1010    Module:'unit test'(Test, Line, TestOptions, Body),
 1011    unit_options(Unit, UnitOptions),
 1012    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).
 run_test(+Unit, +Name, +Line, +UnitOptions, +Options, +Body)
Deals with forall(Generator, Test)
 1018run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1019    option(forall(Generator), Options),
 1020    !,
 1021    unit_module(Unit, Module),
 1022    term_variables(Generator, Vars),
 1023    start_test(Unit, @(Name,Line), Nth),
 1024    State = state(0),
 1025    call_time(forall(Module:Generator,            % may become concurrent
 1026                     (   incr_forall(State, I),
 1027                         run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
 1028                                        UnitOptions, Options, Body)
 1029                     )),
 1030                     Time),
 1031    arg(1, State, Generated),
 1032    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1033run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1034    start_test(Unit, @(Name,Line), Nth),
 1035    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1036
 1037start_test(_Unit, _TestID, Nth) :-
 1038    flag(plunit_test, Nth, Nth+1).
 1039
 1040incr_forall(State, I) :-
 1041    arg(1, State, I0),
 1042    I is I0+1,
 1043    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).
 1050run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1051    current_test_flag(timeout, DefTimeOut),
 1052    current_test_flag(occurs_check, DefOccurs),
 1053    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1054    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1055    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1056
 1057inherit_option(Name, Options0, Chain, Default, Options) :-
 1058    Term =.. [Name,_Value],
 1059    (   option(Term, Options0)
 1060    ->  Options = Options0
 1061    ;   member(Opts, Chain),
 1062        option(Term, Opts)
 1063    ->  Options = [Term|Options0]
 1064    ;   Default == (-)
 1065    ->  Options = Options0
 1066    ;   Opt =.. [Name,Default],
 1067	Options = [Opt|Options0]
 1068    ).
 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.
 1075run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1076    option(occurs_check(Occurs), Options),
 1077    !,
 1078    begin_test(Unit, Name, Line, Progress),
 1079    current_prolog_flag(occurs_check, Old),
 1080    setup_call_cleanup(
 1081	set_prolog_flag(occurs_check, Occurs),
 1082	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1083		       Output),
 1084	set_prolog_flag(occurs_check, Old)),
 1085    end_test(Unit, Name, Line, Progress),
 1086    report_result(Result, Progress, Output, Options).
 1087run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1088    begin_test(Unit, Name, Line, Progress),
 1089    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1090		   Output),
 1091    end_test(Unit, Name, Line, Progress),
 1092    report_result(Result, Progress, Output, Options).
 report_result(+Result, +Progress, +Output, +Options) is det
 1096:- det(report_result/4). 1097report_result(failure(Unit, Name, Line, How, Time),
 1098	      Progress, Output, Options) :-
 1099    !,
 1100    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1101report_result(success(Unit, Name, Line, Determinism, Time),
 1102	      Progress, Output, Options) :-
 1103    !,
 1104    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1105report_result(setup_failed(_Unit, _Name, _Line),
 1106	      _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)
 1128run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1129    option(setup(_Setup), Options),
 1130    !,
 1131    (   unit_module(Unit, Module),
 1132        setup(Module, test(Unit,Name,Line), Options)
 1133    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1134        cleanup(Module, Options)
 1135    ;   Result = setup_failed(Unit, Name, Line)
 1136    ).
 1137run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1138    unit_module(Unit, Module),
 1139    run_test_7(Unit, Name, Line, Options, Body, Result),
 1140    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.
 1149run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1150    option(true(Cmp), Options),			   % expected success
 1151    !,
 1152    unit_module(Unit, Module),
 1153    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1154    (   Result0 == true
 1155    ->  cmp_true(Cmp, Module, CmpResult),
 1156	(   CmpResult == []
 1157	->  Result = success(Unit, Name, Line, Det, Time)
 1158	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1159	)
 1160    ;   Result0 == false
 1161    ->  Result = failure(Unit, Name, Line, failed, Time)
 1162    ;   Result0 = throw(E2)
 1163    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1164    ).
 1165run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1166    option(fail, Options),                         % expected failure
 1167    !,
 1168    unit_module(Unit, Module),
 1169    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1170    (   Result0 == true
 1171    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1172    ;   Result0 == false
 1173    ->  Result = success(Unit, Name, Line, true, Time)
 1174    ;   Result0 = throw(E)
 1175    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1176    ).
 1177run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1178    option(throws(Expect), Options),		   % Expected error
 1179    !,
 1180    unit_module(Unit, Module),
 1181    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1182    (   Result0 == true
 1183    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1184    ;   Result0 == false
 1185    ->  Result = failure(Unit, Name, Line, failed, Time)
 1186    ;   Result0 = throw(E)
 1187    ->  (   match_error(Expect, E)
 1188        ->  Result = success(Unit, Name, Line, true, Time)
 1189        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1190        )
 1191    ).
 1192run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1193    option(all(Answer), Options),                  % all(Bindings)
 1194    !,
 1195    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1196run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1197    option(set(Answer), Options),                  % set(Bindings)
 1198    !,
 1199    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.
 1205nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1206    unit_module(Unit, Module),
 1207    result_vars(Expected, Vars),
 1208    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1209                            Result0, Options), Time)
 1210    ->  (   Result0 == true
 1211        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1212            ->  Result = success(Unit, Name, Line, true, Time)
 1213            ;   Result = failure(Unit, Name, Line,
 1214				 [wrong_answer(Expected, Bindings)], Time)
 1215            )
 1216        ;   Result0 = throw(E)
 1217        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1218        )
 1219    ).
 1220
 1221cmp_true([], _, L) =>
 1222    L = [].
 1223cmp_true([Cmp|T], Module, L) =>
 1224    E = error(Formal,_),
 1225    cmp_goal(Cmp, Goal),
 1226    (   catch(Module:Goal, E, true)
 1227    ->  (   var(Formal)
 1228	->  cmp_true(T, Module, L)
 1229	;   L = [cmp_error(Cmp,E)|L1],
 1230	    cmp_true(T, Module, L1)
 1231	)
 1232    ;   L = [wrong_answer(Cmp)|L1],
 1233	cmp_true(T, Module, L1)
 1234    ).
 1235
 1236cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1237cmp_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.
 1245result_vars(Expected, Vars) :-
 1246    arg(1, Expected, CmpOp),
 1247    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
 1257nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1258    cmp(Cmp, _Vars, Op, Values),
 1259    cmp_list(Values, Bindings, Op).
 1260nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1261    cmp(Cmp, _Vars, Op, Values0),
 1262    sort(Bindings0, Bindings),
 1263    sort(Values0, Values),
 1264    cmp_list(Values, Bindings, Op).
 1265
 1266cmp_list([], [], _Op).
 1267cmp_list([E0|ET], [V0|VT], Op) :-
 1268    call(Op, E0, V0),
 1269    cmp_list(ET, VT, Op).
 cmp(+CmpTerm, -Left, -Op, -Right) is det
 1273cmp(Var  == Value, Var,  ==, Value).
 1274cmp(Var =:= Value, Var, =:=, Value).
 1275cmp(Var  =  Value, Var,  =,  Value).
 1276:- if(swi). 1277cmp(Var =@= Value, Var, =@=, Value).
 1278:- else. 1279:- if(sicstus). 1280cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1281:- endif. 1282:- endif.
 call_det(:Goal, -Det) is nondet
True if Goal succeeded. Det is unified to true if Goal left no choicepoints and false otherwise.
 1290:- if((swi;sicstus)). 1291call_det(Goal, Det) :-
 1292    call_cleanup(Goal,Det0=true),
 1293    ( var(Det0) -> Det = false ; Det = true ).
 1294:- else. 1295call_det(Goal, true) :-
 1296    call(Goal).
 1297:- endif.
 match_error(+Expected, +Received) is semidet
True if the Received errors matches the expected error. Matching is based on subsumes_term/2.
 1304match_error(Expect, Rec) :-
 1305    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
 1318setup(Module, Context, Options) :-
 1319    option(setup(Setup), Options),
 1320    !,
 1321    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1322    (   Result == true
 1323    ->  true
 1324    ;   print_message(error,
 1325		      plunit(error(setup, Context, Output, Result))),
 1326	fail
 1327    ).
 1328setup(_,_,_).
 condition(+Module, +Context, +Options) is semidet
Evaluate the test or test unit condition.
 1334condition(Module, Context, Options) :-
 1335    option(condition(Cond), Options),
 1336    !,
 1337    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1338    (   Result == true
 1339    ->  true
 1340    ;   Result == false
 1341    ->  fail
 1342    ;   print_message(error,
 1343		      plunit(error(condition, Context, Output, Result))),
 1344	fail
 1345    ).
 1346condition(_, _, _).
 call_ex(+Module, +Goal)
Call Goal in Module after applying goal expansion.
 1353call_ex(Module, Goal) :-
 1354    Module:(expand_goal(Goal, GoalEx),
 1355	    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.
 1362cleanup(Module, Options) :-
 1363    option(cleanup(Cleanup), Options, true),
 1364    (   catch(call_ex(Module, Cleanup), E, true)
 1365    ->  (   var(E)
 1366	->  true
 1367	;   print_message(warning, E)
 1368	)
 1369    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1370    ).
 1371
 1372success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1373    memberchk(fixme(Reason), Options),
 1374    !,
 1375    (   (   Det == true
 1376	;   memberchk(nondet, Options)
 1377	)
 1378    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1379	Ok = passed
 1380    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1381	Ok = nondet
 1382    ),
 1383    flush_output(user_error),
 1384    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1385success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1386    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1387    !,
 1388    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1389success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1390    Output = true-_,
 1391    !,
 1392    failure(Unit, Name, Progress, Line, message, Time, Output, Options).
 1393success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1394    assert(passed(Unit, Name, Line, Det, Time)),
 1395    (   (   Det == true
 1396	;   memberchk(nondet, Options)
 1397	)
 1398    ->  progress(Unit:Name, Progress, passed, Time)
 1399    ;   unit_file(Unit, File),
 1400	print_message(warning, plunit(nondet(File, Line, Name)))
 1401    ).
 failure(+Unit, +Name, +Progress, +Line, +How, +Time, +Output, +Options) is det
Test failed. Report the error.
 1408failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1409  memberchk(fixme(Reason), Options) =>
 1410    assert(fixme(Unit, Name, Line, Reason, failed)),
 1411    progress(Unit:Name, Progress, fixme(failed), Time).
 1412failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1413	Output, Options) =>
 1414    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1415    progress(Unit:Name, Progress, timeout(Limit), Time),
 1416    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1417failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1418    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1419    progress(Unit:Name, Progress, failed, Time),
 1420    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.
 1430:- if(swi). 1431assert_cyclic(Term) :-
 1432    acyclic_term(Term),
 1433    !,
 1434    assert(Term).
 1435assert_cyclic(Term) :-
 1436    Term =.. [Functor|Args],
 1437    recorda(cyclic, Args, Id),
 1438    functor(Term, _, Arity),
 1439    length(NewArgs, Arity),
 1440    Head =.. [Functor|NewArgs],
 1441    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1442:- else. 1443:- if(sicstus). 1444:- endif. 1445assert_cyclic(Term) :-
 1446    assert(Term).
 1447:- endif. 1448
 1449
 1450		 /*******************************
 1451		 *             JOBS             *
 1452		 *******************************/
 1453
 1454:- if(current_prolog_flag(threads, true)). 1455
 1456:- dynamic
 1457       job_data/2,		% Queue, Threads
 1458       scheduled_unit/1. 1459
 1460schedule_unit(_:[]) :-
 1461    !.
 1462schedule_unit(UnitAndTests) :-
 1463    UnitAndTests = Unit:_Tests,
 1464    job_data(Queue, _),
 1465    !,
 1466    assertz(scheduled_unit(Unit)),
 1467    thread_send_message(Queue, unit(UnitAndTests)).
 1468schedule_unit(Unit) :-
 1469    run_unit(Unit).
 setup_jobs(+Count) is det
Setup threads for concurrent testing.
 1475setup_jobs(Count) :-
 1476    (   current_test_flag(jobs, Jobs0),
 1477	integer(Jobs0)
 1478    ->  true
 1479    ;   current_prolog_flag(cpu_count, Jobs0)
 1480    ),
 1481    Jobs is min(Count, Jobs0),
 1482    Jobs > 1,
 1483    !,
 1484    message_queue_create(Q, [alias(plunit_jobs)]),
 1485    length(TIDs, Jobs),
 1486    foldl(create_plunit_job(Q), TIDs, 1, _),
 1487    asserta(job_data(Q, TIDs)),
 1488    job_feedback(informational, jobs(Jobs)).
 1489setup_jobs(_) :-
 1490    job_feedback(informational, jobs(1)).
 1491
 1492create_plunit_job(Q, TID, N, N1) :-
 1493    N1 is N + 1,
 1494    atom_concat(plunit_job_, N, Alias),
 1495    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1496
 1497plunit_job(Queue) :-
 1498    repeat,
 1499    (   catch(thread_get_message(Queue, Job,
 1500				 [ timeout(10)
 1501				 ]),
 1502	      error(_,_), fail)
 1503    ->  job(Job),
 1504	fail
 1505    ;   !
 1506    ).
 1507
 1508job(unit(Unit:Tests)) =>
 1509    run_unit(Unit:Tests).
 1510job(test(Unit, Test)) =>
 1511    run_test(Unit, Test).
 1512
 1513cleanup_jobs :-
 1514    retract(job_data(Queue, TIDSs)),
 1515    !,
 1516    message_queue_destroy(Queue),
 1517    maplist(thread_join, TIDSs).
 1518cleanup_jobs.
 job_wait(?Unit) is det
Wait for all test jobs to finish.
 1524job_wait(Unit) :-
 1525    thread_wait(\+ scheduled_unit(Unit),
 1526		[ wait_preds([scheduled_unit/1]),
 1527		  timeout(1)
 1528		]),
 1529    !.
 1530job_wait(Unit) :-
 1531    job_data(_Queue, TIDs),
 1532    member(TID, TIDs),
 1533    thread_property(TID, status(running)),
 1534    !,
 1535    job_wait(Unit).
 1536job_wait(_).
 1537
 1538
 1539job_info(begin(unit(Unit))) =>
 1540    print_message(silent, plunit(begin(Unit))).
 1541job_info(end(unit(Unit, Summary))) =>
 1542    retractall(scheduled_unit(Unit)),
 1543    print_message(silent, plunit(end(Unit, Summary))).
 1544
 1545:- else.			% No jobs
 1546
 1547schedule_unit(Unit) :-
 1548    run_unit(Unit).
 1549
 1550setup_jobs(_) :-
 1551    print_message(silent, plunit(jobs(1))).
 1552cleanup_jobs.
 1553job_wait(_).
 1554job_info(_).
 1555
 1556:- endif. 1557
 1558
 1559
 1560		 /*******************************
 1561		 *            REPORTING         *
 1562		 *******************************/
 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
 1575begin_test(Unit, Test, Line, Progress) :-
 1576    thread_self(Me),
 1577    assert(running(Unit, Test, Line, Progress, Me)),
 1578    unit_file(Unit, File),
 1579    test_count(Total),
 1580    job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
 1581
 1582end_test(Unit, Test, Line, Progress) :-
 1583    thread_self(Me),
 1584    retractall(running(_,_,_,_,Me)),
 1585    unit_file(Unit, File),
 1586    test_count(Total),
 1587    job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
 running_tests is det
Print the currently running test.
 1593running_tests :-
 1594    running_tests(Running),
 1595    print_message(informational, plunit(running(Running))).
 1596
 1597running_tests(Running) :-
 1598    test_count(Total),
 1599    findall(running(Unit:Test, File:Line, Progress/Total, Thread),
 1600	    (   running(Unit, Test, Line, Progress, Thread),
 1601		unit_file(Unit, File)
 1602	    ), Running).
 current_test(?Unit, ?Test, ?Line, ?Body, ?Options) is nondet
True when a test with the specified properties is loaded.
 1609current_test(Unit, Test, Line, Body, Options) :-
 1610    current_unit(Unit, Module, _Supers, _UnitOptions),
 1611    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.
 1617current_test_unit(Unit, UnitOptions) :-
 1618    current_unit(Unit, _Module, _Supers, UnitOptions).
 1619
 1620
 1621count(Goal, Count) :-
 1622    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.
 1629test_summary(Unit, Summary) :-
 1630    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1631    count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
 1632    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1633    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1634    count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme),
 1635    test_count(Total),
 1636    Summary = plunit{total:Total,
 1637		     passed:Passed,
 1638		     failed:Failed,
 1639		     timeout:Timeout,
 1640		     blocked:Blocked,
 1641		     fixme:Fixme}.
 1642
 1643test_summary_passed(Summary) :-
 1644    _{failed: 0} :< Summary.
 report(+Time, +Options) is det
Print a summary of the tests that ran.
 1650report(Time, _Options) :-
 1651    test_summary(_, Summary),
 1652    print_message(silent, plunit(Summary)),
 1653    _{ passed:Passed,
 1654       failed:Failed,
 1655       timeout:Timeout,
 1656       blocked:Blocked,
 1657       fixme:Fixme
 1658     } :< Summary,
 1659    (   Passed+Failed+Timeout+Blocked+Fixme =:= 0
 1660    ->  info(plunit(no_tests))
 1661    ;   Failed+Timeout =:= 0
 1662    ->  report_blocked(Blocked),
 1663	report_fixme,
 1664        test_count(Total),
 1665	info(plunit(all_passed(Total, Passed, Time)))
 1666    ;   report_blocked(Blocked),
 1667	report_fixme,
 1668	report_failed(Failed),
 1669	report_timeout(Timeout),
 1670	info(plunit(passed(Passed))),
 1671        info(plunit(total_time(Time)))
 1672    ).
 1673
 1674report_blocked(0) =>
 1675    true.
 1676report_blocked(Blocked) =>
 1677    findall(blocked(Unit:Name, File:Line, Reason),
 1678	    ( blocked(Unit, Name, Line, Reason),
 1679	      unit_file(Unit, File)
 1680	    ),
 1681	    BlockedTests),
 1682    info(plunit(blocked(Blocked, BlockedTests))).
 1683
 1684report_failed(Failed) :-
 1685    print_message(error, plunit(failed(Failed))).
 1686
 1687report_timeout(Count) :-
 1688    print_message(warning, plunit(timeout(Count))).
 1689
 1690report_fixme :-
 1691    report_fixme(_,_,_).
 1692
 1693report_fixme(TuplesF, TuplesP, TuplesN) :-
 1694    fixme(failed, TuplesF, Failed),
 1695    fixme(passed, TuplesP, Passed),
 1696    fixme(nondet, TuplesN, Nondet),
 1697    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1698
 1699
 1700fixme(How, Tuples, Count) :-
 1701    findall(fixme(Unit, Name, Line, Reason, How),
 1702	    fixme(Unit, Name, Line, Reason, How), Tuples),
 1703    length(Tuples, Count).
 1704
 1705report_failure(Unit, Name, Progress, Line, Error,
 1706	       Time, Output, _Options) =>
 1707    test_count(Total),
 1708    job_feedback(error, failed(Unit:Name, Progress/Total, Line,
 1709			       Error, Time, Output)).
 test_report(+What) is det
Produce reports on test results after the run. Currently only supports fixme for What.
 1717test_report(fixme) :-
 1718    !,
 1719    report_fixme(TuplesF, TuplesP, TuplesN),
 1720    append([TuplesF, TuplesP, TuplesN], Tuples),
 1721    print_message(informational, plunit(fixme(Tuples))).
 1722test_report(What) :-
 1723    throw_error(domain_error(report_class, What), _).
 1724
 1725
 1726		 /*******************************
 1727		 *             INFO             *
 1728		 *******************************/
 unit_file(+Unit, -File) is det
unit_file(?Unit, ?File) is nondet
True when the test unit Unit is defined in File.
 1735unit_file(Unit, File), nonvar(Unit) =>
 1736    unit_file_(Unit, File),
 1737    !.
 1738unit_file(Unit, File) =>
 1739    unit_file_(Unit, File).
 1740
 1741unit_file_(Unit, File) :-
 1742    current_unit(Unit, Module, _Context, _Options),
 1743    module_property(Module, file(File)).
 1744unit_file_(Unit, PlFile) :-
 1745    test_file_for(TestFile, PlFile),
 1746    module_property(Module, file(TestFile)),
 1747    current_unit(Unit, Module, _Context, _Options).
 1748
 1749
 1750		 /*******************************
 1751		 *             FILES            *
 1752		 *******************************/
 load_test_files(+Options) is det
Load .plt test-files related to loaded source-files. Options is currently ignored.
 1759load_test_files(_Options) :-
 1760    State = state(0,0),
 1761    (   source_file(File),
 1762	file_name_extension(Base, Old, File),
 1763	Old \== plt,
 1764	file_name_extension(Base, plt, TestFile),
 1765	exists_file(TestFile),
 1766        inc_arg(1, State),
 1767	(   test_file_for(TestFile, File)
 1768	->  true
 1769	;   load_files(TestFile,
 1770		       [ if(changed),
 1771			 imports([])
 1772		       ]),
 1773            inc_arg(2, State),
 1774	    asserta(test_file_for(TestFile, File))
 1775	),
 1776        fail
 1777    ;   State = state(Total, Loaded),
 1778        print_message(informational, plunit(test_files(Total, Loaded)))
 1779    ).
 1780
 1781inc_arg(Arg, State) :-
 1782    arg(Arg, State, N0),
 1783    N is N0+1,
 1784    nb_setarg(Arg, State, N).
 1785
 1786
 1787		 /*******************************
 1788		 *           MESSAGES           *
 1789		 *******************************/
 info(+Term)
Runs print_message(Level, Term), where Level is one of silent or informational (default).
 1796info(Term) :-
 1797    message_level(Level),
 1798    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)
 1815progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) =>
 1816    (   retract(forall_failures(Nth, FFailed))
 1817    ->  true
 1818    ;   FFailed = 0
 1819    ),
 1820    test_count(Total),
 1821    job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)).
 1822progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) =>
 1823    with_mutex(plunit_forall_counter,
 1824               update_forall_failures(Nth, Result)),
 1825    test_count(Total),
 1826    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1827progress(UnitTest, Progress, Result, Time) =>
 1828    test_count(Total),
 1829    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1830
 1831update_forall_failures(_Nth, passed) =>
 1832    true.
 1833update_forall_failures(Nth, _) =>
 1834    (   retract(forall_failures(Nth, Failed0))
 1835    ->  true
 1836    ;   Failed0 = 0
 1837    ),
 1838    Failed is Failed0+1,
 1839    asserta(forall_failures(Nth, Failed)).
 1840
 1841message_level(Level) :-
 1842    (   current_test_flag(silent, true)
 1843    ->  Level = silent
 1844    ;   Level = informational
 1845    ).
 1846
 1847locationprefix(File:Line) -->
 1848    !,
 1849    [ url(File:Line), ':'-[], nl, '    ' ].
 1850locationprefix(test(Unit,_Test,Line)) -->
 1851    !,
 1852    { unit_file(Unit, File) },
 1853    locationprefix(File:Line).
 1854locationprefix(unit(Unit)) -->
 1855    !,
 1856    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1857locationprefix(FileLine) -->
 1858    { throw_error(type_error(locationprefix,FileLine), _) }.
 1859
 1860:- discontiguous
 1861    message//1. 1862:- '$hide'(message//1). 1863
 1864message(error(context_error(plunit_close(Name, -)), _)) -->
 1865    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1866message(error(context_error(plunit_close(Name, Start)), _)) -->
 1867    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1868message(plunit(nondet(File, Line, Name))) -->
 1869    locationprefix(File:Line),
 1870    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1871message(error(plunit(incompatible_options, Tests), _)) -->
 1872    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1873message(plunit(sto(true))) -->
 1874    [ 'Option sto(true) is ignored.  See `occurs_check` option.'-[] ].
 1875message(plunit(test_files(Total, Loaded))) -->
 1876    [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ].
 1877
 1878					% Unit start/end
 1879message(plunit(jobs(1))) -->
 1880    !.
 1881message(plunit(jobs(N))) -->
 1882    [ 'Testing with ~D parallel jobs'-[N] ].
 1883message(plunit(begin(_Unit))) -->
 1884    { tty_feedback },
 1885    !.
 1886message(plunit(begin(Unit))) -->
 1887    [ 'Start unit: ~w~n'-[Unit], flush ].
 1888message(plunit(end(_Unit, _Summary))) -->
 1889    { tty_feedback },
 1890    !.
 1891message(plunit(end(Unit, Summary))) -->
 1892    (   {test_summary_passed(Summary)}
 1893    ->  [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
 1894    ;   [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
 1895    ).
 1896message(plunit(blocked(unit(Unit, Reason)))) -->
 1897    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1898message(plunit(running([]))) -->
 1899    !,
 1900    [ 'PL-Unit: no tests running' ].
 1901message(plunit(running([One]))) -->
 1902    !,
 1903    [ 'PL-Unit: running ' ],
 1904    running(One).
 1905message(plunit(running(More))) -->
 1906    !,
 1907    [ 'PL-Unit: running tests:', nl ],
 1908    running(More).
 1909message(plunit(fixme([]))) --> !.
 1910message(plunit(fixme(Tuples))) -->
 1911    !,
 1912    fixme_message(Tuples).
 1913message(plunit(total_time(Time))) -->
 1914    [ 'Test run completed'-[] ],
 1915    test_time(Time).
 1916
 1917					% Blocked tests
 1918message(plunit(blocked(1, Tests))) -->
 1919    !,
 1920    [ 'one test is blocked'-[] ],
 1921    blocked_tests(Tests).
 1922message(plunit(blocked(N, Tests))) -->
 1923    [ '~D tests are blocked'-[N] ],
 1924    blocked_tests(Tests).
 1925
 1926blocked_tests(Tests) -->
 1927    { current_test_flag(show_blocked, true) },
 1928    !,
 1929    [':'-[]],
 1930    list_blocked(Tests).
 1931blocked_tests(_) -->
 1932    [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []),
 1933      ' for details)'-[]
 1934    ].
 1935
 1936list_blocked([]) --> !.
 1937list_blocked([blocked(Unit:Test, Pos, Reason)|T]) -->
 1938    [nl],
 1939    locationprefix(Pos),
 1940    test_name(Unit:Test, -),
 1941    [ ': ~w'-[Reason] ],
 1942    list_blocked(T).
 1943
 1944					% fail/success
 1945message(plunit(no_tests)) -->
 1946    !,
 1947    [ 'No tests to run' ].
 1948message(plunit(all_passed(1, 1, Time))) -->
 1949    !,
 1950    [ 'test passed' ],
 1951    test_time(Time).
 1952message(plunit(all_passed(Total, Total, Time))) -->
 1953    !,
 1954    [ 'All ~D tests passed'-[Total] ],
 1955    test_time(Time).
 1956message(plunit(all_passed(Total, Count, Time))) -->
 1957    !,
 1958    { SubTests is Count-Total },
 1959    [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ],
 1960    test_time(Time).
 1961
 1962test_time(Time) -->
 1963    { var(Time) }, !.
 1964test_time(Time) -->
 1965    [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ].
 1966
 1967message(plunit(passed(Count))) -->
 1968    !,
 1969    [ '~D tests passed'-[Count] ].
 1970message(plunit(failed(0))) -->
 1971    !,
 1972    [].
 1973message(plunit(failed(1))) -->
 1974    !,
 1975    [ '1 test failed'-[] ].
 1976message(plunit(failed(N))) -->
 1977    [ '~D tests failed'-[N] ].
 1978message(plunit(timeout(0))) -->
 1979    !,
 1980    [].
 1981message(plunit(timeout(N))) -->
 1982    [ '~D tests timed out'-[N] ].
 1983message(plunit(fixme(0,0,0))) -->
 1984    [].
 1985message(plunit(fixme(Failed,0,0))) -->
 1986    !,
 1987    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1988message(plunit(fixme(Failed,Passed,0))) -->
 1989    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1990message(plunit(fixme(Failed,Passed,Nondet))) -->
 1991    { TotalPassed is Passed+Nondet },
 1992    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1993      [Failed, TotalPassed, Nondet] ].
 1994
 1995message(plunit(begin(Unit:Test, _Location, Progress))) -->
 1996    { tty_columns(SummaryWidth, _Margin),
 1997      test_name_summary(Unit:Test, SummaryWidth, NameS),
 1998      progress_string(Progress, ProgressS)
 1999    },
 2000    (   { tty_feedback,
 2001	  tty_clear_to_eol(CE)
 2002	}
 2003    ->  [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS,
 2004					     CE], flush ]
 2005    ;   { jobs(_) }
 2006    ->  [ '[~w] ~w ..'-[ProgressS, NameS] ]
 2007    ;   [ '[~w] ~w ..'-[ProgressS, NameS], flush ]
 2008    ).
 2009message(plunit(end(_UnitTest, _Location, _Progress))) -->
 2010    [].
 2011message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
 2012    { Status = forall(_,_)
 2013    ; Status == assertion
 2014    },
 2015    !.
 2016message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
 2017    { jobs(_),
 2018      !,
 2019      tty_columns(SummaryWidth, Margin),
 2020      test_name_summary(Unit:Test, SummaryWidth, NameS),
 2021      progress_string(Progress, ProgressS),
 2022      progress_tag(Status, Tag, _Keep, Style)
 2023    },
 2024    [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|',
 2025	   [ProgressS, NameS, Tag, Time.wall, Margin]) ].
 2026message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
 2027    { tty_columns(_SummaryWidth, Margin),
 2028      progress_tag(Status, Tag, _Keep, Style)
 2029    },
 2030    [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
 2031			 [Tag, Time.wall, Margin]) ],
 2032    (   { tty_feedback }
 2033    ->  [flush]
 2034    ;   []
 2035    ).
 2036message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
 2037    { unit_file(Unit, File) },
 2038    locationprefix(File:Line),
 2039    test_name(Unit:Test, Progress),
 2040    [': '-[] ],
 2041    failure(Failure),
 2042    test_output(Output).
 2043message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
 2044    { unit_file(Unit, File) },
 2045    locationprefix(File:Line),
 2046    test_name(Unit:Test, Progress),
 2047    [': '-[] ],
 2048    timeout(Limit),
 2049    test_output(Output).
 2050:- if(swi). 2051message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
 2052				Progress, Reason, Goal))) -->
 2053    { unit_file(Unit, File) },
 2054    locationprefix(File:Line),
 2055    test_name(Unit:Test, Progress),
 2056    [ ': assertion'-[] ],
 2057    assertion_location(AssertLoc, File),
 2058    assertion_reason(Reason), ['\n\t'],
 2059    assertion_goal(Unit, Goal).
 2060
 2061assertion_location(File:Line, File) -->
 2062    [ ' at line ~w'-[Line] ].
 2063assertion_location(File:Line, _) -->
 2064    [ ' at ', url(File:Line) ].
 2065assertion_location(unknown, _) -->
 2066    [].
 2067
 2068assertion_reason(fail) -->
 2069    !,
 2070    [ ' failed'-[] ].
 2071assertion_reason(Error) -->
 2072    { message_to_string(Error, String) },
 2073    [ ' raised "~w"'-[String] ].
 2074
 2075assertion_goal(Unit, Goal) -->
 2076    { unit_module(Unit, Module),
 2077      unqualify(Goal, Module, Plain)
 2078    },
 2079    [ 'Assertion: ~p'-[Plain] ].
 2080
 2081unqualify(Var, _, Var) :-
 2082    var(Var),
 2083    !.
 2084unqualify(M:Goal, Unit, Goal) :-
 2085    nonvar(M),
 2086    unit_module(Unit, M),
 2087    !.
 2088unqualify(M:Goal, _, Goal) :-
 2089    callable(Goal),
 2090    predicate_property(M:Goal, imported_from(system)),
 2091    !.
 2092unqualify(Goal, _, Goal).
 2093
 2094test_output(Msgs-String) -->
 2095    { nonvar(Msgs) },
 2096    !,
 2097    test_output(String).
 2098test_output("") --> [].
 2099test_output(Output) -->
 2100    [ ansi(code, '~N~s', [Output]) ].
 2101
 2102:- endif. 2103					% Setup/condition errors
 2104message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
 2105    locationprefix(Context),
 2106    { message_to_string(Exception, String) },
 2107    [ 'error in ~w: ~w'-[Where, String] ].
 2108message(plunit(error(Where, Context, _Output, false))) -->
 2109    locationprefix(Context),
 2110    [ 'setup failed in ~w'-[Where] ].
 2111
 2112                                        % delayed output
 2113message(plunit(test_output(_, Output))) -->
 2114    [ '~s'-[Output] ].
 2115					% Interrupts (SWI)
 2116:- if(swi). 2117message(interrupt(begin)) -->
 2118    { thread_self(Me),
 2119      running(Unit, Test, Line, Progress, Me),
 2120      !,
 2121      unit_file(Unit, File),
 2122      restore_output_state
 2123    },
 2124    [ 'Interrupted test '-[] ],
 2125    running(running(Unit:Test, File:Line, Progress, Me)),
 2126    [nl],
 2127    '$messages':prolog_message(interrupt(begin)).
 2128message(interrupt(begin)) -->
 2129    '$messages':prolog_message(interrupt(begin)).
 2130:- endif. 2131
 2132message(concurrent) -->
 2133    [ 'concurrent(true) at the level of units is currently ignored.', nl,
 2134      'See set_test_options/1 with jobs(Count) for concurrent testing.'
 2135    ].
 2136
 2137test_name(Name, forall(Bindings, _Nth-I)) -->
 2138    !,
 2139    test_name(Name, -),
 2140    [ ' (~d-th forall bindings = '-[I],
 2141      ansi(code, '~p', [Bindings]), ')'-[]
 2142    ].
 2143test_name(Name, _) -->
 2144    !,
 2145    [ 'test ', ansi(code, '~q', [Name]) ].
 2146
 2147running(running(Unit:Test, File:Line, _Progress, Thread)) -->
 2148    thread(Thread),
 2149    [ '~q:~q at '-[Unit, Test], url(File:Line) ].
 2150running([H|T]) -->
 2151    ['\t'], running(H),
 2152    (   {T == []}
 2153    ->  []
 2154    ;   [nl], running(T)
 2155    ).
 2156
 2157thread(main) --> !.
 2158thread(Other) -->
 2159    [' [~w] '-[Other] ].
 2160
 2161:- if(swi). 2162write_term(T, OPS) -->
 2163    ['~W'-[T,OPS] ].
 2164:- else. 2165write_term(T, _OPS) -->
 2166    ['~q'-[T]].
 2167:- endif. 2168
 2169expected_got_ops_(Ex, E, OPS, Goals) -->
 2170    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 2171    ['    Got:      '-[]], write_term(E,  OPS), [],
 2172    ( { Goals = [] } -> []
 2173    ; [nl, '       with: '-[]], write_term(Goals, OPS), []
 2174    ).
 2175
 2176
 2177failure(List) -->
 2178    { is_list(List) },
 2179    !,
 2180    [ nl ],
 2181    failures(List).
 2182failure(Var) -->
 2183    { var(Var) },
 2184    !,
 2185    [ 'Unknown failure?' ].
 2186failure(succeeded(Time)) -->
 2187    !,
 2188    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 2189failure(wrong_error(Expected, Error)) -->
 2190    !,
 2191    { copy_term(Expected-Error, Ex-E, Goals),
 2192      numbervars(Ex-E-Goals, 0, _),
 2193      write_options(OPS)
 2194    },
 2195    [ 'wrong error'-[], nl ],
 2196    expected_got_ops_(Ex, E, OPS, Goals).
 2197failure(wrong_answer(cmp(Var, Cmp))) -->
 2198    { Cmp =.. [Op,Answer,Expected],
 2199      !,
 2200      copy_term(Expected-Answer, Ex-A, Goals),
 2201      numbervars(Ex-A-Goals, 0, _),
 2202      write_options(OPS)
 2203    },
 2204    [ 'wrong answer for ', ansi(code, '~w', [Var]),
 2205      ' (compared using ~w)'-[Op], nl ],
 2206    expected_got_ops_(Ex, A, OPS, Goals).
 2207failure(wrong_answer(Cmp)) -->
 2208    { Cmp =.. [Op,Answer,Expected],
 2209      !,
 2210      copy_term(Expected-Answer, Ex-A, Goals),
 2211      numbervars(Ex-A-Goals, 0, _),
 2212      write_options(OPS)
 2213    },
 2214    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 2215    expected_got_ops_(Ex, A, OPS, Goals).
 2216failure(wrong_answer(CmpExpected, Bindings)) -->
 2217    { (   CmpExpected = all(Cmp)
 2218      ->  Cmp =.. [_Op1,_,Expected],
 2219	  Got = Bindings,
 2220	  Type = all
 2221      ;   CmpExpected = set(Cmp),
 2222	  Cmp =.. [_Op2,_,Expected0],
 2223	  sort(Expected0, Expected),
 2224	  sort(Bindings, Got),
 2225	  Type = set
 2226      )
 2227    },
 2228    [ 'wrong "~w" answer:'-[Type] ],
 2229    [ nl, '    Expected: ~q'-[Expected] ],
 2230    [ nl, '       Found: ~q'-[Got] ].
 2231:- if(swi). 2232failure(cmp_error(_Cmp, Error)) -->
 2233    { message_to_string(Error, Message) },
 2234    [ 'Comparison error: ~w'-[Message] ].
 2235failure(throw(Error)) -->
 2236    { Error = error(_,_),
 2237      !,
 2238      message_to_string(Error, Message)
 2239    },
 2240    [ 'received error: ~w'-[Message] ].
 2241:- endif. 2242failure(message) -->
 2243    !,
 2244    [ 'Generated unexpected warning or error'-[] ].
 2245failure(Why) -->
 2246    [ '~p'-[Why] ].
 2247
 2248failures([]) -->
 2249    !.
 2250failures([H|T]) -->
 2251    !,
 2252    failure(H), [nl],
 2253    failures(T).
 2254
 2255timeout(Limit) -->
 2256    [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
 2257
 2258fixme_message([]) --> [].
 2259fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 2260    { unit_file(Unit, File) },
 2261    fixme_message(File:Line, Reason, How),
 2262    (   {T == []}
 2263    ->  []
 2264    ;   [nl],
 2265	fixme_message(T)
 2266    ).
 2267
 2268fixme_message(Location, Reason, failed) -->
 2269    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 2270fixme_message(Location, Reason, passed) -->
 2271    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 2272fixme_message(Location, Reason, nondet) -->
 2273    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 2274
 2275
 2276write_options([ numbervars(true),
 2277		quoted(true),
 2278		portray(true),
 2279		max_depth(100),
 2280		attributes(portray)
 2281	      ]).
 test_name_summary(+Term, +MaxLen, -Summary) is det
Given the test id, generate string that summarizes this in MaxLen characters.
 2288test_name_summary(Term, MaxLen, Summary) :-
 2289    summary_string(Term, Text),
 2290    atom_length(Text, Len),
 2291    (   Len =< MaxLen
 2292    ->  Summary = Text
 2293    ;   End is MaxLen//2,
 2294        Pre is MaxLen - End - 2,
 2295        sub_string(Text, 0, Pre, _, PreText),
 2296        sub_string(Text, _, End, 0, PostText),
 2297        format(string(Summary), '~w..~w', [PreText,PostText])
 2298    ).
 2299
 2300summary_string(Unit:Test, String) =>
 2301    summary_string(Test, String1),
 2302    atomics_to_string([Unit, String1], :, String).
 2303summary_string(@(Name,Vars), String) =>
 2304    format(string(String), '~W (using ~W)',
 2305           [ Name, [numbervars(true), quoted(false)],
 2306             Vars, [numbervars(true), portray(true), quoted(true)]
 2307           ]).
 2308summary_string(Name, String) =>
 2309    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.
 2315progress_string(forall(_Vars, N-I)/Total, S) =>
 2316    format(string(S), '~w-~w/~w', [N,I,Total]).
 2317progress_string(Progress, S) =>
 2318    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.
 2326progress_tag(passed,        Tag, Keep, Style) =>
 2327    Tag = passed, Keep = false, Style = comment.
 2328progress_tag(fixme(passed), Tag, Keep, Style) =>
 2329    Tag = passed, Keep = false, Style = comment.
 2330progress_tag(fixme(_),      Tag, Keep, Style) =>
 2331    Tag = fixme, Keep = true, Style = warning.
 2332progress_tag(nondet,        Tag, Keep, Style) =>
 2333    Tag = '**NONDET', Keep = true, Style = warning.
 2334progress_tag(timeout(_Limit), Tag, Keep, Style) =>
 2335    Tag = '**TIMEOUT', Keep = true, Style = warning.
 2336progress_tag(assertion,     Tag, Keep, Style) =>
 2337    Tag = '**FAILED', Keep = true, Style = error.
 2338progress_tag(failed,        Tag, Keep, Style) =>
 2339    Tag = '**FAILED', Keep = true, Style = error.
 2340progress_tag(forall(_,0),   Tag, Keep, Style) =>
 2341    Tag = passed, Keep = false, Style = comment.
 2342progress_tag(forall(_,_),   Tag, Keep, Style) =>
 2343    Tag = '**FAILED', Keep = true, Style = error.
 2344
 2345
 2346		 /*******************************
 2347		 *           OUTPUT		*
 2348		 *******************************/
 2349
 2350save_output_state :-
 2351    stream_property(Output, alias(user_output)),
 2352    stream_property(Error, alias(user_error)),
 2353    asserta(output_streams(Output, Error)).
 2354
 2355restore_output_state :-
 2356    output_streams(Output, Error),
 2357    !,
 2358    set_stream(Output, alias(user_output)),
 2359    set_stream(Error, alias(user_error)).
 2360restore_output_state.
 2361
 2362
 2363
 2364		 /*******************************
 2365		 *      CONCURRENT STATUS       *
 2366		 *******************************/
 2367
 2368/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2369This part deals with interactive feedback   when we are running multiple
 2370threads. The terminal window cannot work on   top  of the Prolog message
 2371infrastructure and (thus) we have to use more low-level means.
 2372- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2373
 2374:- dynamic
 2375       jobs/1,			% Count
 2376       job_window/1,		% Count
 2377       job_status_line/3.	% Job, Format, Args
 2378
 2379job_feedback(_, jobs(Jobs)) :-
 2380    retractall(jobs(_)),
 2381    Jobs > 1,
 2382    asserta(jobs(Jobs)),
 2383    tty_feedback,
 2384    !,
 2385    retractall(job_window(_)),
 2386    asserta(job_window(Jobs)),
 2387    retractall(job_status_line(_,_,_)),
 2388    jobs_redraw.
 2389job_feedback(_, jobs(Jobs)) :-
 2390    !,
 2391    retractall(job_window(_)),
 2392    info(plunit(jobs(Jobs))).
 2393job_feedback(_, Msg) :-
 2394    job_window(_),
 2395    !,
 2396    with_mutex(plunit_feedback, job_feedback(Msg)).
 2397job_feedback(Level, Msg) :-
 2398    print_message(Level, plunit(Msg)).
 2399
 2400job_feedback(begin(Unit:Test, _Location, Progress)) =>
 2401    tty_columns(SummaryWidth, _Margin),
 2402    test_name_summary(Unit:Test, SummaryWidth, NameS),
 2403    progress_string(Progress, ProgressS),
 2404    tty_clear_to_eol(CE),
 2405    job_format(comment, '\r[~w] ~w ..~w',
 2406	       [ProgressS, NameS, CE]),
 2407    flush_output.
 2408job_feedback(end(_UnitTest, _Location, _Progress)) =>
 2409    true.
 2410job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
 2411    (   hide_progress(Status)
 2412    ->  true
 2413    ;   tty_columns(_SummaryWidth, Margin),
 2414	progress_tag(Status, Tag, _Keep, Style),
 2415	job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2416		   [Tag, Time.wall, Margin])
 2417    ).
 2418job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
 2419    tty_columns(_SummaryWidth, Margin),
 2420    progress_tag(failed, Tag, _Keep, Style),
 2421    job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2422	       [Tag, Time.wall, Margin]),
 2423    print_test_output(Error, Output),
 2424    (   (   Error = timeout(_)	% Status line suffices
 2425	;   Error == assertion	% We will get an failed test later
 2426	)
 2427    ->  true
 2428    ;   print_message(Style, plunit(failed(UnitTest, Progress, Line,
 2429					   Error, Time, "")))
 2430    ),
 2431    jobs_redraw.
 2432job_feedback(begin(_Unit)) => true.
 2433job_feedback(end(_Unit, _Summary)) => true.
 2434
 2435hide_progress(assertion).
 2436hide_progress(forall(_,_)).
 2437hide_progress(failed).
 2438hide_progress(timeout(_)).
 2439
 2440print_test_output(Error, _Msgs-Output) =>
 2441    print_test_output(Error, Output).
 2442print_test_output(_, "") => true.
 2443print_test_output(assertion, Output) =>
 2444    print_message(debug, plunit(test_output(error, Output))).
 2445print_test_output(message, Output) =>
 2446    print_message(debug, plunit(test_output(error, Output))).
 2447print_test_output(_, Output) =>
 2448    print_message(debug, plunit(test_output(informational, Output))).
 jobs_redraw is det
Redraw the job window.
 2454jobs_redraw :-
 2455    job_window(N),
 2456    !,
 2457    tty_columns(_, Width),
 2458    tty_header_line(Width),
 2459    forall(between(1,N,Line), job_redraw_worker(Line)),
 2460    tty_header_line(Width).
 2461jobs_redraw.
 2462
 2463job_redraw_worker(Line) :-
 2464    (   job_status_line(Line, Fmt, Args)
 2465    ->  ansi_format(comment, Fmt, Args)
 2466    ;   true
 2467    ),
 2468    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.
 2476job_format(Style, Fmt, Args) :-
 2477    job_self(Job),
 2478    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.
 2486job_finish(Style, Fmt, Args) :-
 2487    job_self(Job),
 2488    job_finish(Job, Style, Fmt, Args).
 2489
 2490:- det(job_finish/4). 2491job_finish(Job, Style, Fmt, Args) :-
 2492    retract(job_status_line(Job, Fmt0, Args0)),
 2493    !,
 2494    string_concat(Fmt0, Fmt, Fmt1),
 2495    append(Args0, Args, Args1),
 2496    job_format(Job, Style, Fmt1, Args1, false).
 2497
 2498:- det(job_format/5). 2499job_format(Job, Style, Fmt, Args, Save) :-
 2500    job_window(Jobs),
 2501    Up is Jobs+2-Job,
 2502    flush_output(user_output),
 2503    tty_up_and_clear(Up),
 2504    ansi_format(Style, Fmt, Args),
 2505    (   Save == true
 2506    ->  retractall(job_status_line(Job, _, _)),
 2507	asserta(job_status_line(Job, Fmt, Args))
 2508    ;   true
 2509    ),
 2510    tty_down_and_home(Up),
 2511    flush_output(user_output).
 2512
 2513:- det(job_self/1). 2514job_self(Job) :-
 2515    job_window(N),
 2516    N > 1,
 2517    thread_self(Me),
 2518    split_string(Me, '_', '', [_,_,S]),
 2519    number_string(Job, S).
 feedback is semidet
provide feedback using the tty format, which reuses the current output line if the test is successful.
 2526tty_feedback :-
 2527    has_tty,
 2528    current_test_flag(format, tty).
 2529
 2530has_tty :-
 2531    stream_property(user_output, tty(true)).
 2532
 2533tty_columns(SummaryWidth, Margin) :-
 2534    tty_width(W),
 2535    Margin is W-8,
 2536    SummaryWidth is max(20,Margin-34).
 2537
 2538tty_width(W) :-
 2539    current_predicate(tty_size/2),
 2540    catch(tty_size(_Rows, Cols), error(_,_), fail),
 2541    Cols > 25,
 2542    !,
 2543    W = Cols.
 2544tty_width(80).
 2545
 2546tty_header_line(Width) :-
 2547    ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
 2548
 2549:- if(current_predicate(tty_get_capability/3)). 2550tty_clear_to_eol(S) :-
 2551    getenv('TERM', _),
 2552    catch(tty_get_capability(ce, string, S),
 2553          error(_,_),
 2554          fail),
 2555    !.
 2556:- endif. 2557tty_clear_to_eol('\e[K').
 2558
 2559tty_up_and_clear(Lines) :-
 2560    format(user_output, '\e[~dA\r\e[K', [Lines]).
 2561
 2562tty_down_and_home(Lines) :-
 2563    format(user_output, '\e[~dB\r', [Lines]).
 2564
 2565:- if(swi). 2566
 2567:- multifile
 2568    prolog:message/3,
 2569    user:message_hook/3. 2570
 2571prolog:message(Term) -->
 2572    message(Term).
 2573
 2574%       user:message_hook(+Term, +Kind, +Lines)
 2575
 2576user:message_hook(make(done(Files)), _, _) :-
 2577    make_run_tests(Files),
 2578    fail.                           % give other hooks a chance
 2579
 2580:- endif. 2581
 2582:- if(sicstus). 2583
 2584user:generate_message_hook(Message) -->
 2585    message(Message),
 2586    [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 ...
 2595user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 2596    format(user_error, '% PL-Unit: ~w ', [Unit]),
 2597    flush_output(user_error).
 2598user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 2599    format(user, ' done~n', []).
 2600
 2601:- endif.