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	  ]).

   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.

 set_test_options(+Options)

Specifies how to deal with test suites. Defined options are:

load +Load

Whether or not the tests must be loaded. Values are never, always, normal (only if not optimised)

run(+When)

When the tests are run. Values are manual, make or make(all).

format(+Mode)

Currently one of tty or log. tty uses terminal control to overwrite successful tests, allowing the user to see the currently running tests and output from failed tests. This is the default of the output is a tty. log prints a full log of the executed tests and their result and is intended for non-interactive usage.

output(+When)

If always, emit all output as it is produced, if never, suppress all output and if on_failure, emit the output if the test fails.

show_blocked(+Bool)

Show individual blocked tests during the report.

occurs_check(+Mode)

Defines the default for the occurs_check flag during testing.

cleanup(+Bool)

If true (default =false), cleanup report at the end of run_tests/1. Used to improve cooperation with memory debuggers such as dmalloc.

jobs(Num)

Number of jobs to use for concurrent testing. Default is one, implying sequential testing.

timeout(+Seconds)

Set timeout for each individual test. This acts as a default that may be overuled at the level of units or individual tests. A timeout of 0 or negative is handled as inifinite.

  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).

 loading_tests

True if tests must be loaded.

  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

 begin_tests(+UnitName:atom) is det

 begin_tests(+UnitName:atom, Options) is det

Start a test-unit. UnitName is the name of the test set. the unit is ended by :- end_tests(UnitName).

  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.

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  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, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  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		 *******************************/

 expand_test(+Name, +Options, +Body, -Clause) is det

Expand test(Name, Options) :- Body into a clause for 'unit test'/4 and 'unit body'/2.

  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(_)).

 expand(+Term, -Clauses) is semidet

  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		 *******************************/

 valid_options(:Pred, +Options) is det

Verify Options to be a list of valid options according to Pred.

Errors

- type_error or instantiation_error.

  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).

 test_option(+Option) is semidet

True if Option is a valid option for test(Name, Options).

  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).

 test_option(+Option) is semidet

True if Option is a valid option for :- begin_tests(Name, Options).

  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,-).

 reify_tmo(:Goal, -Result, +Options) is det

  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).

 reify(:Goal, -Result) is det

Call Goal and unify Result with one of true, false or throw(E).

  609reify(Goal, Result) :-
  610    (   catch(Goal, E, true)
  611    ->  (   var(E)
  612	->  Result = true
  613	;   Result = throw(E)
  614	)
  615    ;   Result = false
  616    ).

 capture_output(:Goal, -Output) is semidet

 capture_output(:Goal, -Output, +Options) is semidet

Arguments:

Output

- is a pair Msgs-String, where Msgs is a boolean that is true if there were messages that require a non-zero exit status and Output contains the output as a string.

  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    ).

 got_messages(:Goal, -Result)

  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

 run_tests is semidet

 run_tests(+TestSet) is semidet

 run_tests(+TestSet, +Options) is semidet

Run tests and report about the results. The predicate run_tests/0 runs all known tests that are not blocked. The predicate run_tests/1 takes a specification of tests to run.

The predicate run_tests/2 is synchronized. Concurrent testing may be achieved using the relevant options. See set_test_options/1. Options are passed to set_test_options/1. In addition the following options are processed:

summary(-Summary)

Unify Summary do a dict holding the keys below. The value of these keys is an integer describing the number of tests. If this option is given, run_tests/2 does not fail if some tests failed.

• total
• passed
• failed
• timeout
• blocked

Arguments:

TestSet

- is either a single specification or a list of specifications. Each single specification is either the name of a test-unit or a term <test-unit>:<test>, denoting a single test within a unit. If TestSet is all, all known tests are executed.

  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_jobs(Count),
  742	setup_call_cleanup(
  743	    setup_trap_assertions(Ref),
  744	    ( call_time(run_units(Units, Options), Time),
  745              test_summary(_All, Summary)
  746            ),
  747	    report_and_cleanup(Ref, Time, Options)),
  748	cleanup_jobs),
  749    (   option(summary(Summary), Options)
  750    ->  true
  751    ;   test_summary_passed(Summary) % fail if some test failed
  752    ).

 report_and_cleanup(+Ref, +Time, +Options)

