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-2025, University of Amsterdam
    7			      VU University Amsterdam
    8			      CWI, Amsterdam
    9			      SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(plunit,
   39	  [ set_test_options/1,         % +Options
   40	    begin_tests/1,              % +Name
   41	    begin_tests/2,              % +Name, +Options
   42	    end_tests/1,                % +Name
   43	    run_tests/0,                % Run all tests
   44	    run_tests/1,                % +Tests
   45	    run_tests/2,                % +Tests, +Options
   46	    load_test_files/1,          % +Options
   47	    running_tests/0,            % Prints currently running test
   48	    current_test/5,             % ?Unit,?Test,?Line,?Body,?Options
   49	    current_test_unit/2,        % ?Unit,?Options
   50	    test_report/1               % +What
   51	  ]).

   59:- autoload(library(statistics), [call_time/2]).   60:- autoload(library(apply),
   61            [maplist/3, include/3, maplist/2, foldl/4, partition/4]).   62:- autoload(library(lists), [member/2, append/2, flatten/2, append/3]).   63:- autoload(library(option), [ option/3, option/2, select_option/3 ]).   64:- autoload(library(ordsets), [ord_intersection/3]).   65:- autoload(library(error), [must_be/2, domain_error/2]).   66:- autoload(library(aggregate), [aggregate_all/3]).   67:- autoload(library(streams), [with_output_to/3]).   68:- autoload(library(ansi_term), [ansi_format/3]).   69:- if(exists_source(library(time))).   70:- autoload(library(time), [call_with_time_limit/2]).   71:- endif.   72
   73:- public
   74    unit_module/2.   75
   76:- meta_predicate
   77    valid_options(1, +),
   78    count(0, -).   79
   80		 /*******************************
   81		 *    CONDITIONAL COMPILATION   *
   82		 *******************************/
   83
   84swi     :- catch(current_prolog_flag(dialect, swi),     _, fail).
   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:- thread_local
  254    loading_unit/4.                 % Unit, Module, File, OldSource
  255:- dynamic
  256    current_unit/4,                 % Unit, Module, Context, Options
  257    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).

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

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  342end_tests(Unit) :-
  343    loading_unit(StartUnit, _, _, _),
  344    !,
  345    (   Unit == StartUnit
  346    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  347	'$set_source_module'(_, Old)
  348    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  349    ).
  350end_tests(Unit) :-
  351    throw_error(context_error(plunit_close(Unit, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  356:- if(swi).  357
  358unit_module(Unit, Module) :-
  359    atom_concat('plunit_', Unit, Module).
  360
  361make_unit_module(Unit, Module) :-
  362    unit_module(Unit, Module),
  363    (   current_module(Module),
  364	\+ current_unit(_, Module, _, _),
  365	predicate_property(Module:H, _P),
  366	\+ predicate_property(Module:H, imported_from(_M))
  367    ->  throw_error(permission_error(create, plunit, Unit),
  368		    'Existing module')
  369    ;  true
  370    ).
  371
  372:- else.  373
  374:- dynamic
  375    unit_module_store/2.  376
  377unit_module(Unit, Module) :-
  378    unit_module_store(Unit, Module),
  379    !.
  380
  381make_unit_module(Unit, Module) :-
  382    prolog_load_context(module, Module),
  383    assert(unit_module_store(Unit, Module)).
  384
  385:- endif.  386
  387		 /*******************************
  388		 *           EXPANSION          *
  389		 *******************************/

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

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

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

 expand(+Term, -Clauses) is semidet

  477expand(end_of_file, _) :-
  478    loading_unit(Unit, _, _, _),
  479    !,
  480    end_tests(Unit),                % warn?
  481    fail.
  482expand((:-end_tests(_)), _) :-
  483    !,
  484    fail.
  485expand(_Term, []) :-
  486    \+ loading_tests.
  487expand((test(Name) :- Body), Clauses) :-
  488    !,
  489    expand_test(Name, [], Body, Clauses).
  490expand((test(Name, Options) :- Body), Clauses) :-
  491    !,
  492    expand_test(Name, Options, Body, Clauses).
  493expand(test(Name), _) :-
  494    !,
  495    throw_error(existence_error(body, test(Name)), _).
  496expand(test(Name, _Options), _) :-
  497    !,
  498    throw_error(existence_error(body, test(Name)), _).
  499
  500:- multifile
  501    system:term_expansion/2.  502
  503system:term_expansion(Term, Expanded) :-
  504    (   loading_unit(_, _, File, _)
  505    ->  source_location(ThisFile, _),
  506	(   File == ThisFile
  507	->  true
  508	;   source_file_property(ThisFile, included_in(File, _))
  509	),
  510	expand(Term, Expanded)
  511    ).
  512
  513
  514		 /*******************************
  515		 *             OPTIONS          *
  516		 *******************************/

 valid_options(:Pred, +Options) is det

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

Errors

- type_error or instantiation_error.

  525valid_options(Pred, Options) :-
  526    must_be(list, Options),
  527    verify_options(Options, Pred).
  528
  529verify_options([], _).
  530verify_options([H|T], Pred) :-
  531    (   call(Pred, H)
  532    ->  verify_options(T, Pred)
  533    ;   throw_error(domain_error(Pred, H), _)
  534    ).
  535
  536valid_options(Pred, Options0, Options, Rest) :-
  537    must_be(list, Options0),
  538    partition(Pred, Options0, Options, Rest).

 test_option(+Option) is semidet

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

  544test_option(Option) :-
  545    test_set_option(Option),
  546    !.
  547test_option(true(_)).
  548test_option(fail).
  549test_option(throws(_)).
  550test_option(all(_)).
  551test_option(set(_)).
  552test_option(nondet).
  553test_option(fixme(_)).
  554test_option(forall(X)) :-
  555    must_be(callable, X).
  556test_option(timeout(Seconds)) :-
  557    must_be(number, Seconds).

 test_option(+Option) is semidet

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

  564test_set_option(blocked(X)) :-
  565    must_be(ground, X).
  566test_set_option(condition(X)) :-
  567    must_be(callable, X).
  568test_set_option(setup(X)) :-
  569    must_be(callable, X).
  570test_set_option(cleanup(X)) :-
  571    must_be(callable, X).
  572test_set_option(occurs_check(V)) :-
  573    must_be(oneof([false,true,error]), V).
  574test_set_option(concurrent(V)) :-
  575    must_be(boolean, V),
  576    print_message(informational, plunit(concurrent)).
  577test_set_option(timeout(Seconds)) :-
  578    must_be(number, Seconds).
  579
  580		 /*******************************
  581		 *             UTIL		*
  582		 *******************************/
  583
  584:- meta_predicate
  585       reify_tmo(0, -, +),
  586       reify(0, -),
  587       capture_output(0,-),
  588       capture_output(0,-,+),
  589       got_messages(0,-).

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

  593:- if(current_predicate(call_with_time_limit/2)).  594reify_tmo(Goal, Result, Options) :-
  595    option(timeout(Time), Options),
  596    Time > 0,
  597    !,
  598    reify(call_with_time_limit(Time, Goal), Result0),
  599    (   Result0 = throw(time_limit_exceeded)
  600    ->  Result = throw(time_limit_exceeded(Time))
  601    ;   Result = Result0
  602    ).
  603:- endif.  604reify_tmo(Goal, Result, _Options) :-
  605    reify(Goal, Result).

 reify(:Goal, -Result) is det

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

  612reify(Goal, Result) :-
  613    (   catch(Goal, E, true)
  614    ->  (   var(E)
  615	->  Result = true
  616	;   Result = throw(E)
  617	)
  618    ;   Result = false
  619    ).

 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.

  628capture_output(Goal, Output) :-
  629    current_test_flag(output, OutputMode),
  630    capture_output(Goal, Output, [output(OutputMode)]).
  631
  632capture_output(Goal, Msgs-Output, Options) :-
  633    option(output(How), Options, always),
  634    (   How == always
  635    ->  call(Goal),
  636        Msgs = false                % irrelavant
  637    ;   with_output_to(string(Output), got_messages(Goal, Msgs),
  638                       [ capture([user_output, user_error]),
  639                         color(true)
  640                       ])
  641    ).

 got_messages(:Goal, -Result)

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

  717run_tests :-
  718    run_tests(all).
  719
  720run_tests(Set) :-
  721    run_tests(Set, []).
  722
  723run_tests(all, Options) :-
  724    !,
  725    findall(Unit, current_test_unit(Unit,_), Units),
  726    run_tests(Units, Options).
  727run_tests(Set, Options) :-
  728    valid_options(global_test_option, Options, Global, Rest),
  729    current_test_flags(Old),
  730    setup_call_cleanup(
  731	set_test_options(Global),
  732	( flatten([Set], List),
  733	  maplist(runnable_tests, List, Units),
  734	  with_mutex(plunit, run_tests_sync(Units, Rest))
  735	),
  736	set_test_options(Old)).
  737
  738run_tests_sync(Units0, Options) :-
  739    cleanup,
  740    count_tests(Units0, Units, Count),
  741    asserta(test_count(Count)),
  742    save_output_state,
  743    setup_call_cleanup(
  744        setup_trap_assertions(Ref),
  745        call_time(setup_jobs_and_run_units(Count, Units, Summary, Options),
  746                  Time),
  747        report_and_cleanup(Ref, Time, Options)),
  748    (   option(summary(Summary), Options)
  749    ->  true
  750    ;   test_summary_passed(Summary) % fail if some test failed
  751    ).
  752
  753setup_jobs_and_run_units(Count, Units, Summary, Options) :-
  754    setup_call_cleanup(
  755        setup_jobs(Count),
  756        ( run_units(Units, Options),
  757          test_summary(_All, Summary)
  758        ),
  759        cleanup_jobs).

 report_and_cleanup(+Ref, +Time, +Options)

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

  766report_and_cleanup(Ref, Time, Options) :-
  767    cleanup_trap_assertions(Ref),
  768    report(Time, Options),
  769    cleanup_after_test.

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  776run_units(Units, _Options) :-
  777    maplist(schedule_unit, Units),
  778    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.

  787:- det(runnable_tests/2).  788runnable_tests(Spec, Unit:RunnableTests) :-
  789    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  790    (   option(blocked(Reason), UnitOptions)
  791    ->  info(plunit(blocked(unit(Unit, Reason)))),
  792        RunnableTests = []
  793    ;   \+ condition(Module, unit(Unit), UnitOptions)
  794    ->  RunnableTests = []
  795    ;   var(Tests)
  796    ->  findall(TestID,
  797                runnable_test(Unit, _Test, Module, TestID),
  798                RunnableTests)
  799    ;   flatten([Tests], TestList),
  800        findall(TestID,
  801                ( member(Test, TestList),
  802                  runnable_test(Unit,Test,Module, TestID)
  803                ),
  804                RunnableTests)
  805    ).
  806
  807runnable_test(Unit, Name, Module, @(Test,Line)) :-
  808    current_test(Unit, Name, Line, _Body, TestOptions),
  809    (   option(blocked(Reason), TestOptions)
  810    ->  Test = blocked(Name, Reason)
  811    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  812        Test = Name
  813    ).
  814
  815unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  816    Unit = Unit0,
  817    Tests = Tests0,
  818    (   current_unit(Unit, Module, _Supers, Options)
  819    ->  true
  820    ;   throw_error(existence_error(unit_test, Unit), _)
  821    ).
  822unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  823    Unit = Unit0,
  824    (   current_unit(Unit, Module, _Supers, Options)
  825    ->  true
  826    ;   throw_error(existence_error(unit_test, Unit), _)
  827    ).

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

  835count_tests(Units0, Units, Count) :-
  836    count_tests(Units0, Units, 0, Count).
  837
  838count_tests([], T, C0, C) =>
  839    T = [],
  840    C = C0.
  841count_tests([_:[]|T0], T, C0, C) =>
  842    count_tests(T0, T, C0, C).
  843count_tests([Unit:Tests|T0], T, C0, C) =>
  844    partition(is_blocked, Tests, Blocked, Use),
  845    maplist(assert_blocked(Unit), Blocked),
  846    (   Use == []
  847    ->  count_tests(T0, T, C0, C)
  848    ;   length(Use, N),
  849        C1 is C0+N,
  850        T = [Unit:Use|T1],
  851        count_tests(T0, T1, C1, C)
  852    ).
  853
  854is_blocked(@(blocked(_,_),_)) => true.
  855is_blocked(_) => fail.
  856
  857assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  858    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.

  865run_unit(_Unit:[]) =>
  866    true.
  867run_unit(Unit:Tests) =>
  868    unit_module(Unit, Module),
  869    unit_options(Unit, UnitOptions),
  870    (   setup(Module, unit(Unit), UnitOptions)
  871    ->  begin_unit(Unit),
  872        call_time(run_unit_2(Unit, Tests), Time),
  873        test_summary(Unit, Summary),
  874	end_unit(Unit, Summary.put(time, Time)),
  875        cleanup(Module, UnitOptions)
  876    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  877    ).
  878
  879begin_unit(Unit) :-
  880    job_info(begin(unit(Unit))),
  881    job_feedback(informational, begin(Unit)).
  882
  883end_unit(Unit, Summary) :-
  884    job_info(end(unit(Unit, Summary))),
  885    job_feedback(informational, end(Unit, Summary)).
  886
  887run_unit_2(Unit, Tests) :-
  888    forall(member(Test, Tests),
  889	   run_test(Unit, Test)).
  890
  891
  892unit_options(Unit, Options) :-
  893    current_unit(Unit, _Module, _Supers, Options).
  894
  895
  896cleanup :-
  897    set_flag(plunit_test, 1),
  898    retractall(output_streams(_,_)),
  899    retractall(test_count(_)),
  900    retractall(passed(_, _, _, _, _)),
  901    retractall(failed(_, _, _, _, _)),
  902    retractall(timeout(_, _, _, _, _)),
  903    retractall(failed_assertion(_, _, _, _, _, _, _)),
  904    retractall(blocked(_, _, _, _)),
  905    retractall(fixme(_, _, _, _, _)),
  906    retractall(running(_,_,_,_,_)),
  907    retractall(forall_failures(_,_)).
  908
  909cleanup_after_test :-
  910    (   current_test_flag(cleanup, true)
  911    ->  cleanup
  912    ;   true
  913    ).

 run_tests_in_files(+Files:list) is det

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

  920run_tests_in_files(Files) :-
  921    findall(Unit, unit_in_files(Files, Unit), Units),
  922    (   Units == []
  923    ->  true
  924    ;   run_tests(Units)
  925    ).
  926
  927unit_in_files(Files, Unit) :-
  928    is_list(Files),
  929    !,
  930    member(F, Files),
  931    absolute_file_name(F, Source,
  932		       [ file_type(prolog),
  933			 access(read),
  934			 file_errors(fail)
  935		       ]),
  936    unit_file(Unit, Source).
  937
  938
  939		 /*******************************
  940		 *         HOOKING MAKE/0       *
  941		 *******************************/

 make_run_tests(+Files)

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

  947make_run_tests(Files) :-
  948    current_test_flag(run, When),
  949    (   When == make
  950    ->  run_tests_in_files(Files)
  951    ;   When == make(all)
  952    ->  run_tests
  953    ;   true
  954    ).
  955
  956		 /*******************************
  957		 *      ASSERTION HANDLING      *
  958		 *******************************/
  959
  960:- if(swi).  961
  962:- dynamic prolog:assertion_failed/2.  963
  964setup_trap_assertions(Ref) :-
  965    asserta((prolog:assertion_failed(Reason, Goal) :-
  966		    test_assertion_failed(Reason, Goal)),
  967	    Ref).
  968
  969cleanup_trap_assertions(Ref) :-
  970    erase(Ref).
  971
  972test_assertion_failed(Reason, Goal) :-
  973    thread_self(Me),
  974    running(Unit, Test, Line, Progress, Me),
  975    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  976	assertion_location(Stack, AssertLoc)
  977    ->  true
  978    ;   AssertLoc = unknown
  979    ),
  980    report_failed_assertion(Unit:Test, Line, AssertLoc,
  981			    Progress, Reason, Goal),
  982    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  983				   Progress, Reason, Goal)).
  984
  985assertion_location(Stack, File:Line) :-
  986    append(_, [AssertFrame,CallerFrame|_], Stack),
  987    prolog_stack_frame_property(AssertFrame,
  988				predicate(prolog_debug:assertion/1)),
  989    !,
  990    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  991
  992report_failed_assertion(UnitTest, Line, AssertLoc,
  993			Progress, Reason, Goal) :-
  994    print_message(
  995	error,
  996	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  997				Progress, Reason, Goal))).
  998
  999:- else. 1000
 1001setup_trap_assertions(_).
 1002cleanup_trap_assertions(_).
 1003
 1004:- endif. 1005
 1006
 1007		 /*******************************
 1008		 *         RUNNING A TEST       *
 1009		 *******************************/

 run_test(+Unit, +Test) is det

