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    start_test(Unit, @(Name,Line), Nth),
 1027    State = state(0),
 1028    call_time(forall(Module:Generator,            % may become concurrent
 1029                     (   incr_forall(State, I),
 1030                         run_test_once6(Unit, Name,
 1031                                        forall(Generator, 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, Unit:Name, Progress)))
 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(_Gen, 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(Pos, Test, Progress))) -->
 1876    locationprefix(Pos),
 1877    test_name(Test, Progress),
 1878    [ ': Test succeeded with choicepoint'-[] ].
 1879message(error(plunit(incompatible_options, Tests), _)) -->
 1880    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1881message(plunit(sto(true))) -->
 1882    [ 'Option sto(true) is ignored.  See `occurs_check` option.'-[] ].
 1883message(plunit(test_files(Total, Loaded))) -->
 1884    [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ].
 1885
 1886					% Unit start/end
 1887message(plunit(jobs(1))) -->
 1888    !.
 1889message(plunit(jobs(N))) -->
 1890    [ 'Testing with ~D parallel jobs'-[N] ].
 1891message(plunit(begin(_Unit))) -->
 1892    { tty_feedback },
 1893    !.
 1894message(plunit(begin(Unit))) -->
 1895    [ 'Start unit: ~w~n'-[Unit], flush ].
 1896message(plunit(end(_Unit, _Summary))) -->
 1897    { tty_feedback },
 1898    !.
 1899message(plunit(end(Unit, Summary))) -->
 1900    (   {test_summary_passed(Summary)}
 1901    ->  [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
 1902    ;   [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
 1903    ).
 1904message(plunit(blocked(unit(Unit, Reason)))) -->
 1905    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1906message(plunit(running([]))) -->
 1907    !,
 1908    [ 'PL-Unit: no tests running' ].
 1909message(plunit(running([One]))) -->
 1910    !,
 1911    [ 'PL-Unit: running ' ],
 1912    running(One).
 1913message(plunit(running(More))) -->
 1914    !,
 1915    [ 'PL-Unit: running tests:', nl ],
 1916    running(More).
 1917message(plunit(fixme([]))) --> !.
 1918message(plunit(fixme(Tuples))) -->
 1919    !,
 1920    fixme_message(Tuples).
 1921message(plunit(total_time(Time))) -->
 1922    [ 'Test run completed'-[] ],
 1923    test_time(Time).
 1924
 1925					% Blocked tests
 1926message(plunit(blocked(1, Tests))) -->
 1927    !,
 1928    [ 'one test is blocked'-[] ],
 1929    blocked_tests(Tests).
 1930message(plunit(blocked(N, Tests))) -->
 1931    [ '~D tests are blocked'-[N] ],
 1932    blocked_tests(Tests).
 1933
 1934blocked_tests(Tests) -->
 1935    { current_test_flag(show_blocked, true) },
 1936    !,
 1937    [':'-[]],
 1938    list_blocked(Tests).
 1939blocked_tests(_) -->
 1940    [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []),
 1941      ' for details)'-[]
 1942    ].
 1943
 1944list_blocked([]) --> !.
 1945list_blocked([blocked(Unit:Test, Pos, Reason)|T]) -->
 1946    [nl],
 1947    locationprefix(Pos),
 1948    test_name(Unit:Test, -),
 1949    [ ': ~w'-[Reason] ],
 1950    list_blocked(T).
 1951
 1952					% fail/success
 1953message(plunit(no_tests)) -->
 1954    !,
 1955    [ 'No tests to run' ].
 1956message(plunit(all_passed(1, 1, Time))) -->
 1957    !,
 1958    [ 'test passed' ],
 1959    test_time(Time).
 1960message(plunit(all_passed(Total, Total, Time))) -->
 1961    !,
 1962    [ 'All ~D tests passed'-[Total] ],
 1963    test_time(Time).
 1964message(plunit(all_passed(Total, Count, Time))) -->
 1965    !,
 1966    { SubTests is Count-Total },
 1967    [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ],
 1968    test_time(Time).
 1969
 1970test_time(Time) -->
 1971    { var(Time) }, !.
 1972test_time(Time) -->
 1973    [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ].
 1974
 1975message(plunit(passed(Count))) -->
 1976    !,
 1977    [ '~D tests passed'-[Count] ].
 1978message(plunit(failed(0))) -->
 1979    !,
 1980    [].
 1981message(plunit(failed(1))) -->
 1982    !,
 1983    [ '1 test failed'-[] ].
 1984message(plunit(failed(N))) -->
 1985    [ '~D tests failed'-[N] ].
 1986message(plunit(timeout(0))) -->
 1987    !,
 1988    [].
 1989message(plunit(timeout(N))) -->
 1990    [ '~D tests timed out'-[N] ].
 1991message(plunit(fixme(0,0,0))) -->
 1992    [].
 1993message(plunit(fixme(Failed,0,0))) -->
 1994    !,
 1995    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1996message(plunit(fixme(Failed,Passed,0))) -->
 1997    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1998message(plunit(fixme(Failed,Passed,Nondet))) -->
 1999    { TotalPassed is Passed+Nondet },
 2000    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 2001      [Failed, TotalPassed, Nondet] ].
 2002
 2003message(plunit(begin(Unit:Test, _Location, Progress))) -->
 2004    { tty_columns(SummaryWidth, _Margin),
 2005      test_name_summary(Unit:Test, SummaryWidth, NameS),
 2006      progress_string(Progress, ProgressS)
 2007    },
 2008    (   { tty_feedback,
 2009	  tty_clear_to_eol(CE)
 2010	}
 2011    ->  [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS,
 2012					     CE], flush ]
 2013    ;   { jobs(_) }
 2014    ->  [ '[~w] ~w ..'-[ProgressS, NameS] ]
 2015    ;   [ '[~w] ~w ..'-[ProgressS, NameS], flush ]
 2016    ).
 2017message(plunit(end(_UnitTest, _Location, _Progress))) -->
 2018    [].
 2019message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
 2020    { Status = forall(_Gen,_NthI)
 2021    ; Status == assertion
 2022    },
 2023    !.
 2024message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
 2025    { jobs(_),
 2026      !,
 2027      tty_columns(SummaryWidth, Margin),
 2028      test_name_summary(Unit:Test, SummaryWidth, NameS),
 2029      progress_string(Progress, ProgressS),
 2030      progress_tag(Status, Tag, _Keep, Style)
 2031    },
 2032    [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|',
 2033	   [ProgressS, NameS, Tag, Time.wall, Margin]) ].
 2034message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
 2035    { tty_columns(_SummaryWidth, Margin),
 2036      progress_tag(Status, Tag, _Keep, Style)
 2037    },
 2038    [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
 2039			 [Tag, Time.wall, Margin]) ],
 2040    (   { tty_feedback }
 2041    ->  [flush]
 2042    ;   []
 2043    ).
 2044message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
 2045    { unit_file(Unit, File) },
 2046    locationprefix(File:Line),
 2047    test_name(Unit:Test, Progress),
 2048    [': '-[] ],
 2049    failure(Failure),
 2050    test_output(Output).
 2051message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
 2052    { unit_file(Unit, File) },
 2053    locationprefix(File:Line),
 2054    test_name(Unit:Test, Progress),
 2055    [': '-[] ],
 2056    timeout(Limit),
 2057    test_output(Output).
 2058:- if(swi). 2059message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
 2060				Progress, Reason, Goal))) -->
 2061    { unit_file(Unit, File) },
 2062    locationprefix(File:Line),
 2063    test_name(Unit:Test, Progress),
 2064    [ ': assertion'-[] ],
 2065    assertion_location(AssertLoc, File),
 2066    assertion_reason(Reason), ['\n\t'],
 2067    assertion_goal(Unit, Goal).
 2068
 2069assertion_location(File:Line, File) -->
 2070    [ ' at line ~w'-[Line] ].
 2071assertion_location(File:Line, _) -->
 2072    [ ' at ', url(File:Line) ].
 2073assertion_location(unknown, _) -->
 2074    [].
 2075
 2076assertion_reason(fail) -->
 2077    !,
 2078    [ ' failed'-[] ].
 2079assertion_reason(Error) -->
 2080    { message_to_string(Error, String) },
 2081    [ ' raised "~w"'-[String] ].
 2082
 2083assertion_goal(Unit, Goal) -->
 2084    { unit_module(Unit, Module),
 2085      unqualify(Goal, Module, Plain)
 2086    },
 2087    [ 'Assertion: ~p'-[Plain] ].
 2088
 2089unqualify(Var, _, Var) :-
 2090    var(Var),
 2091    !.
 2092unqualify(M:Goal, Unit, Goal) :-
 2093    nonvar(M),
 2094    unit_module(Unit, M),
 2095    !.
 2096unqualify(M:Goal, _, Goal) :-
 2097    callable(Goal),
 2098    predicate_property(M:Goal, imported_from(system)),
 2099    !.
 2100unqualify(Goal, _, Goal).
 2101
 2102test_output(Msgs-String) -->
 2103    { nonvar(Msgs) },
 2104    !,
 2105    test_output(String).
 2106test_output("") --> [].
 2107test_output(Output) -->
 2108    [ ansi(code, '~N~s', [Output]) ].
 2109
 2110:- endif. 2111					% Setup/condition errors
 2112message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
 2113    locationprefix(Context),
 2114    { message_to_string(Exception, String) },
 2115    [ 'error in ~w: ~w'-[Where, String] ].
 2116message(plunit(error(Where, Context, _Output, false))) -->
 2117    locationprefix(Context),
 2118    [ 'setup failed in ~w'-[Where] ].
 2119
 2120                                        % delayed output
 2121message(plunit(test_output(_, Output))) -->
 2122    [ '~s'-[Output] ].
 2123					% Interrupts (SWI)
 2124:- if(swi). 2125message(interrupt(begin)) -->
 2126    { thread_self(Me),
 2127      running(Unit, Test, Line, Progress, Me),
 2128      !,
 2129      unit_file(Unit, File),
 2130      restore_output_state
 2131    },
 2132    [ 'Interrupted test '-[] ],
 2133    running(running(Unit:Test, File:Line, Progress, Me)),
 2134    [nl],
 2135    '$messages':prolog_message(interrupt(begin)).
 2136message(interrupt(begin)) -->
 2137    '$messages':prolog_message(interrupt(begin)).
 2138:- endif. 2139
 2140message(concurrent) -->
 2141    [ 'concurrent(true) at the level of units is currently ignored.', nl,
 2142      'See set_test_options/1 with jobs(Count) for concurrent testing.'
 2143    ].
 2144
 2145test_name(Name, forall(Generator, _Nth-I)/_Total) -->
 2146    !,
 2147    test_name(Name, -),
 2148    [ ' (~d-th forall generator = '-[I],
 2149      ansi(code, '~p', [Generator]), ')'-[]
 2150    ].
 2151test_name(Name, _) -->
 2152    !,
 2153    [ 'test ', ansi(code, '~q', [Name]) ].
 2154
 2155running(running(Unit:Test, File:Line, _Progress, Thread)) -->
 2156    thread(Thread),
 2157    [ '~q:~q at '-[Unit, Test], url(File:Line) ].
 2158running([H|T]) -->
 2159    ['\t'], running(H),
 2160    (   {T == []}
 2161    ->  []
 2162    ;   [nl], running(T)
 2163    ).
 2164
 2165thread(main) --> !.
 2166thread(Other) -->
 2167    [' [~w] '-[Other] ].
 2168
 2169:- if(swi). 2170write_term(T, OPS) -->
 2171    ['~W'-[T,OPS] ].
 2172:- else. 2173write_term(T, _OPS) -->
 2174    ['~q'-[T]].
 2175:- endif. 2176
 2177expected_got_ops_(Ex, E, OPS, Goals) -->
 2178    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 2179    ['    Got:      '-[]], write_term(E,  OPS), [],
 2180    ( { Goals = [] } -> []
 2181    ; [nl, '       with: '-[]], write_term(Goals, OPS), []
 2182    ).
 2183
 2184
 2185failure(List) -->
 2186    { is_list(List) },
 2187    !,
 2188    [ nl ],
 2189    failures(List).
 2190failure(Var) -->
 2191    { var(Var) },
 2192    !,
 2193    [ 'Unknown failure?' ].
 2194failure(succeeded(Time)) -->
 2195    !,
 2196    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 2197failure(wrong_error(Expected, Error)) -->
 2198    !,
 2199    { copy_term(Expected-Error, Ex-E, Goals),
 2200      numbervars(Ex-E-Goals, 0, _),
 2201      write_options(OPS)
 2202    },
 2203    [ 'wrong error'-[], nl ],
 2204    expected_got_ops_(Ex, E, OPS, Goals).
 2205failure(wrong_answer(cmp(Var, Cmp))) -->
 2206    { Cmp =.. [Op,Answer,Expected],
 2207      !,
 2208      copy_term(Expected-Answer, Ex-A, Goals),
 2209      numbervars(Ex-A-Goals, 0, _),
 2210      write_options(OPS)
 2211    },
 2212    [ 'wrong answer for ', ansi(code, '~w', [Var]),
 2213      ' (compared using ~w)'-[Op], nl ],
 2214    expected_got_ops_(Ex, A, OPS, Goals).
 2215failure(wrong_answer(Cmp)) -->
 2216    { Cmp =.. [Op,Answer,Expected],
 2217      !,
 2218      copy_term(Expected-Answer, Ex-A, Goals),
 2219      numbervars(Ex-A-Goals, 0, _),
 2220      write_options(OPS)
 2221    },
 2222    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 2223    expected_got_ops_(Ex, A, OPS, Goals).
 2224failure(wrong_answer(CmpExpected, Bindings)) -->
 2225    { (   CmpExpected = all(Cmp)
 2226      ->  Cmp =.. [_Op1,_,Expected],
 2227	  Got = Bindings,
 2228	  Type = all
 2229      ;   CmpExpected = set(Cmp),
 2230	  Cmp =.. [_Op2,_,Expected0],
 2231	  sort(Expected0, Expected),
 2232	  sort(Bindings, Got),
 2233	  Type = set
 2234      )
 2235    },
 2236    [ 'wrong "~w" answer:'-[Type] ],
 2237    [ nl, '    Expected: ~q'-[Expected] ],
 2238    [ nl, '       Found: ~q'-[Got] ].
 2239:- if(swi). 2240failure(cmp_error(_Cmp, Error)) -->
 2241    { message_to_string(Error, Message) },
 2242    [ 'Comparison error: ~w'-[Message] ].
 2243failure(throw(Error)) -->
 2244    { Error = error(_,_),
 2245      !,
 2246      message_to_string(Error, Message)
 2247    },
 2248    [ 'received error: ~w'-[Message] ].
 2249:- endif. 2250failure(message) -->
 2251    !,
 2252    [ 'Generated unexpected warning or error'-[] ].
 2253failure(setup_failed(throw(Error))) -->
 2254    { Error = error(_,_),
 2255      !,
 2256      message_to_string(Error, Message)
 2257    },
 2258    [ 'test setup goal raised error: ~w'-[Message] ].
 2259failure(setup_failed(_)) -->
 2260    !,
 2261    [ 'test setup goal failed' ].
 2262failure(Why) -->
 2263    [ '~p'-[Why] ].
 2264
 2265failures([]) -->
 2266    !.
 2267failures([H|T]) -->
 2268    !,
 2269    failure(H), [nl],
 2270    failures(T).
 2271
 2272timeout(Limit) -->
 2273    [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
 2274
 2275fixme_message([]) --> [].
 2276fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 2277    { unit_file(Unit, File) },
 2278    fixme_message(File:Line, Reason, How),
 2279    (   {T == []}
 2280    ->  []
 2281    ;   [nl],
 2282	fixme_message(T)
 2283    ).
 2284
 2285fixme_message(Location, Reason, failed) -->
 2286    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 2287fixme_message(Location, Reason, passed) -->
 2288    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 2289fixme_message(Location, Reason, nondet) -->
 2290    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 2291
 2292
 2293write_options([ numbervars(true),
 2294		quoted(true),
 2295		portray(true),
 2296		max_depth(100),
 2297		attributes(portray)
 2298	      ]).
 2299
 2300%!  test_name_summary(+Term, +MaxLen, -Summary) is det.
 2301%
 2302%   Given the test id, generate  string that summarizes this in MaxLen
 2303%   characters.
 2304
 2305test_name_summary(Term, MaxLen, Summary) :-
 2306    summary_string(Term, Text),
 2307    atom_length(Text, Len),
 2308    (   Len =< MaxLen
 2309    ->  Summary = Text
 2310    ;   End is MaxLen//2,
 2311        Pre is MaxLen - End - 2,
 2312        sub_string(Text, 0, Pre, _, PreText),
 2313        sub_string(Text, _, End, 0, PostText),
 2314        format(string(Summary), '~w..~w', [PreText,PostText])
 2315    ).
 2316
 2317summary_string(Unit:Test, String) =>
 2318    summary_string(Test, String1),
 2319    atomics_to_string([Unit, String1], :, String).
 2320summary_string(@(Name,Vars), String) =>
 2321    format(string(String), '~W (using ~W)',
 2322           [ Name, [numbervars(true), quoted(false)],
 2323             Vars, [numbervars(true), portray(true), quoted(true)]
 2324           ]).
 2325summary_string(Name, String) =>
 2326    term_string(Name, String, [numbervars(true), quoted(false)]).
 2327
 2328%!  progress_string(+Progress, -S) is det.
 2329%
 2330%   True when S is a string representation for the test progress.
 2331
 2332progress_string(forall(_Vars, N-I)/Total, S) =>
 2333    format(string(S), '~w-~w/~w', [N,I,Total]).
 2334progress_string(Progress, S) =>
 2335    term_string(Progress, S).
 2336
 2337%!  progress_tag(+Status, -Tag, -Keep, -Style) is det.
 2338%
 2339%   Given a progress status, determine the status tag, whether we must
 2340%   preserve the  line and the Style  we must use to  print the status
 2341%   line.
 2342
 2343progress_tag(passed,        Tag, Keep, Style) =>
 2344    Tag = passed, Keep = false, Style = comment.
 2345progress_tag(fixme(passed), Tag, Keep, Style) =>
 2346    Tag = passed, Keep = false, Style = comment.
 2347progress_tag(fixme(_),      Tag, Keep, Style) =>
 2348    Tag = fixme, Keep = true, Style = warning.
 2349progress_tag(nondet,        Tag, Keep, Style) =>
 2350    Tag = '**NONDET', Keep = true, Style = warning.
 2351progress_tag(timeout(_Limit), Tag, Keep, Style) =>
 2352    Tag = '**TIMEOUT', Keep = true, Style = warning.
 2353progress_tag(assertion,     Tag, Keep, Style) =>
 2354    Tag = '**FAILED', Keep = true, Style = error.
 2355progress_tag(failed,        Tag, Keep, Style) =>
 2356    Tag = '**FAILED', Keep = true, Style = error.
 2357progress_tag(forall(_,0),   Tag, Keep, Style) =>
 2358    Tag = passed, Keep = false, Style = comment.
 2359progress_tag(forall(_,_),   Tag, Keep, Style) =>
 2360    Tag = '**FAILED', Keep = true, Style = error.
 2361
 2362
 2363		 /*******************************
 2364		 *           OUTPUT		*
 2365		 *******************************/
 2366
 2367save_output_state :-
 2368    stream_property(Output, alias(user_output)),
 2369    stream_property(Error, alias(user_error)),
 2370    asserta(output_streams(Output, Error)).
 2371
 2372restore_output_state :-
 2373    output_streams(Output, Error),
 2374    !,
 2375    set_stream(Output, alias(user_output)),
 2376    set_stream(Error, alias(user_error)).
 2377restore_output_state.
 2378
 2379
 2380
 2381		 /*******************************
 2382		 *      CONCURRENT STATUS       *
 2383		 *******************************/
 2384
 2385/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 2386This part deals with interactive feedback   when we are running multiple
 2387threads. The terminal window cannot work on   top  of the Prolog message
 2388infrastructure and (thus) we have to use more low-level means.
 2389- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 2390
 2391:- dynamic
 2392       jobs/1,			% Count
 2393       job_window/1,		% Count
 2394       job_status_line/3.	% Job, Format, Args
 2395
 2396job_feedback(_, jobs(Jobs)) :-
 2397    retractall(jobs(_)),
 2398    Jobs > 1,
 2399    asserta(jobs(Jobs)),
 2400    tty_feedback,
 2401    !,
 2402    retractall(job_window(_)),
 2403    asserta(job_window(Jobs)),
 2404    retractall(job_status_line(_,_,_)),
 2405    jobs_redraw.
 2406job_feedback(_, jobs(Jobs)) :-
 2407    !,
 2408    retractall(job_window(_)),
 2409    info(plunit(jobs(Jobs))).
 2410job_feedback(_, Msg) :-
 2411    job_window(_),
 2412    !,
 2413    with_mutex(plunit_feedback, job_feedback(Msg)).
 2414job_feedback(Level, Msg) :-
 2415    print_message(Level, plunit(Msg)).
 2416
 2417job_feedback(begin(Unit:Test, _Location, Progress)) =>
 2418    tty_columns(SummaryWidth, _Margin),
 2419    test_name_summary(Unit:Test, SummaryWidth, NameS),
 2420    progress_string(Progress, ProgressS),
 2421    tty_clear_to_eol(CE),
 2422    job_format(comment, '\r[~w] ~w ..~w',
 2423	       [ProgressS, NameS, CE]),
 2424    flush_output.
 2425job_feedback(end(_UnitTest, _Location, _Progress)) =>
 2426    true.
 2427job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
 2428    (   hide_progress(Status)
 2429    ->  true
 2430    ;   tty_columns(_SummaryWidth, Margin),
 2431	progress_tag(Status, Tag, _Keep, Style),
 2432	job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2433		   [Tag, Time.wall, Margin])
 2434    ).
 2435job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
 2436    tty_columns(_SummaryWidth, Margin),
 2437    progress_tag(failed, Tag, _Keep, Style),
 2438    job_finish(Style, '~`.t ~w (~3f sec)~*|',
 2439	       [Tag, Time.wall, Margin]),
 2440    print_test_output(Error, Output),
 2441    (   (   Error = timeout(_)	% Status line suffices
 2442	;   Error == assertion	% We will get an failed test later
 2443	)
 2444    ->  true
 2445    ;   print_message(Style, plunit(failed(UnitTest, Progress, Line,
 2446					   Error, Time, "")))
 2447    ),
 2448    jobs_redraw.
 2449job_feedback(begin(_Unit)) => true.
 2450job_feedback(end(_Unit, _Summary)) => true.
 2451
 2452hide_progress(assertion).
 2453hide_progress(forall(_,_)).
 2454hide_progress(failed).
 2455hide_progress(timeout(_)).
 2456
 2457print_test_output(Error, _Msgs-Output) =>
 2458    print_test_output(Error, Output).
 2459print_test_output(_, "") => true.
 2460print_test_output(assertion, Output) =>
 2461    print_message(debug, plunit(test_output(error, Output))).
 2462print_test_output(message, Output) =>
 2463    print_message(debug, plunit(test_output(error, Output))).
 2464print_test_output(_, Output) =>
 2465    print_message(debug, plunit(test_output(informational, Output))).
 2466
 2467%!  jobs_redraw is det.
 2468%
 2469%   Redraw the job window.
 2470
 2471jobs_redraw :-
 2472    job_window(N),
 2473    !,
 2474    tty_columns(_, Width),
 2475    tty_header_line(Width),
 2476    forall(between(1,N,Line), job_redraw_worker(Line)),
 2477    tty_header_line(Width).
 2478jobs_redraw.
 2479
 2480job_redraw_worker(Line) :-
 2481    (   job_status_line(Line, Fmt, Args)
 2482    ->  ansi_format(comment, Fmt, Args)
 2483    ;   true
 2484    ),
 2485    nl.
 2486
 2487%!  job_format(+Style, +Fmt, +Args) is det.
 2488%!  job_format(+Job, +Style, +Fmt, +Args, +Save) is det.
 2489%
 2490%   Point should be  below the status window.  Format  Fmt+Args in the
 2491%   line Job using Style and return to the position below the window.
 2492
 2493job_format(Style, Fmt, Args) :-
 2494    job_self(Job),
 2495    job_format(Job, Style, Fmt, Args, true).
 2496
 2497%!  job_finish(+Style, +Fmt, +Args) is det.
 2498%!  job_finish(+Job, +Style, +Fmt, +Args) is det.
 2499%
 2500%   Complete  the status  line  for Job.   This  redraws the  original
 2501%   status line when we are using a job window.
 2502
 2503job_finish(Style, Fmt, Args) :-
 2504    job_self(Job),
 2505    job_finish(Job, Style, Fmt, Args).
 2506
 2507:- det(job_finish/4). 2508job_finish(Job, Style, Fmt, Args) :-
 2509    retract(job_status_line(Job, Fmt0, Args0)),
 2510    !,
 2511    string_concat(Fmt0, Fmt, Fmt1),
 2512    append(Args0, Args, Args1),
 2513    job_format(Job, Style, Fmt1, Args1, false).
 2514
 2515:- det(job_format/5). 2516job_format(Job, Style, Fmt, Args, Save) :-
 2517    job_window(Jobs),
 2518    Up is Jobs+2-Job,
 2519    flush_output(user_output),
 2520    tty_up_and_clear(Up),
 2521    ansi_format(Style, Fmt, Args),
 2522    (   Save == true
 2523    ->  retractall(job_status_line(Job, _, _)),
 2524	asserta(job_status_line(Job, Fmt, Args))
 2525    ;   true
 2526    ),
 2527    tty_down_and_home(Up),
 2528    flush_output(user_output).
 2529
 2530:- det(job_self/1). 2531job_self(Job) :-
 2532    job_window(N),
 2533    N > 1,
 2534    thread_self(Me),
 2535    split_string(Me, '_', '', [_,_,S]),
 2536    number_string(Job, S).
 2537
 2538%!  feedback is semidet.
 2539%
 2540%   provide feedback using the `tty`  format, which reuses the current
 2541%   output line if the test is successful.
 2542
 2543tty_feedback :-
 2544    has_tty,
 2545    current_test_flag(format, tty).
 2546
 2547has_tty :-
 2548    stream_property(user_output, tty(true)).
 2549
 2550tty_columns(SummaryWidth, Margin) :-
 2551    tty_width(W),
 2552    Margin is W-8,
 2553    SummaryWidth is max(20,Margin-34).
 2554
 2555tty_width(W) :-
 2556    current_predicate(tty_size/2),
 2557    catch(tty_size(_Rows, Cols), error(_,_), fail),
 2558    Cols > 25,
 2559    !,
 2560    W = Cols.
 2561tty_width(80).
 2562
 2563tty_header_line(Width) :-
 2564    ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
 2565
 2566:- if(current_predicate(tty_get_capability/3)). 2567tty_clear_to_eol(S) :-
 2568    getenv('TERM', _),
 2569    catch(tty_get_capability(ce, string, S),
 2570          error(_,_),
 2571          fail),
 2572    !.
 2573:- endif. 2574tty_clear_to_eol('\e[K').
 2575
 2576tty_up_and_clear(Lines) :-
 2577    format(user_output, '\e[~dA\r\e[K', [Lines]).
 2578
 2579tty_down_and_home(Lines) :-
 2580    format(user_output, '\e[~dB\r', [Lines]).
 2581
 2582:- if(swi). 2583
 2584:- multifile
 2585    prolog:message/3,
 2586    user:message_hook/3. 2587
 2588prolog:message(Term) -->
 2589    message(Term).
 2590
 2591%       user:message_hook(+Term, +Kind, +Lines)
 2592
 2593user:message_hook(make(done(Files)), _, _) :-
 2594    make_run_tests(Files),
 2595    fail.                           % give other hooks a chance
 2596
 2597:- endif. 2598
 2599:- if(sicstus). 2600
 2601user:generate_message_hook(Message) -->
 2602    message(Message),
 2603    [nl].                           % SICStus requires nl at the end
 2604
 2605%!  user:message_hook(+Severity, +Message, +Lines) is semidet.
 2606%
 2607%   Redefine printing some messages. It appears   SICStus has no way
 2608%   to get multiple messages at the same   line, so we roll our own.
 2609%   As there is a lot pre-wired and   checked in the SICStus message
 2610%   handling we cannot reuse the lines. Unless I miss something ...
 2611
 2612user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 2613    format(user_error, '% PL-Unit: ~w ', [Unit]),
 2614    flush_output(user_error).
 2615user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 2616    format(user, ' done~n', []).
 2617
 2618:- endif.