Undo changes to the environment (trapping assertions), report the results and cleanup.

  759report_and_cleanup(Ref, Time, Options) :-
  760    cleanup_trap_assertions(Ref),
  761    report(Time, Options),
  762    cleanup_after_test.

 run_units_and_check_errors(+Units, +Options) is semidet

Run all test units and succeed if all tests passed.

  769run_units(Units, _Options) :-
  770    maplist(schedule_unit, Units),
  771    job_wait(_).

 runnable_tests(+Spec, -Plan) is det

Change a Unit+Test spec into a plain Unit:Tests lists, where blocked tests or tests whose condition fails are already removed. Each test in Tests is a term @(Test,Line), which serves as a unique identifier of the test.

  780:- det(runnable_tests/2).  781runnable_tests(Spec, Unit:RunnableTests) :-
  782    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  783    (   option(blocked(Reason), UnitOptions)
  784    ->  info(plunit(blocked(unit(Unit, Reason)))),
  785        RunnableTests = []
  786    ;   \+ condition(Module, unit(Unit), UnitOptions)
  787    ->  RunnableTests = []
  788    ;   var(Tests)
  789    ->  findall(TestID,
  790                runnable_test(Unit, _Test, Module, TestID),
  791                RunnableTests)
  792    ;   flatten([Tests], TestList),
  793        findall(TestID,
  794                ( member(Test, TestList),
  795                  runnable_test(Unit,Test,Module, TestID)
  796                ),
  797                RunnableTests)
  798    ).
  799
  800runnable_test(Unit, Name, Module, @(Test,Line)) :-
  801    current_test(Unit, Name, Line, _Body, TestOptions),
  802    (   option(blocked(Reason), TestOptions)
  803    ->  Test = blocked(Name, Reason)
  804    ;   condition(Module, test(Unit,Name,Line), TestOptions),
  805        Test = Name
  806    ).
  807
  808unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
  809    Unit = Unit0,
  810    Tests = Tests0,
  811    (   current_unit(Unit, Module, _Supers, Options)
  812    ->  true
  813    ;   throw_error(existence_error(unit_test, Unit), _)
  814    ).
  815unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
  816    Unit = Unit0,
  817    (   current_unit(Unit, Module, _Supers, Options)
  818    ->  true
  819    ;   throw_error(existence_error(unit_test, Unit), _)
  820    ).

 count_tests(+Units0, -Units, -Count) is det

Count the number of tests to run. A forall(Generator, Test) counts as a single test. During the execution, the concrete tests of the forall are considered "sub tests".

  828count_tests(Units0, Units, Count) :-
  829    count_tests(Units0, Units, 0, Count).
  830
  831count_tests([], T, C0, C) =>
  832    T = [],
  833    C = C0.
  834count_tests([_:[]|T0], T, C0, C) =>
  835    count_tests(T0, T, C0, C).
  836count_tests([Unit:Tests|T0], T, C0, C) =>
  837    partition(is_blocked, Tests, Blocked, Use),
  838    maplist(assert_blocked(Unit), Blocked),
  839    (   Use == []
  840    ->  count_tests(T0, T, C0, C)
  841    ;   length(Use, N),
  842        C1 is C0+N,
  843        T = [Unit:Use|T1],
  844        count_tests(T0, T1, C1, C)
  845    ).
  846
  847is_blocked(@(blocked(_,_),_)) => true.
  848is_blocked(_) => fail.
  849
  850assert_blocked(Unit, @(blocked(Test, Reason), Line)) =>
  851    assert(blocked(Unit, Test, Line, Reason)).

 run_unit(+Unit) is det