Run a single test.

 1015run_test(Unit, @(Test,Line)) :-
 1016    unit_module(Unit, Module),
 1017    Module:'unit test'(Test, Line, TestOptions, Body),
 1018    unit_options(Unit, UnitOptions),
 1019    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).

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

Deals with forall(Generator, Test)

 1025run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1026    option(forall(Generator), Options),
 1027    !,
 1028    unit_module(Unit, Module),
 1029    start_test(Unit, @(Name,Line), Nth),
 1030    State = state(0),
 1031    call_time(forall(Module:Generator,            % may become concurrent
 1032                     (   incr_forall(State, I),
 1033                         run_test_once6(Unit, Name,
 1034                                        forall(Generator, Nth-I), Line,
 1035                                        UnitOptions, Options, Body)
 1036                     )),
 1037                     Time),
 1038    arg(1, State, Generated),
 1039    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1040run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1041    start_test(Unit, @(Name,Line), Nth),
 1042    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1043
 1044start_test(_Unit, _TestID, Nth) :-
 1045    flag(plunit_test, Nth, Nth+1).
 1046
 1047incr_forall(State, I) :-
 1048    arg(1, State, I0),
 1049    I is I0+1,
 1050    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).

 1057run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1058    current_test_flag(timeout, DefTimeOut),
 1059    current_test_flag(occurs_check, DefOccurs),
 1060    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1061    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1062    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1063
 1064inherit_option(Name, Options0, Chain, Default, Options) :-
 1065    Term =.. [Name,_Value],
 1066    (   option(Term, Options0)
 1067    ->  Options = Options0
 1068    ;   member(Opts, Chain),
 1069        option(Term, Opts)
 1070    ->  Options = [Term|Options0]
 1071    ;   Default == (-)
 1072    ->  Options = Options0
 1073    ;   Opt =.. [Name,Default],
 1074	Options = [Opt|Options0]
 1075    ).

 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.

 1082run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1083    option(occurs_check(Occurs), Options),
 1084    !,
 1085    begin_test(Unit, Name, Line, Progress),
 1086    setup_call_cleanup(
 1087	push_prolog_flag(occurs_check, Occurs),
 1088	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1089		       Output),
 1090	pop_prolog_flag(occurs_check)),
 1091    end_test(Unit, Name, Line, Progress),
 1092    report_result(Result, Progress, Output, Options).
 1093run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1094    begin_test(Unit, Name, Line, Progress),
 1095    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1096		   Output),
 1097    end_test(Unit, Name, Line, Progress),
 1098    report_result(Result, Progress, Output, Options).

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

 1102:- det(report_result/4). 1103report_result(failure(Unit, Name, Line, How, Time),
 1104	      Progress, Output, Options) =>
 1105    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1106report_result(success(Unit, Name, Line, Determinism, Time),
 1107	      Progress, Output, Options) =>
 1108    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1109report_result(setup_failed(Unit, Name, Line, Time, Output, Result),
 1110	      Progress, _Output, Options) =>
 1111    failure(Unit, Name, Progress, Line,
 1112            setup_failed(Result), Time, 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)

 1134run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1135    option(setup(Setup), Options),
 1136    !,
 1137    unit_module(Unit, Module),
 1138    capture_output(call_time(reify(call_ex(Module, Setup), SetupResult),
 1139                             Time),
 1140                   Output),
 1141    (   SetupResult == true
 1142    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1143        cleanup(Module, Options)
 1144    ;   Result = setup_failed(Unit, Name, Line, Time, Output, SetupResult)
 1145    ).
 1146run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1147    unit_module(Unit, Module),
 1148    run_test_7(Unit, Name, Line, Options, Body, Result),
 1149    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.

 1158run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1159    option(true(Cmp), Options),			   % expected success
 1160    !,
 1161    unit_module(Unit, Module),
 1162    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1163    (   Result0 == true
 1164    ->  cmp_true(Cmp, Module, CmpResult),
 1165	(   CmpResult == []
 1166	->  Result = success(Unit, Name, Line, Det, Time)
 1167	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1168	)
 1169    ;   Result0 == false
 1170    ->  Result = failure(Unit, Name, Line, failed, Time)
 1171    ;   Result0 = throw(E2)
 1172    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1173    ).
 1174run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1175    option(fail, Options),                         % expected failure
 1176    !,
 1177    unit_module(Unit, Module),
 1178    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1179    (   Result0 == true
 1180    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1181    ;   Result0 == false
 1182    ->  Result = success(Unit, Name, Line, true, Time)
 1183    ;   Result0 = throw(E)
 1184    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1185    ).
 1186run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1187    option(throws(Expect), Options),		   % Expected error
 1188    !,
 1189    unit_module(Unit, Module),
 1190    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1191    (   Result0 == true
 1192    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1193    ;   Result0 == false
 1194    ->  Result = failure(Unit, Name, Line, failed, Time)
 1195    ;   Result0 = throw(E)
 1196    ->  (   match_error(Expect, E)
 1197        ->  Result = success(Unit, Name, Line, true, Time)
 1198        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1199        )
 1200    ).
 1201run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1202    option(all(Answer), Options),                  % all(Bindings)
 1203    !,
 1204    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1205run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1206    option(set(Answer), Options),                  % set(Bindings)
 1207    !,
 1208    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.

 1214nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1215    unit_module(Unit, Module),
 1216    result_vars(Expected, Vars),
 1217    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1218                            Result0, Options), Time)
 1219    ->  (   Result0 == true
 1220        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1221            ->  Result = success(Unit, Name, Line, true, Time)
 1222            ;   Result = failure(Unit, Name, Line,
 1223				 [wrong_answer(Expected, Bindings)], Time)
 1224            )
 1225        ;   Result0 = throw(E)
 1226        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1227        )
 1228    ).
 1229
 1230cmp_true([], _, L) =>
 1231    L = [].
 1232cmp_true([Cmp|T], Module, L) =>
 1233    E = error(Formal,_),
 1234    cmp_goal(Cmp, Goal),
 1235    (   catch(Module:Goal, E, true)
 1236    ->  (   var(Formal)
 1237	->  cmp_true(T, Module, L)
 1238	;   L = [cmp_error(Cmp,E)|L1],
 1239	    cmp_true(T, Module, L1)
 1240	)
 1241    ;   L = [wrong_answer(Cmp)|L1],
 1242	cmp_true(T, Module, L1)
 1243    ).
 1244
 1245cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1246cmp_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.

 1254result_vars(Expected, Vars) :-
 1255    arg(1, Expected, CmpOp),
 1256    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

 1266nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1267    cmp(Cmp, _Vars, Op, Values),
 1268    cmp_list(Values, Bindings, Op).
 1269nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1270    cmp(Cmp, _Vars, Op, Values0),
 1271    sort(Bindings0, Bindings),
 1272    sort(Values0, Values),
 1273    cmp_list(Values, Bindings, Op).
 1274
 1275cmp_list([], [], _Op).
 1276cmp_list([E0|ET], [V0|VT], Op) :-
 1277    call(Op, E0, V0),
 1278    cmp_list(ET, VT, Op).

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

 1282cmp(Var  == Value, Var,  ==, Value).
 1283cmp(Var =:= Value, Var, =:=, Value).
 1284cmp(Var  =  Value, Var,  =,  Value).
 1285:- if(swi). 1286cmp(Var =@= Value, Var, =@=, Value).
 1287:- else. 1288:- if(sicstus). 1289cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1290:- endif. 1291:- endif.

 call_det(:Goal, -Det) is nondet

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

 1299:- if((swi;sicstus)). 1300call_det(Goal, Det) :-
 1301    call_cleanup(Goal,Det0=true),
 1302    ( var(Det0) -> Det = false ; Det = true ).
 1303:- else. 1304call_det(Goal, true) :-
 1305    call(Goal).
 1306:- endif.

 match_error(+Expected, +Received) is semidet

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

 1313match_error(Expect, Rec) :-
 1314    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

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

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

