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