Run a single test unit. Unit is a term Unit:Tests, where Tests is a list of tests to run.

  858run_unit(_Unit:[]) =>
  859    true.
  860run_unit(Unit:Tests) =>
  861    unit_module(Unit, Module),
  862    unit_options(Unit, UnitOptions),
  863    (   setup(Module, unit(Unit), UnitOptions)
  864    ->  begin_unit(Unit),
  865        call_time(run_unit_2(Unit, Tests), Time),
  866        test_summary(Unit, Summary),
  867	end_unit(Unit, Summary.put(time, Time)),
  868        cleanup(Module, UnitOptions)
  869    ;   job_info(end(unit(Unit, _{error:setup_failed})))
  870    ).
  871
  872begin_unit(Unit) :-
  873    job_info(begin(unit(Unit))),
  874    job_feedback(informational, begin(Unit)).
  875
  876end_unit(Unit, Summary) :-
  877    job_info(end(unit(Unit, Summary))),
  878    job_feedback(informational, end(Unit, Summary)).
  879
  880run_unit_2(Unit, Tests) :-
  881    forall(member(Test, Tests),
  882	   run_test(Unit, Test)).
  883
  884
  885unit_options(Unit, Options) :-
  886    current_unit(Unit, _Module, _Supers, Options).
  887
  888
  889cleanup :-
  890    set_flag(plunit_test, 1),
  891    retractall(output_streams(_,_)),
  892    retractall(test_count(_)),
  893    retractall(passed(_, _, _, _, _)),
  894    retractall(failed(_, _, _, _, _)),
  895    retractall(timeout(_, _, _, _, _)),
  896    retractall(failed_assertion(_, _, _, _, _, _, _)),
  897    retractall(blocked(_, _, _, _)),
  898    retractall(fixme(_, _, _, _, _)),
  899    retractall(running(_,_,_,_,_)),
  900    retractall(forall_failures(_,_)).
  901
  902cleanup_after_test :-
  903    (   current_test_flag(cleanup, true)
  904    ->  cleanup
  905    ;   true
  906    ).

 run_tests_in_files(+Files:list) is det

Run all test-units that appear in the given Files.

  913run_tests_in_files(Files) :-
  914    findall(Unit, unit_in_files(Files, Unit), Units),
  915    (   Units == []
  916    ->  true
  917    ;   run_tests(Units)
  918    ).
  919
  920unit_in_files(Files, Unit) :-
  921    is_list(Files),
  922    !,
  923    member(F, Files),
  924    absolute_file_name(F, Source,
  925		       [ file_type(prolog),
  926			 access(read),
  927			 file_errors(fail)
  928		       ]),
  929    unit_file(Unit, Source).
  930
  931
  932		 /*******************************
  933		 *         HOOKING MAKE/0       *
  934		 *******************************/

 make_run_tests(+Files)

Called indirectly from make/0 after Files have been reloaded.

  940make_run_tests(Files) :-
  941    current_test_flag(run, When),
  942    (   When == make
  943    ->  run_tests_in_files(Files)
  944    ;   When == make(all)
  945    ->  run_tests
  946    ;   true
  947    ).
  948
  949		 /*******************************
  950		 *      ASSERTION HANDLING      *
  951		 *******************************/
  952
  953:- if(swi).  954
  955:- dynamic prolog:assertion_failed/2.  956
  957setup_trap_assertions(Ref) :-
  958    asserta((prolog:assertion_failed(Reason, Goal) :-
  959		    test_assertion_failed(Reason, Goal)),
  960	    Ref).
  961
  962cleanup_trap_assertions(Ref) :-
  963    erase(Ref).
  964
  965test_assertion_failed(Reason, Goal) :-
  966    thread_self(Me),
  967    running(Unit, Test, Line, Progress, Me),
  968    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  969	assertion_location(Stack, AssertLoc)
  970    ->  true
  971    ;   AssertLoc = unknown
  972    ),
  973    report_failed_assertion(Unit:Test, Line, AssertLoc,
  974			    Progress, Reason, Goal),
  975    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  976				   Progress, Reason, Goal)).
  977
  978assertion_location(Stack, File:Line) :-
  979    append(_, [AssertFrame,CallerFrame|_], Stack),
  980    prolog_stack_frame_property(AssertFrame,
  981				predicate(prolog_debug:assertion/1)),
  982    !,
  983    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  984
  985report_failed_assertion(UnitTest, Line, AssertLoc,
  986			Progress, Reason, Goal) :-
  987    print_message(
  988	error,
  989	plunit(failed_assertion(UnitTest, Line, AssertLoc,
  990				Progress, Reason, Goal))).
  991
  992:- else.  993
  994setup_trap_assertions(_).
  995cleanup_trap_assertions(_).
  996
  997:- endif.  998
  999
 1000		 /*******************************
 1001		 *         RUNNING A TEST       *
 1002		 *******************************/

 run_test(+Unit, +Test) is det