Evaluate the test or test unit condition.

 1343condition(Module, Context, Options) :-
 1344    option(condition(Cond), Options),
 1345    !,
 1346    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1347    (   Result == true
 1348    ->  true
 1349    ;   Result == false
 1350    ->  fail
 1351    ;   print_message(error,
 1352		      plunit(error(condition, Context, Output, Result))),
 1353	fail
 1354    ).
 1355condition(_, _, _).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1362call_ex(Module, Goal) :-
 1363    Module:(expand_goal(Goal, GoalEx),
 1364	    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.

 1371cleanup(Module, Options) :-
 1372    option(cleanup(Cleanup), Options, true),
 1373    (   catch(call_ex(Module, Cleanup), E, true)
 1374    ->  (   var(E)
 1375	->  true
 1376	;   print_message(warning, E)
 1377	)
 1378    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1379    ).
 1380
 1381success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1382    option(fixme(Reason), Options),
 1383    !,
 1384    (   (   Det == true
 1385	;   memberchk(nondet, Options)
 1386	)
 1387    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1388	Ok = passed
 1389    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1390	Ok = nondet
 1391    ),
 1392    flush_output(user_error),
 1393    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1394success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1395    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1396    !,
 1397    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1398success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1399    Output = true-_,
 1400    !,
 1401    failure(Unit, Name, Progress, Line, message, Time, Output, Options).
 1402success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1403    assert(passed(Unit, Name, Line, Det, Time)),
 1404    (   (   Det == true
 1405	;   memberchk(nondet, Options)
 1406	)
 1407    ->  progress(Unit:Name, Progress, passed, Time)
 1408    ;   unit_file(Unit, File),
 1409	print_message(warning, plunit(nondet(File:Line, Unit:Name, Progress)))
 1410    ).

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

Test failed. Report the error.

 1417failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1418  memberchk(fixme(Reason), Options) =>
 1419    assert(fixme(Unit, Name, Line, Reason, failed)),
 1420    progress(Unit:Name, Progress, fixme(failed), Time).
 1421failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1422	Output, Options) =>
 1423    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1424    progress(Unit:Name, Progress, timeout(Limit), Time),
 1425    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1426failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1427    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1428    progress(Unit:Name, Progress, failed, Time),
 1429    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.

 1439:- if(swi). 1440assert_cyclic(Term) :-
 1441    acyclic_term(Term),
 1442    !,
 1443    assert(Term).
 1444assert_cyclic(Term) :-
 1445    Term =.. [Functor|Args],
 1446    recorda(cyclic, Args, Id),
 1447    functor(Term, _, Arity),
 1448    length(NewArgs, Arity),
 1449    Head =.. [Functor|NewArgs],
 1450    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1451:- else. 1452:- if(sicstus). 1453:- endif. 1454assert_cyclic(Term) :-
 1455    assert(Term).
 1456:- endif. 1457
 1458
 1459		 /*******************************
 1460		 *             JOBS             *
 1461		 *******************************/
 1462
 1463:- if(current_prolog_flag(threads, true)). 1464
 1465:- dynamic
 1466       job_data/2,		% Queue, Threads
 1467       scheduled_unit/1. 1468
 1469schedule_unit(_:[]) :-
 1470    !.
 1471schedule_unit(UnitAndTests) :-
 1472    UnitAndTests = Unit:_Tests,
 1473    job_data(Queue, _),
 1474    !,
 1475    assertz(scheduled_unit(Unit)),
 1476    thread_send_message(Queue, unit(UnitAndTests)).
 1477schedule_unit(Unit) :-
 1478    run_unit(Unit).

 setup_jobs(+Count) is det

