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