Run a single test.

 1008run_test(Unit, @(Test,Line)) :-
 1009    unit_module(Unit, Module),
 1010    Module:'unit test'(Test, Line, TestOptions, Body),
 1011    unit_options(Unit, UnitOptions),
 1012    run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).

 run_test(+Unit, +Name, +Line, +UnitOptions, +Options, +Body)

Deals with forall(Generator, Test)

 1018run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1019    option(forall(Generator), Options),
 1020    !,
 1021    unit_module(Unit, Module),
 1022    term_variables(Generator, Vars),
 1023    start_test(Unit, @(Name,Line), Nth),
 1024    State = state(0),
 1025    call_time(forall(Module:Generator,            % may become concurrent
 1026                     (   incr_forall(State, I),
 1027                         run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
 1028                                        UnitOptions, Options, Body)
 1029                     )),
 1030                     Time),
 1031    arg(1, State, Generated),
 1032    progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
 1033run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
 1034    start_test(Unit, @(Name,Line), Nth),
 1035    run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
 1036
 1037start_test(_Unit, _TestID, Nth) :-
 1038    flag(plunit_test, Nth, Nth+1).
 1039
 1040incr_forall(State, I) :-
 1041    arg(1, State, I0),
 1042    I is I0+1,
 1043    nb_setarg(1, State, I).

 run_test_once6(+Unit, +Name, +Progress, +Line, +UnitOptions, +Options, +Body)

Inherit the timeout and occurs_check option (Global -> Unit -> Test).

 1050run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
 1051    current_test_flag(timeout, DefTimeOut),
 1052    current_test_flag(occurs_check, DefOccurs),
 1053    inherit_option(timeout,      Options,  [UnitOptions], DefTimeOut, Options1),
 1054    inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2),
 1055    run_test_once(Unit, Name, Progress, Line, Options2, Body).
 1056
 1057inherit_option(Name, Options0, Chain, Default, Options) :-
 1058    Term =.. [Name,_Value],
 1059    (   option(Term, Options0)
 1060    ->  Options = Options0
 1061    ;   member(Opts, Chain),
 1062        option(Term, Opts)
 1063    ->  Options = [Term|Options0]
 1064    ;   Default == (-)
 1065    ->  Options = Options0
 1066    ;   Opt =.. [Name,Default],
 1067	Options = [Opt|Options0]
 1068    ).

 run_test_once(+Unit, +Name, Progress, +Line, +Options, +Body)

Deal with occurs_check, i.e., running the test multiple times with different unification settings wrt. the occurs check.

 1075run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1076    option(occurs_check(Occurs), Options),
 1077    !,
 1078    begin_test(Unit, Name, Line, Progress),
 1079    current_prolog_flag(occurs_check, Old),
 1080    setup_call_cleanup(
 1081	set_prolog_flag(occurs_check, Occurs),
 1082	capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1083		       Output),
 1084	set_prolog_flag(occurs_check, Old)),
 1085    end_test(Unit, Name, Line, Progress),
 1086    report_result(Result, Progress, Output, Options).
 1087run_test_once(Unit, Name, Progress, Line, Options, Body) :-
 1088    begin_test(Unit, Name, Line, Progress),
 1089    capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
 1090		   Output),
 1091    end_test(Unit, Name, Line, Progress),
 1092    report_result(Result, Progress, Output, Options).

 report_result(+Result, +Progress, +Output, +Options) is det

 1096:- det(report_result/4). 1097report_result(failure(Unit, Name, Line, How, Time),
 1098	      Progress, Output, Options) =>
 1099    failure(Unit, Name, Progress, Line, How, Time, Output, Options).
 1100report_result(success(Unit, Name, Line, Determinism, Time),
 1101	      Progress, Output, Options) =>
 1102    success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
 1103report_result(setup_failed(Unit, Name, Line, Time, Output, Result),
 1104	      Progress, _Output, Options) =>
 1105    failure(Unit, Name, Progress, Line,
 1106            setup_failed(Result), Time, Output, Options).

 run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det