Setup threads for concurrent testing.

 1484setup_jobs(Count) :-
 1485    (   current_test_flag(jobs, Jobs0),
 1486	integer(Jobs0)
 1487    ->  true
 1488    ;   current_prolog_flag(cpu_count, Jobs0)
 1489    ),
 1490    Jobs is min(Count, Jobs0),
 1491    Jobs > 1,
 1492    !,
 1493    message_queue_create(Q, [alias(plunit_jobs)]),
 1494    length(TIDs, Jobs),
 1495    foldl(create_plunit_job(Q), TIDs, 1, _),
 1496    asserta(job_data(Q, TIDs)),
 1497    job_feedback(informational, jobs(Jobs)).
 1498setup_jobs(_) :-
 1499    job_feedback(informational, jobs(1)).
 1500
 1501create_plunit_job(Q, TID, N, N1) :-
 1502    N1 is N + 1,
 1503    atom_concat(plunit_job_, N, Alias),
 1504    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1505
 1506plunit_job(Queue) :-
 1507    repeat,
 1508    (   catch(thread_get_message(Queue, Job,
 1509				 [ timeout(10)
 1510				 ]),
 1511	      error(_,_), fail)
 1512    ->  job(Job),
 1513	fail
 1514    ;   !
 1515    ).
 1516
 1517job(unit(Unit:Tests)) =>
 1518    run_unit(Unit:Tests).
 1519job(test(Unit, Test)) =>
 1520    run_test(Unit, Test).
 1521
 1522cleanup_jobs :-
 1523    retract(job_data(Queue, TIDSs)),
 1524    !,
 1525    message_queue_destroy(Queue),
 1526    maplist(thread_join, TIDSs).
 1527cleanup_jobs.

 job_wait(?Unit) is det

