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	  ]).   52
   53/** <module> Unit Testing
   54
   55Unit testing environment for SWI-Prolog and   SICStus Prolog. For usage,
   56please visit https://www.swi-prolog.org/pldoc/package/plunit.
   57*/
   58
   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.
  152
  153
  154
  155%!  set_test_options(+Options)
  156%
  157%   Specifies how to deal with test suites.  Defined options are:
  158%
  159%    - load(+Load)
  160%      Whether or not the tests must be loaded.  Values are
  161%      `never`, `always`, `normal` (only if not optimised)
  162%
  163%    - run(+When)
  164%      When the tests are run.  Values are `manual`, `make`
  165%      or make(all).
  166%
  167%    - format(+Mode)
  168%      Currently one of `tty` or `log`.   `tty` uses terminal
  169%      control to overwrite successful tests, allowing the
  170%      user to see the currently running tests and output
  171%      from failed tests.  This is the default of the output
  172%      is a tty.  `log` prints a full log of the executed
  173%      tests and their result and is intended for non-interactive
  174%      usage.
  175%
  176%    - output(+When)
  177%      If `always`, emit all output as it is produced, if `never`,
  178%      suppress all output and if `on_failure`, emit the output
  179%      if the test fails.
  180%
  181%    - show_blocked(+Bool)
  182%      Show individual blocked tests during the report.
  183%
  184%    - occurs_check(+Mode)
  185%      Defines the default for the `occurs_check` flag during
  186%      testing.
  187%
  188%    - cleanup(+Bool)
  189%      If `true` (default =false), cleanup report at the end
  190%      of run_tests/1.  Used to improve cooperation with
  191%      memory debuggers such as dmalloc.
  192%
  193%    - jobs(Num)
  194%      Number of jobs to use for concurrent testing.  Default
  195%      is one, implying sequential testing.
  196%
  197%    - timeout(+Seconds)
  198%      Set timeout for each individual test.  This acts as a
  199%      default that may be overuled at the level of units or
  200%      individual tests.   A timeout of 0 or negative is handled
  201%      as _inifinite_.
  202
  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).
  236
  237%!  loading_tests
  238%
  239%   True if tests must be loaded.
  240
  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
  258
  259%!  begin_tests(+UnitName:atom) is det.
  260%!  begin_tests(+UnitName:atom, Options) is det.
  261%
  262%   Start a test-unit. UnitName is the  name   of  the test set. the
  263%   unit is ended by :- end_tests(UnitName).
  264
  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.  334
  335%!  end_tests(+Name) is det.
  336%
  337%   Close a unit-test module.
  338%
  339%   @tbd    Run tests/clean module?
  340%   @tbd    End of file?
  341
  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, -)), _).
  352
  353%!  make_unit_module(+Name, -ModuleName) is det.
  354%!  unit_module(+Name, -ModuleName) is det.
  355
  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		 *******************************/
  390
  391%!  expand_test(+Name, +Options, +Body, -Clause) is det.
  392%
  393%   Expand test(Name, Options) :-  Body  into   a  clause  for
  394%   'unit test'/4 and 'unit body'/2.
  395
  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(_)).
  473
  474
  475%!  expand(+Term, -Clauses) is semidet.
  476
  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		 *******************************/
  517
  518%!  valid_options(:Pred, +Options) is det.
  519%
  520%   Verify Options to be a list of valid options according to
  521%   Pred.
  522%
  523%   @error `type_error` or `instantiation_error`.
  524
  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).
  539
  540%!  test_option(+Option) is semidet.
  541%
  542%   True if Option is a valid option for test(Name, Options).
  543
  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).
  558
  559%!  test_option(+Option) is semidet.
  560%
  561%   True if Option is a valid option for :- begin_tests(Name,
  562%   Options).
  563
  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,-).  590
  591%!  reify_tmo(:Goal, -Result, +Options) is det.
  592
  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).
  606
  607%!  reify(:Goal, -Result) is det.
  608%
  609%   Call  Goal  and  unify  Result  with   one  of  `true`,  `false`  or
  610%   `throw(E)`.
  611
  612reify(Goal, Result) :-
  613    (   catch(Goal, E, true)
  614    ->  (   var(E)
  615	->  Result = true
  616	;   Result = throw(E)
  617	)
  618    ;   Result = false
  619    ).
  620
  621%!  capture_output(:Goal, -Output) is semidet.
  622%!  capture_output(:Goal, -Output, +Options) is semidet.
  623%
  624%   @arg Output is a pair `Msgs-String`, where  `Msgs` is a boolean that
  625%   is true if there were messages that   require a non-zero exit status
  626%   and Output contains the output as a string.
  627
  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    ).
  642
  643%!  got_messages(:Goal, -Result)
  644
  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
  686
  687%!  run_tests is semidet.
  688%!  run_tests(+TestSet) is semidet.
  689%!  run_tests(+TestSet, +Options) is semidet.
  690%
  691%   Run tests and report about the   results.  The predicate run_tests/0
  692%   runs all known tests that are not blocked. The predicate run_tests/1
  693%   takes a specification of tests  to  run.
  694%
  695%   The predicate run_tests/2 is  synchronized. Concurrent testing may
  696%   be     achieved    using     the     relevant    options.      See
  697%   set_test_options/1. Options are  passed to set_test_options/1.  In
  698%   addition the following options are processed:
  699%
  700%     - summary(-Summary)
  701%       Unify Summary do a dict holding the keys below.  The value of
  702%       these keys is an integer describing the number of tests.  If
  703%       this option is given, run_tests/2 does not fail if some tests
  704%       failed.
  705%
  706%       - total
  707%       - passed
  708%       - failed
  709%       - timeout
  710%       - blocked
  711%
  712%   @arg  TestSet  is either  a  single  specification  or a  list  of
  713%   specifications. Each single specification is  either the name of a
  714%   test-unit  or a  term <test-unit>:<test>,  denoting a  single test
  715%   within a unit.  If TestSet is `all`, all known tests are executed.
  716
  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).
  760
  761%!  report_and_cleanup(+Ref, +Time, +Options)
  762%
  763%   Undo changes to the environment   (trapping  assertions), report the
  764%   results and cleanup.
  765
  766report_and_cleanup(Ref, Time, Options) :-
  767    cleanup_trap_assertions(Ref),
  768    report(Time, Options),
  769    cleanup_after_test.
  770
  771
  772%!  run_units_and_check_errors(+Units, +Options) is semidet.
  773%
  774%   Run all test units and succeed if all tests passed.
  775
  776run_units(Units, _Options) :-
  777    maplist(schedule_unit, Units),
  778    job_wait(_).
  779
  780%!  runnable_tests(+Spec, -Plan) is det.
  781%
  782%   Change a Unit+Test spec  into  a   plain  `Unit:Tests`  lists, where
  783%   blocked tests or tests whose condition   fails  are already removed.
  784%   Each test in `Tests` is a  term   `@(Test,Line)`,  which serves as a
  785%   unique identifier of the test.
  786
  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    ).
  828
  829%!  count_tests(+Units0, -Units, -Count) is det.
  830%
  831%   Count the number of tests to   run. A forall(Generator, Test) counts
  832%   as a single test. During the execution,   the  concrete tests of the
  833%   _forall_ are considered "sub tests".
  834
  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)).
  859
  860%!  run_unit(+Unit) is det.
  861%
  862%   Run a single test unit. Unit is a  term Unit:Tests, where Tests is a
  863%   list of tests to run.
  864
  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    ).
  914
  915
  916%!  run_tests_in_files(+Files:list) is det.
  917%
  918%   Run all test-units that appear in the given Files.
  919
  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		 *******************************/
  942
  943%!  make_run_tests(+Files)
  944%
  945%   Called indirectly from make/0 after Files have been reloaded.
  946
  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		 *******************************/
 1010
 1011%!  run_test(+Unit, +Test) is det.
 1012%
 1013%   Run a single test.
 1014
 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).
 1020
 1021%!  run_test(+Unit, +Name, +Line, +UnitOptions, +Options, +Body)
 1022%
 1023%   Deals with forall(Generator, Test)
 1024
 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).
 1051
 1052%!  run_test_once6(+Unit, +Name, +Progress, +Line, +UnitOptions,
 1053%!                 +Options, +Body)
 1054%
 1055%   Inherit the `timeout` and `occurs_check` option (Global -> Unit -> Test).
 1056
 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    ).
 1076
 1077%!  run_test_once(+Unit, +Name, +Progress, +Line, +Options, +Body)
 1078%
 1079%   Deal with occurs_check, i.e., running the  test multiple times with different
 1080%   unification settings wrt. the occurs check.
 1081
 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).
 1099
 1100%!  report_result(+Result, +Progress, +Output, +Options) is det.
 1101
 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).
 1113
 1114%!  run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1115%
 1116%   6th step  of the  tests.  Deals  with tests  that must  be ignored
 1117%   (blocked, conditions fails), setup and cleanup at the test level.
 1118%   Result is one of:
 1119%
 1120%     - failure(Unit, Name, Line, How, Time)
 1121%       How is one of:
 1122%       - succeeded
 1123%       - Exception
 1124%       - time_limit_exceeded(Limit)
 1125%       - cmp_error(Cmp, E)
 1126%       - wrong_answer(Cmp)
 1127%       - failed
 1128%       - no_exception
 1129%       - wrong_error(Expect, E)
 1130%       - wrong_answer(Expected, Bindings)
 1131%     - success(Unit, Name, Line, Determinism, Time)
 1132%     - setup_failed(Unit, Name, Line)
 1133
 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).
 1150
 1151%!  run_test_7(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1152%
 1153%   This step  deals with the expected  outcome of the test.   It runs
 1154%   the  actual test  and then  compares  the result  to the  outcome.
 1155%   There are  two main categories:  dealing with a single  result and
 1156%   all results.
 1157
 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).
 1209
 1210%!  non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)
 1211%
 1212%   Run tests on non-deterministic predicates.
 1213
 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.
 1247
 1248
 1249%!  result_vars(+Expected, -Vars) is det.
 1250%
 1251%   Create a term v(V1, ...) containing all variables at the left
 1252%   side of the comparison operator on Expected.
 1253
 1254result_vars(Expected, Vars) :-
 1255    arg(1, Expected, CmpOp),
 1256    arg(1, CmpOp, Vars).
 1257
 1258%!  nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet.
 1259%
 1260%   Compare list/set results for non-deterministic predicates.
 1261%
 1262%   @tbd    Properly report errors
 1263%   @bug    Sort should deal with equivalence on the comparison
 1264%           operator.
 1265
 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).
 1279
 1280%!  cmp(+CmpTerm, -Left, -Op, -Right) is det.
 1281
 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. 1292
 1293
 1294%!  call_det(:Goal, -Det) is nondet.
 1295%
 1296%   True if Goal succeeded.  Det is unified to =true= if Goal left
 1297%   no choicepoints and =false= otherwise.
 1298
 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. 1307
 1308%!  match_error(+Expected, +Received) is semidet.
 1309%
 1310%   True if the Received errors matches the expected error. Matching
 1311%   is based on subsumes_term/2.
 1312
 1313match_error(Expect, Rec) :-
 1314    subsumes_term(Expect, Rec).
 1315
 1316%!  setup(+Module, +Context, +Options) is semidet.
 1317%
 1318%   Call the setup handler and  fail  if   it  cannot  run  for some
 1319%   reason. The condition handler is  similar,   but  failing is not
 1320%   considered an error.  Context is one of
 1321%
 1322%    - unit(Unit)
 1323%      If it is the setup handler for a unit
 1324%    - test(Unit,Name,Line)
 1325%      If it is the setup handler for a test
 1326
 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(_,_,_).
 1338
 1339%!  condition(+Module, +Context, +Options) is semidet.
 1340%
 1341%   Evaluate the test or test unit condition.
 1342
 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(_, _, _).
 1356
 1357
 1358%!  call_ex(+Module, +Goal)
 1359%
 1360%   Call Goal in Module after applying goal expansion.
 1361
 1362call_ex(Module, Goal) :-
 1363    Module:(expand_goal(Goal, GoalEx),
 1364	    GoalEx).
 1365
 1366%!  cleanup(+Module, +Options) is det.
 1367%
 1368%   Call the cleanup handler and succeed.   Failure  or error of the
 1369%   cleanup handler is reported, but tests continue normally.
 1370
 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    ).
 1411
 1412%!  failure(+Unit, +Name, +Progress, +Line,
 1413%!          +How, +Time, +Output, +Options) is det.
 1414%
 1415%   Test failed.  Report the error.
 1416
 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).
 1430
 1431%!  assert_cyclic(+Term) is det.
 1432%
 1433%   Assert  a  possibly  cyclic  unit   clause.  Current  SWI-Prolog
 1434%   assert/1 does not handle cyclic terms,  so we emulate this using
 1435%   the recorded database.
 1436%
 1437%   @tbd    Implement cycle-safe assert and remove this.
 1438
 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).
 1479
 1480%!  setup_jobs(+Count) is det.
 1481%
 1482%   Setup threads for concurrent testing.
 1483
 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.
 1528
 1529%!  job_wait(?Unit) is det.
 1530%
 1531%   Wait for all test jobs to finish.
 1532
 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		 *******************************/
 1572
 1573%!  begin_test(+Unit, +Test, +Line, +Progress) is det.
 1574%!  end_test(+Unit, +Test, +Line, +Progress) is det.
 1575%
 1576%   Maintain running/5 and report a test has started/is ended using
 1577%   a =silent= message:
 1578%
 1579%       * plunit(begin(Unit:Test, File:Line, Progress))
 1580%       * plunit(end(Unit:Test, File:Line, Progress))
 1581%
 1582%   @see message_hook/3 for intercepting these messages
 1583
 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)).
 1597
 1598%!  running_tests is det.
 1599%
 1600%   Print the currently running test.
 1601
 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).
 1612
 1613
 1614%!  current_test(?Unit, ?Test, ?Line, ?Body, ?Options) is nondet.
 1615%
 1616%   True when a test with the specified properties is loaded.
 1617
 1618current_test(Unit, Test, Line, Body, Options) :-
 1619    current_unit(Unit, Module, _Supers, _UnitOptions),
 1620    Module:'unit test'(Test, Line, Options, Body).
 1621
 1622%!  current_test_unit(?Unit, ?Options) is nondet.
 1623%
 1624%   True when a Unit is a current unit test declared with Options.
 1625
 1626current_test_unit(Unit, UnitOptions) :-
 1627    current_unit(Unit, _Module, _Supers, UnitOptions).
 1628
 1629
 1630count(Goal, Count) :-
 1631    aggregate_all(count, Goal, Count).
 1632
 1633%!  test_summary(?Unit, -Summary) is det.
 1634%
 1635%   True when Summary is a dict that reports the main statistics
 1636%   about the executed tests.
 1637
 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.
 1654
 1655%!  report(+Time, +Options) is det.
 1656%
 1657%   Print a summary of the tests that ran.
 1658
 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)).
 1719
 1720
 1721%!  test_report(+What) is det.
 1722%
 1723%   Produce reports on test  results  after   the  run.  Currently  only
 1724%   supports `fixme` for What.
 1725
 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		 *******************************/
 1738
 1739%!  unit_file(+Unit, -File) is det.
 1740%!  unit_file(?Unit, ?File) is nondet.
 1741%
 1742%   True when the test unit Unit is defined in File.
 1743
 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		 *******************************/
 1762
 1763%!  load_test_files(+Options) is det.
 1764%
 1765%   Load .plt test-files related  to   loaded  source-files.  Options is
 1766%   currently ignored.
 1767
 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		 *******************************/
 1799
 1800%!  info(+Term)
 1801%
 1802%   Runs print_message(Level, Term), where Level is   one of `silent` or
 1803%   `informational` (default).
 1804
 1805info(Term) :-
 1806    message_level(Level),
 1807    print_message(Level, Term).
 1808
 1809%!  progress(+UnitTest, +Progress, +Result, +Time) is det.
 1810%
 1811%   Test Unit:Name completed in Time. Result is the result and is one of
 1812%
 1813%     - passed
 1814%     - failed
 1815%     - assertion
 1816%     - nondet
 1817%     - fixme(passed)
 1818%     - fixme(nondet)
 1819%     - fixme(failed)
 1820%     - forall(end, Nth, FTotal)
 1821%       Pseudo result for completion of a forall(Gen,Test) set.  Mapped
 1822%       to forall(FTotal, FFailed)
 1823
 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	      ]).
 2301
 2302%!  test_name_summary(+Term, +MaxLen, -Summary) is det.
 2303%
 2304%   Given the test id, generate  string that summarizes this in MaxLen
 2305%   characters.
 2306
 2307test_name_summary(Term, MaxLen, Summary) :-
 2308    summary_string(Term, Text),
 2309    atom_length(Text, Len),
 2310    (   Len =< MaxLen
 2311    ->  Summary = Text
 2312    ;   End is MaxLen//2,
 2313        Pre is MaxLen - End - 2,
 2314        sub_string(Text, 0, Pre, _, PreText),
 2315        sub_string(Text, _, End, 0, PostText),
 2316        format(string(Summary), '~w..~w', [PreText,PostText])
 2317    ).
 2318
 2319summary_string(Unit:Test, String) =>
 2320    summary_string(Test, String1),
 2321    atomics_to_string([Unit, String1], :, String).
 2322summary_string(@(Name,Vars), String) =>
 2323    format(string(String), '~W (using ~W)',
 2324           [ Name, [numbervars(true), quoted(false)],
 2325             Vars, [numbervars(true), portray(true), quoted(true)]
 2326           ]).
 2327summary_string(Name, String) =>
 2328    term_string(Name, String, [numbervars(true), quoted(false)]).
 2329
 2330%!  progress_string(+Progress, -S) is det.
 2331%
 2332%   True when S is a string representation for the test progress.
 2333
 2334progress_string(forall(_Vars, N-I)/Total, S) =>
 2335    format(string(S), '~w-~w/~w', [N,I,Total]).
 2336progress_string(Progress, S) =>
 2337    term_string(Progress, S).
 2338
 2339%!  progress_tag(+Status, -Tag, -Keep, -Style) is det.
 2340%
 2341%   Given a progress status, determine the status tag, whether we must
 2342%   preserve the  line and the Style  we must use to  print the status
 2343%   line.
 2344
 2345progress_tag(passed,        Tag, Keep, Style) =>
 2346    Tag = passed, Keep = false, Style = comment.
 2347progress_tag(fixme(passed), Tag, Keep, Style) =>
 2348    Tag = passed, Keep = false, Style = comment.
 2349progress_tag(fixme(_),      Tag, Keep, Style) =>
 2350    Tag = fixme, Keep = true, Style = warning.
 2351progress_tag(nondet,        Tag, Keep, Style) =>
 2352    Tag = '**NONDET', Keep = true, Style = warning.
 2353progress_tag(timeout(_Limit), Tag, Keep, Style) =>
 2354    Tag = '**TIMEOUT', Keep = true, Style = warning.
 2355progress_tag(assertion,     Tag, Keep, Style) =>
 2356    Tag = '**FAILED', Keep = true, Style = error.
 2357progress_tag(failed,        Tag, Keep, Style) =>
 2358    Tag = '**FAILED', Keep = true, Style = error.
 2359progress_tag(forall(_,0),   Tag, Keep, Style) =>
 2360    Tag = passed, Keep = false, Style = comment.
 2361progress_tag(forall(_,_),   Tag, Keep, Style) =>
 2362    Tag = '**FAILED', Keep = true, Style = error.
 2363
 2364
 2365		 /*******************************
 2366		 *           OUTPUT		*
 2367		 *******************************/
 2368
 2369save_output_state :-
 2370    stream_property(Output, alias(user_output)),
 2371    stream_property(Error, alias(user_error)),
 2372    asserta(output_streams(Output, Error)).
 2373
 2374restore_output_state :-
 2375    output_streams(Output, Error),
 2376    !,
 2377    set_stream(Output, alias(user_output)),
 2378    set_stream(Error, alias(user_error)).
 2379restore_output_state.
 2380
 2381
 2382
 2383		 /*******************************
 2384		 *      CONCURRENT STATUS       *
 2385		 *******************************/
 2386
 2387/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2388This part deals with interactive feedback   when we are running multiple
 2389threads. The terminal window cannot work on   top  of the Prolog message
 2390infrastructure and (thus) we have to use more low-level means.
 2391- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2392
 2393:- dynamic
 2394       jobs/1,			% Count
 2395       job_window/1,		% Count
 2396       job_status_line/3.	% Job, Format, Args
 2397
 2398job_feedback(_, jobs(Jobs)) :-
 2399    retractall(jobs(_)),
 2400    Jobs > 1,
 2401    asserta(jobs(Jobs)),
 2402    tty_feedback,
 2403    !,
 2404    retractall(job_window(_)),
 2405    asserta(job_window(Jobs)),
 2406    retractall(job_status_line(_,_,_)),
 2407    jobs_redraw.
 2408job_feedback(_, jobs(Jobs)) :-
 2409    !,
 2410    retractall(job_window(_)),
 2411    info(plunit(jobs(Jobs))).
 2412job_feedback(_, Msg) :-
 2413    job_window(_),
 2414    !,
 2415    with_mutex(plunit_feedback, job_feedback(Msg)).
 2416job_feedback(Level, Msg) :-
 2417    print_message(Level, plunit(Msg)).
 2418
 2419job_feedback(begin(Unit:Test, _Location, Progress)) =>
 2420    tty_columns(SummaryWidth, _Margin),
 2421    test_name_summary(Unit:Test, SummaryWidth, NameS),
 2422    progress_string(Progress, ProgressS),
 2423    tty_clear_to_eol(CE),
 2424    job_format(comment, '\r[~w] ~w ..~w',
 2425	       [ProgressS, NameS, CE]),
 2426    flush_output.
 2427job_feedback(end(_UnitTest, _Location, _Progress)) =>
 2428    true.
 2429job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
 2430    (   hide_progress(Status)
 2431    ->  true
 2432    ;   tty_columns(_SummaryWidth, Margin),
 2433	progress_tag(Status, Tag, _Keep, Style),
 2434	job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2435		   [Tag, Time.wall, Margin])
 2436    ).
 2437job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
 2438    tty_columns(_SummaryWidth, Margin),
 2439    progress_tag(failed, Tag, _Keep, Style),
 2440    job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2441	       [Tag, Time.wall, Margin]),
 2442    print_test_output(Error, Output),
 2443    (   (   Error = timeout(_)	% Status line suffices
 2444	;   Error == assertion	% We will get an failed test later
 2445	)
 2446    ->  true
 2447    ;   print_message(Style, plunit(failed(UnitTest, Progress, Line,
 2448					   Error, Time, "")))
 2449    ),
 2450    jobs_redraw.
 2451job_feedback(begin(_Unit)) => true.
 2452job_feedback(end(_Unit, _Summary)) => true.
 2453
 2454hide_progress(assertion).
 2455hide_progress(forall(_,_)).
 2456hide_progress(failed).
 2457hide_progress(timeout(_)).
 2458
 2459print_test_output(Error, _Msgs-Output) =>
 2460    print_test_output(Error, Output).
 2461print_test_output(_, "") => true.
 2462print_test_output(assertion, Output) =>
 2463    print_message(debug, plunit(test_output(error, Output))).
 2464print_test_output(message, Output) =>
 2465    print_message(debug, plunit(test_output(error, Output))).
 2466print_test_output(_, Output) =>
 2467    print_message(debug, plunit(test_output(informational, Output))).
 2468
 2469%!  jobs_redraw is det.
 2470%
 2471%   Redraw the job window.
 2472
 2473jobs_redraw :-
 2474    job_window(N),
 2475    !,
 2476    tty_columns(_, Width),
 2477    tty_header_line(Width),
 2478    forall(between(1,N,Line), job_redraw_worker(Line)),
 2479    tty_header_line(Width).
 2480jobs_redraw.
 2481
 2482job_redraw_worker(Line) :-
 2483    (   job_status_line(Line, Fmt, Args)
 2484    ->  ansi_format(comment, Fmt, Args)
 2485    ;   true
 2486    ),
 2487    nl.
 2488
 2489%!  job_format(+Style, +Fmt, +Args) is det.
 2490%!  job_format(+Job, +Style, +Fmt, +Args, +Save) is det.
 2491%
 2492%   Point should be  below the status window.  Format  Fmt+Args in the
 2493%   line Job using Style and return to the position below the window.
 2494
 2495job_format(Style, Fmt, Args) :-
 2496    job_self(Job),
 2497    job_format(Job, Style, Fmt, Args, true).
 2498
 2499%!  job_finish(+Style, +Fmt, +Args) is det.
 2500%!  job_finish(+Job, +Style, +Fmt, +Args) is det.
 2501%
 2502%   Complete  the status  line  for Job.   This  redraws the  original
 2503%   status line when we are using a job window.
 2504
 2505job_finish(Style, Fmt, Args) :-
 2506    job_self(Job),
 2507    job_finish(Job, Style, Fmt, Args).
 2508
 2509:- det(job_finish/4). 2510job_finish(Job, Style, Fmt, Args) :-
 2511    retract(job_status_line(Job, Fmt0, Args0)),
 2512    !,
 2513    string_concat(Fmt0, Fmt, Fmt1),
 2514    append(Args0, Args, Args1),
 2515    job_format(Job, Style, Fmt1, Args1, false).
 2516
 2517:- det(job_format/5). 2518job_format(Job, Style, Fmt, Args, Save) :-
 2519    job_window(Jobs),
 2520    Up is Jobs+2-Job,
 2521    flush_output(user_output),
 2522    tty_up_and_clear(Up),
 2523    ansi_format(Style, Fmt, Args),
 2524    (   Save == true
 2525    ->  retractall(job_status_line(Job, _, _)),
 2526	asserta(job_status_line(Job, Fmt, Args))
 2527    ;   true
 2528    ),
 2529    tty_down_and_home(Up),
 2530    flush_output(user_output).
 2531
 2532:- det(job_self/1). 2533job_self(Job) :-
 2534    job_window(N),
 2535    N > 1,
 2536    thread_self(Me),
 2537    split_string(Me, '_', '', [_,_,S]),
 2538    number_string(Job, S).
 2539
 2540%!  feedback is semidet.
 2541%
 2542%   provide feedback using the `tty`  format, which reuses the current
 2543%   output line if the test is successful.
 2544
 2545tty_feedback :-
 2546    has_tty,
 2547    current_test_flag(format, tty).
 2548
 2549has_tty :-
 2550    stream_property(user_output, tty(true)).
 2551
 2552tty_columns(SummaryWidth, Margin) :-
 2553    tty_width(W),
 2554    Margin is W-8,
 2555    SummaryWidth is max(20,Margin-34).
 2556
 2557tty_width(W) :-
 2558    current_predicate(tty_size/2),
 2559    catch(tty_size(_Rows, Cols), error(_,_), fail),
 2560    Cols > 25,
 2561    !,
 2562    W = Cols.
 2563tty_width(80).
 2564
 2565tty_header_line(Width) :-
 2566    ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
 2567
 2568:- if(current_predicate(tty_get_capability/3)). 2569tty_clear_to_eol(S) :-
 2570    getenv('TERM', _),
 2571    catch(tty_get_capability(ce, string, S),
 2572          error(_,_),
 2573          fail),
 2574    !.
 2575:- endif. 2576tty_clear_to_eol('\e[K').
 2577
 2578tty_up_and_clear(Lines) :-
 2579    format(user_output, '\e[~dA\r\e[K', [Lines]).
 2580
 2581tty_down_and_home(Lines) :-
 2582    format(user_output, '\e[~dB\r', [Lines]).
 2583
 2584:- if(swi). 2585
 2586:- multifile
 2587    prolog:message/3,
 2588    prolog:message_action/2. 2589
 2590prolog:message(Term) -->
 2591    message(Term).
 2592
 2593%       prolog:message_action(+Term, +Kind)
 2594
 2595prolog:message_action(make(done(Files)), _) :-
 2596    make_run_tests(Files).
 2597
 2598:- endif. 2599
 2600:- if(sicstus). 2601
 2602user:generate_message_hook(Message) -->
 2603    message(Message),
 2604    [nl].                           % SICStus requires nl at the end
 2605
 2606%!  user:message_hook(+Severity, +Message, +Lines) is semidet.
 2607%
 2608%   Redefine printing some messages. It appears   SICStus has no way
 2609%   to get multiple messages at the same   line, so we roll our own.
 2610%   As there is a lot pre-wired and   checked in the SICStus message
 2611%   handling we cannot reuse the lines. Unless I miss something ...
 2612
 2613user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 2614    format(user_error, '% PL-Unit: ~w ', [Unit]),
 2615    flush_output(user_error).
 2616user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 2617    format(user, ' done~n', []).
 2618
 2619:- endif. 2620
 2621		 /*******************************
 2622		 *  SUPPRESS AUTOLOAD WARNINGS	*
 2623		 *******************************/
 2624
 2625'$nowarn_autoload'(set_test_options/1, _).
 2626'$nowarn_autoload'(run_tests/0, _).
 2627'$nowarn_autoload'(run_tests/1, _).
 2628'$nowarn_autoload'(run_tests/2, _).
 2629'$nowarn_autoload'(running_tests/0, _).
 2630'$nowarn_autoload'(current_test/5, _).
 2631'$nowarn_autoload'(current_test_unit/2, _).
 2632'$nowarn_autoload'(test_report/1, _)