6th step of the tests. Deals with tests that must be ignored (blocked, conditions fails), setup and cleanup at the test level. Result is one of:

failure(Unit, Name, Line, How, Time)

How is one of:

• succeeded
• Exception
• time_limit_exceeded(Limit)
• cmp_error(Cmp, E)
• wrong_answer(Cmp)
• failed
• no_exception
• wrong_error(Expect, E)
• wrong_answer(Expected, Bindings)

success(Unit, Name, Line, Determinism, Time)

setup_failed(Unit, Name, Line)

 1128run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1129    option(setup(Setup), Options),
 1130    !,
 1131    unit_module(Unit, Module),
 1132    capture_output(call_time(reify(call_ex(Module, Setup), SetupResult),
 1133                             Time),
 1134                   Output),
 1135    (   SetupResult == true
 1136    ->  run_test_7(Unit, Name, Line, Options, Body, Result),
 1137        cleanup(Module, Options)
 1138    ;   Result = setup_failed(Unit, Name, Line, Time, Output, SetupResult)
 1139    ).
 1140run_test_6(Unit, Name, Line, Options, Body, Result) :-
 1141    unit_module(Unit, Module),
 1142    run_test_7(Unit, Name, Line, Options, Body, Result),
 1143    cleanup(Module, Options).

 run_test_7(+Unit, +Name, +Line, +Options, :Body, -Result) is det

This step deals with the expected outcome of the test. It runs the actual test and then compares the result to the outcome. There are two main categories: dealing with a single result and all results.

 1152run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1153    option(true(Cmp), Options),			   % expected success
 1154    !,
 1155    unit_module(Unit, Module),
 1156    call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
 1157    (   Result0 == true
 1158    ->  cmp_true(Cmp, Module, CmpResult),
 1159	(   CmpResult == []
 1160	->  Result = success(Unit, Name, Line, Det, Time)
 1161	;   Result = failure(Unit, Name, Line, CmpResult, Time)
 1162	)
 1163    ;   Result0 == false
 1164    ->  Result = failure(Unit, Name, Line, failed, Time)
 1165    ;   Result0 = throw(E2)
 1166    ->  Result = failure(Unit, Name, Line, throw(E2), Time)
 1167    ).
 1168run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1169    option(fail, Options),                         % expected failure
 1170    !,
 1171    unit_module(Unit, Module),
 1172    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1173    (   Result0 == true
 1174    ->  Result = failure(Unit, Name, Line, succeeded, Time)
 1175    ;   Result0 == false
 1176    ->  Result = success(Unit, Name, Line, true, Time)
 1177    ;   Result0 = throw(E)
 1178    ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1179    ).
 1180run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1181    option(throws(Expect), Options),		   % Expected error
 1182    !,
 1183    unit_module(Unit, Module),
 1184    call_time(reify_tmo(Module:Body, Result0, Options), Time),
 1185    (   Result0 == true
 1186    ->  Result = failure(Unit, Name, Line, no_exception, Time)
 1187    ;   Result0 == false
 1188    ->  Result = failure(Unit, Name, Line, failed, Time)
 1189    ;   Result0 = throw(E)
 1190    ->  (   match_error(Expect, E)
 1191        ->  Result = success(Unit, Name, Line, true, Time)
 1192        ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
 1193        )
 1194    ).
 1195run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1196    option(all(Answer), Options),                  % all(Bindings)
 1197    !,
 1198    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
 1199run_test_7(Unit, Name, Line, Options, Body, Result) :-
 1200    option(set(Answer), Options),                  % set(Bindings)
 1201    !,
 1202    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).

 non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)