Wait for all test jobs to finish.

 1533job_wait(Unit) :-
 1534    thread_wait(\+ scheduled_unit(Unit),
 1535		[ wait_preds([scheduled_unit/1]),
 1536		  timeout(1)
 1537		]),
 1538    !.
 1539job_wait(Unit) :-
 1540    job_data(_Queue, TIDs),
 1541    member(TID, TIDs),
 1542    thread_property(TID, status(running)),
 1543    !,
 1544    job_wait(Unit).
 1545job_wait(_).
 1546
 1547
 1548job_info(begin(unit(Unit))) =>
 1549    print_message(silent, plunit(begin(Unit))).
 1550job_info(end(unit(Unit, Summary))) =>
 1551    retractall(scheduled_unit(Unit)),
 1552    print_message(silent, plunit(end(Unit, Summary))).
 1553
 1554:- else.			% No jobs
 1555
 1556schedule_unit(Unit) :-
 1557    run_unit(Unit).
 1558
 1559setup_jobs(_) :-
 1560    print_message(silent, plunit(jobs(1))).
 1561cleanup_jobs.
 1562job_wait(_).
 1563job_info(_).
 1564
 1565:- endif. 1566
 1567
 1568
 1569		 /*******************************
 1570		 *            REPORTING         *
 1571		 *******************************/

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

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

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

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

See also

- message_hook/3 for intercepting these messages

 1584begin_test(Unit, Test, Line, Progress) :-
 1585    thread_self(Me),
 1586    assert(running(Unit, Test, Line, Progress, Me)),
 1587    unit_file(Unit, File),
 1588    test_count(Total),
 1589    job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
 1590
 1591end_test(Unit, Test, Line, Progress) :-
 1592    thread_self(Me),
 1593    retractall(running(_,_,_,_,Me)),
 1594    unit_file(Unit, File),
 1595    test_count(Total),
 1596    job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).

 running_tests is det

Print the currently running test.

 1602running_tests :-
 1603    running_tests(Running),
 1604    print_message(informational, plunit(running(Running))).
 1605
 1606running_tests(Running) :-
 1607    test_count(Total),
 1608    findall(running(Unit:Test, File:Line, Progress/Total, Thread),
 1609	    (   running(Unit, Test, Line, Progress, Thread),
 1610		unit_file(Unit, File)
 1611	    ), Running).

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

True when a test with the specified properties is loaded.

 1618current_test(Unit, Test, Line, Body, Options) :-
 1619    current_unit(Unit, Module, _Supers, _UnitOptions),
 1620    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.

 1626current_test_unit(Unit, UnitOptions) :-
 1627    current_unit(Unit, _Module, _Supers, UnitOptions).
 1628
 1629
 1630count(Goal, Count) :-
 1631    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.

 1638test_summary(Unit, Summary) :-
 1639    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1640    count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
 1641    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1642    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1643    count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme),
 1644    test_count(Total),
 1645    Summary = plunit{total:Total,
 1646		     passed:Passed,
 1647		     failed:Failed,
 1648		     timeout:Timeout,
 1649		     blocked:Blocked,
 1650		     fixme:Fixme}.
 1651
 1652test_summary_passed(Summary) :-
 1653    _{failed: 0} :< Summary.

 report(+Time, +Options) is det

Print a summary of the tests that ran.

 1659report(Time, _Options) :-
 1660    test_summary(_, Summary),
 1661    print_message(silent, plunit(Summary)),
 1662    _{ passed:Passed,
 1663       failed:Failed,
 1664       timeout:Timeout,
 1665       blocked:Blocked,
 1666       fixme:Fixme
 1667     } :< Summary,
 1668    (   Passed+Failed+Timeout+Blocked+Fixme =:= 0
 1669    ->  info(plunit(no_tests))
 1670    ;   Failed+Timeout =:= 0
 1671    ->  report_blocked(Blocked),
 1672	report_fixme,
 1673        test_count(Total),
 1674	info(plunit(all_passed(Total, Passed, Time)))
 1675    ;   report_blocked(Blocked),
 1676	report_fixme,
 1677	report_failed(Failed),
 1678	report_timeout(Timeout),
 1679	info(plunit(passed(Passed))),
 1680        info(plunit(total_time(Time)))
 1681    ).
 1682
 1683report_blocked(0) =>
 1684    true.
 1685report_blocked(Blocked) =>
 1686    findall(blocked(Unit:Name, File:Line, Reason),
 1687	    ( blocked(Unit, Name, Line, Reason),
 1688	      unit_file(Unit, File)
 1689	    ),
 1690	    BlockedTests),
 1691    info(plunit(blocked(Blocked, BlockedTests))).
 1692
 1693report_failed(Failed) :-
 1694    print_message(error, plunit(failed(Failed))).
 1695
 1696report_timeout(Count) :-
 1697    print_message(warning, plunit(timeout(Count))).
 1698
 1699report_fixme :-
 1700    report_fixme(_,_,_).
 1701
 1702report_fixme(TuplesF, TuplesP, TuplesN) :-
 1703    fixme(failed, TuplesF, Failed),
 1704    fixme(passed, TuplesP, Passed),
 1705    fixme(nondet, TuplesN, Nondet),
 1706    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1707
 1708
 1709fixme(How, Tuples, Count) :-
 1710    findall(fixme(Unit, Name, Line, Reason, How),
 1711	    fixme(Unit, Name, Line, Reason, How), Tuples),
 1712    length(Tuples, Count).
 1713
 1714report_failure(Unit, Name, Progress, Line, Error,
 1715	       Time, Output, _Options) =>
 1716    test_count(Total),
 1717    job_feedback(error, failed(Unit:Name, Progress/Total, Line,
 1718			       Error, Time, Output)).

 test_report(+What) is det

