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
  578%!  reify_tmo(:Goal, -Result, +Options) is det.
  579
  580:- if(current_predicate(call_with_time_limit/2)).  581reify_tmo(Goal, Result, Options) :-
  582    option(timeout(Time), Options),
  583    Time > 0,
  584    !,
  585    reify(call_with_time_limit(Time, Goal), Result0),
  586    (   Result0 = throw(time_limit_exceeded)
  587    ->  Result = throw(time_limit_exceeded(Time))
  588    ;   Result = Result0
  589    ).
  590:- endif.  591reify_tmo(Goal, Result, _Options) :-
  592    reify(Goal, Result).
  593
  594%!  reify(:Goal, -Result) is det.
  595%
  596%   Call  Goal  and  unify  Result  with   one  of  `true`,  `false`  or
  597%   `throw(E)`.
  598
  599reify(Goal, Result) :-
  600    (   catch(Goal, E, true)
  601    ->  (   var(E)
  602	->  Result = true
  603	;   Result = throw(E)
  604	)
  605    ;   Result = false
  606    ).
  607
  608capture_output(Goal, Output) :-
  609    current_test_flag(output, OutputMode),
  610    capture_output(Goal, Output, [output(OutputMode)]).
  611
  612capture_output(Goal, Output, Options) :-
  613    option(output(How), Options, always),
  614    (   How == always
  615    ->  call(Goal)
  616    ;   with_output_to(string(Output), Goal,
  617                       [ capture([user_output, user_error]),
  618                         color(true)
  619                       ])
  620    ).
  621
  622
  623		 /*******************************
  624		 *        RUNNING TOPLEVEL      *
  625		 *******************************/
  626
  627:- dynamic
  628    output_streams/2,               % Output, Error
  629    test_count/1,                   % Count
  630    passed/5,                       % Unit, Test, Line, Det, Time
  631    failed/5,                       % Unit, Test, Line, Reason, Time
  632    timeout/5,                      % Unit, Test, Line, Limit, Time
  633    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  634    blocked/4,                      % Unit, Test, Line, Reason
  635    fixme/5,                        % Unit, Test, Line, Reason, Status
  636    running/5,                      % Unit, Test, Line, STO, Thread
  637    forall_failures/2.              % Nth, Failures
  638
  639%!  run_tests is semidet.
  640%!  run_tests(+TestSet) is semidet.
  641%!  run_tests(+TestSet, +Options) is semidet.
  642%
  643%   Run tests and report about the   results.  The predicate run_tests/0
  644%   runs all known tests that are not blocked. The predicate run_tests/1
  645%   takes a specification of tests  to  run.
  646%
  647%   The predicate run_tests/2 is  synchronized. Concurrent testing may
  648%   be     achieved    using     the     relevant    options.      See
  649%   set_test_options/1. Options are  passed to set_test_options/1.  In
  650%   addition the following options are processed:
  651%
  652%     - summary(-Summary)
  653%       Unify Summary do a dict holding the keys below.  The value of
  654%       these keys is an integer describing the number of tests.  If
  655%       this option is given, run_tests/2 does not fail if some tests
  656%       failed.
  657%
  658%       - total
  659%       - passed
  660%       - failed
  661%       - timeout
  662%       - blocked
  663%
  664%   @arg  TestSet  is either  a  single  specification  or a  list  of
  665%   specifications. Each single specification is  either the name of a
  666%   test-unit  or a  term <test-unit>:<test>,  denoting a  single test
  667%   within a unit.  If TestSet is `all`, all known tests are executed.
  668
  669run_tests :-
  670    run_tests(all).
  671
  672run_tests(Set) :-
  673    run_tests(Set, []).
  674
  675run_tests(all, Options) :-
  676    !,
  677    findall(Unit, current_test_unit(Unit,_), Units),
  678    run_tests(Units, Options).
  679run_tests(Set, Options) :-
  680    valid_options(global_test_option, Options, Global, Rest),
  681    current_test_flags(Old),
  682    setup_call_cleanup(
  683	set_test_options(Global),
  684	( flatten([Set], List),
  685	  maplist(runnable_tests, List, Units),
  686	  with_mutex(plunit, run_tests_sync(Units, Rest))
  687	),
  688	set_test_options(Old)).
  689
  690run_tests_sync(Units0, Options) :-
  691    cleanup,
  692    count_tests(Units0, Units, Count),
  693    asserta(test_count(Count)),
  694    save_output_state,
  695    setup_call_cleanup(
  696	setup_jobs(Count),
  697	setup_call_cleanup(
  698	    setup_trap_assertions(Ref),
  699	    ( call_time(run_units(Units, Options), Time),
  700              test_summary(_All, Summary)
  701            ),
  702	    report_and_cleanup(Ref, Time, Options)),
  703	cleanup_jobs),
  704    (   option(summary(Summary), Options)
  705    ->  true
  706    ;   test_summary_passed(Summary) % fail if some test failed
  707    ).
  708
  709%!  report_and_cleanup(+Ref, +Time, +Options)
  710%
  711%   Undo changes to the environment   (trapping  assertions), report the
  712%   results and cleanup.
  713
  714report_and_cleanup(Ref, Time, Options) :-
  715    cleanup_trap_assertions(Ref),
  716    report(Time, Options),
  717    cleanup_after_test.
  718
  719
  720%!  run_units_and_check_errors(+Units, +Options) is semidet.
  721%
  722%   Run all test units and succeed if all tests passed.
  723
  724run_units(Units, _Options) :-
  725    maplist(schedule_unit, Units),
  726    job_wait(_).
  727
  728%!  runnable_tests(+Spec, -Plan) is det.
  729%
  730%   Change a Unit+Test spec  into  a   plain  `Unit:Tests`  lists, where
  731%   blocked tests or tests whose condition   fails  are already removed.
  732%   Each test in `Tests` is a  term   `@(Test,Line)`,  which serves as a
  733%   unique identifier of the test.
  734
  735:- det(runnable_tests/2).  736runnable_tests(Spec, Unit:RunnableTests) :-
  737    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  738    (   option(blocked(Reason), UnitOptions)
  739    ->  info(plunit(blocked(unit(Unit, Reason)))),
  740        RunnableTests = []
  741    ;   \+ condition(Module, unit(Unit), UnitOptions)
  742    ->  RunnableTests = []
  743    ;   var(Tests)
  744    ->  findall(TestID,
  745                runnable_test(Unit, _Test, Module, TestID),
  746                RunnableTests)
  747    ;   flatten([Tests], TestList),
  748        findall(TestID,
  749                ( member(Test, TestList),
  750                  runnable_test(Unit,Test,Module, TestID)
  751                ),
  752                RunnableTests)
  753    ).
  754
  755runnable_test(Unit, Name, Module, @(Test,Line)) :-
  756    current_test(Unit, Name, Line, _Body, TestOptions),
  757    (   option(blocked(Reason), TestOptions)
  758    ->  Test = blocked(Name, Reason)
  759    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  760        Test = Name
  761    ).
  762
  763unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  764    Unit = Unit0,
  765    Tests = Tests0,
  766    (   current_unit(Unit, Module, _Supers, Options)
  767    ->  true
  768    ;   throw_error(existence_error(unit_test, Unit), _)
  769    ).
  770unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  771    Unit = Unit0,
  772    (   current_unit(Unit, Module, _Supers, Options)
  773    ->  true
  774    ;   throw_error(existence_error(unit_test, Unit), _)
  775    ).
  776
  777%!  count_tests(+Units0, -Units, -Count) is det.
  778%
  779%   Count the number of tests to   run. A forall(Generator, Test) counts
  780%   as a single test. During the execution,   the  concrete tests of the
  781%   _forall_ are considered "sub tests".
  782
  783count_tests(Units0, Units, Count) :-
  784    count_tests(Units0, Units, 0, Count).
  785
  786count_tests([], T, C0, C) =>
  787    T = [],
  788    C = C0.
  789count_tests([_:[]|T0], T, C0, C) =>
  790    count_tests(T0, T, C0, C).
  791count_tests([Unit:Tests|T0], T, C0, C) =>
  792    partition(is_blocked, Tests, Blocked, Use),
  793    maplist(assert_blocked(Unit), Blocked),
  794    (   Use == []
  795    ->  count_tests(T0, T, C0, C)
  796    ;   length(Use, N),
  797        C1 is C0+N,
  798        T = [Unit:Use|T1],
  799        count_tests(T0, T1, C1, C)
  800    ).
  801
  802is_blocked(@(blocked(_,_),_)) => true.
  803is_blocked(_) => fail.
  804
  805assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  806    assert(blocked(Unit, Test, Line, Reason)).
  807
  808%!  run_unit(+Unit) is det.
  809%
  810%   Run a single test unit. Unit is a  term Unit:Tests, where Tests is a
  811%   list of tests to run.
  812
  813run_unit(_Unit:[]) =>
  814    true.
  815run_unit(Unit:Tests) =>
  816    unit_module(Unit, Module),
  817    unit_options(Unit, UnitOptions),
  818    (   setup(Module, unit(Unit), UnitOptions)
  819    ->  begin_unit(Unit),
  820        call_time(run_unit_2(Unit, Tests), Time),
  821        test_summary(Unit, Summary),
  822	end_unit(Unit, Summary.put(time, Time)),
  823        cleanup(Module, UnitOptions)
  824    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  825    ).
  826
  827begin_unit(Unit) :-
  828    job_info(begin(unit(Unit))),
  829    job_feedback(informational, begin(Unit)).
  830
  831end_unit(Unit, Summary) :-
  832    job_info(end(unit(Unit, Summary))),
  833    job_feedback(informational, end(Unit, Summary)).
  834
  835run_unit_2(Unit, Tests) :-
  836    forall(member(Test, Tests),
  837	   run_test(Unit, Test)).
  838
  839
  840unit_options(Unit, Options) :-
  841    current_unit(Unit, _Module, _Supers, Options).
  842
  843
  844cleanup :-
  845    set_flag(plunit_test, 1),
  846    retractall(output_streams(_,_)),
  847    retractall(test_count(_)),
  848    retractall(passed(_, _, _, _, _)),
  849    retractall(failed(_, _, _, _, _)),
  850    retractall(timeout(_, _, _, _, _)),
  851    retractall(failed_assertion(_, _, _, _, _, _, _)),
  852    retractall(blocked(_, _, _, _)),
  853    retractall(fixme(_, _, _, _, _)),
  854    retractall(running(_,_,_,_,_)),
  855    retractall(forall_failures(_,_)).
  856
  857cleanup_after_test :-
  858    (   current_test_flag(cleanup, true)
  859    ->  cleanup
  860    ;   true
  861    ).
  862
  863
  864%!  run_tests_in_files(+Files:list) is det.
  865%
  866%   Run all test-units that appear in the given Files.
  867
  868run_tests_in_files(Files) :-
  869    findall(Unit, unit_in_files(Files, Unit), Units),
  870    (   Units == []
  871    ->  true
  872    ;   run_tests(Units)
  873    ).
  874
  875unit_in_files(Files, Unit) :-
  876    is_list(Files),
  877    !,
  878    member(F, Files),
  879    absolute_file_name(F, Source,
  880		       [ file_type(prolog),
  881			 access(read),
  882			 file_errors(fail)
  883		       ]),
  884    unit_file(Unit, Source).
  885
  886
  887		 /*******************************
  888		 *         HOOKING MAKE/0       *
  889		 *******************************/
  890
  891%!  make_run_tests(+Files)
  892%
  893%   Called indirectly from make/0 after Files have been reloaded.
  894
  895make_run_tests(Files) :-
  896    current_test_flag(run, When),
  897    (   When == make
  898    ->  run_tests_in_files(Files)
  899    ;   When == make(all)
  900    ->  run_tests
  901    ;   true
  902    ).
  903
  904		 /*******************************
  905		 *      ASSERTION HANDLING      *
  906		 *******************************/
  907
  908:- if(swi).  909
  910:- dynamic prolog:assertion_failed/2.  911
  912setup_trap_assertions(Ref) :-
  913    asserta((prolog:assertion_failed(Reason, Goal) :-
  914		    test_assertion_failed(Reason, Goal)),
  915	    Ref).
  916
  917cleanup_trap_assertions(Ref) :-
  918    erase(Ref).
  919
  920test_assertion_failed(Reason, Goal) :-
  921    thread_self(Me),
  922    running(Unit, Test, Line, Progress, Me),
  923    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  924	assertion_location(Stack, AssertLoc)
  925    ->  true
  926    ;   AssertLoc = unknown
  927    ),
  928    report_failed_assertion(Unit:Test, Line, AssertLoc,
  929			    Progress, Reason, Goal),
  930    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  931				   Progress, Reason, Goal)).
  932
  933assertion_location(Stack, File:Line) :-
  934    append(_, [AssertFrame,CallerFrame|_], Stack),
  935    prolog_stack_frame_property(AssertFrame,
  936				predicate(prolog_debug:assertion/1)),
  937    !,
  938    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  939
  940report_failed_assertion(UnitTest, Line, AssertLoc,
  941			Progress, Reason, Goal) :-
  942    print_message(
  943	error,
  944	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  945				Progress, Reason, Goal))).
  946
  947:- else.  948
  949setup_trap_assertions(_).
  950cleanup_trap_assertions(_).
  951
  952:- endif.  953
  954
  955		 /*******************************
  956		 *         RUNNING A TEST       *
  957		 *******************************/
  958
  959%!  run_test(+Unit, +Test) is det.
  960%
  961%   Run a single test.
  962
  963run_test(Unit, @(Test,Line)) :-
  964    unit_module(Unit, Module),
  965    Module:'unit test'(Test, Line, TestOptions, Body),
  966    unit_options(Unit, UnitOptions),
  967    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).
  968
  969%!  run_test(+Unit, +Name, +Line, +UnitOptions, +Options, +Body)
  970%
  971%   Deals with forall(Generator, Test)
  972
  973run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
  974    option(forall(Generator), Options),
  975    !,
  976    unit_module(Unit, Module),
  977    term_variables(Generator, Vars),
  978    start_test(Unit, @(Name,Line), Nth),
  979    State = state(0),
  980    call_time(forall(Module:Generator,            % may become concurrent
  981                     (   incr_forall(State, I),
  982                         run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
  983                                        UnitOptions, Options, Body)
  984                     )),
  985                     Time),
  986    arg(1, State, Generated),
  987    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
  988run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
  989    start_test(Unit, @(Name,Line), Nth),
  990    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
  991
  992start_test(_Unit, _TestID, Nth) :-
  993    flag(plunit_test, Nth, Nth+1).
  994
  995incr_forall(State, I) :-
  996    arg(1, State, I0),
  997    I is I0+1,
  998    nb_setarg(1, State, I).
  999
 1000%!  run_test_once6(+Unit, +Name, +Progress, +Line, +UnitOptions,
 1001%!                 +Options, +Body)
 1002%
 1003%   Inherit the `timeout` and `occurs_check` option (Global -> Unit -> Test).
 1004
 1005run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1006    current_test_flag(timeout, DefTimeOut),
 1007    current_test_flag(occurs_check, DefOccurs),
 1008    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1009    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1010    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1011
 1012inherit_option(Name, Options0, Chain, Default, Options) :-
 1013    Term =.. [Name,_Value],
 1014    (   option(Term, Options0)
 1015    ->  Options = Options0
 1016    ;   member(Opts, Chain),
 1017        option(Term, Opts)
 1018    ->  Options = [Term|Options0]
 1019    ;   Default == (-)
 1020    ->  Options = Options0
 1021    ;   Opt =.. [Name,Default],
 1022	Options = [Opt|Options0]
 1023    ).
 1024
 1025%!  run_test_once(+Unit, +Name, Progress, +Line, +Options, +Body)
 1026%
 1027%   Deal with occurs_check, i.e., running the  test multiple times with different
 1028%   unification settings wrt. the occurs check.
 1029
 1030run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1031    option(occurs_check(Occurs), Options),
 1032    !,
 1033    begin_test(Unit, Name, Line, Progress),
 1034    current_prolog_flag(occurs_check, Old),
 1035    setup_call_cleanup(
 1036	set_prolog_flag(occurs_check, Occurs),
 1037	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1038		       Output),
 1039	set_prolog_flag(occurs_check, Old)),
 1040    end_test(Unit, Name, Line, Progress),
 1041    report_result(Result, Progress, Output, Options).
 1042run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1043    begin_test(Unit, Name, Line, Progress),
 1044    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1045		   Output),
 1046    end_test(Unit, Name, Line, Progress),
 1047    report_result(Result, Progress, Output, Options).
 1048
 1049%!  report_result(+Result, +Progress, +Output, +Options) is det.
 1050
 1051:- det(report_result/4). 1052report_result(failure(Unit, Name, Line, How, Time),
 1053	      Progress, Output, Options) :-
 1054    !,
 1055    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1056report_result(success(Unit, Name, Line, Determinism, Time),
 1057	      Progress, Output, Options) :-
 1058    !,
 1059    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1060report_result(setup_failed(_Unit, _Name, _Line),
 1061	      _Progress, _Output, _Options).
 1062
 1063%!  run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1064%
 1065%   6th step  of the  tests.  Deals  with tests  that must  be ignored
 1066%   (blocked, conditions fails), setup and cleanup at the test level.
 1067%   Result is one of:
 1068%
 1069%     - failure(Unit, Name, Line, How, Time)
 1070%       How is one of:
 1071%       - succeeded
 1072%       - Exception
 1073%       - time_limit_exceeded(Limit)
 1074%       - cmp_error(Cmp, E)
 1075%       - wrong_answer(Cmp)
 1076%       - failed
 1077%       - no_exception
 1078%       - wrong_error(Expect, E)
 1079%       - wrong_answer(Expected, Bindings)
 1080%     - success(Unit, Name, Line, Determinism, Time)
 1081%     - setup_failed(Unit, Name, Line)
 1082
 1083run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1084    option(setup(_Setup), Options),
 1085    !,
 1086    (   unit_module(Unit, Module),
 1087        setup(Module, test(Unit,Name,Line), Options)
 1088    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1089        cleanup(Module, Options)
 1090    ;   Result = setup_failed(Unit, Name, Line)
 1091    ).
 1092run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1093    unit_module(Unit, Module),
 1094    run_test_7(Unit, Name, Line, Options, Body, Result),
 1095    cleanup(Module, Options).
 1096
 1097%!  run_test_7(+Unit, +Name, +Line, +Options, :Body, -Result) is det.
 1098%
 1099%   This step  deals with the expected  outcome of the test.   It runs
 1100%   the  actual test  and then  compares  the result  to the  outcome.
 1101%   There are  two main categories:  dealing with a single  result and
 1102%   all results.
 1103
 1104run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1105    option(true(Cmp), Options),			   % expected success
 1106    !,
 1107    unit_module(Unit, Module),
 1108    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1109    (   Result0 == true
 1110    ->  cmp_true(Cmp, Module, CmpResult),
 1111	(   CmpResult == []
 1112	->  Result = success(Unit, Name, Line, Det, Time)
 1113	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1114	)
 1115    ;   Result0 == false
 1116    ->  Result = failure(Unit, Name, Line, failed, Time)
 1117    ;   Result0 = throw(E2)
 1118    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1119    ).
 1120run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1121    option(fail, Options),                         % expected failure
 1122    !,
 1123    unit_module(Unit, Module),
 1124    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1125    (   Result0 == true
 1126    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1127    ;   Result0 == false
 1128    ->  Result = success(Unit, Name, Line, true, Time)
 1129    ;   Result0 = throw(E)
 1130    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1131    ).
 1132run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1133    option(throws(Expect), Options),		   % Expected error
 1134    !,
 1135    unit_module(Unit, Module),
 1136    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1137    (   Result0 == true
 1138    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1139    ;   Result0 == false
 1140    ->  Result = failure(Unit, Name, Line, failed, Time)
 1141    ;   Result0 = throw(E)
 1142    ->  (   match_error(Expect, E)
 1143        ->  Result = success(Unit, Name, Line, true, Time)
 1144        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1145        )
 1146    ).
 1147run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1148    option(all(Answer), Options),                  % all(Bindings)
 1149    !,
 1150    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1151run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1152    option(set(Answer), Options),                  % set(Bindings)
 1153    !,
 1154    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
 1155
 1156%!  non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)
 1157%
 1158%   Run tests on non-deterministic predicates.
 1159
 1160nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1161    unit_module(Unit, Module),
 1162    result_vars(Expected, Vars),
 1163    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1164                            Result0, Options), Time)
 1165    ->  (   Result0 == true
 1166        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1167            ->  Result = success(Unit, Name, Line, true, Time)
 1168            ;   Result = failure(Unit, Name, Line,
 1169				 [wrong_answer(Expected, Bindings)], Time)
 1170            )
 1171        ;   Result0 = throw(E)
 1172        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1173        )
 1174    ).
 1175
 1176cmp_true([], _, L) =>
 1177    L = [].
 1178cmp_true([Cmp|T], Module, L) =>
 1179    E = error(Formal,_),
 1180    cmp_goal(Cmp, Goal),
 1181    (   catch(Module:Goal, E, true)
 1182    ->  (   var(Formal)
 1183	->  cmp_true(T, Module, L)
 1184	;   L = [cmp_error(Cmp,E)|L1],
 1185	    cmp_true(T, Module, L1)
 1186	)
 1187    ;   L = [wrong_answer(Cmp)|L1],
 1188	cmp_true(T, Module, L1)
 1189    ).
 1190
 1191cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1192cmp_goal(Expr, Goal) => Goal = Expr.
 1193
 1194
 1195%!  result_vars(+Expected, -Vars) is det.
 1196%
 1197%   Create a term v(V1, ...) containing all variables at the left
 1198%   side of the comparison operator on Expected.
 1199
 1200result_vars(Expected, Vars) :-
 1201    arg(1, Expected, CmpOp),
 1202    arg(1, CmpOp, Vars).
 1203
 1204%!  nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet.
 1205%
 1206%   Compare list/set results for non-deterministic predicates.
 1207%
 1208%   @tbd    Properly report errors
 1209%   @bug    Sort should deal with equivalence on the comparison
 1210%           operator.
 1211
 1212nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1213    cmp(Cmp, _Vars, Op, Values),
 1214    cmp_list(Values, Bindings, Op).
 1215nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1216    cmp(Cmp, _Vars, Op, Values0),
 1217    sort(Bindings0, Bindings),
 1218    sort(Values0, Values),
 1219    cmp_list(Values, Bindings, Op).
 1220
 1221cmp_list([], [], _Op).
 1222cmp_list([E0|ET], [V0|VT], Op) :-
 1223    call(Op, E0, V0),
 1224    cmp_list(ET, VT, Op).
 1225
 1226%!  cmp(+CmpTerm, -Left, -Op, -Right) is det.
 1227
 1228cmp(Var  == Value, Var,  ==, Value).
 1229cmp(Var =:= Value, Var, =:=, Value).
 1230cmp(Var  =  Value, Var,  =,  Value).
 1231:- if(swi). 1232cmp(Var =@= Value, Var, =@=, Value).
 1233:- else. 1234:- if(sicstus). 1235cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1236:- endif. 1237:- endif. 1238
 1239
 1240%!  call_det(:Goal, -Det) is nondet.
 1241%
 1242%   True if Goal succeeded.  Det is unified to =true= if Goal left
 1243%   no choicepoints and =false= otherwise.
 1244
 1245:- if((swi;sicstus)). 1246call_det(Goal, Det) :-
 1247    call_cleanup(Goal,Det0=true),
 1248    ( var(Det0) -> Det = false ; Det = true ).
 1249:- else. 1250call_det(Goal, true) :-
 1251    call(Goal).
 1252:- endif. 1253
 1254%!  match_error(+Expected, +Received) is semidet.
 1255%
 1256%   True if the Received errors matches the expected error. Matching
 1257%   is based on subsumes_term/2.
 1258
 1259match_error(Expect, Rec) :-
 1260    subsumes_term(Expect, Rec).
 1261
 1262%!  setup(+Module, +Context, +Options) is semidet.
 1263%
 1264%   Call the setup handler and  fail  if   it  cannot  run  for some
 1265%   reason. The condition handler is  similar,   but  failing is not
 1266%   considered an error.  Context is one of
 1267%
 1268%    - unit(Unit)
 1269%      If it is the setup handler for a unit
 1270%    - test(Unit,Name,Line)
 1271%      If it is the setup handler for a test
 1272
 1273setup(Module, Context, Options) :-
 1274    option(setup(Setup), Options),
 1275    !,
 1276    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1277    (   Result == true
 1278    ->  true
 1279    ;   print_message(error,
 1280		      plunit(error(setup, Context, Output, Result))),
 1281	fail
 1282    ).
 1283setup(_,_,_).
 1284
 1285%!  condition(+Module, +Context, +Options) is semidet.
 1286%
 1287%   Evaluate the test or test unit condition.
 1288
 1289condition(Module, Context, Options) :-
 1290    option(condition(Cond), Options),
 1291    !,
 1292    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1293    (   Result == true
 1294    ->  true
 1295    ;   Result == false
 1296    ->  fail
 1297    ;   print_message(error,
 1298		      plunit(error(condition, Context, Output, Result))),
 1299	fail
 1300    ).
 1301condition(_, _, _).
 1302
 1303
 1304%!  call_ex(+Module, +Goal)
 1305%
 1306%   Call Goal in Module after applying goal expansion.
 1307
 1308call_ex(Module, Goal) :-
 1309    Module:(expand_goal(Goal, GoalEx),
 1310	    GoalEx).
 1311
 1312%!  cleanup(+Module, +Options) is det.
 1313%
 1314%   Call the cleanup handler and succeed.   Failure  or error of the
 1315%   cleanup handler is reported, but tests continue normally.
 1316
 1317cleanup(Module, Options) :-
 1318    option(cleanup(Cleanup), Options, true),
 1319    (   catch(call_ex(Module, Cleanup), E, true)
 1320    ->  (   var(E)
 1321	->  true
 1322	;   print_message(warning, E)
 1323	)
 1324    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1325    ).
 1326
 1327success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1328    memberchk(fixme(Reason), Options),
 1329    !,
 1330    (   (   Det == true
 1331	;   memberchk(nondet, Options)
 1332	)
 1333    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1334	Ok = passed
 1335    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1336	Ok = nondet
 1337    ),
 1338    flush_output(user_error),
 1339    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1340success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1341    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1342    !,
 1343    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1344success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1345    assert(passed(Unit, Name, Line, Det, Time)),
 1346    (   (   Det == true
 1347	;   memberchk(nondet, Options)
 1348	)
 1349    ->  progress(Unit:Name, Progress, passed, Time)
 1350    ;   unit_file(Unit, File),
 1351	print_message(warning, plunit(nondet(File, Line, Name)))
 1352    ).
 1353
 1354%!  failure(+Unit, +Name, +Progress, +Line,
 1355%!          +How, +Time, +Output, +Options) is det.
 1356%
 1357%   Test failed.  Report the error.
 1358
 1359failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1360  memberchk(fixme(Reason), Options) =>
 1361    assert(fixme(Unit, Name, Line, Reason, failed)),
 1362    progress(Unit:Name, Progress, fixme(failed), Time).
 1363failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1364	Output, Options) =>
 1365    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1366    progress(Unit:Name, Progress, timeout(Limit), Time),
 1367    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1368failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1369    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1370    progress(Unit:Name, Progress, failed, Time),
 1371    report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
 1372
 1373%!  assert_cyclic(+Term) is det.
 1374%
 1375%   Assert  a  possibly  cyclic  unit   clause.  Current  SWI-Prolog
 1376%   assert/1 does not handle cyclic terms,  so we emulate this using
 1377%   the recorded database.
 1378%
 1379%   @tbd    Implement cycle-safe assert and remove this.
 1380
 1381:- if(swi). 1382assert_cyclic(Term) :-
 1383    acyclic_term(Term),
 1384    !,
 1385    assert(Term).
 1386assert_cyclic(Term) :-
 1387    Term =.. [Functor|Args],
 1388    recorda(cyclic, Args, Id),
 1389    functor(Term, _, Arity),
 1390    length(NewArgs, Arity),
 1391    Head =.. [Functor|NewArgs],
 1392    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1393:- else. 1394:- if(sicstus). 1395:- endif. 1396assert_cyclic(Term) :-
 1397    assert(Term).
 1398:- endif. 1399
 1400
 1401		 /*******************************
 1402		 *             JOBS             *
 1403		 *******************************/
 1404
 1405:- if(current_prolog_flag(threads, true)). 1406
 1407:- dynamic
 1408       job_data/2,		% Queue, Threads
 1409       scheduled_unit/1. 1410
 1411schedule_unit(_:[]) :-
 1412    !.
 1413schedule_unit(UnitAndTests) :-
 1414    UnitAndTests = Unit:_Tests,
 1415    job_data(Queue, _),
 1416    !,
 1417    assertz(scheduled_unit(Unit)),
 1418    thread_send_message(Queue, unit(UnitAndTests)).
 1419schedule_unit(Unit) :-
 1420    run_unit(Unit).
 1421
 1422%!  setup_jobs(+Count) is det.
 1423%
 1424%   Setup threads for concurrent testing.
 1425
 1426setup_jobs(Count) :-
 1427    (   current_test_flag(jobs, Jobs0),
 1428	integer(Jobs0)
 1429    ->  true
 1430    ;   current_prolog_flag(cpu_count, Jobs0)
 1431    ),
 1432    Jobs is min(Count, Jobs0),
 1433    Jobs > 1,
 1434    !,
 1435    message_queue_create(Q, [alias(plunit_jobs)]),
 1436    length(TIDs, Jobs),
 1437    foldl(create_plunit_job(Q), TIDs, 1, _),
 1438    asserta(job_data(Q, TIDs)),
 1439    job_feedback(informational, jobs(Jobs)).
 1440setup_jobs(_) :-
 1441    job_feedback(informational, jobs(1)).
 1442
 1443create_plunit_job(Q, TID, N, N1) :-
 1444    N1 is N + 1,
 1445    atom_concat(plunit_job_, N, Alias),
 1446    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1447
 1448plunit_job(Queue) :-
 1449    repeat,
 1450    (   catch(thread_get_message(Queue, Job,
 1451				 [ timeout(10)
 1452				 ]),
 1453	      error(_,_), fail)
 1454    ->  job(Job),
 1455	fail
 1456    ;   !
 1457    ).
 1458
 1459job(unit(Unit:Tests)) =>
 1460    run_unit(Unit:Tests).
 1461job(test(Unit, Test)) =>
 1462    run_test(Unit, Test).
 1463
 1464cleanup_jobs :-
 1465    retract(job_data(Queue, TIDSs)),
 1466    !,
 1467    message_queue_destroy(Queue),
 1468    maplist(thread_join, TIDSs).
 1469cleanup_jobs.
 1470
 1471%!  job_wait(?Unit) is det.
 1472%
 1473%   Wait for all test jobs to finish.
 1474
 1475job_wait(Unit) :-
 1476    thread_wait(\+ scheduled_unit(Unit),
 1477		[ wait_preds([scheduled_unit/1]),
 1478		  timeout(1)
 1479		]),
 1480    !.
 1481job_wait(Unit) :-
 1482    job_data(_Queue, TIDs),
 1483    member(TID, TIDs),
 1484    thread_property(TID, status(running)),
 1485    !,
 1486    job_wait(Unit).
 1487job_wait(_).
 1488
 1489
 1490job_info(begin(unit(Unit))) =>
 1491    print_message(silent, plunit(begin(Unit))).
 1492job_info(end(unit(Unit, Summary))) =>
 1493    retractall(scheduled_unit(Unit)),
 1494    print_message(silent, plunit(end(Unit, Summary))).
 1495
 1496:- else.			% No jobs
 1497
 1498schedule_unit(Unit) :-
 1499    run_unit(Unit).
 1500
 1501setup_jobs(_) :-
 1502    print_message(silent, plunit(jobs(1))).
 1503cleanup_jobs.
 1504job_wait(_).
 1505job_info(_).
 1506
 1507:- endif. 1508
 1509
 1510
 1511		 /*******************************
 1512		 *            REPORTING         *
 1513		 *******************************/
 1514
 1515%!  begin_test(+Unit, +Test, +Line, +Progress) is det.
 1516%!  end_test(+Unit, +Test, +Line, +Progress) is det.
 1517%
 1518%   Maintain running/5 and report a test has started/is ended using
 1519%   a =silent= message:
 1520%
 1521%       * plunit(begin(Unit:Test, File:Line, Progress))
 1522%       * plunit(end(Unit:Test, File:Line, Progress))
 1523%
 1524%   @see message_hook/3 for intercepting these messages
 1525
 1526begin_test(Unit, Test, Line, Progress) :-
 1527    thread_self(Me),
 1528    assert(running(Unit, Test, Line, Progress, Me)),
 1529    unit_file(Unit, File),
 1530    test_count(Total),
 1531    job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
 1532
 1533end_test(Unit, Test, Line, Progress) :-
 1534    thread_self(Me),
 1535    retractall(running(_,_,_,_,Me)),
 1536    unit_file(Unit, File),
 1537    test_count(Total),
 1538    job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
 1539
 1540%!  running_tests is det.
 1541%
 1542%   Print the currently running test.
 1543
 1544running_tests :-
 1545    running_tests(Running),
 1546    print_message(informational, plunit(running(Running))).
 1547
 1548running_tests(Running) :-
 1549    test_count(Total),
 1550    findall(running(Unit:Test, File:Line, Progress/Total, Thread),
 1551	    (   running(Unit, Test, Line, Progress, Thread),
 1552		unit_file(Unit, File)
 1553	    ), Running).
 1554
 1555
 1556%!  current_test(?Unit, ?Test, ?Line, ?Body, ?Options) is nondet.
 1557%
 1558%   True when a test with the specified properties is loaded.
 1559
 1560current_test(Unit, Test, Line, Body, Options) :-
 1561    current_unit(Unit, Module, _Supers, _UnitOptions),
 1562    Module:'unit test'(Test, Line, Options, Body).
 1563
 1564%!  current_test_unit(?Unit, ?Options) is nondet.
 1565%
 1566%   True when a Unit is a current unit test declared with Options.
 1567
 1568current_test_unit(Unit, UnitOptions) :-
 1569    current_unit(Unit, _Module, _Supers, UnitOptions).
 1570
 1571
 1572count(Goal, Count) :-
 1573    aggregate_all(count, Goal, Count).
 1574
 1575%!  test_summary(?Unit, -Summary) is det.
 1576%
 1577%   True when Summary is a dict that reports the main statistics
 1578%   about the executed tests.
 1579
 1580test_summary(Unit, Summary) :-
 1581    count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
 1582    count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
 1583    count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
 1584    count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
 1585    count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme),
 1586    test_count(Total),
 1587    Summary = plunit{total:Total,
 1588		     passed:Passed,
 1589		     failed:Failed,
 1590		     timeout:Timeout,
 1591		     blocked:Blocked,
 1592		     fixme:Fixme}.
 1593
 1594test_summary_passed(Summary) :-
 1595    _{failed: 0} :< Summary.
 1596
 1597%!  report(+Time, +Options) is det.
 1598%
 1599%   Print a summary of the tests that ran.
 1600
 1601report(Time, _Options) :-
 1602    test_summary(_, Summary),
 1603    print_message(silent, plunit(Summary)),
 1604    _{ passed:Passed,
 1605       failed:Failed,
 1606       timeout:Timeout,
 1607       blocked:Blocked,
 1608       fixme:Fixme
 1609     } :< Summary,
 1610    (   Passed+Failed+Timeout+Blocked+Fixme =:= 0
 1611    ->  info(plunit(no_tests))
 1612    ;   Failed+Timeout =:= 0
 1613    ->  report_blocked(Blocked),
 1614	report_fixme,
 1615        test_count(Total),
 1616	info(plunit(all_passed(Total, Passed, Time)))
 1617    ;   report_blocked(Blocked),
 1618	report_fixme,
 1619	report_failed(Failed),
 1620	report_timeout(Timeout),
 1621	info(plunit(passed(Passed))),
 1622        info(plunit(total_time(Time)))
 1623    ).
 1624
 1625report_blocked(0) =>
 1626    true.
 1627report_blocked(Blocked) =>
 1628    findall(blocked(Unit:Name, File:Line, Reason),
 1629	    ( blocked(Unit, Name, Line, Reason),
 1630	      unit_file(Unit, File)
 1631	    ),
 1632	    BlockedTests),
 1633    info(plunit(blocked(Blocked, BlockedTests))).
 1634
 1635report_failed(Failed) :-
 1636    print_message(error, plunit(failed(Failed))).
 1637
 1638report_timeout(Count) :-
 1639    print_message(warning, plunit(timeout(Count))).
 1640
 1641report_fixme :-
 1642    report_fixme(_,_,_).
 1643
 1644report_fixme(TuplesF, TuplesP, TuplesN) :-
 1645    fixme(failed, TuplesF, Failed),
 1646    fixme(passed, TuplesP, Passed),
 1647    fixme(nondet, TuplesN, Nondet),
 1648    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1649
 1650
 1651fixme(How, Tuples, Count) :-
 1652    findall(fixme(Unit, Name, Line, Reason, How),
 1653	    fixme(Unit, Name, Line, Reason, How), Tuples),
 1654    length(Tuples, Count).
 1655
 1656report_failure(Unit, Name, Progress, Line, Error,
 1657	       Time, Output, _Options) =>
 1658    test_count(Total),
 1659    job_feedback(error, failed(Unit:Name, Progress/Total, Line,
 1660			       Error, Time, Output)).
 1661
 1662
 1663%!  test_report(+What) is det.
 1664%
 1665%   Produce reports on test  results  after   the  run.  Currently  only
 1666%   supports `fixme` for What.
 1667
 1668test_report(fixme) :-
 1669    !,
 1670    report_fixme(TuplesF, TuplesP, TuplesN),
 1671    append([TuplesF, TuplesP, TuplesN], Tuples),
 1672    print_message(informational, plunit(fixme(Tuples))).
 1673test_report(What) :-
 1674    throw_error(domain_error(report_class, What), _).
 1675
 1676
 1677		 /*******************************
 1678		 *             INFO             *
 1679		 *******************************/
 1680
 1681%!  unit_file(+Unit, -File) is det.
 1682%!  unit_file(?Unit, ?File) is nondet.
 1683%
 1684%   True when the test unit Unit is defined in File.
 1685
 1686unit_file(Unit, File), nonvar(Unit) =>
 1687    unit_file_(Unit, File),
 1688    !.
 1689unit_file(Unit, File) =>
 1690    unit_file_(Unit, File).
 1691
 1692unit_file_(Unit, File) :-
 1693    current_unit(Unit, Module, _Context, _Options),
 1694    module_property(Module, file(File)).
 1695unit_file_(Unit, PlFile) :-
 1696    test_file_for(TestFile, PlFile),
 1697    module_property(Module, file(TestFile)),
 1698    current_unit(Unit, Module, _Context, _Options).
 1699
 1700
 1701		 /*******************************
 1702		 *             FILES            *
 1703		 *******************************/
 1704
 1705%!  load_test_files(+Options) is det.
 1706%
 1707%   Load .plt test-files related  to   loaded  source-files.  Options is
 1708%   currently ignored.
 1709
 1710load_test_files(_Options) :-
 1711    State = state(0,0),
 1712    (   source_file(File),
 1713	file_name_extension(Base, Old, File),
 1714	Old \== plt,
 1715	file_name_extension(Base, plt, TestFile),
 1716	exists_file(TestFile),
 1717        inc_arg(1, State),
 1718	(   test_file_for(TestFile, File)
 1719	->  true
 1720	;   load_files(TestFile,
 1721		       [ if(changed),
 1722			 imports([])
 1723		       ]),
 1724            inc_arg(2, State),
 1725	    asserta(test_file_for(TestFile, File))
 1726	),
 1727        fail
 1728    ;   State = state(Total, Loaded),
 1729        print_message(informational, plunit(test_files(Total, Loaded)))
 1730    ).
 1731
 1732inc_arg(Arg, State) :-
 1733    arg(Arg, State, N0),
 1734    N is N0+1,
 1735    nb_setarg(Arg, State, N).
 1736
 1737
 1738		 /*******************************
 1739		 *           MESSAGES           *
 1740		 *******************************/
 1741
 1742%!  info(+Term)
 1743%
 1744%   Runs print_message(Level, Term), where Level is   one of `silent` or
 1745%   `informational` (default).
 1746
 1747info(Term) :-
 1748    message_level(Level),
 1749    print_message(Level, Term).
 1750
 1751%!  progress(+UnitTest, +Progress, +Result, +Time) is det.
 1752%
 1753%   Test Unit:Name completed in Time. Result is the result and is one of
 1754%
 1755%     - passed
 1756%     - failed
 1757%     - assertion
 1758%     - nondet
 1759%     - fixme(passed)
 1760%     - fixme(nondet)
 1761%     - fixme(failed)
 1762%     - forall(end, Nth, FTotal)
 1763%       Pseudo result for completion of a forall(Gen,Test) set.  Mapped
 1764%       to forall(FTotal, FFailed)
 1765
 1766progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) =>
 1767    (   retract(forall_failures(Nth, FFailed))
 1768    ->  true
 1769    ;   FFailed = 0
 1770    ),
 1771    test_count(Total),
 1772    job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)).
 1773progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) =>
 1774    with_mutex(plunit_forall_counter,
 1775               update_forall_failures(Nth, Result)),
 1776    test_count(Total),
 1777    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1778progress(UnitTest, Progress, Result, Time) =>
 1779    test_count(Total),
 1780    job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
 1781
 1782update_forall_failures(_Nth, passed) =>
 1783    true.
 1784update_forall_failures(Nth, _) =>
 1785    (   retract(forall_failures(Nth, Failed0))
 1786    ->  true
 1787    ;   Failed0 = 0
 1788    ),
 1789    Failed is Failed0+1,
 1790    asserta(forall_failures(Nth, Failed)).
 1791
 1792message_level(Level) :-
 1793    (   current_test_flag(silent, true)
 1794    ->  Level = silent
 1795    ;   Level = informational
 1796    ).
 1797
 1798locationprefix(File:Line) -->
 1799    !,
 1800    [ url(File:Line), ':'-[], nl, '    ' ].
 1801locationprefix(test(Unit,_Test,Line)) -->
 1802    !,
 1803    { unit_file(Unit, File) },
 1804    locationprefix(File:Line).
 1805locationprefix(unit(Unit)) -->
 1806    !,
 1807    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1808locationprefix(FileLine) -->
 1809    { throw_error(type_error(locationprefix,FileLine), _) }.
 1810
 1811:- discontiguous
 1812    message//1. 1813:- '$hide'(message//1). 1814
 1815message(error(context_error(plunit_close(Name, -)), _)) -->
 1816    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1817message(error(context_error(plunit_close(Name, Start)), _)) -->
 1818    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1819message(plunit(nondet(File, Line, Name))) -->
 1820    locationprefix(File:Line),
 1821    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1822message(error(plunit(incompatible_options, Tests), _)) -->
 1823    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1824message(plunit(sto(true))) -->
 1825    [ 'Option sto(true) is ignored.  See `occurs_check` option.'-[] ].
 1826message(plunit(test_files(Total, Loaded))) -->
 1827    [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ].
 1828
 1829					% Unit start/end
 1830message(plunit(jobs(1))) -->
 1831    !.
 1832message(plunit(jobs(N))) -->
 1833    [ 'Testing with ~D parallel jobs'-[N] ].
 1834message(plunit(begin(_Unit))) -->
 1835    { tty_feedback },
 1836    !.
 1837message(plunit(begin(Unit))) -->
 1838    [ 'Start unit: ~w~n'-[Unit], flush ].
 1839message(plunit(end(_Unit, _Summary))) -->
 1840    { tty_feedback },
 1841    !.
 1842message(plunit(end(Unit, Summary))) -->
 1843    (   {test_summary_passed(Summary)}
 1844    ->  [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
 1845    ;   [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
 1846    ).
 1847message(plunit(blocked(unit(Unit, Reason)))) -->
 1848    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1849message(plunit(running([]))) -->
 1850    !,
 1851    [ 'PL-Unit: no tests running' ].
 1852message(plunit(running([One]))) -->
 1853    !,
 1854    [ 'PL-Unit: running ' ],
 1855    running(One).
 1856message(plunit(running(More))) -->
 1857    !,
 1858    [ 'PL-Unit: running tests:', nl ],
 1859    running(More).
 1860message(plunit(fixme([]))) --> !.
 1861message(plunit(fixme(Tuples))) -->
 1862    !,
 1863    fixme_message(Tuples).
 1864message(plunit(total_time(Time))) -->
 1865    [ 'Test run completed'-[] ],
 1866    test_time(Time).
 1867
 1868					% Blocked tests
 1869message(plunit(blocked(1, Tests))) -->
 1870    !,
 1871    [ 'one test is blocked'-[] ],
 1872    blocked_tests(Tests).
 1873message(plunit(blocked(N, Tests))) -->
 1874    [ '~D tests are blocked'-[N] ],
 1875    blocked_tests(Tests).
 1876
 1877blocked_tests(Tests) -->
 1878    { current_test_flag(show_blocked, true) },
 1879    !,
 1880    [':'-[]],
 1881    list_blocked(Tests).
 1882blocked_tests(_) -->
 1883    [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []),
 1884      ' for details)'-[]
 1885    ].
 1886
 1887list_blocked([]) --> !.
 1888list_blocked([blocked(Unit:Test, Pos, Reason)|T]) -->
 1889    [nl],
 1890    locationprefix(Pos),
 1891    test_name(Unit:Test, -),
 1892    [ ': ~w'-[Reason] ],
 1893    list_blocked(T).
 1894
 1895					% fail/success
 1896message(plunit(no_tests)) -->
 1897    !,
 1898    [ 'No tests to run' ].
 1899message(plunit(all_passed(1, 1, Time))) -->
 1900    !,
 1901    [ 'test passed' ],
 1902    test_time(Time).
 1903message(plunit(all_passed(Total, Total, Time))) -->
 1904    !,
 1905    [ 'All ~D tests passed'-[Total] ],
 1906    test_time(Time).
 1907message(plunit(all_passed(Total, Count, Time))) -->
 1908    !,
 1909    { SubTests is Count-Total },
 1910    [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ],
 1911    test_time(Time).
 1912
 1913test_time(Time) -->
 1914    { var(Time) }, !.
 1915test_time(Time) -->
 1916    [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ].
 1917
 1918message(plunit(passed(Count))) -->
 1919    !,
 1920    [ '~D tests passed'-[Count] ].
 1921message(plunit(failed(0))) -->
 1922    !,
 1923    [].
 1924message(plunit(failed(1))) -->
 1925    !,
 1926    [ '1 test failed'-[] ].
 1927message(plunit(failed(N))) -->
 1928    [ '~D tests failed'-[N] ].
 1929message(plunit(timeout(0))) -->
 1930    !,
 1931    [].
 1932message(plunit(timeout(N))) -->
 1933    [ '~D tests timed out'-[N] ].
 1934message(plunit(fixme(0,0,0))) -->
 1935    [].
 1936message(plunit(fixme(Failed,0,0))) -->
 1937    !,
 1938    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1939message(plunit(fixme(Failed,Passed,0))) -->
 1940    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1941message(plunit(fixme(Failed,Passed,Nondet))) -->
 1942    { TotalPassed is Passed+Nondet },
 1943    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1944      [Failed, TotalPassed, Nondet] ].
 1945
 1946message(plunit(begin(Unit:Test, _Location, Progress))) -->
 1947    { tty_columns(SummaryWidth, _Margin),
 1948      test_name_summary(Unit:Test, SummaryWidth, NameS),
 1949      progress_string(Progress, ProgressS)
 1950    },
 1951    (   { tty_feedback,
 1952	  tty_clear_to_eol(CE)
 1953	}
 1954    ->  [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS,
 1955					     CE], flush ]
 1956    ;   { jobs(_) }
 1957    ->  [ '[~w] ~w ..'-[ProgressS, NameS] ]
 1958    ;   [ '[~w] ~w ..'-[ProgressS, NameS], flush ]
 1959    ).
 1960message(plunit(end(_UnitTest, _Location, _Progress))) -->
 1961    [].
 1962message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
 1963    { Status = forall(_,_)
 1964    ; Status == assertion
 1965    },
 1966    !.
 1967message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
 1968    { jobs(_),
 1969      !,
 1970      tty_columns(SummaryWidth, Margin),
 1971      test_name_summary(Unit:Test, SummaryWidth, NameS),
 1972      progress_string(Progress, ProgressS),
 1973      progress_tag(Status, Tag, _Keep, Style)
 1974    },
 1975    [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|',
 1976	   [ProgressS, NameS, Tag, Time.wall, Margin]) ].
 1977message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
 1978    { tty_columns(_SummaryWidth, Margin),
 1979      progress_tag(Status, Tag, _Keep, Style)
 1980    },
 1981    [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
 1982			 [Tag, Time.wall, Margin]) ],
 1983    (   { tty_feedback }
 1984    ->  [flush]
 1985    ;   []
 1986    ).
 1987message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
 1988    { unit_file(Unit, File) },
 1989    locationprefix(File:Line),
 1990    test_name(Unit:Test, Progress),
 1991    [': '-[] ],
 1992    failure(Failure),
 1993    test_output(Output).
 1994message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
 1995    { unit_file(Unit, File) },
 1996    locationprefix(File:Line),
 1997    test_name(Unit:Test, Progress),
 1998    [': '-[] ],
 1999    timeout(Limit),
 2000    test_output(Output).
 2001:- if(swi). 2002message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
 2003				Progress, Reason, Goal))) -->
 2004    { unit_file(Unit, File) },
 2005    locationprefix(File:Line),
 2006    test_name(Unit:Test, Progress),
 2007    [ ': assertion'-[] ],
 2008    assertion_location(AssertLoc, File),
 2009    assertion_reason(Reason), ['\n\t'],
 2010    assertion_goal(Unit, Goal).
 2011
 2012assertion_location(File:Line, File) -->
 2013    [ ' at line ~w'-[Line] ].
 2014assertion_location(File:Line, _) -->
 2015    [ ' at ', url(File:Line) ].
 2016assertion_location(unknown, _) -->
 2017    [].
 2018
 2019assertion_reason(fail) -->
 2020    !,
 2021    [ ' failed'-[] ].
 2022assertion_reason(Error) -->
 2023    { message_to_string(Error, String) },
 2024    [ ' raised "~w"'-[String] ].
 2025
 2026assertion_goal(Unit, Goal) -->
 2027    { unit_module(Unit, Module),
 2028      unqualify(Goal, Module, Plain)
 2029    },
 2030    [ 'Assertion: ~p'-[Plain] ].
 2031
 2032unqualify(Var, _, Var) :-
 2033    var(Var),
 2034    !.
 2035unqualify(M:Goal, Unit, Goal) :-
 2036    nonvar(M),
 2037    unit_module(Unit, M),
 2038    !.
 2039unqualify(M:Goal, _, Goal) :-
 2040    callable(Goal),
 2041    predicate_property(M:Goal, imported_from(system)),
 2042    !.
 2043unqualify(Goal, _, Goal).
 2044
 2045test_output("") --> [].
 2046test_output(Output) -->
 2047    [ ansi(code, '~s', [Output]) ].
 2048
 2049:- endif. 2050					% Setup/condition errors
 2051message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
 2052    locationprefix(Context),
 2053    { message_to_string(Exception, String) },
 2054    [ 'error in ~w: ~w'-[Where, String] ].
 2055message(plunit(error(Where, Context, _Output, false))) -->
 2056    locationprefix(Context),
 2057    [ 'setup failed in ~w'-[Where] ].
 2058
 2059                                        % delayed output
 2060message(plunit(test_output(_, Output))) -->
 2061    [ '~s'-[Output] ].
 2062					% Interrupts (SWI)
 2063:- if(swi). 2064message(interrupt(begin)) -->
 2065    { thread_self(Me),
 2066      running(Unit, Test, Line, Progress, Me),
 2067      !,
 2068      unit_file(Unit, File),
 2069      restore_output_state
 2070    },
 2071    [ 'Interrupted test '-[] ],
 2072    running(running(Unit:Test, File:Line, Progress, Me)),
 2073    [nl],
 2074    '$messages':prolog_message(interrupt(begin)).
 2075message(interrupt(begin)) -->
 2076    '$messages':prolog_message(interrupt(begin)).
 2077:- endif. 2078
 2079message(concurrent) -->
 2080    [ 'concurrent(true) at the level of units is currently ignored.', nl,
 2081      'See set_test_options/1 with jobs(Count) for concurrent testing.'
 2082    ].
 2083
 2084test_name(Name, forall(Bindings, _Nth-I)) -->
 2085    !,
 2086    test_name(Name, -),
 2087    [ ' (~d-th forall bindings = '-[I],
 2088      ansi(code, '~p', [Bindings]), ')'-[]
 2089    ].
 2090test_name(Name, _) -->
 2091    !,
 2092    [ 'test ', ansi(code, '~q', [Name]) ].
 2093
 2094running(running(Unit:Test, File:Line, _Progress, Thread)) -->
 2095    thread(Thread),
 2096    [ '~q:~q at '-[Unit, Test], url(File:Line) ].
 2097running([H|T]) -->
 2098    ['\t'], running(H),
 2099    (   {T == []}
 2100    ->  []
 2101    ;   [nl], running(T)
 2102    ).
 2103
 2104thread(main) --> !.
 2105thread(Other) -->
 2106    [' [~w] '-[Other] ].
 2107
 2108:- if(swi). 2109write_term(T, OPS) -->
 2110    ['~W'-[T,OPS] ].
 2111:- else. 2112write_term(T, _OPS) -->
 2113    ['~q'-[T]].
 2114:- endif. 2115
 2116expected_got_ops_(Ex, E, OPS, Goals) -->
 2117    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 2118    ['    Got:      '-[]], write_term(E,  OPS), [],
 2119    ( { Goals = [] } -> []
 2120    ; [nl, '       with: '-[]], write_term(Goals, OPS), []
 2121    ).
 2122
 2123
 2124failure(List) -->
 2125    { is_list(List) },
 2126    !,
 2127    [ nl ],
 2128    failures(List).
 2129failure(Var) -->
 2130    { var(Var) },
 2131    !,
 2132    [ 'Unknown failure?' ].
 2133failure(succeeded(Time)) -->
 2134    !,
 2135    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 2136failure(wrong_error(Expected, Error)) -->
 2137    !,
 2138    { copy_term(Expected-Error, Ex-E, Goals),
 2139      numbervars(Ex-E-Goals, 0, _),
 2140      write_options(OPS)
 2141    },
 2142    [ 'wrong error'-[], nl ],
 2143    expected_got_ops_(Ex, E, OPS, Goals).
 2144failure(wrong_answer(cmp(Var, Cmp))) -->
 2145    { Cmp =.. [Op,Answer,Expected],
 2146      !,
 2147      copy_term(Expected-Answer, Ex-A, Goals),
 2148      numbervars(Ex-A-Goals, 0, _),
 2149      write_options(OPS)
 2150    },
 2151    [ 'wrong answer for ', ansi(code, '~w', [Var]),
 2152      ' (compared using ~w)'-[Op], nl ],
 2153    expected_got_ops_(Ex, A, OPS, Goals).
 2154failure(wrong_answer(Cmp)) -->
 2155    { Cmp =.. [Op,Answer,Expected],
 2156      !,
 2157      copy_term(Expected-Answer, Ex-A, Goals),
 2158      numbervars(Ex-A-Goals, 0, _),
 2159      write_options(OPS)
 2160    },
 2161    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 2162    expected_got_ops_(Ex, A, OPS, Goals).
 2163failure(wrong_answer(CmpExpected, Bindings)) -->
 2164    { (   CmpExpected = all(Cmp)
 2165      ->  Cmp =.. [_Op1,_,Expected],
 2166	  Got = Bindings,
 2167	  Type = all
 2168      ;   CmpExpected = set(Cmp),
 2169	  Cmp =.. [_Op2,_,Expected0],
 2170	  sort(Expected0, Expected),
 2171	  sort(Bindings, Got),
 2172	  Type = set
 2173      )
 2174    },
 2175    [ 'wrong "~w" answer:'-[Type] ],
 2176    [ nl, '    Expected: ~q'-[Expected] ],
 2177    [ nl, '       Found: ~q'-[Got] ].
 2178:- if(swi). 2179failure(cmp_error(_Cmp, Error)) -->
 2180    { message_to_string(Error, Message) },
 2181    [ 'Comparison error: ~w'-[Message] ].
 2182failure(throw(Error)) -->
 2183    { Error = error(_,_),
 2184      !,
 2185      message_to_string(Error, Message)
 2186    },
 2187    [ 'received error: ~w'-[Message] ].
 2188:- endif. 2189failure(Why) -->
 2190    [ '~p'-[Why] ].
 2191
 2192failures([]) -->
 2193    !.
 2194failures([H|T]) -->
 2195    !,
 2196    failure(H), [nl],
 2197    failures(T).
 2198
 2199timeout(Limit) -->
 2200    [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
 2201
 2202fixme_message([]) --> [].
 2203fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 2204    { unit_file(Unit, File) },
 2205    fixme_message(File:Line, Reason, How),
 2206    (   {T == []}
 2207    ->  []
 2208    ;   [nl],
 2209	fixme_message(T)
 2210    ).
 2211
 2212fixme_message(Location, Reason, failed) -->
 2213    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 2214fixme_message(Location, Reason, passed) -->
 2215    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 2216fixme_message(Location, Reason, nondet) -->
 2217    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 2218
 2219
 2220write_options([ numbervars(true),
 2221		quoted(true),
 2222		portray(true),
 2223		max_depth(100),
 2224		attributes(portray)
 2225	      ]).
 2226
 2227%!  test_name_summary(+Term, +MaxLen, -Summary) is det.
 2228%
 2229%   Given the test id, generate  string that summarizes this in MaxLen
 2230%   characters.
 2231
 2232test_name_summary(Term, MaxLen, Summary) :-
 2233    summary_string(Term, Text),
 2234    atom_length(Text, Len),
 2235    (   Len =< MaxLen
 2236    ->  Summary = Text
 2237    ;   End is MaxLen//2,
 2238        Pre is MaxLen - End - 2,
 2239        sub_string(Text, 0, Pre, _, PreText),
 2240        sub_string(Text, _, End, 0, PostText),
 2241        format(string(Summary), '~w..~w', [PreText,PostText])
 2242    ).
 2243
 2244summary_string(Unit:Test, String) =>
 2245    summary_string(Test, String1),
 2246    atomics_to_string([Unit, String1], :, String).
 2247summary_string(@(Name,Vars), String) =>
 2248    format(string(String), '~W (using ~W)',
 2249           [ Name, [numbervars(true), quoted(false)],
 2250             Vars, [numbervars(true), portray(true), quoted(true)]
 2251           ]).
 2252summary_string(Name, String) =>
 2253    term_string(Name, String, [numbervars(true), quoted(false)]).
 2254
 2255%!  progress_string(+Progress, -S) is det.
 2256%
 2257%   True when S is a string representation for the test progress.
 2258
 2259progress_string(forall(_Vars, N-I)/Total, S) =>
 2260    format(string(S), '~w-~w/~w', [N,I,Total]).
 2261progress_string(Progress, S) =>
 2262    term_string(Progress, S).
 2263
 2264%!  progress_tag(+Status, -Tag, -Keep, -Style) is det.
 2265%
 2266%   Given a progress status, determine the status tag, whether we must
 2267%   preserve the  line and the Style  we must use to  print the status
 2268%   line.
 2269
 2270progress_tag(passed,        Tag, Keep, Style) =>
 2271    Tag = passed, Keep = false, Style = comment.
 2272progress_tag(fixme(passed), Tag, Keep, Style) =>
 2273    Tag = passed, Keep = false, Style = comment.
 2274progress_tag(fixme(_),      Tag, Keep, Style) =>
 2275    Tag = fixme, Keep = true, Style = warning.
 2276progress_tag(nondet,        Tag, Keep, Style) =>
 2277    Tag = '**NONDET', Keep = true, Style = warning.
 2278progress_tag(timeout(_Limit), Tag, Keep, Style) =>
 2279    Tag = '**TIMEOUT', Keep = true, Style = warning.
 2280progress_tag(assertion,     Tag, Keep, Style) =>
 2281    Tag = '**FAILED', Keep = true, Style = error.
 2282progress_tag(failed,        Tag, Keep, Style) =>
 2283    Tag = '**FAILED', Keep = true, Style = error.
 2284progress_tag(forall(_,0),   Tag, Keep, Style) =>
 2285    Tag = passed, Keep = false, Style = comment.
 2286progress_tag(forall(_,_),   Tag, Keep, Style) =>
 2287    Tag = '**FAILED', Keep = true, Style = error.
 2288
 2289
 2290		 /*******************************
 2291		 *           OUTPUT		*
 2292		 *******************************/
 2293
 2294save_output_state :-
 2295    stream_property(Output, alias(user_output)),
 2296    stream_property(Error, alias(user_error)),
 2297    asserta(output_streams(Output, Error)).
 2298
 2299restore_output_state :-
 2300    output_streams(Output, Error),
 2301    !,
 2302    set_stream(Output, alias(user_output)),
 2303    set_stream(Error, alias(user_error)).
 2304restore_output_state.
 2305
 2306
 2307
 2308		 /*******************************
 2309		 *      CONCURRENT STATUS       *
 2310		 *******************************/
 2311
 2312/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2313This part deals with interactive feedback   when we are running multiple
 2314threads. The terminal window cannot work on   top  of the Prolog message
 2315infrastructure and (thus) we have to use more low-level means.
 2316- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2317
 2318:- dynamic
 2319       jobs/1,			% Count
 2320       job_window/1,		% Count
 2321       job_status_line/3.	% Job, Format, Args
 2322
 2323job_feedback(_, jobs(Jobs)) :-
 2324    retractall(jobs(_)),
 2325    Jobs > 1,
 2326    asserta(jobs(Jobs)),
 2327    tty_feedback,
 2328    !,
 2329    retractall(job_window(_)),
 2330    asserta(job_window(Jobs)),
 2331    retractall(job_status_line(_,_,_)),
 2332    jobs_redraw.
 2333job_feedback(_, jobs(Jobs)) :-
 2334    !,
 2335    retractall(job_window(_)),
 2336    info(plunit(jobs(Jobs))).
 2337job_feedback(_, Msg) :-
 2338    job_window(_),
 2339    !,
 2340    with_mutex(plunit_feedback, job_feedback(Msg)).
 2341job_feedback(Level, Msg) :-
 2342    print_message(Level, plunit(Msg)).
 2343
 2344job_feedback(begin(Unit:Test, _Location, Progress)) =>
 2345    tty_columns(SummaryWidth, _Margin),
 2346    test_name_summary(Unit:Test, SummaryWidth, NameS),
 2347    progress_string(Progress, ProgressS),
 2348    tty_clear_to_eol(CE),
 2349    job_format(comment, '\r[~w] ~w ..~w',
 2350	       [ProgressS, NameS, CE]),
 2351    flush_output.
 2352job_feedback(end(_UnitTest, _Location, _Progress)) =>
 2353    true.
 2354job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
 2355    (   hide_progress(Status)
 2356    ->  true
 2357    ;   tty_columns(_SummaryWidth, Margin),
 2358	progress_tag(Status, Tag, _Keep, Style),
 2359	job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2360		   [Tag, Time.wall, Margin])
 2361    ).
 2362job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
 2363    tty_columns(_SummaryWidth, Margin),
 2364    progress_tag(failed, Tag, _Keep, Style),
 2365    job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2366	       [Tag, Time.wall, Margin]),
 2367    print_test_output(Error, Output),
 2368    (   (   Error = timeout(_)	% Status line suffices
 2369	;   Error == assertion	% We will get an failed test later
 2370	)
 2371    ->  true
 2372    ;   print_message(Style, plunit(failed(UnitTest, Progress, Line,
 2373					   Error, Time, "")))
 2374    ),
 2375    jobs_redraw.
 2376job_feedback(begin(_Unit)) => true.
 2377job_feedback(end(_Unit, _Summary)) => true.
 2378
 2379hide_progress(assertion).
 2380hide_progress(forall(_,_)).
 2381hide_progress(failed).
 2382hide_progress(timeout(_)).
 2383
 2384print_test_output(_, "") => true.
 2385print_test_output(assertion, Output) =>
 2386    print_message(debug, plunit(test_output(error, Output))).
 2387print_test_output(_, Output) =>
 2388    print_message(debug, plunit(test_output(informational, Output))).
 2389
 2390%!  jobs_redraw is det.
 2391%
 2392%   Redraw the job window.
 2393
 2394jobs_redraw :-
 2395    job_window(N),
 2396    !,
 2397    tty_columns(_, Width),
 2398    tty_header_line(Width),
 2399    forall(between(1,N,Line), job_redraw_worker(Line)),
 2400    tty_header_line(Width).
 2401jobs_redraw.
 2402
 2403job_redraw_worker(Line) :-
 2404    (   job_status_line(Line, Fmt, Args)
 2405    ->  ansi_format(comment, Fmt, Args)
 2406    ;   true
 2407    ),
 2408    nl.
 2409
 2410%!  job_format(+Style, +Fmt, +Args) is det.
 2411%!  job_format(+Job, +Style, +Fmt, +Args, +Save) is det.
 2412%
 2413%   Point should be  below the status window.  Format  Fmt+Args in the
 2414%   line Job using Style and return to the position below the window.
 2415
 2416job_format(Style, Fmt, Args) :-
 2417    job_self(Job),
 2418    job_format(Job, Style, Fmt, Args, true).
 2419
 2420%!  job_finish(+Style, +Fmt, +Args) is det.
 2421%!  job_finish(+Job, +Style, +Fmt, +Args) is det.
 2422%
 2423%   Complete  the status  line  for Job.   This  redraws the  original
 2424%   status line when we are using a job window.
 2425
 2426job_finish(Style, Fmt, Args) :-
 2427    job_self(Job),
 2428    job_finish(Job, Style, Fmt, Args).
 2429
 2430:- det(job_finish/4). 2431job_finish(Job, Style, Fmt, Args) :-
 2432    retract(job_status_line(Job, Fmt0, Args0)),
 2433    !,
 2434    string_concat(Fmt0, Fmt, Fmt1),
 2435    append(Args0, Args, Args1),
 2436    job_format(Job, Style, Fmt1, Args1, false).
 2437
 2438:- det(job_format/5). 2439job_format(Job, Style, Fmt, Args, Save) :-
 2440    job_window(Jobs),
 2441    Up is Jobs+2-Job,
 2442    flush_output(user_output),
 2443    tty_up_and_clear(Up),
 2444    ansi_format(Style, Fmt, Args),
 2445    (   Save == true
 2446    ->  retractall(job_status_line(Job, _, _)),
 2447	asserta(job_status_line(Job, Fmt, Args))
 2448    ;   true
 2449    ),
 2450    tty_down_and_home(Up),
 2451    flush_output(user_output).
 2452
 2453:- det(job_self/1). 2454job_self(Job) :-
 2455    job_window(N),
 2456    N > 1,
 2457    thread_self(Me),
 2458    split_string(Me, '_', '', [_,_,S]),
 2459    number_string(Job, S).
 2460
 2461%!  feedback is semidet.
 2462%
 2463%   provide feedback using the `tty`  format, which reuses the current
 2464%   output line if the test is successful.
 2465
 2466tty_feedback :-
 2467    has_tty,
 2468    current_test_flag(format, tty).
 2469
 2470has_tty :-
 2471    stream_property(user_output, tty(true)).
 2472
 2473tty_columns(SummaryWidth, Margin) :-
 2474    tty_width(W),
 2475    Margin is W-8,
 2476    SummaryWidth is max(20,Margin-34).
 2477
 2478tty_width(W) :-
 2479    current_predicate(tty_size/2),
 2480    catch(tty_size(_Rows, Cols), error(_,_), fail),
 2481    Cols > 25,
 2482    !,
 2483    W = Cols.
 2484tty_width(80).
 2485
 2486tty_header_line(Width) :-
 2487    ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
 2488
 2489:- if(current_predicate(tty_get_capability/3)). 2490tty_clear_to_eol(S) :-
 2491    tty_get_capability(ce, string, S),
 2492    !.
 2493:- endif. 2494tty_clear_to_eol('\e[K').
 2495
 2496tty_up_and_clear(Lines) :-
 2497    format(user_output, '\e[~dA\r\e[K', [Lines]).
 2498
 2499tty_down_and_home(Lines) :-
 2500    format(user_output, '\e[~dB\r', [Lines]).
 2501
 2502:- if(swi). 2503
 2504:- multifile
 2505    prolog:message/3,
 2506    user:message_hook/3. 2507
 2508prolog:message(Term) -->
 2509    message(Term).
 2510
 2511%       user:message_hook(+Term, +Kind, +Lines)
 2512
 2513user:message_hook(make(done(Files)), _, _) :-
 2514    make_run_tests(Files),
 2515    fail.                           % give other hooks a chance
 2516
 2517:- endif. 2518
 2519:- if(sicstus). 2520
 2521user:generate_message_hook(Message) -->
 2522    message(Message),
 2523    [nl].                           % SICStus requires nl at the end
 2524
 2525%!  user:message_hook(+Severity, +Message, +Lines) is semidet.
 2526%
 2527%   Redefine printing some messages. It appears   SICStus has no way
 2528%   to get multiple messages at the same   line, so we roll our own.
 2529%   As there is a lot pre-wired and   checked in the SICStus message
 2530%   handling we cannot reuse the lines. Unless I miss something ...
 2531
 2532user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 2533    format(user_error, '% PL-Unit: ~w ', [Unit]),
 2534    flush_output(user_error).
 2535user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 2536    format(user, ' done~n', []).
 2537
 2538:- endif.