Run tests on non-deterministic predicates.

 1208nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1209    unit_module(Unit, Module),
 1210    result_vars(Expected, Vars),
 1211    (   call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
 1212                            Result0, Options), Time)
 1213    ->  (   Result0 == true
 1214        ->  (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1215            ->  Result = success(Unit, Name, Line, true, Time)
 1216            ;   Result = failure(Unit, Name, Line,
 1217				 [wrong_answer(Expected, Bindings)], Time)
 1218            )
 1219        ;   Result0 = throw(E)
 1220        ->  Result = failure(Unit, Name, Line, throw(E), Time)
 1221        )
 1222    ).
 1223
 1224cmp_true([], _, L) =>
 1225    L = [].
 1226cmp_true([Cmp|T], Module, L) =>
 1227    E = error(Formal,_),
 1228    cmp_goal(Cmp, Goal),
 1229    (   catch(Module:Goal, E, true)
 1230    ->  (   var(Formal)
 1231	->  cmp_true(T, Module, L)
 1232	;   L = [cmp_error(Cmp,E)|L1],
 1233	    cmp_true(T, Module, L1)
 1234	)
 1235    ;   L = [wrong_answer(Cmp)|L1],
 1236	cmp_true(T, Module, L1)
 1237    ).
 1238
 1239cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
 1240cmp_goal(Expr, Goal) => Goal = Expr.

 result_vars(+Expected, -Vars) is det

Create a term v(V1, ...) containing all variables at the left side of the comparison operator on Expected.

 1248result_vars(Expected, Vars) :-
 1249    arg(1, Expected, CmpOp),
 1250    arg(1, CmpOp, Vars).

 nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet

Compare list/set results for non-deterministic predicates.

bug

- Sort should deal with equivalence on the comparison operator.

To be done

- Properly report errors

 1260nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1261    cmp(Cmp, _Vars, Op, Values),
 1262    cmp_list(Values, Bindings, Op).
 1263nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1264    cmp(Cmp, _Vars, Op, Values0),
 1265    sort(Bindings0, Bindings),
 1266    sort(Values0, Values),
 1267    cmp_list(Values, Bindings, Op).
 1268
 1269cmp_list([], [], _Op).
 1270cmp_list([E0|ET], [V0|VT], Op) :-
 1271    call(Op, E0, V0),
 1272    cmp_list(ET, VT, Op).

 cmp(+CmpTerm, -Left, -Op, -Right) is det

 1276cmp(Var  == Value, Var,  ==, Value).
 1277cmp(Var =:= Value, Var, =:=, Value).
 1278cmp(Var  =  Value, Var,  =,  Value).
 1279:- if(swi). 1280cmp(Var =@= Value, Var, =@=, Value).
 1281:- else. 1282:- if(sicstus). 1283cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1284:- endif. 1285:- endif.

 call_det(:Goal, -Det) is nondet

True if Goal succeeded. Det is unified to true if Goal left no choicepoints and false otherwise.

 1293:- if((swi;sicstus)). 1294call_det(Goal, Det) :-
 1295    call_cleanup(Goal,Det0=true),
 1296    ( var(Det0) -> Det = false ; Det = true ).
 1297:- else. 1298call_det(Goal, true) :-
 1299    call(Goal).
 1300:- endif.

 match_error(+Expected, +Received) is semidet

True if the Received errors matches the expected error. Matching is based on subsumes_term/2.

 1307match_error(Expect, Rec) :-
 1308    subsumes_term(Expect, Rec).

 setup(+Module, +Context, +Options) is semidet

Call the setup handler and fail if it cannot run for some reason. The condition handler is similar, but failing is not considered an error. Context is one of

unit(Unit)

If it is the setup handler for a unit

test(Unit, Name, Line)