Produce reports on test results after the run. Currently only supports fixme for What.

 1726test_report(fixme) :-
 1727    !,
 1728    report_fixme(TuplesF, TuplesP, TuplesN),
 1729    append([TuplesF, TuplesP, TuplesN], Tuples),
 1730    print_message(informational, plunit(fixme(Tuples))).
 1731test_report(What) :-
 1732    throw_error(domain_error(report_class, What), _).
 1733
 1734
 1735		 /*******************************
 1736		 *             INFO             *
 1737		 *******************************/

 unit_file(+Unit, -File) is det

unit_file(?Unit, ?File) is nondet

True when the test unit Unit is defined in File.

 1744unit_file(Unit, File), nonvar(Unit) =>
 1745    unit_file_(Unit, File),
 1746    !.
 1747unit_file(Unit, File) =>
 1748    unit_file_(Unit, File).
 1749
 1750unit_file_(Unit, File) :-
 1751    current_unit(Unit, Module, _Context, _Options),
 1752    module_property(Module, file(File)).
 1753unit_file_(Unit, PlFile) :-
 1754    test_file_for(TestFile, PlFile),
 1755    module_property(Module, file(TestFile)),
 1756    current_unit(Unit, Module, _Context, _Options).
 1757
 1758
 1759		 /*******************************
 1760		 *             FILES            *
 1761		 *******************************/

 load_test_files(+Options) is det

Load .plt test-files related to loaded source-files. Options is currently ignored.

 1768load_test_files(_Options) :-
 1769    State = state(0,0),
 1770    (   source_file(File),
 1771	file_name_extension(Base, Old, File),
 1772	Old \== plt,
 1773	file_name_extension(Base, plt, TestFile),
 1774	exists_file(TestFile),
 1775        inc_arg(1, State),
 1776	(   test_file_for(TestFile, File)
 1777	->  true
 1778	;   load_files(TestFile,
 1779		       [ if(changed),
 1780			 imports([])
 1781		       ]),
 1782            inc_arg(2, State),
 1783	    asserta(test_file_for(TestFile, File))
 1784	),
 1785        fail
 1786    ;   State = state(Total, Loaded),
 1787        print_message(informational, plunit(test_files(Total, Loaded)))
 1788    ).
 1789
 1790inc_arg(Arg, State) :-
 1791    arg(Arg, State, N0),
 1792    N is N0+1,
 1793    nb_setarg(Arg, State, N).
 1794
 1795
 1796		 /*******************************
 1797		 *           MESSAGES           *
 1798		 *******************************/

 info(+Term)

