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