If it is the setup handler for a test

 1321setup(Module, Context, Options) :-
 1322    option(setup(Setup), Options),
 1323    !,
 1324    capture_output(reify(call_ex(Module, Setup), Result), Output),
 1325    (   Result == true
 1326    ->  true
 1327    ;   print_message(error,
 1328		      plunit(error(setup, Context, Output, Result))),
 1329	fail
 1330    ).
 1331setup(_,_,_).

 condition(+Module, +Context, +Options) is semidet

Evaluate the test or test unit condition.

 1337condition(Module, Context, Options) :-
 1338    option(condition(Cond), Options),
 1339    !,
 1340    capture_output(reify(call_ex(Module, Cond), Result), Output),
 1341    (   Result == true
 1342    ->  true
 1343    ;   Result == false
 1344    ->  fail
 1345    ;   print_message(error,
 1346		      plunit(error(condition, Context, Output, Result))),
 1347	fail
 1348    ).
 1349condition(_, _, _).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1356call_ex(Module, Goal) :-
 1357    Module:(expand_goal(Goal, GoalEx),
 1358	    GoalEx).

 cleanup(+Module, +Options) is det

Call the cleanup handler and succeed. Failure or error of the cleanup handler is reported, but tests continue normally.

 1365cleanup(Module, Options) :-
 1366    option(cleanup(Cleanup), Options, true),
 1367    (   catch(call_ex(Module, Cleanup), E, true)
 1368    ->  (   var(E)
 1369	->  true
 1370	;   print_message(warning, E)
 1371	)
 1372    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1373    ).
 1374
 1375success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1376    memberchk(fixme(Reason), Options),
 1377    !,
 1378    (   (   Det == true
 1379	;   memberchk(nondet, Options)
 1380	)
 1381    ->  progress(Unit:Name, Progress, fixme(passed), Time),
 1382	Ok = passed
 1383    ;   progress(Unit:Name, Progress, fixme(nondet), Time),
 1384	Ok = nondet
 1385    ),
 1386    flush_output(user_error),
 1387    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1388success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1389    failed_assertion(Unit, Name, Line, _,Progress,_,_),
 1390    !,
 1391    failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
 1392success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
 1393    Output = true-_,
 1394    !,
 1395    failure(Unit, Name, Progress, Line, message, Time, Output, Options).
 1396success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
 1397    assert(passed(Unit, Name, Line, Det, Time)),
 1398    (   (   Det == true
 1399	;   memberchk(nondet, Options)
 1400	)
 1401    ->  progress(Unit:Name, Progress, passed, Time)
 1402    ;   unit_file(Unit, File),
 1403	print_message(warning, plunit(nondet(File, Line, Name)))
 1404    ).

 failure(+Unit, +Name, +Progress, +Line, +How, +Time, +Output, +Options) is det

Test failed. Report the error.

 1411failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
 1412  memberchk(fixme(Reason), Options) =>
 1413    assert(fixme(Unit, Name, Line, Reason, failed)),
 1414    progress(Unit:Name, Progress, fixme(failed), Time).
 1415failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
 1416	Output, Options) =>
 1417    assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
 1418    progress(Unit:Name, Progress, timeout(Limit), Time),
 1419    report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
 1420failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
 1421    assert_cyclic(failed(Unit, Name, Line, E, Time)),
 1422    progress(Unit:Name, Progress, failed, Time),
 1423    report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).

 assert_cyclic(+Term) is det

Assert a possibly cyclic unit clause. Current SWI-Prolog assert/1 does not handle cyclic terms, so we emulate this using the recorded database.

To be done