Runs print_message(Level, Term), where Level is one of silent or informational (default).

 1805info(Term) :-
 1806    message_level(Level),
 1807    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)

 1824progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) =>
 1825    (   retract(forall_failures(Nth, FFailed))
 1826    ->  true
 1827    ;   FFailed = 0
 1828    ),
 1829    test_count(Total),
 1830    job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)).
 1831progress(UnitTest, Progress, Result, Time), Progress = forall(_Gen, Nth-_I) =>
 1832    with_mutex(plunit_forall_counter,
 1833               update_forall_failures(Nth, Result)),
 1834    test_count(Total),
 1835    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1836progress(UnitTest, Progress, Result, Time) =>
 1837    test_count(Total),
 1838    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1839
 1840update_forall_failures(_Nth, passed) =>
 1841    true.
 1842update_forall_failures(Nth, _) =>
 1843    (   retract(forall_failures(Nth, Failed0))
 1844    ->  true
 1845    ;   Failed0 = 0
 1846    ),
 1847    Failed is Failed0+1,
 1848    asserta(forall_failures(Nth, Failed)).
 1849
 1850message_level(Level) :-
 1851    (   current_test_flag(silent, true)
 1852    ->  Level = silent
 1853    ;   Level = informational
 1854    ).
 1855
 1856locationprefix(File:Line) -->
 1857    !,
 1858    [ url(File:Line), ':'-[], nl, '    ' ].
 1859locationprefix(test(Unit,_Test,Line)) -->
 1860    !,
 1861    { unit_file(Unit, File) },
 1862    locationprefix(File:Line).
 1863locationprefix(unit(Unit)) -->
 1864    !,
 1865    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1866locationprefix(FileLine) -->
 1867    { throw_error(type_error(locationprefix,FileLine), _) }.
 1868
 1869:- discontiguous
 1870    message//1. 1871:- '$hide'(message//1). 1872
 1873message(error(context_error(plunit_close(Name, -)), _)) -->
 1874    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1875message(error(context_error(plunit_close(Name, Start)), _)) -->
 1876    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1877message(plunit(nondet(Pos, Test, Progress))) -->
 1878    locationprefix(Pos),
 1879    test_name(Test, Progress),
 1880    [ ': Test succeeded with choicepoint'-[] ].
 1881message(error(plunit(incompatible_options, Tests), _)) -->
 1882    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1883message(plunit(sto(true))) -->
 1884    [ 'Option sto(true) is ignored.  See `occurs_check` option.'-[] ].
 1885message(plunit(test_files(Total, Loaded))) -->
 1886    [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ].
 1887
 1888					% Unit start/end
 1889message(plunit(jobs(1))) -->
 1890    !.
 1891message(plunit(jobs(N))) -->
 1892    [ 'Testing with ~D parallel jobs'-[N] ].
 1893message(plunit(begin(_Unit))) -->
 1894    { tty_feedback },
 1895    !.
 1896message(plunit(begin(Unit))) -->
 1897    [ 'Start unit: ~w~n'-[Unit], flush ].
 1898message(plunit(end(_Unit, _Summary))) -->
 1899    { tty_feedback },
 1900    !.
 1901message(plunit(end(Unit, Summary))) -->
 1902    (   {test_summary_passed(Summary)}
 1903    ->  [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
 1904    ;   [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
 1905    ).
 1906message(plunit(blocked(unit(Unit, Reason)))) -->
 1907    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1908message(plunit(running([]))) -->
 1909    !,
 1910    [ 'PL-Unit: no tests running' ].
 1911message(plunit(running([One]))) -->
 1912    !,
 1913    [ 'PL-Unit: running ' ],
 1914    running(One).
 1915message(plunit(running(More))) -->
 1916    !,
 1917    [ 'PL-Unit: running tests:', nl ],
 1918    running(More).
 1919message(plunit(fixme([]))) --> !.
 1920message(plunit(fixme(Tuples))) -->
 1921    !,
 1922    fixme_message(Tuples).
 1923message(plunit(total_time(Time))) -->
 1924    [ 'Test run completed'-[] ],
 1925    test_time(Time).
 1926
 1927					% Blocked tests
 1928message(plunit(blocked(1, Tests))) -->
 1929    !,
 1930    [ 'one test is blocked'-[] ],
 1931    blocked_tests(Tests).
 1932message(plunit(blocked(N, Tests))) -->
 1933    [ '~D tests are blocked'-[N] ],
 1934    blocked_tests(Tests).
 1935
 1936blocked_tests(Tests) -->
 1937    { current_test_flag(show_blocked, true) },
 1938    !,
 1939    [':'-[]],
 1940    list_blocked(Tests).
 1941blocked_tests(_) -->
 1942    [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []),
 1943      ' for details)'-[]
 1944    ].
 1945
 1946list_blocked([]) --> !.
 1947list_blocked([blocked(Unit:Test, Pos, Reason)|T]) -->
 1948    [nl],
 1949    locationprefix(Pos),
 1950    test_name(Unit:Test, -),
 1951    [ ': ~w'-[Reason] ],
 1952    list_blocked(T).
 1953
 1954					% fail/success
 1955message(plunit(no_tests)) -->
 1956    !,
 1957    [ 'No tests to run' ].
 1958message(plunit(all_passed(1, 1, Time))) -->
 1959    !,
 1960    [ 'test passed' ],
 1961    test_time(Time).
 1962message(plunit(all_passed(Total, Total, Time))) -->
 1963    !,
 1964    [ 'All ~D tests passed'-[Total] ],
 1965    test_time(Time).
 1966message(plunit(all_passed(Total, Count, Time))) -->
 1967    !,
 1968    { SubTests is Count-Total },
 1969    [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ],
 1970    test_time(Time).
 1971
 1972test_time(Time) -->
 1973    { var(Time) }, !.
 1974test_time(Time) -->
 1975    [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ].
 1976
 1977message(plunit(passed(Count))) -->
 1978    !,
 1979    [ '~D tests passed'-[Count] ].
 1980message(plunit(failed(0))) -->
 1981    !,
 1982    [].
 1983message(plunit(failed(1))) -->
 1984    !,
 1985    [ '1 test failed'-[] ].
 1986message(plunit(failed(N))) -->
 1987    [ '~D tests failed'-[N] ].
 1988message(plunit(timeout(0))) -->
 1989    !,
 1990    [].
 1991message(plunit(timeout(N))) -->
 1992    [ '~D tests timed out'-[N] ].
 1993message(plunit(fixme(0,0,0))) -->
 1994    [].
 1995message(plunit(fixme(Failed,0,0))) -->
 1996    !,
 1997    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1998message(plunit(fixme(Failed,Passed,0))) -->
 1999    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 2000message(plunit(fixme(Failed,Passed,Nondet))) -->
 2001    { TotalPassed is Passed+Nondet },
 2002    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 2003      [Failed, TotalPassed, Nondet] ].
 2004
 2005message(plunit(begin(Unit:Test, _Location, Progress))) -->
 2006    { tty_columns(SummaryWidth, _Margin),
 2007      test_name_summary(Unit:Test, SummaryWidth, NameS),
 2008      progress_string(Progress, ProgressS)
 2009    },
 2010    (   { tty_feedback,
 2011	  tty_clear_to_eol(CE)
 2012	}
 2013    ->  [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS,
 2014					     CE], flush ]
 2015    ;   { jobs(_) }
 2016    ->  [ '[~w] ~w ..'-[ProgressS, NameS] ]
 2017    ;   [ '[~w] ~w ..'-[ProgressS, NameS], flush ]
 2018    ).
 2019message(plunit(end(_UnitTest, _Location, _Progress))) -->
 2020    [].
 2021message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
 2022    { Status = forall(_Gen,_NthI)
 2023    ; Status == assertion
 2024    },
 2025    !.
 2026message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
 2027    { jobs(_),
 2028      !,
 2029      tty_columns(SummaryWidth, Margin),
 2030      test_name_summary(Unit:Test, SummaryWidth, NameS),
 2031      progress_string(Progress, ProgressS),
 2032      progress_tag(Status, Tag, _Keep, Style)
 2033    },
 2034    [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|',
 2035	   [ProgressS, NameS, Tag, Time.wall, Margin]) ].
 2036message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
 2037    { tty_columns(_SummaryWidth, Margin),
 2038      progress_tag(Status, Tag, _Keep, Style)
 2039    },
 2040    [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
 2041			 [Tag, Time.wall, Margin]) ],
 2042    (   { tty_feedback }
 2043    ->  [flush]
 2044    ;   []
 2045    ).
 2046message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
 2047    { unit_file(Unit, File) },
 2048    locationprefix(File:Line),
 2049    test_name(Unit:Test, Progress),
 2050    [': '-[] ],
 2051    failure(Failure),
 2052    test_output(Output).
 2053message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
 2054    { unit_file(Unit, File) },
 2055    locationprefix(File:Line),
 2056    test_name(Unit:Test, Progress),
 2057    [': '-[] ],
 2058    timeout(Limit),
 2059    test_output(Output).
 2060:- if(swi). 2061message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
 2062				Progress, Reason, Goal))) -->
 2063    { unit_file(Unit, File) },
 2064    locationprefix(File:Line),
 2065    test_name(Unit:Test, Progress),
 2066    [ ': assertion'-[] ],
 2067    assertion_location(AssertLoc, File),
 2068    assertion_reason(Reason), ['\n\t'],
 2069    assertion_goal(Unit, Goal).
 2070
 2071assertion_location(File:Line, File) -->
 2072    [ ' at line ~w'-[Line] ].
 2073assertion_location(File:Line, _) -->
 2074    [ ' at ', url(File:Line) ].
 2075assertion_location(unknown, _) -->
 2076    [].
 2077
 2078assertion_reason(fail) -->
 2079    !,
 2080    [ ' failed'-[] ].
 2081assertion_reason(Error) -->
 2082    { message_to_string(Error, String) },
 2083    [ ' raised "~w"'-[String] ].
 2084
 2085assertion_goal(Unit, Goal) -->
 2086    { unit_module(Unit, Module),
 2087      unqualify(Goal, Module, Plain)
 2088    },
 2089    [ 'Assertion: ~p'-[Plain] ].
 2090
 2091unqualify(Var, _, Var) :-
 2092    var(Var),
 2093    !.
 2094unqualify(M:Goal, Unit, Goal) :-
 2095    nonvar(M),
 2096    unit_module(Unit, M),
 2097    !.
 2098unqualify(M:Goal, _, Goal) :-
 2099    callable(Goal),
 2100    predicate_property(M:Goal, imported_from(system)),
 2101    !.
 2102unqualify(Goal, _, Goal).
 2103
 2104test_output(Msgs-String) -->
 2105    { nonvar(Msgs) },
 2106    !,
 2107    test_output(String).
 2108test_output("") --> [].
 2109test_output(Output) -->
 2110    [ ansi(code, '~N~s', [Output]) ].
 2111
 2112:- endif. 2113					% Setup/condition errors
 2114message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
 2115    locationprefix(Context),
 2116    { message_to_string(Exception, String) },
 2117    [ 'error in ~w: ~w'-[Where, String] ].
 2118message(plunit(error(Where, Context, _Output, false))) -->
 2119    locationprefix(Context),
 2120    [ 'setup failed in ~w'-[Where] ].
 2121
 2122                                        % delayed output
 2123message(plunit(test_output(_, Output))) -->
 2124    [ '~s'-[Output] ].
 2125					% Interrupts (SWI)
 2126:- if(swi). 2127message(interrupt(begin)) -->
 2128    { thread_self(Me),
 2129      running(Unit, Test, Line, Progress, Me),
 2130      !,
 2131      unit_file(Unit, File),
 2132      restore_output_state
 2133    },
 2134    [ 'Interrupted test '-[] ],
 2135    running(running(Unit:Test, File:Line, Progress, Me)),
 2136    [nl],
 2137    '$messages':prolog_message(interrupt(begin)).
 2138message(interrupt(begin)) -->
 2139    '$messages':prolog_message(interrupt(begin)).
 2140:- endif. 2141
 2142message(concurrent) -->
 2143    [ 'concurrent(true) at the level of units is currently ignored.', nl,
 2144      'See set_test_options/1 with jobs(Count) for concurrent testing.'
 2145    ].
 2146
 2147test_name(Name, forall(Generator, _Nth-I)/_Total) -->
 2148    !,
 2149    test_name(Name, -),
 2150    [ ' (~d-th forall generator = '-[I],
 2151      ansi(code, '~p', [Generator]), ')'-[]
 2152    ].
 2153test_name(Name, _) -->
 2154    !,
 2155    [ 'test ', ansi(code, '~q', [Name]) ].
 2156
 2157running(running(Unit:Test, File:Line, _Progress, Thread)) -->
 2158    thread(Thread),
 2159    [ '~q:~q at '-[Unit, Test], url(File:Line) ].
 2160running([H|T]) -->
 2161    ['\t'], running(H),
 2162    (   {T == []}
 2163    ->  []
 2164    ;   [nl], running(T)
 2165    ).
 2166
 2167thread(main) --> !.
 2168thread(Other) -->
 2169    [' [~w] '-[Other] ].
 2170
 2171:- if(swi). 2172write_term(T, OPS) -->
 2173    ['~W'-[T,OPS] ].
 2174:- else. 2175write_term(T, _OPS) -->
 2176    ['~q'-[T]].
 2177:- endif. 2178
 2179expected_got_ops_(Ex, E, OPS, Goals) -->
 2180    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 2181    ['    Got:      '-[]], write_term(E,  OPS), [],
 2182    ( { Goals = [] } -> []
 2183    ; [nl, '       with: '-[]], write_term(Goals, OPS), []
 2184    ).
 2185
 2186
 2187failure(List) -->
 2188    { is_list(List) },
 2189    !,
 2190    [ nl ],
 2191    failures(List).
 2192failure(Var) -->
 2193    { var(Var) },
 2194    !,
 2195    [ 'Unknown failure?' ].
 2196failure(succeeded(Time)) -->
 2197    !,
 2198    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 2199failure(wrong_error(Expected, Error)) -->
 2200    !,
 2201    { copy_term(Expected-Error, Ex-E, Goals),
 2202      numbervars(Ex-E-Goals, 0, _),
 2203      write_options(OPS)
 2204    },
 2205    [ 'wrong error'-[], nl ],
 2206    expected_got_ops_(Ex, E, OPS, Goals).
 2207failure(wrong_answer(cmp(Var, 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 for ', ansi(code, '~w', [Var]),
 2215      ' (compared using ~w)'-[Op], nl ],
 2216    expected_got_ops_(Ex, A, OPS, Goals).
 2217failure(wrong_answer(Cmp)) -->
 2218    { Cmp =.. [Op,Answer,Expected],
 2219      !,
 2220      copy_term(Expected-Answer, Ex-A, Goals),
 2221      numbervars(Ex-A-Goals, 0, _),
 2222      write_options(OPS)
 2223    },
 2224    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 2225    expected_got_ops_(Ex, A, OPS, Goals).
 2226failure(wrong_answer(CmpExpected, Bindings)) -->
 2227    { (   CmpExpected = all(Cmp)
 2228      ->  Cmp =.. [_Op1,_,Expected],
 2229	  Got = Bindings,
 2230	  Type = all
 2231      ;   CmpExpected = set(Cmp),
 2232	  Cmp =.. [_Op2,_,Expected0],
 2233	  sort(Expected0, Expected),
 2234	  sort(Bindings, Got),
 2235	  Type = set
 2236      )
 2237    },
 2238    [ 'wrong "~w" answer:'-[Type] ],
 2239    [ nl, '    Expected: ~q'-[Expected] ],
 2240    [ nl, '       Found: ~q'-[Got] ].
 2241:- if(swi). 2242failure(cmp_error(_Cmp, Error)) -->
 2243    { message_to_string(Error, Message) },
 2244    [ 'Comparison error: ~w'-[Message] ].
 2245failure(throw(Error)) -->
 2246    { Error = error(_,_),
 2247      !,
 2248      message_to_string(Error, Message)
 2249    },
 2250    [ 'received error: ~w'-[Message] ].
 2251:- endif. 2252failure(message) -->
 2253    !,
 2254    [ 'Generated unexpected warning or error'-[] ].
 2255failure(setup_failed(throw(Error))) -->
 2256    { Error = error(_,_),
 2257      !,
 2258      message_to_string(Error, Message)
 2259    },
 2260    [ 'test setup goal raised error: ~w'-[Message] ].
 2261failure(setup_failed(_)) -->
 2262    !,
 2263    [ 'test setup goal failed' ].
 2264failure(Why) -->
 2265    [ '~p'-[Why] ].
 2266
 2267failures([]) -->
 2268    !.
 2269failures([H|T]) -->
 2270    !,
 2271    failure(H), [nl],
 2272    failures(T).
 2273
 2274timeout(Limit) -->
 2275    [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
 2276
 2277fixme_message([]) --> [].
 2278fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 2279    { unit_file(Unit, File) },
 2280    fixme_message(File:Line, Reason, How),
 2281    (   {T == []}
 2282    ->  []
 2283    ;   [nl],
 2284	fixme_message(T)
 2285    ).
 2286
 2287fixme_message(Location, Reason, failed) -->
 2288    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 2289fixme_message(Location, Reason, passed) -->
 2290    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 2291fixme_message(Location, Reason, nondet) -->
 2292    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 2293
 2294
 2295write_options([ numbervars(true),
 2296		quoted(true),
 2297		portray(true),
 2298		max_depth(100),
 2299		attributes(portray)
 2300	      ]).