1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2023, University of Amsterdam
    7			      VU University Amsterdam
    8			      CWI, Amsterdam
    9			      SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(plunit,
   39	  [ set_test_options/1,         % +Options
   40	    begin_tests/1,              % +Name
   41	    begin_tests/2,              % +Name, +Options
   42	    end_tests/1,                % +Name
   43	    run_tests/0,                % Run all tests
   44	    run_tests/1,                % +Tests
   45	    run_tests/2,                % +Tests, +Options
   46	    load_test_files/1,          % +Options
   47	    running_tests/0,            % Prints currently running test
   48	    current_test/5,             % ?Unit,?Test,?Line,?Body,?Options
   49	    current_test_unit/2,        % ?Unit,?Options
   50	    test_report/1               % +What
   51	  ]).   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), !.
   85swi     :- catch(current_prolog_flag(dialect, yap), _, fail).
   86sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
   87
   88throw_error(Error_term,Impldef) :-
   89    throw(error(Error_term,context(Impldef,_))).
   90
   91:- set_prolog_flag(generate_debug_info, false).   92current_test_flag(optimise, Value) =>
   93    current_prolog_flag(optimise, Value).
   94current_test_flag(occurs_check, Value) =>
   95    (   current_prolog_flag(plunit_occurs_check, Value0)
   96    ->  Value = Value0
   97    ;   current_prolog_flag(occurs_check, Value)
   98    ).
   99current_test_flag(Name, Value), atom(Name) =>
  100    atom_concat(plunit_, Name, Flag),
  101    current_prolog_flag(Flag, Value).
  102current_test_flag(Name, Value), var(Name) =>
  103    global_test_option(Opt, _, _Type, _Default),
  104    functor(Opt, Name, 1),
  105    current_test_flag(Name, Value).
  106
  107set_test_flag(Name, Value) :-
  108    Opt =.. [Name, Value],
  109    global_test_option(Opt),
  110    !,
  111    atom_concat(plunit_, Name, Flag),
  112    set_prolog_flag(Flag, Value).
  113set_test_flag(Name, _) :-
  114    domain_error(test_flag, Name).
  115
  116current_test_flags(Flags) :-
  117    findall(Flag, current_test_flag(Flag), Flags).
  118
  119current_test_flag(Opt) :-
  120    current_test_flag(Name, Value),
  121    Opt =.. [Name, Value].
  122
  123% ensure expansion to avoid tracing
  124goal_expansion(forall(C,A),
  125	       \+ (C, \+ A)).
  126goal_expansion(current_module(Module,File),
  127	       module_property(Module, file(File))).
  128
  129
  130		 /*******************************
  131		 *            IMPORTS           *
  132		 *******************************/
  133
  134:- initialization init_flags.  135
  136init_flags :-
  137    (   global_test_option(Option, _Value, _Type, Default),
  138	Default \== (-),
  139	Option =.. [Name,_],
  140	atom_concat(plunit_, Name, Flag),
  141	create_prolog_flag(Flag, Default, [keep(true)]),
  142	fail
  143    ;   true
  144    ).
  145
  146%!  set_test_options(+Options)
  147%
  148%   Specifies how to deal with test suites.  Defined options are:
  149%
  150%    - load(+Load)
  151%      Whether or not the tests must be loaded.  Values are
  152%      `never`, `always`, `normal` (only if not optimised)
  153%
  154%    - run(+When)
  155%      When the tests are run.  Values are `manual`, `make`
  156%      or make(all).
  157%
  158%    - format(+Mode)
  159%      Currently one of `tty` or `log`.   `tty` uses terminal
  160%      control to overwrite successful tests, allowing the
  161%      user to see the currently running tests and output
  162%      from failed tests.  This is the default of the output
  163%      is a tty.  `log` prints a full log of the executed
  164%      tests and their result and is intended for non-interactive
  165%      usage.
  166%
  167%    - output(+When)
  168%      If `always`, emit all output as it is produced, if `never`,
  169%      suppress all output and if `on_failure`, emit the output
  170%      if the test fails.
  171%
  172%    - show_blocked(+Bool)
  173%      Show individual blocked tests during the report.
  174%
  175%    - occurs_check(+Mode)
  176%      Defines the default for the `occurs_check` flag during
  177%      testing.
  178%
  179%    - cleanup(+Bool)
  180%      If `true` (default =false), cleanup report at the end
  181%      of run_tests/1.  Used to improve cooperation with
  182%      memory debuggers such as dmalloc.
  183%
  184%    - jobs(Num)
  185%      Number of jobs to use for concurrent testing.  Default
  186%      is one, implying sequential testing.
  187%
  188%    - timeout(+Seconds)
  189%      Set timeout for each individual test.  This acts as a
  190%      default that may be overuled at the level of units or
  191%      individual tests.   A timeout of 0 or negative is handled
  192%      as _inifinite_.
  193
  194set_test_options(Options) :-
  195    flatten([Options], List),
  196    maplist(set_test_option, List).
  197
  198set_test_option(sto(true)) =>
  199    print_message(warning, plunit(sto(true))).
  200set_test_option(jobs(Jobs)) =>
  201    must_be(positive_integer, Jobs),
  202    set_test_option_flag(jobs(Jobs)).
  203set_test_option(Option),
  204  compound(Option), global_test_option(Option) =>
  205    set_test_option_flag(Option).
  206set_test_option(Option) =>
  207    domain_error(option, Option).
  208
  209global_test_option(Opt) :-
  210    global_test_option(Opt, Value, Type, _Default),
  211    must_be(Type, Value).
  212
  213global_test_option(load(Load), Load, oneof([never,always,normal]), normal).
  214global_test_option(output(Cond), Cond, oneof([always,on_failure]), on_failure).
  215global_test_option(format(Feedback), Feedback, oneof([tty,log]), tty).
  216global_test_option(silent(Silent), Silent, boolean, false).
  217global_test_option(show_blocked(Blocked), Blocked, boolean, false).
  218global_test_option(run(When), When, oneof([manual,make,make(all)]), make).
  219global_test_option(occurs_check(Mode), Mode, oneof([false,true,error]), -).
  220global_test_option(cleanup(Bool), Bool, boolean, true).
  221global_test_option(jobs(Count), Count, positive_integer, 1).
  222global_test_option(timeout(Number), Number, number, 3600).
  223
  224set_test_option_flag(Option) :-
  225    Option =.. [Name, Value],
  226    set_test_flag(Name, Value).
  227
  228%!  loading_tests
  229%
  230%   True if tests must be loaded.
  231
  232loading_tests :-
  233    current_test_flag(load, Load),
  234    (   Load == always
  235    ->  true
  236    ;   Load == normal,
  237	\+ current_test_flag(optimise, true)
  238    ).
  239
  240		 /*******************************
  241		 *            MODULE            *
  242		 *******************************/
  243
  244:- dynamic
  245    loading_unit/4,                 % Unit, Module, File, OldSource
  246    current_unit/4,                 % Unit, Module, Context, Options
  247    test_file_for/2.                % ?TestFile, ?PrologFile
  248
  249%!  begin_tests(+UnitName:atom) is det.
  250%!  begin_tests(+UnitName:atom, Options) is det.
  251%
  252%   Start a test-unit. UnitName is the  name   of  the test set. the
  253%   unit is ended by :- end_tests(UnitName).
  254
  255begin_tests(Unit) :-
  256    begin_tests(Unit, []).
  257
  258begin_tests(Unit, Options) :-
  259    must_be(atom, Unit),
  260    map_sto_option(Options, Options1),
  261    valid_options(test_set_option, Options1),
  262    make_unit_module(Unit, Name),
  263    source_location(File, Line),
  264    begin_tests(Unit, Name, File:Line, Options1).
  265
  266map_sto_option(Options0, Options) :-
  267    select_option(sto(Mode), Options0, Options1),
  268    !,
  269    map_sto(Mode, Flag),
  270    Options = [occurs_check(Flag)|Options1].
  271map_sto_option(Options, Options).
  272
  273map_sto(rational_trees, Flag) => Flag = false.
  274map_sto(finite_trees, Flag)   => Flag = true.
  275map_sto(Mode, _) => domain_error(sto, Mode).
  276
  277
  278:- if(swi).  279begin_tests(Unit, Name, File:Line, Options) :-
  280    loading_tests,
  281    !,
  282    '$set_source_module'(Context, Context),
  283    (   current_unit(Unit, Name, Context, Options)
  284    ->  true
  285    ;   retractall(current_unit(Unit, Name, _, _)),
  286	assert(current_unit(Unit, Name, Context, Options))
  287    ),
  288    '$set_source_module'(Old, Name),
  289    '$declare_module'(Name, test, Context, File, Line, false),
  290    discontiguous(Name:'unit test'/4),
  291    '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
  292    discontiguous(Name:'unit body'/2),
  293    asserta(loading_unit(Unit, Name, File, Old)).
  294begin_tests(Unit, Name, File:_Line, _Options) :-
  295    '$set_source_module'(Old, Old),
  296    asserta(loading_unit(Unit, Name, File, Old)).
  297
  298:- else.  299
  300% we cannot use discontiguous as a goal in SICStus Prolog.
  301
  302user:term_expansion((:- begin_tests(Set)),
  303		    [ (:- begin_tests(Set)),
  304		      (:- discontiguous(test/2)),
  305		      (:- discontiguous('unit body'/2)),
  306		      (:- discontiguous('unit test'/4))
  307		    ]).
  308
  309begin_tests(Unit, Name, File:_Line, Options) :-
  310    loading_tests,
  311    !,
  312    (   current_unit(Unit, Name, _, Options)
  313    ->  true
  314    ;   retractall(current_unit(Unit, Name, _, _)),
  315	assert(current_unit(Unit, Name, -, Options))
  316    ),
  317    asserta(loading_unit(Unit, Name, File, -)).
  318begin_tests(Unit, Name, File:_Line, _Options) :-
  319    asserta(loading_unit(Unit, Name, File, -)).
  320
  321:- endif.  322
  323%!  end_tests(+Name) is det.
  324%
  325%   Close a unit-test module.
  326%
  327%   @tbd    Run tests/clean module?
  328%   @tbd    End of file?
  329
  330end_tests(Unit) :-
  331    loading_unit(StartUnit, _, _, _),
  332    !,
  333    (   Unit == StartUnit
  334    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  335	'$set_source_module'(_, Old)
  336    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  337    ).
  338end_tests(Unit) :-
  339    throw_error(context_error(plunit_close(Unit, -)), _).
  340
  341%!  make_unit_module(+Name, -ModuleName) is det.
  342%!  unit_module(+Name, -ModuleName) is det.
  343
  344:- if(swi).  345
  346unit_module(Unit, Module) :-
  347    atom_concat('plunit_', Unit, Module).
  348
  349make_unit_module(Unit, Module) :-
  350    unit_module(Unit, Module),
  351    (   current_module(Module),
  352	\+ current_unit(_, Module, _, _),
  353	predicate_property(Module:H, _P),
  354	\+ predicate_property(Module:H, imported_from(_M))
  355    ->  throw_error(permission_error(create, plunit, Unit),
  356		    'Existing module')
  357    ;  true
  358    ).
  359
  360:- else.  361
  362:- dynamic
  363    unit_module_store/2.  364
  365unit_module(Unit, Module) :-
  366    unit_module_store(Unit, Module),
  367    !.
  368
  369make_unit_module(Unit, Module) :-
  370    prolog_load_context(module, Module),
  371    assert(unit_module_store(Unit, Module)).
  372
  373:- endif.  374
  375		 /*******************************
  376		 *           EXPANSION          *
  377		 *******************************/
  378
  379%!  expand_test(+Name, +Options, +Body, -Clause) is det.
  380%
  381%   Expand test(Name, Options) :-  Body  into   a  clause  for
  382%   'unit test'/4 and 'unit body'/2.
  383
  384expand_test(Name, Options0, Body,
  385	    [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
  386	      ('unit body'(Id, Vars) :- !, Body)
  387	    ]) :-
  388    source_location(_File, Line),
  389    prolog_load_context(module, Module),
  390    (   prolog_load_context(variable_names, Bindings)
  391    ->  true
  392    ;   Bindings = []
  393    ),
  394    atomic_list_concat([Name, '@line ', Line], Id),
  395    term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
  396    term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
  397    ord_intersection(OptionVars, BodyVars, VarList),
  398    Vars =.. [vars|VarList],
  399    (   is_list(Options0)           % allow for single option without list
  400    ->  Options1 = Options0
  401    ;   Options1 = [Options0]
  402    ),
  403    maplist(expand_option(Bindings), Options1, Options2),
  404    join_true_options(Options2, Options3),
  405    map_sto_option(Options3, Options4),
  406    valid_options(test_option, Options4),
  407    valid_test_mode(Options4, Options).
  408
  409expand_option(_, Var, _) :-
  410    var(Var),
  411    !,
  412    throw_error(instantiation_error,_).
  413expand_option(Bindings, Cmp, true(Cond)) :-
  414    cmp(Cmp),
  415    !,
  416    var_cmp(Bindings, Cmp, Cond).
  417expand_option(_, error(X), throws(error(X, _))) :- !.
  418expand_option(_, exception(X), throws(X)) :- !. % SICStus 4 compatibility
  419expand_option(_, error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
  420expand_option(_, true, true(true)) :- !.
  421expand_option(_, O, O).
  422
  423cmp(_ == _).
  424cmp(_ = _).
  425cmp(_ =@= _).
  426cmp(_ =:= _).
  427
  428var_cmp(Bindings, Expr, cmp(Name, Expr)) :-
  429    arg(_, Expr, Var),
  430    var(Var),
  431    member(Name=V, Bindings),
  432    V == Var,
  433    !.
  434var_cmp(_, Expr, Expr).
  435
  436join_true_options(Options0, Options) :-
  437    partition(true_option, Options0, True, Rest),
  438    True \== [],
  439    !,
  440    maplist(arg(1), True, Conds0),
  441    flatten(Conds0, Conds),
  442    Options = [true(Conds)|Rest].
  443join_true_options(Options, Options).
  444
  445true_option(true(_)).
  446
  447valid_test_mode(Options0, Options) :-
  448    include(test_mode, Options0, Tests),
  449    (   Tests == []
  450    ->  Options = [true([true])|Options0]
  451    ;   Tests = [_]
  452    ->  Options = Options0
  453    ;   throw_error(plunit(incompatible_options, Tests), _)
  454    ).
  455
  456test_mode(true(_)).
  457test_mode(all(_)).
  458test_mode(set(_)).
  459test_mode(fail).
  460test_mode(throws(_)).
  461
  462
  463%!  expand(+Term, -Clauses) is semidet.
  464
  465expand(end_of_file, _) :-
  466    loading_unit(Unit, _, _, _),
  467    !,
  468    end_tests(Unit),                % warn?
  469    fail.
  470expand((:-end_tests(_)), _) :-
  471    !,
  472    fail.
  473expand(_Term, []) :-
  474    \+ loading_tests.
  475expand((test(Name) :- Body), Clauses) :-
  476    !,
  477    expand_test(Name, [], Body, Clauses).
  478expand((test(Name, Options) :- Body), Clauses) :-
  479    !,
  480    expand_test(Name, Options, Body, Clauses).
  481expand(test(Name), _) :-
  482    !,
  483    throw_error(existence_error(body, test(Name)), _).
  484expand(test(Name, _Options), _) :-
  485    !,
  486    throw_error(existence_error(body, test(Name)), _).
  487
  488:- multifile
  489    system:term_expansion/2.  490
  491system:term_expansion(Term, Expanded) :-
  492    (   loading_unit(_, _, File, _)
  493    ->  source_location(ThisFile, _),
  494	(   File == ThisFile
  495	->  true
  496	;   source_file_property(ThisFile, included_in(File, _))
  497	),
  498	expand(Term, Expanded)
  499    ).
  500
  501
  502		 /*******************************
  503		 *             OPTIONS          *
  504		 *******************************/
  505
  506%!  valid_options(:Pred, +Options) is det.
  507%
  508%   Verify Options to be a list of valid options according to
  509%   Pred.
  510%
  511%   @error `type_error` or `instantiation_error`.
  512
  513valid_options(Pred, Options) :-
  514    must_be(list, Options),
  515    verify_options(Options, Pred).
  516
  517verify_options([], _).
  518verify_options([H|T], Pred) :-
  519    (   call(Pred, H)
  520    ->  verify_options(T, Pred)
  521    ;   throw_error(domain_error(Pred, H), _)
  522    ).
  523
  524valid_options(Pred, Options0, Options, Rest) :-
  525    must_be(list, Options0),
  526    partition(Pred, Options0, Options, Rest).
  527
  528%!  test_option(+Option) is semidet.
  529%
  530%   True if Option is a valid option for test(Name, Options).
  531
  532test_option(Option) :-
  533    test_set_option(Option),
  534    !.
  535test_option(true(_)).
  536test_option(fail).
  537test_option(throws(_)).
  538test_option(all(_)).
  539test_option(set(_)).
  540test_option(nondet).
  541test_option(fixme(_)).
  542test_option(forall(X)) :-
  543    must_be(callable, X).
  544test_option(timeout(Seconds)) :-
  545    must_be(number, Seconds).
  546
  547%!  test_option(+Option) is semidet.
  548%
  549%   True if Option is a valid option for :- begin_tests(Name,
  550%   Options).
  551
  552test_set_option(blocked(X)) :-
  553    must_be(ground, X).
  554test_set_option(condition(X)) :-
  555    must_be(callable, X).
  556test_set_option(setup(X)) :-
  557    must_be(callable, X).
  558test_set_option(cleanup(X)) :-
  559    must_be(callable, X).
  560test_set_option(occurs_check(V)) :-
  561    must_be(oneof([false,true,error]), V).
  562test_set_option(concurrent(V)) :-
  563    must_be(boolean, V),
  564    print_message(informational, plunit(concurrent)).
  565test_set_option(timeout(Seconds)) :-
  566    must_be(number, Seconds).
  567
  568		 /*******************************
  569		 *             UTIL		*
  570		 *******************************/
  571
  572:- meta_predicate
  573       reify_tmo(0, -, +),
  574       reify(0, -),
  575       capture_output(0,-),
  576       capture_output(0,-,+),
  577       got_messages(0,-).  578
  579%!  reify_tmo(:Goal, -Result, +Options) is det.
  580
  581:- if(current_predicate(call_with_time_limit/2)).  582reify_tmo(Goal, Result, Options) :-
  583    option(timeout(Time), Options),
  584    Time > 0,
  585    !,
  586    reify(call_with_time_limit(Time, Goal), Result0),
  587    (   Result0 = throw(time_limit_exceeded)
  588    ->  Result = throw(time_limit_exceeded(Time))
  589    ;   Result = Result0
  590    ).
  591:- endif.  592reify_tmo(Goal, Result, _Options) :-
  593    reify(Goal, Result).
  594
  595%!  reify(:Goal, -Result) is det.
  596%
  597%   Call  Goal  and  unify  Result  with   one  of  `true`,  `false`  or
  598%   `throw(E)`.
  599
  600reify(Goal, Result) :-
  601    (   catch(Goal, E, true)
  602    ->  (   var(E)
  603	->  Result = true
  604	;   Result = throw(E)
  605	)
  606    ;   Result = false
  607    ).
  608
  609%!  capture_output(:Goal, -Output) is semidet.
  610%!  capture_output(:Goal, -Output, +Options) is semidet.
  611%
  612%   @arg Output is a pair `Msgs-String`, where  `Msgs` is a boolean that
  613%   is true if there were messages that   require a non-zero exit status
  614%   and Output contains the output as a string.
  615
  616capture_output(Goal, Output) :-
  617    current_test_flag(output, OutputMode),
  618    capture_output(Goal, Output, [output(OutputMode)]).
  619
  620capture_output(Goal, Msgs-Output, Options) :-
  621    option(output(How), Options, always),
  622    (   How == always
  623    ->  call(Goal),
  624        Msgs = false                % irrelavant
  625    ;   with_output_to(string(Output), got_messages(Goal, Msgs),
  626                       [ capture([user_output, user_error]),
  627                         color(true)
  628                       ])
  629    ).
  630
  631%!  got_messages(:Goal, -Result)
  632
  633got_messages(Goal, Result) :-
  634    (   current_prolog_flag(on_warning, status)
  635    ;   current_prolog_flag(on_error, status)
  636    ), !,
  637    nb_delete(plunit_got_message),
  638    setup_call_cleanup(
  639        asserta(( user:thread_message_hook(_Term, Kind, _Lines) :-
  640                      got_message(Kind), fail), Ref),
  641        Goal,
  642        erase(Ref)),
  643    (   nb_current(plunit_got_message, true)
  644    ->  Result = true
  645    ;   Result = false
  646    ).
  647got_messages(Goal, false) :-
  648    call(Goal).
  649
  650:- public got_message/1.  651got_message(warning) :-
  652    current_prolog_flag(on_warning, status), !,
  653    nb_setval(plunit_got_message, true).
  654got_message(error) :-
  655    current_prolog_flag(on_error, status), !,
  656    nb_setval(plunit_got_message, true).
  657
  658
  659		 /*******************************
  660		 *        RUNNING TOPLEVEL      *
  661		 *******************************/
  662
  663:- dynamic
  664    output_streams/2,               % Output, Error
  665    test_count/1,                   % Count
  666    passed/5,                       % Unit, Test, Line, Det, Time
  667    failed/5,                       % Unit, Test, Line, Reason, Time
  668    timeout/5,                      % Unit, Test, Line, Limit, Time
  669    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  670    blocked/4,                      % Unit, Test, Line, Reason
  671    fixme/5,                        % Unit, Test, Line, Reason, Status
  672    running/5,                      % Unit, Test, Line, STO, Thread
  673    forall_failures/2.              % Nth, Failures
  674
  675%!  run_tests is semidet.
  676%!  run_tests(+TestSet) is semidet.
  677%!  run_tests(+TestSet, +Options) is semidet.
  678%
  679%   Run tests and report about the   results.  The predicate run_tests/0
  680%   runs all known tests that are not blocked. The predicate run_tests/1
  681%   takes a specification of tests  to  run.
  682%
  683%   The predicate run_tests/2 is  synchronized. Concurrent testing may
  684%   be     achieved    using     the     relevant    options.      See
  685%   set_test_options/1. Options are  passed to set_test_options/1.  In
  686%   addition the following options are processed:
  687%
  688%     - summary(-Summary)
  689%       Unify Summary do a dict holding the keys below.  The value of
  690%       these keys is an integer describing the number of tests.  If
  691%       this option is given, run_tests/2 does not fail if some tests
  692%       failed.
  693%
  694%       - total
  695%       - passed
  696%       - failed
  697%       - timeout
  698%       - blocked
  699%
  700%   @arg  TestSet  is either  a  single  specification  or a  list  of
  701%   specifications. Each single specification is  either the name of a
  702%   test-unit  or a  term <test-unit>:<test>,  denoting a  single test
  703%   within a unit.  If TestSet is `all`, all known tests are executed.
  704
  705run_tests :-
  706    run_tests(all).
  707
  708run_tests(Set) :-
  709    run_tests(Set, []).
  710
  711run_tests(all, Options) :-
  712    !,
  713    findall(Unit, current_test_unit(Unit,_), Units),
  714    run_tests(Units, Options).
  715run_tests(Set, Options) :-
  716    valid_options(global_test_option, Options, Global, Rest),
  717    current_test_flags(Old),
  718    setup_call_cleanup(
  719	set_test_options(Global),
  720	( flatten([Set], List),
  721	  maplist(runnable_tests, List, Units),
  722	  with_mutex(plunit, run_tests_sync(Units, Rest))
  723	),
  724	set_test_options(Old)).
  725
  726run_tests_sync(Units0, Options) :-
  727    cleanup,
  728    count_tests(Units0, Units, Count),
  729    asserta(test_count(Count)),
  730    save_output_state,
  731    setup_call_cleanup(
  732	setup_jobs(Count),
  733	setup_call_cleanup(
  734	    setup_trap_assertions(Ref),
  735	    ( call_time(run_units(Units, Options), Time),
  736              test_summary(_All, Summary)
  737            ),
  738	    report_and_cleanup(Ref, Time, Options)),
  739	cleanup_jobs),
  740    (   option(summary(Summary), Options)
  741    ->  true
  742    ;   test_summary_passed(Summary) % fail if some test failed
  743    ).
  744
  745%!  report_and_cleanup(+Ref, +Time, +Options)
  746%
  747%   Undo changes to the environment   (trapping  assertions), report the
  748%   results and cleanup.
  749
  750report_and_cleanup(Ref, Time, Options) :-
  751    cleanup_trap_assertions(Ref),
  752    report(Time, Options),
  753    cleanup_after_test.
  754
  755
  756%!  run_units_and_check_errors(+Units, +Options) is semidet.
  757%
  758%   Run all test units and succeed if all tests passed.
  759
  760run_units(Units, _Options) :-
  761    maplist(schedule_unit, Units),
  762    job_wait(_).
  763
  764%!  runnable_tests(+Spec, -Plan) is det.
  765%
  766%   Change a Unit+Test spec  into  a   plain  `Unit:Tests`  lists, where
  767%   blocked tests or tests whose condition   fails  are already removed.
  768%   Each test in `Tests` is a  term   `@(Test,Line)`,  which serves as a
  769%   unique identifier of the test.
  770
  771:- det(runnable_tests/2).  772runnable_tests(Spec, Unit:RunnableTests) :-
  773    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  774    (   option(blocked(Reason), UnitOptions)
  775    ->  info(plunit(blocked(unit(Unit, Reason)))),
  776        RunnableTests = []
  777    ;   \+ condition(Module, unit(Unit), UnitOptions)
  778    ->  RunnableTests = []
  779    ;   var(Tests)
  780    ->  findall(TestID,
  781                runnable_test(Unit, _Test, Module, TestID),
  782                RunnableTests)
  783    ;   flatten([Tests], TestList),
  784        findall(TestID,
  785                ( member(Test, TestList),
  786                  runnable_test(Unit,Test,Module, TestID)
  787                ),
  788                RunnableTests)
  789    ).
  790
  791runnable_test(Unit, Name, Module, @(Test,Line)) :-
  792    current_test(Unit, Name, Line, _Body, TestOptions),
  793    (   option(blocked(Reason), TestOptions)
  794    ->  Test = blocked(Name, Reason)
  795    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  796        Test = Name
  797    ).
  798
  799unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  800    Unit = Unit0,
  801    Tests = Tests0,
  802    (   current_unit(Unit, Module, _Supers, Options)
  803    ->  true
  804    ;   throw_error(existence_error(unit_test, Unit), _)
  805    ).
  806unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  807    Unit = Unit0,
  808    (   current_unit(Unit, Module, _Supers, Options)
  809    ->  true
  810    ;   throw_error(existence_error(unit_test, Unit), _)
  811    ).
  812
  813%!  count_tests(+Units0, -Units, -Count) is det.
  814%
  815%   Count the number of tests to   run. A forall(Generator, Test) counts
  816%   as a single test. During the execution,   the  concrete tests of the
  817%   _forall_ are considered "sub tests".
  818
  819count_tests(Units0, Units, Count) :-
  820    count_tests(Units0, Units, 0, Count).
  821
  822count_tests([], T, C0, C) =>
  823    T = [],
  824    C = C0.
  825count_tests([_:[]|T0], T, C0, C) =>
  826    count_tests(T0, T, C0, C).
  827count_tests([Unit:Tests|T0], T, C0, C) =>
  828    partition(is_blocked, Tests, Blocked, Use),
  829    maplist(assert_blocked(Unit), Blocked),
  830    (   Use == []
  831    ->  count_tests(T0, T, C0, C)
  832    ;   length(Use, N),
  833        C1 is C0+N,
  834        T = [Unit:Use|T1],
  835        count_tests(T0, T1, C1, C)
  836    ).
  837
  838is_blocked(@(blocked(_,_),_)) => true.
  839is_blocked(_) => fail.
  840
  841assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  842    assert(blocked(Unit, Test, Line, Reason)).
  843
  844%!  run_unit(+Unit) is det.
  845%
  846%   Run a single test unit. Unit is a  term Unit:Tests, where Tests is a
  847%   list of tests to run.
  848
  849run_unit(_Unit:[]) =>
  850    true.
  851run_unit(Unit:Tests) =>
  852    unit_module(Unit, Module),
  853    unit_options(Unit, UnitOptions),
  854    (   setup(Module, unit(Unit), UnitOptions)
  855    ->  begin_unit(Unit),
  856        call_time(run_unit_2(Unit, Tests), Time),
  857        test_summary(Unit, Summary),
  858	end_unit(Unit, Summary.put(time, Time)),
  859        cleanup(Module, UnitOptions)
  860    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  861    ).
  862
  863begin_unit(Unit) :-
  864    job_info(begin(unit(Unit))),
  865    job_feedback(informational, begin(Unit)).
  866
  867end_unit(Unit, Summary) :-
  868    job_info(end(unit(Unit, Summary))),
  869    job_feedback(informational, end(Unit, Summary)).
  870
  871run_unit_2(Unit, Tests) :-
  872    forall(member(Test, Tests),
  873	   run_test(Unit, Test)).
  874
  875
  876unit_options(Unit, Options) :-
  877    current_unit(Unit, _Module, _Supers, Options).
  878
  879
  880cleanup :-
  881    set_flag(plunit_test, 1),
  882    retractall(output_streams(_,_)),
  883    retractall(test_count(_)),
  884    retractall(passed(_, _, _, _, _)),
  885    retractall(failed(_, _, _, _, _)),
  886    retractall(timeout(_, _, _, _, _)),
  887    retractall(failed_assertion(_, _, _, _, _, _, _)),
  888    retractall(blocked(_, _, _, _)),
  889    retractall(fixme(_, _, _, _, _)),
  890    retractall(running(_,_,_,_,_)),
  891    retractall(forall_failures(_,_)).
  892
  893cleanup_after_test :-
  894    (   current_test_flag(cleanup, true)
  895    ->  cleanup
  896    ;   true
  897    ).
  898
  899
  900%!  run_tests_in_files(+Files:list) is det.
  901%
  902%   Run all test-units that appear in the given Files.
  903
  904run_tests_in_files(Files) :-
  905    findall(Unit, unit_in_files(Files, Unit), Units),
  906    (   Units == []
  907    ->  true
  908    ;   run_tests(Units)
  909    ).
  910
  911unit_in_files(Files, Unit) :-
  912    is_list(Files),
  913    !,
  914    member(F, Files),
  915    absolute_file_name(F, Source,
  916		       [ file_type(prolog),
  917			 access(read),
  918			 file_errors(fail)
  919		       ]),
  920    unit_file(Unit, Source).
  921
  922
  923		 /*******************************
  924		 *         HOOKING MAKE/0       *
  925		 *******************************/
  926
  927%!  make_run_tests(+Files)
  928%
  929%   Called indirectly from make/0 after Files have been reloaded.
  930
  931make_run_tests(Files) :-
  932    current_test_flag(run, When),
  933    (   When == make
  934    ->  run_tests_in_files(Files)
  935    ;   When == make(all)
  936    ->  run_tests
  937    ;   true
  938    ).
  939
  940		 /*******************************
  941		 *      ASSERTION HANDLING      *
  942		 *******************************/
  943
  944:- if(swi).  945
  946:- dynamic prolog:assertion_failed/2.  947
  948setup_trap_assertions(Ref) :-
  949    asserta((prolog:assertion_failed(Reason, Goal) :-
  950		    test_assertion_failed(Reason, Goal)),
  951	    Ref).
  952
  953cleanup_trap_assertions(Ref) :-
  954    erase(Ref).
  955
  956test_assertion_failed(Reason, Goal) :-
  957    thread_self(Me),
  958    running(Unit, Test, Line, Progress, Me),
  959    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  960	assertion_location(Stack, AssertLoc)
  961    ->  true
  962    ;   AssertLoc = unknown
  963    ),
  964    report_failed_assertion(Unit:Test, Line, AssertLoc,
  965			    Progress, Reason, Goal),
  966    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  967				   Progress, Reason, Goal)).
  968
  969assertion_location(Stack, File:Line) :-
  970    append(_, [AssertFrame,CallerFrame|_], Stack),
  971    prolog_stack_frame_property(AssertFrame,
  972				predicate(prolog_debug:assertion/1)),
  973    !,
  974    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  975
  976report_failed_assertion(UnitTest, Line, AssertLoc,
  977			Progress, Reason, Goal) :-
  978    print_message(
  979	error,
  980	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  981				Progress, Reason, Goal))).
  982
  983:- else.  984
  985setup_trap_assertions(_).
  986cleanup_trap_assertions(_).
  987
  988:- endif.  989
  990
  991		 /*******************************
  992		 *         RUNNING A TEST       *
  993		 *******************************/
  994
  995%!  run_test(+Unit, +Test) is det.
  996%
  997%   Run a single test.
  998
  999run_test(Unit, @(Test,Line)) :-
 1000    unit_module(Unit, Module),
 1001    Module:'unit test'(Test, Line, TestOptions, Body),
 1002    unit_options(Unit, UnitOptions),
 1003    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).
 1004
 1005%!  run_test(+Unit, +Name, +Line, +UnitOptions, +Options, +Body)
 1006%
 1007%   Deals with forall(Generator, Test)
 1008
 1009run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1010    option(forall(Generator), Options),
 1011    !,
 1012    unit_module(Unit, Module),
 1013    term_variables(Generator, Vars),
 1014    start_test(Unit, @(Name,Line), Nth),
 1015    State = state(0),
 1016    call_time(forall(Module:Generator,            % may become concurrent
 1017                     (   incr_forall(State, I),
 1018                         run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
 1019                                        UnitOptions, Options, Body)
 1020                     )),
 1021                     Time),
 1022    arg(1, State, Generated),
 1023    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1024run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1025    start_test(Unit, @(Name,Line), Nth),
 1026    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1027
 1028start_test(_Unit, _TestID, Nth) :-
 1029    flag(plunit_test, Nth, Nth+1).
 1030
 1031incr_forall(State, I) :-
 1032    arg(1, State, I0),
 1033    I is I0+1,
 1034    nb_setarg(1, State, I).
 1035
 1036%!  run_test_once6(+Unit, +Name, +Progress, +Line, +UnitOptions,
 1037%!                 +Options, +Body)
 1038%
 1039%   Inherit the `timeout` and `occurs_check` option (Global -> Unit -> Test).
 1040
 1041run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1042    current_test_flag(timeout, DefTimeOut),
 1043    current_test_flag(occurs_check, DefOccurs),
 1044    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1045    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1046    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1047
 1048inherit_option(Name, Options0, Chain, Default, Options) :-
 1049    Term =.. [Name,_Value],
 1050    (   option(Term, Options0)
 1051    ->  Options = Options0
 1052    ;   member(Opts, Chain),
 1053        option(Term, Opts)
 1054    ->  Options = [Term|Options0]
 1055    ;   Default == (-)
 1056    ->  Options = Options0
 1057    ;   Opt =.. [Name,Default],
 1058	Options = [Opt|Options0]
 1059    ).
 1060
 1061%!  run_test_once(+Unit, +Name, Progress, +Line, +Options, +Body)
 1062%
 1063%   Deal with occurs_check, i.e., running the  test multiple times with different
 1064%   unification settings wrt. the occurs check.
 1065
 1066run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1067    option(occurs_check(Occurs), Options),
 1068    !,
 1069    begin_test(Unit, Name, Line, Progress),
 1070    current_prolog_flag(occurs_check, Old),
 1071    setup_call_cleanup(
 1072	set_prolog_flag(occurs_check, Occurs),
 1073	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1074		       Output),
 1075	set_prolog_flag(occurs_check, Old)),
 1076    end_test(Unit, Name, Line, Progress),
 1077    report_result(Result, Progress, Output, Options).
 1078run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1079    begin_test(Unit, Name, Line, Progress),
 1080    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1081		   Output),
 1082    end_test(Unit, Name, Line, Progress),
 1083    report_result(Result, Progress, Output, Options).
 1084
 1085%!  report_result(+Result, +Progress, +Output, +Options) is det.
 1086
 1087:- det(report_result/4). 1088report_result(failure(Unit, Name, Line, How, Time),
 1089	      Progress, Output, Options) :-
 1090    !,
 1091    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1092report_result(success(Unit, Name, Line, Determinism, Time),
 1093	      Progress, Output, Options) :-
 1094    !,
 1095    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1096report_result(setup_failed(_Unit, _Name, _Line),
 1097	      _Progress, _Output, _Options).
 1098
 1099%!  run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1100%
 1101%   6th step  of the  tests.  Deals  with tests  that must  be ignored
 1102%   (blocked, conditions fails), setup and cleanup at the test level.
 1103%   Result is one of:
 1104%
 1105%     - failure(Unit, Name, Line, How, Time)
 1106%       How is one of:
 1107%       - succeeded
 1108%       - Exception
 1109%       - time_limit_exceeded(Limit)
 1110%       - cmp_error(Cmp, E)
 1111%       - wrong_answer(Cmp)
 1112%       - failed
 1113%       - no_exception
 1114%       - wrong_error(Expect, E)
 1115%       - wrong_answer(Expected, Bindings)
 1116%     - success(Unit, Name, Line, Determinism, Time)
 1117%     - setup_failed(Unit, Name, Line)
 1118
 1119run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1120    option(setup(_Setup), Options),
 1121    !,
 1122    (   unit_module(Unit, Module),
 1123        setup(Module, test(Unit,Name,Line), Options)
 1124    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1125        cleanup(Module, Options)
 1126    ;   Result = setup_failed(Unit, Name, Line)
 1127    ).
 1128run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1129    unit_module(Unit, Module),
 1130    run_test_7(Unit, Name, Line, Options, Body, Result),
 1131    cleanup(Module, Options).
 1132
 1133%!  run_test_7(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1134%
 1135%   This step  deals with the expected  outcome of the test.   It runs
 1136%   the  actual test  and then  compares  the result  to the  outcome.
 1137%   There are  two main categories:  dealing with a single  result and
 1138%   all results.
 1139
 1140run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1141    option(true(Cmp), Options),			   % expected success
 1142    !,
 1143    unit_module(Unit, Module),
 1144    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1145    (   Result0 == true
 1146    ->  cmp_true(Cmp, Module, CmpResult),
 1147	(   CmpResult == []
 1148	->  Result = success(Unit, Name, Line, Det, Time)
 1149	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1150	)
 1151    ;   Result0 == false
 1152    ->  Result = failure(Unit, Name, Line, failed, Time)
 1153    ;   Result0 = throw(E2)
 1154    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1155    ).
 1156run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1157    option(fail, Options),                         % expected failure
 1158    !,
 1159    unit_module(Unit, Module),
 1160    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1161    (   Result0 == true
 1162    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1163    ;   Result0 == false
 1164    ->  Result = success(Unit, Name, Line, true, Time)
 1165    ;   Result0 = throw(E)
 1166    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1167    ).
 1168run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1169    option(throws(Expect), Options),		   % Expected error
 1170    !,
 1171    unit_module(Unit, Module),
 1172    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1173    (   Result0 == true
 1174    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1175    ;   Result0 == false
 1176    ->  Result = failure(Unit, Name, Line, failed, Time)
 1177    ;   Result0 = throw(E)
 1178    ->  (   match_error(Expect, E)
 1179        ->  Result = success(Unit, Name, Line, true, Time)
 1180        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1181        )
 1182    ).
 1183run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1184    option(all(Answer), Options),                  % all(Bindings)
 1185    !,
 1186    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1187run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1188    option(set(Answer), Options),                  % set(Bindings)
 1189    !,
 1190    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
 1191
 1192%!  non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)
 1193%
 1194%   Run tests on non-deterministic predicates.
 1195
 1196nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1197    unit_module(Unit, Module),
 1198    result_vars(Expected, Vars),
 1199    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1200                            Result0, Options), Time)
 1201    ->  (   Result0 == true
 1202        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1203            ->  Result = success(Unit, Name, Line, true, Time)
 1204            ;   Result = failure(Unit, Name, Line,
 1205				 [wrong_answer(Expected, Bindings)], Time)
 1206            )
 1207        ;   Result0 = throw(E)
 1208        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1209        )
 1210    ).
 1211
 1212cmp_true([], _, L) =>
 1213    L = [].
 1214cmp_true([Cmp|T], Module, L) =>
 1215    E = error(Formal,_),
 1216    cmp_goal(Cmp, Goal),
 1217    (   catch(Module:Goal, E, true)
 1218    ->  (   var(Formal)
 1219	->  cmp_true(T, Module, L)
 1220	;   L = [cmp_error(Cmp,E)|L1],
 1221	    cmp_true(T, Module, L1)
 1222	)
 1223    ;   L = [wrong_answer(Cmp)|L1],
 1224	cmp_true(T, Module, L1)
 1225    ).
 1226
 1227cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1228cmp_goal(Expr, Goal) => Goal = Expr.
 1229
 1230
 1231%!  result_vars(+Expected, -Vars) is det.
 1232%
 1233%   Create a term v(V1, ...) containing all variables at the left
 1234%   side of the comparison operator on Expected.
 1235
 1236result_vars(Expected, Vars) :-
 1237    arg(1, Expected, CmpOp),
 1238    arg(1, CmpOp, Vars).
 1239
 1240%!  nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet.
 1241%
 1242%   Compare list/set results for non-deterministic predicates.
 1243%
 1244%   @tbd    Properly report errors
 1245%   @bug    Sort should deal with equivalence on the comparison
 1246%           operator.
 1247
 1248nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1249    cmp(Cmp, _Vars, Op, Values),
 1250    cmp_list(Values, Bindings, Op).
 1251nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1252    cmp(Cmp, _Vars, Op, Values0),
 1253    sort(Bindings0, Bindings),
 1254    sort(Values0, Values),
 1255    cmp_list(Values, Bindings, Op).
 1256
 1257cmp_list([], [], _Op).
 1258cmp_list([E0|ET], [V0|VT], Op) :-
 1259    call(Op, E0, V0),
 1260    cmp_list(ET, VT, Op).
 1261
 1262%!  cmp(+CmpTerm, -Left, -Op, -Right) is det.
 1263
 1264cmp(Var  == Value, Var,  ==, Value).
 1265cmp(Var =:= Value, Var, =:=, Value).
 1266cmp(Var  =  Value, Var,  =,  Value).
 1267:- if(swi). 1268cmp(Var =@= Value, Var, =@=, Value).
 1269:- else. 1270:- if(sicstus). 1271cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1272:- endif. 1273:- endif. 1274
 1275
 1276%!  call_det(:Goal, -Det) is nondet.
 1277%
 1278%   True if Goal succeeded.  Det is unified to =true= if Goal left
 1279%   no choicepoints and =false= otherwise.
 1280
 1281:- if((swi;sicstus)). 1282call_det(Goal, Det) :-
 1283    call_cleanup(Goal,Det0=true),
 1284    ( var(Det0) -> Det = false ; Det = true ).
 1285:- else. 1286call_det(Goal, true) :-
 1287    call(Goal).
 1288:- endif. 1289
 1290%!  match_error(+Expected, +Received) is semidet.
 1291%
 1292%   True if the Received errors matches the expected error. Matching
 1293%   is based on subsumes_term/2.
 1294
 1295match_error(Expect, Rec) :-
 1296    subsumes_term(Expect, Rec).
 1297
 1298%!  setup(+Module, +Context, +Options) is semidet.
 1299%
 1300%   Call the setup handler and  fail  if   it  cannot  run  for some
 1301%   reason. The condition handler is  similar,   but  failing is not
 1302%   considered an error.  Context is one of
 1303%
 1304%    - unit(Unit)
 1305%      If it is the setup handler for a unit
 1306%    - test(Unit,Name,Line)
 1307%      If it is the setup handler for a test
 1308
 1309setup(Module, Context, Options) :-
 1310    option(setup(Setup), Options),
 1311    !,
 1312    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1313    (   Result == true
 1314    ->  true
 1315    ;   print_message(error,
 1316		      plunit(error(setup, Context, Output, Result))),
 1317	fail
 1318    ).
 1319setup(_,_,_).
 1320
 1321%!  condition(+Module, +Context, +Options) is semidet.
 1322%
 1323%   Evaluate the test or test unit condition.
 1324
 1325condition(Module, Context, Options) :-
 1326    option(condition(Cond), Options),
 1327    !,
 1328    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1329    (   Result == true
 1330    ->  true
 1331    ;   Result == false
 1332    ->  fail
 1333    ;   print_message(error,
 1334		      plunit(error(condition, Context, Output, Result))),
 1335	fail
 1336    ).
 1337condition(_, _, _).
 1338
 1339
 1340%!  call_ex(+Module, +Goal)
 1341%
 1342%   Call Goal in Module after applying goal expansion.
 1343
 1344call_ex(Module, Goal) :-
 1345    Module:(expand_goal(Goal, GoalEx),
 1346	    GoalEx).
 1347
 1348%!  cleanup(+Module, +Options) is det.
 1349%
 1350%   Call the cleanup handler and succeed.   Failure  or error of the
 1351%   cleanup handler is reported, but tests continue normally.
 1352
 1353cleanup(Module, Options) :-
 1354    option(cleanup(Cleanup), Options, true),
 1355    (   catch(call_ex(Module, Cleanup), E, true)
 1356    ->  (   var(E)
 1357	->  true
 1358	;   print_message(warning, E)
 1359	)
 1360    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1361    ).
 1362
 1363success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1364    memberchk(fixme(Reason), Options),
 1365    !,
 1366    (   (   Det == true
 1367	;   memberchk(nondet, Options)
 1368	)
 1369    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1370	Ok = passed
 1371    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1372	Ok = nondet
 1373    ),
 1374    flush_output(user_error),
 1375    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1376success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1377    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1378    !,
 1379    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1380success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1381    Output = true-_,
 1382    !,
 1383    failure(Unit, Name, Progress, Line, message, Time, Output, Options).
 1384success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1385    assert(passed(Unit, Name, Line, Det, Time)),
 1386    (   (   Det == true
 1387	;   memberchk(nondet, Options)
 1388	)
 1389    ->  progress(Unit:Name, Progress, passed, Time)
 1390    ;   unit_file(Unit, File),
 1391	print_message(warning, plunit(nondet(File, Line, Name)))
 1392    ).
 1393
 1394%!  failure(+Unit, +Name, +Progress, +Line,
 1395%!          +How, +Time, +Output, +Options) is det.
 1396%
 1397%   Test failed.  Report the error.
 1398
 1399failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1400  memberchk(fixme(Reason), Options) =>
 1401    assert(fixme(Unit, Name, Line, Reason, failed)),
 1402    progress(Unit:Name, Progress, fixme(failed), Time).
 1403failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1404	Output, Options) =>
 1405    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1406    progress(Unit:Name, Progress, timeout(Limit), Time),
 1407    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1408failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1409    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1410    progress(Unit:Name, Progress, failed, Time),
 1411    report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
 1412
 1413%!  assert_cyclic(+Term) is det.
 1414%
 1415%   Assert  a  possibly  cyclic  unit   clause.  Current  SWI-Prolog
 1416%   assert/1 does not handle cyclic terms,  so we emulate this using
 1417%   the recorded database.
 1418%
 1419%   @tbd    Implement cycle-safe assert and remove this.
 1420
 1421:- if(swi). 1422assert_cyclic(Term) :-
 1423    acyclic_term(Term),
 1424    !,
 1425    assert(Term).
 1426assert_cyclic(Term) :-
 1427    Term =.. [Functor|Args],
 1428    recorda(cyclic, Args, Id),
 1429    functor(Term, _, Arity),
 1430    length(NewArgs, Arity),
 1431    Head =.. [Functor|NewArgs],
 1432    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1433:- else. 1434:- if(sicstus). 1435:- endif. 1436assert_cyclic(Term) :-
 1437    assert(Term).
 1438:- endif. 1439
 1440
 1441		 /*******************************
 1442		 *             JOBS             *
 1443		 *******************************/
 1444
 1445:- if(current_prolog_flag(threads, true)). 1446
 1447:- dynamic
 1448       job_data/2,		% Queue, Threads
 1449       scheduled_unit/1. 1450
 1451schedule_unit(_:[]) :-
 1452    !.
 1453schedule_unit(UnitAndTests) :-
 1454    UnitAndTests = Unit:_Tests,
 1455    job_data(Queue, _),
 1456    !,
 1457    assertz(scheduled_unit(Unit)),
 1458    thread_send_message(Queue, unit(UnitAndTests)).
 1459schedule_unit(Unit) :-
 1460    run_unit(Unit).
 1461
 1462%!  setup_jobs(+Count) is det.
 1463%
 1464%   Setup threads for concurrent testing.
 1465
 1466setup_jobs(Count) :-
 1467    (   current_test_flag(jobs, Jobs0),
 1468	integer(Jobs0)
 1469    ->  true
 1470    ;   current_prolog_flag(cpu_count, Jobs0)
 1471    ),
 1472    Jobs is min(Count, Jobs0),
 1473    Jobs > 1,
 1474    !,
 1475    message_queue_create(Q, [alias(plunit_jobs)]),
 1476    length(TIDs, Jobs),
 1477    foldl(create_plunit_job(Q), TIDs, 1, _),
 1478    asserta(job_data(Q, TIDs)),
 1479    job_feedback(informational, jobs(Jobs)).
 1480setup_jobs(_) :-
 1481    job_feedback(informational, jobs(1)).
 1482
 1483create_plunit_job(Q, TID, N, N1) :-
 1484    N1 is N + 1,
 1485    atom_concat(plunit_job_, N, Alias),
 1486    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1487
 1488plunit_job(Queue) :-
 1489    repeat,
 1490    (   catch(thread_get_message(Queue, Job,
 1491				 [ timeout(10)
 1492				 ]),
 1493	      error(_,_), fail)
 1494    ->  job(Job),
 1495	fail
 1496    ;   !
 1497    ).
 1498
 1499job(unit(Unit:Tests)) =>
 1500    run_unit(Unit:Tests).
 1501job(test(Unit, Test)) =>
 1502    run_test(Unit, Test).
 1503
 1504cleanup_jobs :-
 1505    retract(job_data(Queue, TIDSs)),
 1506    !,
 1507    message_queue_destroy(Queue),
 1508    maplist(thread_join, TIDSs).
 1509cleanup_jobs.
 1510
 1511%!  job_wait(?Unit) is det.
 1512%
 1513%   Wait for all test jobs to finish.
 1514
 1515job_wait(Unit) :-
 1516    thread_wait(\+ scheduled_unit(Unit),
 1517		[ wait_preds([scheduled_unit/1]),
 1518		  timeout(1)
 1519		]),
 1520    !.
 1521job_wait(Unit) :-
 1522    job_data(_Queue, TIDs),
 1523    member(TID, TIDs),
 1524    thread_property(TID, status(running)),
 1525    !,
 1526    job_wait(Unit).
 1527job_wait(_).
 1528
 1529
 1530job_info(begin(unit(Unit))) =>
 1531    print_message(silent, plunit(begin(Unit))).
 1532job_info(end(unit(Unit, Summary))) =>
 1533    retractall(scheduled_unit(Unit)),
 1534    print_message(silent, plunit(end(Unit, Summary))).
 1535
 1536:- else.			% No jobs
 1537
 1538schedule_unit(Unit) :-
 1539    run_unit(Unit).
 1540
 1541setup_jobs(_) :-
 1542    print_message(silent, plunit(jobs(1))).
 1543cleanup_jobs.
 1544job_wait(_).
 1545job_info(_).
 1546
 1547:- endif. 1548
 1549
 1550
 1551		 /*******************************
 1552		 *            REPORTING         *
 1553		 *******************************/
 1554
 1555%!  begin_test(+Unit, +Test, +Line, +Progress) is det.
 1556%!  end_test(+Unit, +Test, +Line, +Progress) is det.
 1557%
 1558%   Maintain running/5 and report a test has started/is ended using
 1559%   a =silent= message:
 1560%
 1561%       * plunit(begin(Unit:Test, File:Line, Progress))
 1562%       * plunit(end(Unit:Test, File:Line, Progress))
 1563%
 1564%   @see message_hook/3 for intercepting these messages
 1565
 1566begin_test(Unit, Test, Line, Progress) :-
 1567    thread_self(Me),
 1568    assert(running(Unit, Test, Line, Progress, Me)),
 1569    unit_file(Unit, File),
 1570    test_count(Total),
 1571    job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
 1572
 1573end_test(Unit, Test, Line, Progress) :-
 1574    thread_self(Me),
 1575    retractall(running(_,_,_,_,Me)),
 1576    unit_file(Unit, File),
 1577    test_count(Total),
 1578    job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
 1579
 1580%!  running_tests is det.
 1581%
 1582%   Print the currently running test.
 1583
 1584running_tests :-
 1585    running_tests(Running),
 1586    print_message(informational, plunit(running(Running))).
 1587
 1588running_tests(Running) :-
 1589    test_count(Total),
 1590    findall(running(Unit:Test, File:Line, Progress/Total, Thread),
 1591	    (   running(Unit, Test, Line, Progress, Thread),
 1592		unit_file(Unit, File)
 1593	    ), Running).
 1594
 1595
 1596%!  current_test(?Unit, ?Test, ?Line, ?Body, ?Options) is nondet.
 1597%
 1598%   True when a test with the specified properties is loaded.
 1599
 1600current_test(Unit, Test, Line, Body, Options) :-
 1601    current_unit(Unit, Module, _Supers, _UnitOptions),
 1602    Module:'unit test'(Test, Line, Options, Body).
 1603
 1604%!  current_test_unit(?Unit, ?Options) is nondet.
 1605%
 1606%   True when a Unit is a current unit test declared with Options.
 1607
 1608current_test_unit(Unit, UnitOptions) :-
 1609    current_unit(Unit, _Module, _Supers, UnitOptions).
 1610
 1611
 1612count(Goal, Count) :-
 1613    aggregate_all(count, Goal, Count).
 1614
 1615%!  test_summary(?Unit, -Summary) is det.
 1616%
 1617%   True when Summary is a dict that reports the main statistics
 1618%   about the executed tests.
 1619
 1620test_summary(Unit, Summary) :-
 1621    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1622    count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
 1623    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1624    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1625    count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme),
 1626    test_count(Total),
 1627    Summary = plunit{total:Total,
 1628		     passed:Passed,
 1629		     failed:Failed,
 1630		     timeout:Timeout,
 1631		     blocked:Blocked,
 1632		     fixme:Fixme}.
 1633
 1634test_summary_passed(Summary) :-
 1635    _{failed: 0} :< Summary.
 1636
 1637%!  report(+Time, +Options) is det.
 1638%
 1639%   Print a summary of the tests that ran.
 1640
 1641report(Time, _Options) :-
 1642    test_summary(_, Summary),
 1643    print_message(silent, plunit(Summary)),
 1644    _{ passed:Passed,
 1645       failed:Failed,
 1646       timeout:Timeout,
 1647       blocked:Blocked,
 1648       fixme:Fixme
 1649     } :< Summary,
 1650    (   Passed+Failed+Timeout+Blocked+Fixme =:= 0
 1651    ->  info(plunit(no_tests))
 1652    ;   Failed+Timeout =:= 0
 1653    ->  report_blocked(Blocked),
 1654	report_fixme,
 1655        test_count(Total),
 1656	info(plunit(all_passed(Total, Passed, Time)))
 1657    ;   report_blocked(Blocked),
 1658	report_fixme,
 1659	report_failed(Failed),
 1660	report_timeout(Timeout),
 1661	info(plunit(passed(Passed))),
 1662        info(plunit(total_time(Time)))
 1663    ).
 1664
 1665report_blocked(0) =>
 1666    true.
 1667report_blocked(Blocked) =>
 1668    findall(blocked(Unit:Name, File:Line, Reason),
 1669	    ( blocked(Unit, Name, Line, Reason),
 1670	      unit_file(Unit, File)
 1671	    ),
 1672	    BlockedTests),
 1673    info(plunit(blocked(Blocked, BlockedTests))).
 1674
 1675report_failed(Failed) :-
 1676    print_message(error, plunit(failed(Failed))).
 1677
 1678report_timeout(Count) :-
 1679    print_message(warning, plunit(timeout(Count))).
 1680
 1681report_fixme :-
 1682    report_fixme(_,_,_).
 1683
 1684report_fixme(TuplesF, TuplesP, TuplesN) :-
 1685    fixme(failed, TuplesF, Failed),
 1686    fixme(passed, TuplesP, Passed),
 1687    fixme(nondet, TuplesN, Nondet),
 1688    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1689
 1690
 1691fixme(How, Tuples, Count) :-
 1692    findall(fixme(Unit, Name, Line, Reason, How),
 1693	    fixme(Unit, Name, Line, Reason, How), Tuples),
 1694    length(Tuples, Count).
 1695
 1696report_failure(Unit, Name, Progress, Line, Error,
 1697	       Time, Output, _Options) =>
 1698    test_count(Total),
 1699    job_feedback(error, failed(Unit:Name, Progress/Total, Line,
 1700			       Error, Time, Output)).
 1701
 1702
 1703%!  test_report(+What) is det.
 1704%
 1705%   Produce reports on test  results  after   the  run.  Currently  only
 1706%   supports `fixme` for What.
 1707
 1708test_report(fixme) :-
 1709    !,
 1710    report_fixme(TuplesF, TuplesP, TuplesN),
 1711    append([TuplesF, TuplesP, TuplesN], Tuples),
 1712    print_message(informational, plunit(fixme(Tuples))).
 1713test_report(What) :-
 1714    throw_error(domain_error(report_class, What), _).
 1715
 1716
 1717		 /*******************************
 1718		 *             INFO             *
 1719		 *******************************/
 1720
 1721%!  unit_file(+Unit, -File) is det.
 1722%!  unit_file(?Unit, ?File) is nondet.
 1723%
 1724%   True when the test unit Unit is defined in File.
 1725
 1726unit_file(Unit, File), nonvar(Unit) =>
 1727    unit_file_(Unit, File),
 1728    !.
 1729unit_file(Unit, File) =>
 1730    unit_file_(Unit, File).
 1731
 1732unit_file_(Unit, File) :-
 1733    current_unit(Unit, Module, _Context, _Options),
 1734    module_property(Module, file(File)).
 1735unit_file_(Unit, PlFile) :-
 1736    test_file_for(TestFile, PlFile),
 1737    module_property(Module, file(TestFile)),
 1738    current_unit(Unit, Module, _Context, _Options).
 1739
 1740
 1741		 /*******************************
 1742		 *             FILES            *
 1743		 *******************************/
 1744
 1745%!  load_test_files(+Options) is det.
 1746%
 1747%   Load .plt test-files related  to   loaded  source-files.  Options is
 1748%   currently ignored.
 1749
 1750load_test_files(_Options) :-
 1751    State = state(0,0),
 1752    (   source_file(File),
 1753	file_name_extension(Base, Old, File),
 1754	Old \== plt,
 1755	file_name_extension(Base, plt, TestFile),
 1756	exists_file(TestFile),
 1757        inc_arg(1, State),
 1758	(   test_file_for(TestFile, File)
 1759	->  true
 1760	;   load_files(TestFile,
 1761		       [ if(changed),
 1762			 imports([])
 1763		       ]),
 1764            inc_arg(2, State),
 1765	    asserta(test_file_for(TestFile, File))
 1766	),
 1767        fail
 1768    ;   State = state(Total, Loaded),
 1769        print_message(informational, plunit(test_files(Total, Loaded)))
 1770    ).
 1771
 1772inc_arg(Arg, State) :-
 1773    arg(Arg, State, N0),
 1774    N is N0+1,
 1775    nb_setarg(Arg, State, N).
 1776
 1777
 1778		 /*******************************
 1779		 *           MESSAGES           *
 1780		 *******************************/
 1781
 1782%!  info(+Term)
 1783%
 1784%   Runs print_message(Level, Term), where Level is   one of `silent` or
 1785%   `informational` (default).
 1786
 1787info(Term) :-
 1788    message_level(Level),
 1789    print_message(Level, Term).
 1790
 1791%!  progress(+UnitTest, +Progress, +Result, +Time) is det.
 1792%
 1793%   Test Unit:Name completed in Time. Result is the result and is one of
 1794%
 1795%     - passed
 1796%     - failed
 1797%     - assertion
 1798%     - nondet
 1799%     - fixme(passed)
 1800%     - fixme(nondet)
 1801%     - fixme(failed)
 1802%     - forall(end, Nth, FTotal)
 1803%       Pseudo result for completion of a forall(Gen,Test) set.  Mapped
 1804%       to forall(FTotal, FFailed)
 1805
 1806progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) =>
 1807    (   retract(forall_failures(Nth, FFailed))
 1808    ->  true
 1809    ;   FFailed = 0
 1810    ),
 1811    test_count(Total),
 1812    job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)).
 1813progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) =>
 1814    with_mutex(plunit_forall_counter,
 1815               update_forall_failures(Nth, Result)),
 1816    test_count(Total),
 1817    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1818progress(UnitTest, Progress, Result, Time) =>
 1819    test_count(Total),
 1820    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1821
 1822update_forall_failures(_Nth, passed) =>
 1823    true.
 1824update_forall_failures(Nth, _) =>
 1825    (   retract(forall_failures(Nth, Failed0))
 1826    ->  true
 1827    ;   Failed0 = 0
 1828    ),
 1829    Failed is Failed0+1,
 1830    asserta(forall_failures(Nth, Failed)).
 1831
 1832message_level(Level) :-
 1833    (   current_test_flag(silent, true)
 1834    ->  Level = silent
 1835    ;   Level = informational
 1836    ).
 1837
 1838locationprefix(File:Line) -->
 1839    !,
 1840    [ url(File:Line), ':'-[], nl, '    ' ].
 1841locationprefix(test(Unit,_Test,Line)) -->
 1842    !,
 1843    { unit_file(Unit, File) },
 1844    locationprefix(File:Line).
 1845locationprefix(unit(Unit)) -->
 1846    !,
 1847    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1848locationprefix(FileLine) -->
 1849    { throw_error(type_error(locationprefix,FileLine), _) }.
 1850
 1851:- discontiguous
 1852    message//1. 1853:- '$hide'(message//1). 1854
 1855message(error(context_error(plunit_close(Name, -)), _)) -->
 1856    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1857message(error(context_error(plunit_close(Name, Start)), _)) -->
 1858    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1859message(plunit(nondet(File, Line, Name))) -->
 1860    locationprefix(File:Line),
 1861    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1862message(error(plunit(incompatible_options, Tests), _)) -->
 1863    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1864message(plunit(sto(true))) -->
 1865    [ 'Option sto(true) is ignored.  See `occurs_check` option.'-[] ].
 1866message(plunit(test_files(Total, Loaded))) -->
 1867    [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ].
 1868
 1869					% Unit start/end
 1870message(plunit(jobs(1))) -->
 1871    !.
 1872message(plunit(jobs(N))) -->
 1873    [ 'Testing with ~D parallel jobs'-[N] ].
 1874message(plunit(begin(_Unit))) -->
 1875    { tty_feedback },
 1876    !.
 1877message(plunit(begin(Unit))) -->
 1878    [ 'Start unit: ~w~n'-[Unit], flush ].
 1879message(plunit(end(_Unit, _Summary))) -->
 1880    { tty_feedback },
 1881    !.
 1882message(plunit(end(Unit, Summary))) -->
 1883    (   {test_summary_passed(Summary)}
 1884    ->  [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
 1885    ;   [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
 1886    ).
 1887message(plunit(blocked(unit(Unit, Reason)))) -->
 1888    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1889message(plunit(running([]))) -->
 1890    !,
 1891    [ 'PL-Unit: no tests running' ].
 1892message(plunit(running([One]))) -->
 1893    !,
 1894    [ 'PL-Unit: running ' ],
 1895    running(One).
 1896message(plunit(running(More))) -->
 1897    !,
 1898    [ 'PL-Unit: running tests:', nl ],
 1899    running(More).
 1900message(plunit(fixme([]))) --> !.
 1901message(plunit(fixme(Tuples))) -->
 1902    !,
 1903    fixme_message(Tuples).
 1904message(plunit(total_time(Time))) -->
 1905    [ 'Test run completed'-[] ],
 1906    test_time(Time).
 1907
 1908					% Blocked tests
 1909message(plunit(blocked(1, Tests))) -->
 1910    !,
 1911    [ 'one test is blocked'-[] ],
 1912    blocked_tests(Tests).
 1913message(plunit(blocked(N, Tests))) -->
 1914    [ '~D tests are blocked'-[N] ],
 1915    blocked_tests(Tests).
 1916
 1917blocked_tests(Tests) -->
 1918    { current_test_flag(show_blocked, true) },
 1919    !,
 1920    [':'-[]],
 1921    list_blocked(Tests).
 1922blocked_tests(_) -->
 1923    [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []),
 1924      ' for details)'-[]
 1925    ].
 1926
 1927list_blocked([]) --> !.
 1928list_blocked([blocked(Unit:Test, Pos, Reason)|T]) -->
 1929    [nl],
 1930    locationprefix(Pos),
 1931    test_name(Unit:Test, -),
 1932    [ ': ~w'-[Reason] ],
 1933    list_blocked(T).
 1934
 1935					% fail/success
 1936message(plunit(no_tests)) -->
 1937    !,
 1938    [ 'No tests to run' ].
 1939message(plunit(all_passed(1, 1, Time))) -->
 1940    !,
 1941    [ 'test passed' ],
 1942    test_time(Time).
 1943message(plunit(all_passed(Total, Total, Time))) -->
 1944    !,
 1945    [ 'All ~D tests passed'-[Total] ],
 1946    test_time(Time).
 1947message(plunit(all_passed(Total, Count, Time))) -->
 1948    !,
 1949    { SubTests is Count-Total },
 1950    [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ],
 1951    test_time(Time).
 1952
 1953test_time(Time) -->
 1954    { var(Time) }, !.
 1955test_time(Time) -->
 1956    [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ].
 1957
 1958message(plunit(passed(Count))) -->
 1959    !,
 1960    [ '~D tests passed'-[Count] ].
 1961message(plunit(failed(0))) -->
 1962    !,
 1963    [].
 1964message(plunit(failed(1))) -->
 1965    !,
 1966    [ '1 test failed'-[] ].
 1967message(plunit(failed(N))) -->
 1968    [ '~D tests failed'-[N] ].
 1969message(plunit(timeout(0))) -->
 1970    !,
 1971    [].
 1972message(plunit(timeout(N))) -->
 1973    [ '~D tests timed out'-[N] ].
 1974message(plunit(fixme(0,0,0))) -->
 1975    [].
 1976message(plunit(fixme(Failed,0,0))) -->
 1977    !,
 1978    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1979message(plunit(fixme(Failed,Passed,0))) -->
 1980    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1981message(plunit(fixme(Failed,Passed,Nondet))) -->
 1982    { TotalPassed is Passed+Nondet },
 1983    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1984      [Failed, TotalPassed, Nondet] ].
 1985
 1986message(plunit(begin(Unit:Test, _Location, Progress))) -->
 1987    { tty_columns(SummaryWidth, _Margin),
 1988      test_name_summary(Unit:Test, SummaryWidth, NameS),
 1989      progress_string(Progress, ProgressS)
 1990    },
 1991    (   { tty_feedback,
 1992	  tty_clear_to_eol(CE)
 1993	}
 1994    ->  [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS,
 1995					     CE], flush ]
 1996    ;   { jobs(_) }
 1997    ->  [ '[~w] ~w ..'-[ProgressS, NameS] ]
 1998    ;   [ '[~w] ~w ..'-[ProgressS, NameS], flush ]
 1999    ).
 2000message(plunit(end(_UnitTest, _Location, _Progress))) -->
 2001    [].
 2002message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
 2003    { Status = forall(_,_)
 2004    ; Status == assertion
 2005    },
 2006    !.
 2007message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
 2008    { jobs(_),
 2009      !,
 2010      tty_columns(SummaryWidth, Margin),
 2011      test_name_summary(Unit:Test, SummaryWidth, NameS),
 2012      progress_string(Progress, ProgressS),
 2013      progress_tag(Status, Tag, _Keep, Style)
 2014    },
 2015    [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|',
 2016	   [ProgressS, NameS, Tag, Time.wall, Margin]) ].
 2017message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
 2018    { tty_columns(_SummaryWidth, Margin),
 2019      progress_tag(Status, Tag, _Keep, Style)
 2020    },
 2021    [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
 2022			 [Tag, Time.wall, Margin]) ],
 2023    (   { tty_feedback }
 2024    ->  [flush]
 2025    ;   []
 2026    ).
 2027message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
 2028    { unit_file(Unit, File) },
 2029    locationprefix(File:Line),
 2030    test_name(Unit:Test, Progress),
 2031    [': '-[] ],
 2032    failure(Failure),
 2033    test_output(Output).
 2034message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
 2035    { unit_file(Unit, File) },
 2036    locationprefix(File:Line),
 2037    test_name(Unit:Test, Progress),
 2038    [': '-[] ],
 2039    timeout(Limit),
 2040    test_output(Output).
 2041:- if(swi). 2042message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
 2043				Progress, Reason, Goal))) -->
 2044    { unit_file(Unit, File) },
 2045    locationprefix(File:Line),
 2046    test_name(Unit:Test, Progress),
 2047    [ ': assertion'-[] ],
 2048    assertion_location(AssertLoc, File),
 2049    assertion_reason(Reason), ['\n\t'],
 2050    assertion_goal(Unit, Goal).
 2051
 2052assertion_location(File:Line, File) -->
 2053    [ ' at line ~w'-[Line] ].
 2054assertion_location(File:Line, _) -->
 2055    [ ' at ', url(File:Line) ].
 2056assertion_location(unknown, _) -->
 2057    [].
 2058
 2059assertion_reason(fail) -->
 2060    !,
 2061    [ ' failed'-[] ].
 2062assertion_reason(Error) -->
 2063    { message_to_string(Error, String) },
 2064    [ ' raised "~w"'-[String] ].
 2065
 2066assertion_goal(Unit, Goal) -->
 2067    { unit_module(Unit, Module),
 2068      unqualify(Goal, Module, Plain)
 2069    },
 2070    [ 'Assertion: ~p'-[Plain] ].
 2071
 2072unqualify(Var, _, Var) :-
 2073    var(Var),
 2074    !.
 2075unqualify(M:Goal, Unit, Goal) :-
 2076    nonvar(M),
 2077    unit_module(Unit, M),
 2078    !.
 2079unqualify(M:Goal, _, Goal) :-
 2080    callable(Goal),
 2081    predicate_property(M:Goal, imported_from(system)),
 2082    !.
 2083unqualify(Goal, _, Goal).
 2084
 2085test_output(Msgs-String) -->
 2086    { nonvar(Msgs) },
 2087    !,
 2088    test_output(String).
 2089test_output("") --> [].
 2090test_output(Output) -->
 2091    [ ansi(code, '~N~s', [Output]) ].
 2092
 2093:- endif. 2094					% Setup/condition errors
 2095message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
 2096    locationprefix(Context),
 2097    { message_to_string(Exception, String) },
 2098    [ 'error in ~w: ~w'-[Where, String] ].
 2099message(plunit(error(Where, Context, _Output, false))) -->
 2100    locationprefix(Context),
 2101    [ 'setup failed in ~w'-[Where] ].
 2102
 2103                                        % delayed output
 2104message(plunit(test_output(_, Output))) -->
 2105    [ '~s'-[Output] ].
 2106					% Interrupts (SWI)
 2107:- if(swi). 2108message(interrupt(begin)) -->
 2109    { thread_self(Me),
 2110      running(Unit, Test, Line, Progress, Me),
 2111      !,
 2112      unit_file(Unit, File),
 2113      restore_output_state
 2114    },
 2115    [ 'Interrupted test '-[] ],
 2116    running(running(Unit:Test, File:Line, Progress, Me)),
 2117    [nl],
 2118    '$messages':prolog_message(interrupt(begin)).
 2119message(interrupt(begin)) -->
 2120    '$messages':prolog_message(interrupt(begin)).
 2121:- endif. 2122
 2123message(concurrent) -->
 2124    [ 'concurrent(true) at the level of units is currently ignored.', nl,
 2125      'See set_test_options/1 with jobs(Count) for concurrent testing.'
 2126    ].
 2127
 2128test_name(Name, forall(Bindings, _Nth-I)) -->
 2129    !,
 2130    test_name(Name, -),
 2131    [ ' (~d-th forall bindings = '-[I],
 2132      ansi(code, '~p', [Bindings]), ')'-[]
 2133    ].
 2134test_name(Name, _) -->
 2135    !,
 2136    [ 'test ', ansi(code, '~q', [Name]) ].
 2137
 2138running(running(Unit:Test, File:Line, _Progress, Thread)) -->
 2139    thread(Thread),
 2140    [ '~q:~q at '-[Unit, Test], url(File:Line) ].
 2141running([H|T]) -->
 2142    ['\t'], running(H),
 2143    (   {T == []}
 2144    ->  []
 2145    ;   [nl], running(T)
 2146    ).
 2147
 2148thread(main) --> !.
 2149thread(Other) -->
 2150    [' [~w] '-[Other] ].
 2151
 2152:- if(swi). 2153write_term(T, OPS) -->
 2154    ['~W'-[T,OPS] ].
 2155:- else. 2156write_term(T, _OPS) -->
 2157    ['~q'-[T]].
 2158:- endif. 2159
 2160expected_got_ops_(Ex, E, OPS, Goals) -->
 2161    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 2162    ['    Got:      '-[]], write_term(E,  OPS), [],
 2163    ( { Goals = [] } -> []
 2164    ; [nl, '       with: '-[]], write_term(Goals, OPS), []
 2165    ).
 2166
 2167
 2168failure(List) -->
 2169    { is_list(List) },
 2170    !,
 2171    [ nl ],
 2172    failures(List).
 2173failure(Var) -->
 2174    { var(Var) },
 2175    !,
 2176    [ 'Unknown failure?' ].
 2177failure(succeeded(Time)) -->
 2178    !,
 2179    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 2180failure(wrong_error(Expected, Error)) -->
 2181    !,
 2182    { copy_term(Expected-Error, Ex-E, Goals),
 2183      numbervars(Ex-E-Goals, 0, _),
 2184      write_options(OPS)
 2185    },
 2186    [ 'wrong error'-[], nl ],
 2187    expected_got_ops_(Ex, E, OPS, Goals).
 2188failure(wrong_answer(cmp(Var, Cmp))) -->
 2189    { Cmp =.. [Op,Answer,Expected],
 2190      !,
 2191      copy_term(Expected-Answer, Ex-A, Goals),
 2192      numbervars(Ex-A-Goals, 0, _),
 2193      write_options(OPS)
 2194    },
 2195    [ 'wrong answer for ', ansi(code, '~w', [Var]),
 2196      ' (compared using ~w)'-[Op], nl ],
 2197    expected_got_ops_(Ex, A, OPS, Goals).
 2198failure(wrong_answer(Cmp)) -->
 2199    { Cmp =.. [Op,Answer,Expected],
 2200      !,
 2201      copy_term(Expected-Answer, Ex-A, Goals),
 2202      numbervars(Ex-A-Goals, 0, _),
 2203      write_options(OPS)
 2204    },
 2205    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 2206    expected_got_ops_(Ex, A, OPS, Goals).
 2207failure(wrong_answer(CmpExpected, Bindings)) -->
 2208    { (   CmpExpected = all(Cmp)
 2209      ->  Cmp =.. [_Op1,_,Expected],
 2210	  Got = Bindings,
 2211	  Type = all
 2212      ;   CmpExpected = set(Cmp),
 2213	  Cmp =.. [_Op2,_,Expected0],
 2214	  sort(Expected0, Expected),
 2215	  sort(Bindings, Got),
 2216	  Type = set
 2217      )
 2218    },
 2219    [ 'wrong "~w" answer:'-[Type] ],
 2220    [ nl, '    Expected: ~q'-[Expected] ],
 2221    [ nl, '       Found: ~q'-[Got] ].
 2222:- if(swi). 2223failure(cmp_error(_Cmp, Error)) -->
 2224    { message_to_string(Error, Message) },
 2225    [ 'Comparison error: ~w'-[Message] ].
 2226failure(throw(Error)) -->
 2227    { Error = error(_,_),
 2228      !,
 2229      message_to_string(Error, Message)
 2230    },
 2231    [ 'received error: ~w'-[Message] ].
 2232:- endif. 2233failure(message) -->
 2234    !,
 2235    [ 'Generated unexpected warning or error'-[] ].
 2236failure(Why) -->
 2237    [ '~p'-[Why] ].
 2238
 2239failures([]) -->
 2240    !.
 2241failures([H|T]) -->
 2242    !,
 2243    failure(H), [nl],
 2244    failures(T).
 2245
 2246timeout(Limit) -->
 2247    [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
 2248
 2249fixme_message([]) --> [].
 2250fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 2251    { unit_file(Unit, File) },
 2252    fixme_message(File:Line, Reason, How),
 2253    (   {T == []}
 2254    ->  []
 2255    ;   [nl],
 2256	fixme_message(T)
 2257    ).
 2258
 2259fixme_message(Location, Reason, failed) -->
 2260    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 2261fixme_message(Location, Reason, passed) -->
 2262    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 2263fixme_message(Location, Reason, nondet) -->
 2264    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 2265
 2266
 2267write_options([ numbervars(true),
 2268		quoted(true),
 2269		portray(true),
 2270		max_depth(100),
 2271		attributes(portray)
 2272	      ]).
 2273
 2274%!  test_name_summary(+Term, +MaxLen, -Summary) is det.
 2275%
 2276%   Given the test id, generate  string that summarizes this in MaxLen
 2277%   characters.
 2278
 2279test_name_summary(Term, MaxLen, Summary) :-
 2280    summary_string(Term, Text),
 2281    atom_length(Text, Len),
 2282    (   Len =< MaxLen
 2283    ->  Summary = Text
 2284    ;   End is MaxLen//2,
 2285        Pre is MaxLen - End - 2,
 2286        sub_string(Text, 0, Pre, _, PreText),
 2287        sub_string(Text, _, End, 0, PostText),
 2288        format(string(Summary), '~w..~w', [PreText,PostText])
 2289    ).
 2290
 2291summary_string(Unit:Test, String) =>
 2292    summary_string(Test, String1),
 2293    atomics_to_string([Unit, String1], :, String).
 2294summary_string(@(Name,Vars), String) =>
 2295    format(string(String), '~W (using ~W)',
 2296           [ Name, [numbervars(true), quoted(false)],
 2297             Vars, [numbervars(true), portray(true), quoted(true)]
 2298           ]).
 2299summary_string(Name, String) =>
 2300    term_string(Name, String, [numbervars(true), quoted(false)]).
 2301
 2302%!  progress_string(+Progress, -S) is det.
 2303%
 2304%   True when S is a string representation for the test progress.
 2305
 2306progress_string(forall(_Vars, N-I)/Total, S) =>
 2307    format(string(S), '~w-~w/~w', [N,I,Total]).
 2308progress_string(Progress, S) =>
 2309    term_string(Progress, S).
 2310
 2311%!  progress_tag(+Status, -Tag, -Keep, -Style) is det.
 2312%
 2313%   Given a progress status, determine the status tag, whether we must
 2314%   preserve the  line and the Style  we must use to  print the status
 2315%   line.
 2316
 2317progress_tag(passed,        Tag, Keep, Style) =>
 2318    Tag = passed, Keep = false, Style = comment.
 2319progress_tag(fixme(passed), Tag, Keep, Style) =>
 2320    Tag = passed, Keep = false, Style = comment.
 2321progress_tag(fixme(_),      Tag, Keep, Style) =>
 2322    Tag = fixme, Keep = true, Style = warning.
 2323progress_tag(nondet,        Tag, Keep, Style) =>
 2324    Tag = '**NONDET', Keep = true, Style = warning.
 2325progress_tag(timeout(_Limit), Tag, Keep, Style) =>
 2326    Tag = '**TIMEOUT', Keep = true, Style = warning.
 2327progress_tag(assertion,     Tag, Keep, Style) =>
 2328    Tag = '**FAILED', Keep = true, Style = error.
 2329progress_tag(failed,        Tag, Keep, Style) =>
 2330    Tag = '**FAILED', Keep = true, Style = error.
 2331progress_tag(forall(_,0),   Tag, Keep, Style) =>
 2332    Tag = passed, Keep = false, Style = comment.
 2333progress_tag(forall(_,_),   Tag, Keep, Style) =>
 2334    Tag = '**FAILED', Keep = true, Style = error.
 2335
 2336
 2337		 /*******************************
 2338		 *           OUTPUT		*
 2339		 *******************************/
 2340
 2341save_output_state :-
 2342    stream_property(Output, alias(user_output)),
 2343    stream_property(Error, alias(user_error)),
 2344    asserta(output_streams(Output, Error)).
 2345
 2346restore_output_state :-
 2347    output_streams(Output, Error),
 2348    !,
 2349    set_stream(Output, alias(user_output)),
 2350    set_stream(Error, alias(user_error)).
 2351restore_output_state.
 2352
 2353
 2354
 2355		 /*******************************
 2356		 *      CONCURRENT STATUS       *
 2357		 *******************************/
 2358
 2359/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2360This part deals with interactive feedback   when we are running multiple
 2361threads. The terminal window cannot work on   top  of the Prolog message
 2362infrastructure and (thus) we have to use more low-level means.
 2363- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2364
 2365:- dynamic
 2366       jobs/1,			% Count
 2367       job_window/1,		% Count
 2368       job_status_line/3.	% Job, Format, Args
 2369
 2370job_feedback(_, jobs(Jobs)) :-
 2371    retractall(jobs(_)),
 2372    Jobs > 1,
 2373    asserta(jobs(Jobs)),
 2374    tty_feedback,
 2375    !,
 2376    retractall(job_window(_)),
 2377    asserta(job_window(Jobs)),
 2378    retractall(job_status_line(_,_,_)),
 2379    jobs_redraw.
 2380job_feedback(_, jobs(Jobs)) :-
 2381    !,
 2382    retractall(job_window(_)),
 2383    info(plunit(jobs(Jobs))).
 2384job_feedback(_, Msg) :-
 2385    job_window(_),
 2386    !,
 2387    with_mutex(plunit_feedback, job_feedback(Msg)).
 2388job_feedback(Level, Msg) :-
 2389    print_message(Level, plunit(Msg)).
 2390
 2391job_feedback(begin(Unit:Test, _Location, Progress)) =>
 2392    tty_columns(SummaryWidth, _Margin),
 2393    test_name_summary(Unit:Test, SummaryWidth, NameS),
 2394    progress_string(Progress, ProgressS),
 2395    tty_clear_to_eol(CE),
 2396    job_format(comment, '\r[~w] ~w ..~w',
 2397	       [ProgressS, NameS, CE]),
 2398    flush_output.
 2399job_feedback(end(_UnitTest, _Location, _Progress)) =>
 2400    true.
 2401job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
 2402    (   hide_progress(Status)
 2403    ->  true
 2404    ;   tty_columns(_SummaryWidth, Margin),
 2405	progress_tag(Status, Tag, _Keep, Style),
 2406	job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2407		   [Tag, Time.wall, Margin])
 2408    ).
 2409job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
 2410    tty_columns(_SummaryWidth, Margin),
 2411    progress_tag(failed, Tag, _Keep, Style),
 2412    job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2413	       [Tag, Time.wall, Margin]),
 2414    print_test_output(Error, Output),
 2415    (   (   Error = timeout(_)	% Status line suffices
 2416	;   Error == assertion	% We will get an failed test later
 2417	)
 2418    ->  true
 2419    ;   print_message(Style, plunit(failed(UnitTest, Progress, Line,
 2420					   Error, Time, "")))
 2421    ),
 2422    jobs_redraw.
 2423job_feedback(begin(_Unit)) => true.
 2424job_feedback(end(_Unit, _Summary)) => true.
 2425
 2426hide_progress(assertion).
 2427hide_progress(forall(_,_)).
 2428hide_progress(failed).
 2429hide_progress(timeout(_)).
 2430
 2431print_test_output(Error, _Msgs-Output) =>
 2432    print_test_output(Error, Output).
 2433print_test_output(_, "") => true.
 2434print_test_output(assertion, Output) =>
 2435    print_message(debug, plunit(test_output(error, Output))).
 2436print_test_output(message, Output) =>
 2437    print_message(debug, plunit(test_output(error, Output))).
 2438print_test_output(_, Output) =>
 2439    print_message(debug, plunit(test_output(informational, Output))).
 2440
 2441%!  jobs_redraw is det.
 2442%
 2443%   Redraw the job window.
 2444
 2445jobs_redraw :-
 2446    job_window(N),
 2447    !,
 2448    tty_columns(_, Width),
 2449    tty_header_line(Width),
 2450    forall(between(1,N,Line), job_redraw_worker(Line)),
 2451    tty_header_line(Width).
 2452jobs_redraw.
 2453
 2454job_redraw_worker(Line) :-
 2455    (   job_status_line(Line, Fmt, Args)
 2456    ->  ansi_format(comment, Fmt, Args)
 2457    ;   true
 2458    ),
 2459    nl.
 2460
 2461%!  job_format(+Style, +Fmt, +Args) is det.
 2462%!  job_format(+Job, +Style, +Fmt, +Args, +Save) is det.
 2463%
 2464%   Point should be  below the status window.  Format  Fmt+Args in the
 2465%   line Job using Style and return to the position below the window.
 2466
 2467job_format(Style, Fmt, Args) :-
 2468    job_self(Job),
 2469    job_format(Job, Style, Fmt, Args, true).
 2470
 2471%!  job_finish(+Style, +Fmt, +Args) is det.
 2472%!  job_finish(+Job, +Style, +Fmt, +Args) is det.
 2473%
 2474%   Complete  the status  line  for Job.   This  redraws the  original
 2475%   status line when we are using a job window.
 2476
 2477job_finish(Style, Fmt, Args) :-
 2478    job_self(Job),
 2479    job_finish(Job, Style, Fmt, Args).
 2480
 2481:- det(job_finish/4). 2482job_finish(Job, Style, Fmt, Args) :-
 2483    retract(job_status_line(Job, Fmt0, Args0)),
 2484    !,
 2485    string_concat(Fmt0, Fmt, Fmt1),
 2486    append(Args0, Args, Args1),
 2487    job_format(Job, Style, Fmt1, Args1, false).
 2488
 2489:- det(job_format/5). 2490job_format(Job, Style, Fmt, Args, Save) :-
 2491    job_window(Jobs),
 2492    Up is Jobs+2-Job,
 2493    flush_output(user_output),
 2494    tty_up_and_clear(Up),
 2495    ansi_format(Style, Fmt, Args),
 2496    (   Save == true
 2497    ->  retractall(job_status_line(Job, _, _)),
 2498	asserta(job_status_line(Job, Fmt, Args))
 2499    ;   true
 2500    ),
 2501    tty_down_and_home(Up),
 2502    flush_output(user_output).
 2503
 2504:- det(job_self/1). 2505job_self(Job) :-
 2506    job_window(N),
 2507    N > 1,
 2508    thread_self(Me),
 2509    split_string(Me, '_', '', [_,_,S]),
 2510    number_string(Job, S).
 2511
 2512%!  feedback is semidet.
 2513%
 2514%   provide feedback using the `tty`  format, which reuses the current
 2515%   output line if the test is successful.
 2516
 2517tty_feedback :-
 2518    has_tty,
 2519    current_test_flag(format, tty).
 2520
 2521has_tty :-
 2522    stream_property(user_output, tty(true)).
 2523
 2524tty_columns(SummaryWidth, Margin) :-
 2525    tty_width(W),
 2526    Margin is W-8,
 2527    SummaryWidth is max(20,Margin-34).
 2528
 2529tty_width(W) :-
 2530    current_predicate(tty_size/2),
 2531    catch(tty_size(_Rows, Cols), error(_,_), fail),
 2532    Cols > 25,
 2533    !,
 2534    W = Cols.
 2535tty_width(80).
 2536
 2537tty_header_line(Width) :-
 2538    ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
 2539
 2540:- if(current_predicate(tty_get_capability/3)). 2541tty_clear_to_eol(S) :-
 2542    getenv('TERM', _),
 2543    catch(tty_get_capability(ce, string, S),
 2544          error(_,_),
 2545          fail),
 2546    !.
 2547:- endif. 2548tty_clear_to_eol('\e[K').
 2549
 2550tty_up_and_clear(Lines) :-
 2551    format(user_output, '\e[~dA\r\e[K', [Lines]).
 2552
 2553tty_down_and_home(Lines) :-
 2554    format(user_output, '\e[~dB\r', [Lines]).
 2555
 2556:- if(swi). 2557
 2558:- multifile
 2559    prolog:message/3,
 2560    user:message_hook/3. 2561
 2562prolog:message(Term) -->
 2563    message(Term).
 2564
 2565%       user:message_hook(+Term, +Kind, +Lines)
 2566
 2567user:message_hook(make(done(Files)), _, _) :-
 2568    make_run_tests(Files),
 2569    fail.                           % give other hooks a chance
 2570
 2571:- endif. 2572
 2573:- if(sicstus). 2574
 2575user:generate_message_hook(Message) -->
 2576    message(Message),
 2577    [nl].                           % SICStus requires nl at the end
 2578
 2579%!  user:message_hook(+Severity, +Message, +Lines) is semidet.
 2580%
 2581%   Redefine printing some messages. It appears   SICStus has no way
 2582%   to get multiple messages at the same   line, so we roll our own.
 2583%   As there is a lot pre-wired and   checked in the SICStus message
 2584%   handling we cannot reuse the lines. Unless I miss something ...
 2585
 2586user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 2587    format(user_error, '% PL-Unit: ~w ', [Unit]),
 2588    flush_output(user_error).
 2589user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 2590    format(user, ' done~n', []).
 2591
 2592:- endif.