- Implement cycle-safe assert and remove this.

 1433:- if(swi). 1434assert_cyclic(Term) :-
 1435    acyclic_term(Term),
 1436    !,
 1437    assert(Term).
 1438assert_cyclic(Term) :-
 1439    Term =.. [Functor|Args],
 1440    recorda(cyclic, Args, Id),
 1441    functor(Term, _, Arity),
 1442    length(NewArgs, Arity),
 1443    Head =.. [Functor|NewArgs],
 1444    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1445:- else. 1446:- if(sicstus). 1447:- endif. 1448assert_cyclic(Term) :-
 1449    assert(Term).
 1450:- endif. 1451
 1452
 1453		 /*******************************
 1454		 *             JOBS             *
 1455		 *******************************/
 1456
 1457:- if(current_prolog_flag(threads, true)). 1458
 1459:- dynamic
 1460       job_data/2,		% Queue, Threads
 1461       scheduled_unit/1. 1462
 1463schedule_unit(_:[]) :-
 1464    !.
 1465schedule_unit(UnitAndTests) :-
 1466    UnitAndTests = Unit:_Tests,
 1467    job_data(Queue, _),
 1468    !,
 1469    assertz(scheduled_unit(Unit)),
 1470    thread_send_message(Queue, unit(UnitAndTests)).
 1471schedule_unit(Unit) :-
 1472    run_unit(Unit).

 setup_jobs(+Count) is det

Setup threads for concurrent testing.

 1478setup_jobs(Count) :-
 1479    (   current_test_flag(jobs, Jobs0),
 1480	integer(Jobs0)
 1481    ->  true
 1482    ;   current_prolog_flag(cpu_count, Jobs0)
 1483    ),
 1484    Jobs is min(Count, Jobs0),
 1485    Jobs > 1,
 1486    !,
 1487    message_queue_create(Q, [alias(plunit_jobs)]),
 1488    length(TIDs, Jobs),
 1489    foldl(create_plunit_job(Q), TIDs, 1, _),
 1490    asserta(job_data(Q, TIDs)),
 1491    job_feedback(informational, jobs(Jobs)).
 1492setup_jobs(_) :-
 1493    job_feedback(informational, jobs(1)).
 1494
 1495create_plunit_job(Q, TID, N, N1) :-
 1496    N1 is N + 1,
 1497    atom_concat(plunit_job_, N, Alias),
 1498    thread_create(plunit_job(Q), TID, [alias(Alias)]).
 1499
 1500plunit_job(Queue) :-
 1501    repeat,
 1502    (   catch(thread_get_message(Queue, Job,
 1503				 [ timeout(10)
 1504				 ]),
 1505	      error(_,_), fail)
 1506    ->  job(Job),
 1507	fail
 1508    ;   !
 1509    ).
 1510
 1511job(unit(Unit:Tests)) =>
 1512    run_unit(Unit:Tests).
 1513job(test(Unit, Test)) =>
 1514    run_test(Unit, Test).
 1515
 1516cleanup_jobs :-
 1517    retract(job_data(Queue, TIDSs)),
 1518    !,
 1519    message_queue_destroy(Queue),
 1520    maplist(thread_join, TIDSs).
 1521cleanup_jobs.

 job_wait(?Unit) is det

Wait for all test jobs to finish.

 1527job_wait(Unit) :-
 1528    thread_wait(\+ scheduled_unit(Unit),
 1529		[ wait_preds([scheduled_unit/1]),
 1530		  timeout(1)
 1531		]),
 1532    !.
 1533job_wait(Unit) :-
 1534    job_data(_Queue, TIDs),
 1535    member(TID, TIDs),
 1536    thread_property(TID, status(running)),
 1537    !,
 1538    job_wait(Unit).
 1539job_wait(_).
 1540
 1541
 1542job_info(begin(unit(Unit))) =>
 1543    print_message(silent, plunit(begin(Unit))).
 1544job_info(end(unit(Unit, Summary))) =>
 1545    retractall(scheduled_unit(Unit)),
 1546    print_message(silent, plunit(end(Unit, Summary))).
 1547
 1548:- else.			% No jobs
 1549
 1550schedule_unit(Unit) :-
 1551    run_unit(Unit).
 1552
 1553setup_jobs(_) :-
 1554    print_message(silent, plunit(jobs(1))).
 1555cleanup_jobs.
 1556job_wait(_).
 1557job_info(_).
 1558
 1559:- endif. 1560
 1561
 1562
 1563		 /*******************************
 1564		 *            REPORTING         *
 1565		 *******************************/