View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(plunit,
   37          [ set_test_options/1,         % +Options
   38            begin_tests/1,              % +Name
   39            begin_tests/2,              % +Name, +Options
   40            end_tests/1,                % +Name
   41            run_tests/0,                % Run all tests
   42            run_tests/1,                % Run named test-set
   43            load_test_files/1,          % +Options
   44            running_tests/0,            % Prints currently running test
   45            test_report/1               % +What
   46          ]).

Unit Testing

Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit http://www.swi-prolog.org/pldoc/package/plunit.

author
- Jan Wielemaker
license
- GPL+SWI-exception or Artistic 2.0 */
   57:- autoload(library(apply),[maplist/3,include/3]).   58:- autoload(library(lists),[member/2,append/2]).   59:- autoload(library(option),[option/3,option/2]).   60:- autoload(library(ordsets),[ord_intersection/3]).   61:- autoload(library(pairs),[group_pairs_by_key/2,pairs_values/2]).   62:- autoload(library(error),[must_be/2]).   63
   64:- meta_predicate valid_options(+, 1).   65
   66
   67                 /*******************************
   68                 *    CONDITIONAL COMPILATION   *
   69                 *******************************/
   70
   71:- discontiguous
   72    user:term_expansion/2.   73
   74:- dynamic
   75    include_code/1.   76
   77including :-
   78    include_code(X),
   79    !,
   80    X == true.
   81including.
   82
   83if_expansion((:- if(G)), []) :-
   84    (   including
   85    ->  (   catch(G, E, (print_message(error, E), fail))
   86        ->  asserta(include_code(true))
   87        ;   asserta(include_code(false))
   88        )
   89    ;   asserta(include_code(else_false))
   90    ).
   91if_expansion((:- else), []) :-
   92    (   retract(include_code(X))
   93    ->  (   X == true
   94        ->  X2 = false
   95        ;   X == false
   96        ->  X2 = true
   97        ;   X2 = X
   98        ),
   99        asserta(include_code(X2))
  100    ;   throw_error(context_error(no_if),_)
  101    ).
  102if_expansion((:- endif), []) :-
  103    retract(include_code(_)),
  104    !.
  105
  106if_expansion(_, []) :-
  107    \+ including.
  108
  109user:term_expansion(In, Out) :-
  110    prolog_load_context(module, plunit),
  111    if_expansion(In, Out).
  112
  113swi     :- catch(current_prolog_flag(dialect, swi), _, fail), !.
  114swi     :- catch(current_prolog_flag(dialect, yap), _, fail).
  115sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
  116
  117
  118:- if(swi).  119throw_error(Error_term,Impldef) :-
  120    throw(error(Error_term,context(Impldef,_))).
  121
  122:- set_prolog_flag(generate_debug_info, false).  123current_test_flag(Name, Value) :-
  124    current_prolog_flag(Name, Value).
  125
  126set_test_flag(Name, Value) :-
  127    create_prolog_flag(Name, Value, []).
  128
  129% ensure expansion to avoid tracing
  130goal_expansion(forall(C,A),
  131               \+ (C, \+ A)).
  132goal_expansion(current_module(Module,File),
  133               module_property(Module, file(File))).
  134
  135:- if(current_prolog_flag(dialect, yap)).  136
  137'$set_predicate_attribute'(_, _, _).
  138
  139:- endif.  140:- endif.  141
  142:- if(sicstus).  143throw_error(Error_term,Impldef) :-
  144    throw(error(Error_term,i(Impldef))). % SICStus 3 work around
  145
  146% SWI-Compatibility
  147:- op(700, xfx, =@=).  148
  149'$set_source_module'(_, _).
 current_test_flag(?Name, ?Value) is nondet
Query flags that control the testing process. Emulates SWI-Prologs flags.
  156:- dynamic test_flag/2. % Name, Val
  157
  158current_test_flag(optimise, Val) :-
  159    current_prolog_flag(compiling, Compiling),
  160    (   Compiling == debugcode ; true % TBD: Proper test
  161    ->  Val = false
  162    ;   Val = true
  163    ).
  164current_test_flag(Name, Val) :-
  165    test_flag(Name, Val).
 set_test_flag(+Name, +Value) is det
  170set_test_flag(Name, Val) :-
  171    var(Name),
  172    !,
  173    throw_error(instantiation_error, set_test_flag(Name,Val)).
  174set_test_flag( Name, Val ) :-
  175    retractall(test_flag(Name,_)),
  176    asserta(test_flag(Name, Val)).
  177
  178:- op(1150, fx, thread_local).  179
  180user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :-
  181    prolog_load_context(module, plunit).
  182
  183:- endif.  184
  185                 /*******************************
  186                 *            IMPORTS           *
  187                 *******************************/
  188
  189:- initialization
  190   (   current_test_flag(test_options, _)
  191   ->  true
  192   ;   set_test_flag(test_options,
  193                 [ run(make),       % run tests on make/0
  194                   sto(false)
  195                 ])
  196   ).
 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).
silent(+Bool)
If true (default false), report successful tests using message level silent, only printing errors and warnings.
sto(+Bool)
How to test whether code is subject to occurs check (STO). If false (default), STO is not considered. If true and supported by the hosting Prolog, code is run in all supported unification mode and reported if the results are inconsistent.
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.
  227set_test_options(Options) :-
  228    valid_options(Options, global_test_option),
  229    set_test_flag(test_options, Options).
  230
  231global_test_option(load(Load)) :-
  232    must_be(oneof([never,always,normal]), Load).
  233global_test_option(run(When)) :-
  234    must_be(oneof([manual,make,make(all)]), When).
  235global_test_option(silent(Bool)) :-
  236    must_be(boolean, Bool).
  237global_test_option(sto(Bool)) :-
  238    must_be(boolean, Bool).
  239global_test_option(cleanup(Bool)) :-
  240    must_be(boolean, Bool).
 loading_tests
True if tests must be loaded.
  247loading_tests :-
  248    current_test_flag(test_options, Options),
  249    option(load(Load), Options, normal),
  250    (   Load == always
  251    ->  true
  252    ;   Load == normal,
  253        \+ current_test_flag(optimise, true)
  254    ).
  255
  256                 /*******************************
  257                 *            MODULE            *
  258                 *******************************/
  259
  260:- dynamic
  261    loading_unit/4,                 % Unit, Module, File, OldSource
  262    current_unit/4,                 % Unit, Module, Context, Options
  263    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).
  271begin_tests(Unit) :-
  272    begin_tests(Unit, []).
  273
  274begin_tests(Unit, Options) :-
  275    valid_options(Options, test_set_option),
  276    make_unit_module(Unit, Name),
  277    source_location(File, Line),
  278    begin_tests(Unit, Name, File:Line, Options).
  279
  280:- if(swi).  281begin_tests(Unit, Name, File:Line, Options) :-
  282    loading_tests,
  283    !,
  284    '$set_source_module'(Context, Context),
  285    (   current_unit(Unit, Name, Context, Options)
  286    ->  true
  287    ;   retractall(current_unit(Unit, Name, _, _)),
  288        assert(current_unit(Unit, Name, Context, Options))
  289    ),
  290    '$set_source_module'(Old, Name),
  291    '$declare_module'(Name, test, Context, File, Line, false),
  292    discontiguous(Name:'unit test'/4),
  293    '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
  294    discontiguous(Name:'unit body'/2),
  295    asserta(loading_unit(Unit, Name, File, Old)).
  296begin_tests(Unit, Name, File:_Line, _Options) :-
  297    '$set_source_module'(Old, Old),
  298    asserta(loading_unit(Unit, Name, File, Old)).
  299
  300:- else.  301
  302% we cannot use discontiguous as a goal in SICStus Prolog.
  303
  304user:term_expansion((:- begin_tests(Set)),
  305                    [ (:- begin_tests(Set)),
  306                      (:- discontiguous(test/2)),
  307                      (:- discontiguous('unit body'/2)),
  308                      (:- discontiguous('unit test'/4))
  309                    ]).
  310
  311begin_tests(Unit, Name, File:_Line, Options) :-
  312    loading_tests,
  313    !,
  314    (   current_unit(Unit, Name, _, Options)
  315    ->  true
  316    ;   retractall(current_unit(Unit, Name, _, _)),
  317        assert(current_unit(Unit, Name, -, Options))
  318    ),
  319    asserta(loading_unit(Unit, Name, File, -)).
  320begin_tests(Unit, Name, File:_Line, _Options) :-
  321    asserta(loading_unit(Unit, Name, File, -)).
  322
  323:- endif.
 end_tests(+Name) is det
Close a unit-test module.
To be done
- Run tests/clean module?
- End of file?
  332end_tests(Unit) :-
  333    loading_unit(StartUnit, _, _, _),
  334    !,
  335    (   Unit == StartUnit
  336    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  337        '$set_source_module'(_, Old)
  338    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  339    ).
  340end_tests(Unit) :-
  341    throw_error(context_error(plunit_close(Unit, -)), _).
 make_unit_module(+Name, -ModuleName) is det
 unit_module(+Name, -ModuleName) is det
  346:- if(swi).  347
  348unit_module(Unit, Module) :-
  349    atom_concat('plunit_', Unit, Module).
  350
  351make_unit_module(Unit, Module) :-
  352    unit_module(Unit, Module),
  353    (   current_module(Module),
  354        \+ current_unit(_, Module, _, _),
  355        predicate_property(Module:H, _P),
  356        \+ predicate_property(Module:H, imported_from(_M))
  357    ->  throw_error(permission_error(create, plunit, Unit),
  358                    'Existing module')
  359    ;  true
  360    ).
  361
  362:- else.  363
  364:- dynamic
  365    unit_module_store/2.  366
  367unit_module(Unit, Module) :-
  368    unit_module_store(Unit, Module),
  369    !.
  370
  371make_unit_module(Unit, Module) :-
  372    prolog_load_context(module, Module),
  373    assert(unit_module_store(Unit, Module)).
  374
  375:- endif.  376
  377                 /*******************************
  378                 *           EXPANSION          *
  379                 *******************************/
 expand_test(+Name, +Options, +Body, -Clause) is det
Expand test(Name, Options) :- Body into a clause for 'unit test'/4 and 'unit body'/2.
  386expand_test(Name, Options0, Body,
  387            [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
  388              ('unit body'(Id, Vars) :- !, Body)
  389            ]) :-
  390    source_location(_File, Line),
  391    prolog_load_context(module, Module),
  392    atomic_list_concat([Name, '@line ', Line], Id),
  393    term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
  394    term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
  395    ord_intersection(OptionVars, BodyVars, VarList),
  396    Vars =.. [vars|VarList],
  397    (   is_list(Options0)           % allow for single option without list
  398    ->  Options1 = Options0
  399    ;   Options1 = [Options0]
  400    ),
  401    maplist(expand_option, Options1, Options2),
  402    valid_options(Options2, test_option),
  403    valid_test_mode(Options2, Options).
  404
  405expand_option(Var, _) :-
  406    var(Var),
  407    !,
  408    throw_error(instantiation_error,_).
  409expand_option(A == B, true(A==B)) :- !.
  410expand_option(A = B, true(A=B)) :- !.
  411expand_option(A =@= B, true(A=@=B)) :- !.
  412expand_option(A =:= B, true(A=:=B)) :- !.
  413expand_option(error(X), throws(error(X, _))) :- !.
  414expand_option(exception(X), throws(X)) :- !. % SICStus 4 compatibility
  415expand_option(error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
  416expand_option(true, true(true)) :- !.
  417expand_option(O, O).
  418
  419valid_test_mode(Options0, Options) :-
  420    include(test_mode, Options0, Tests),
  421    (   Tests == []
  422    ->  Options = [true(true)|Options0]
  423    ;   Tests = [_]
  424    ->  Options = Options0
  425    ;   throw_error(plunit(incompatible_options, Tests), _)
  426    ).
  427
  428test_mode(true(_)).
  429test_mode(all(_)).
  430test_mode(set(_)).
  431test_mode(fail).
  432test_mode(throws(_)).
 expand(+Term, -Clauses) is semidet
  437expand(end_of_file, _) :-
  438    loading_unit(Unit, _, _, _),
  439    !,
  440    end_tests(Unit),                % warn?
  441    fail.
  442expand((:-end_tests(_)), _) :-
  443    !,
  444    fail.
  445expand(_Term, []) :-
  446    \+ loading_tests.
  447expand((test(Name) :- Body), Clauses) :-
  448    !,
  449    expand_test(Name, [], Body, Clauses).
  450expand((test(Name, Options) :- Body), Clauses) :-
  451    !,
  452    expand_test(Name, Options, Body, Clauses).
  453expand(test(Name), _) :-
  454    !,
  455    throw_error(existence_error(body, test(Name)), _).
  456expand(test(Name, _Options), _) :-
  457    !,
  458    throw_error(existence_error(body, test(Name)), _).
  459
  460:- if(swi).  461:- multifile
  462    system:term_expansion/2.  463:- endif.  464
  465system:term_expansion(Term, Expanded) :-
  466    (   loading_unit(_, _, File, _)
  467    ->  source_location(File, _),
  468        expand(Term, Expanded)
  469    ).
  470
  471
  472                 /*******************************
  473                 *             OPTIONS          *
  474                 *******************************/
  475
  476:- if(swi).  477:- else.  478must_be(list, X) :-
  479    !,
  480    (   is_list(X)
  481    ->  true
  482    ;   is_not(list, X)
  483    ).
  484must_be(Type, X) :-
  485    (   call(Type, X)
  486    ->  true
  487    ;   is_not(Type, X)
  488    ).
  489
  490is_not(Type, X) :-
  491    (   ground(X)
  492    ->  throw_error(type_error(Type, X), _)
  493    ;   throw_error(instantiation_error, _)
  494    ).
  495:- endif.
 valid_options(+Options, :Pred) is det
Verify Options to be a list of valid options according to Pred.
throws
- type_error or instantiation_error.
  504valid_options(Options, Pred) :-
  505    must_be(list, Options),
  506    verify_options(Options, Pred).
  507
  508verify_options([], _).
  509verify_options([H|T], Pred) :-
  510    (   call(Pred, H)
  511    ->  verify_options(T, Pred)
  512    ;   throw_error(domain_error(Pred, H), _)
  513    ).
 test_option(+Option) is semidet
True if Option is a valid option for test(Name, Options).
  520test_option(Option) :-
  521    test_set_option(Option),
  522    !.
  523test_option(true(_)).
  524test_option(fail).
  525test_option(throws(_)).
  526test_option(all(_)).
  527test_option(set(_)).
  528test_option(nondet).
  529test_option(fixme(_)).
  530test_option(forall(X)) :-
  531    must_be(callable, X).
 test_option(+Option) is semidet
True if Option is a valid option for :- begin_tests(Name, Options).
  538test_set_option(blocked(X)) :-
  539    must_be(ground, X).
  540test_set_option(condition(X)) :-
  541    must_be(callable, X).
  542test_set_option(setup(X)) :-
  543    must_be(callable, X).
  544test_set_option(cleanup(X)) :-
  545    must_be(callable, X).
  546test_set_option(sto(V)) :-
  547    nonvar(V), member(V, [finite_trees, rational_trees]).
  548
  549
  550                 /*******************************
  551                 *        RUNNING TOPLEVEL      *
  552                 *******************************/
  553
  554:- thread_local
  555    passed/5,                       % Unit, Test, Line, Det, Time
  556    failed/4,                       % Unit, Test, Line, Reason
  557    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  558    blocked/4,                      % Unit, Test, Line, Reason
  559    sto/4,                          % Unit, Test, Line, Results
  560    fixme/5.                        % Unit, Test, Line, Reason, Status
  561
  562:- dynamic
  563    running/5.                      % Unit, Test, Line, STO, Thread
 run_tests is semidet
 run_tests(+TestSet) 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. This 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.
  576run_tests :-
  577    cleanup,
  578    setup_call_cleanup(
  579        setup_trap_assertions(Ref),
  580        run_current_units,
  581        report_and_cleanup(Ref)).
  582
  583run_current_units :-
  584    forall(current_test_set(Set),
  585           run_unit(Set)),
  586    check_for_test_errors.
  587
  588report_and_cleanup(Ref) :-
  589    cleanup_trap_assertions(Ref),
  590    report,
  591    cleanup_after_test.
  592
  593run_tests(Set) :-
  594    cleanup,
  595    setup_call_cleanup(
  596        setup_trap_assertions(Ref),
  597        run_unit_and_check_errors(Set),
  598        report_and_cleanup(Ref)).
  599
  600run_unit_and_check_errors(Set) :-
  601    run_unit(Set),
  602    check_for_test_errors.
  603
  604run_unit([]) :- !.
  605run_unit([H|T]) :-
  606    !,
  607    run_unit(H),
  608    run_unit(T).
  609run_unit(Spec) :-
  610    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  611    (   option(blocked(Reason), UnitOptions)
  612    ->  info(plunit(blocked(unit(Unit, Reason))))
  613    ;   setup(Module, unit(Unit), UnitOptions)
  614    ->  info(plunit(begin(Spec))),
  615        forall((Module:'unit test'(Name, Line, Options, Body),
  616                matching_test(Name, Tests)),
  617               run_test(Unit, Name, Line, Options, Body)),
  618        info(plunit(end(Spec))),
  619        (   message_level(silent)
  620        ->  true
  621        ;   format(user_error, '~N', [])
  622        ),
  623        cleanup(Module, UnitOptions)
  624    ;   true
  625    ).
  626
  627unit_from_spec(Unit, Unit, _, Module, Options) :-
  628    atom(Unit),
  629    !,
  630    (   current_unit(Unit, Module, _Supers, Options)
  631    ->  true
  632    ;   throw_error(existence_error(unit_test, Unit), _)
  633    ).
  634unit_from_spec(Unit:Tests, Unit, Tests, Module, Options) :-
  635    atom(Unit),
  636    !,
  637    (   current_unit(Unit, Module, _Supers, Options)
  638    ->  true
  639    ;   throw_error(existence_error(unit_test, Unit), _)
  640    ).
  641
  642
  643matching_test(X, X) :- !.
  644matching_test(Name, Set) :-
  645    is_list(Set),
  646    memberchk(Name, Set).
  647
  648cleanup :-
  649    thread_self(Me),
  650    retractall(passed(_, _, _, _, _)),
  651    retractall(failed(_, _, _, _)),
  652    retractall(failed_assertion(_, _, _, _, _, _, _)),
  653    retractall(blocked(_, _, _, _)),
  654    retractall(sto(_, _, _, _)),
  655    retractall(fixme(_, _, _, _, _)),
  656    retractall(running(_,_,_,_,Me)).
  657
  658cleanup_after_test :-
  659    current_test_flag(test_options, Options),
  660    option(cleanup(Cleanup), Options, false),
  661    (   Cleanup == true
  662    ->  cleanup
  663    ;   true
  664    ).
 run_tests_in_files(+Files:list) is det
Run all test-units that appear in the given Files.
  671run_tests_in_files(Files) :-
  672    findall(Unit, unit_in_files(Files, Unit), Units),
  673    (   Units == []
  674    ->  true
  675    ;   run_tests(Units)
  676    ).
  677
  678unit_in_files(Files, Unit) :-
  679    is_list(Files),
  680    !,
  681    member(F, Files),
  682    absolute_file_name(F, Source,
  683                       [ file_type(prolog),
  684                         access(read),
  685                         file_errors(fail)
  686                       ]),
  687    unit_file(Unit, Source).
  688
  689
  690                 /*******************************
  691                 *         HOOKING MAKE/0       *
  692                 *******************************/
 make_run_tests(+Files)
Called indirectly from make/0 after Files have been reloaded.
  698make_run_tests(Files) :-
  699    current_test_flag(test_options, Options),
  700    option(run(When), Options, manual),
  701    (   When == make
  702    ->  run_tests_in_files(Files)
  703    ;   When == make(all)
  704    ->  run_tests
  705    ;   true
  706    ).
  707
  708:- if(swi).  709
  710unification_capability(sto_error_incomplete).
  711% can detect some (almost all) STO runs
  712unification_capability(rational_trees).
  713unification_capability(finite_trees).
  714
  715set_unification_capability(Cap) :-
  716    cap_to_flag(Cap, Flag),
  717    set_prolog_flag(occurs_check, Flag).
  718
  719current_unification_capability(Cap) :-
  720    current_prolog_flag(occurs_check, Flag),
  721    cap_to_flag(Cap, Flag),
  722    !.
  723
  724cap_to_flag(sto_error_incomplete, error).
  725cap_to_flag(rational_trees, false).
  726cap_to_flag(finite_trees, true).
  727
  728:- else.  729:- if(sicstus).  730
  731unification_capability(rational_trees).
  732set_unification_capability(rational_trees).
  733current_unification_capability(rational_trees).
  734
  735:- else.  736
  737unification_capability(_) :-
  738    fail.
  739
  740:- endif.  741:- endif.  742
  743                 /*******************************
  744                 *      ASSERTION HANDLING      *
  745                 *******************************/
  746
  747:- if(swi).  748
  749:- dynamic prolog:assertion_failed/2.  750
  751setup_trap_assertions(Ref) :-
  752    asserta((prolog:assertion_failed(Reason, Goal) :-
  753                    test_assertion_failed(Reason, Goal)),
  754            Ref).
  755
  756cleanup_trap_assertions(Ref) :-
  757    erase(Ref).
  758
  759test_assertion_failed(Reason, Goal) :-
  760    thread_self(Me),
  761    running(Unit, Test, Line, STO, Me),
  762    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  763        assertion_location(Stack, AssertLoc)
  764    ->  true
  765    ;   AssertLoc = unknown
  766    ),
  767    current_test_flag(test_options, Options),
  768    report_failed_assertion(Unit, Test, Line, AssertLoc,
  769                            STO, Reason, Goal, Options),
  770    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  771                                   STO, Reason, Goal)).
  772
  773assertion_location(Stack, File:Line) :-
  774    append(_, [AssertFrame,CallerFrame|_], Stack),
  775    prolog_stack_frame_property(AssertFrame,
  776                                predicate(prolog_debug:assertion/1)),
  777    !,
  778    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  779
  780report_failed_assertion(Unit, Test, Line, AssertLoc,
  781                        STO, Reason, Goal, _Options) :-
  782    print_message(
  783        error,
  784        plunit(failed_assertion(Unit, Test, Line, AssertLoc,
  785                                STO, Reason, Goal))).
  786
  787:- else.  788
  789setup_trap_assertions(_).
  790cleanup_trap_assertions(_).
  791
  792:- endif.  793
  794
  795
  796
  797
  798                 /*******************************
  799                 *         RUNNING A TEST       *
  800                 *******************************/
 run_test(+Unit, +Name, +Line, +Options, +Body) is det
Run a single test.
  806run_test(Unit, Name, Line, Options, Body) :-
  807    option(forall(Generator), Options),
  808    !,
  809    unit_module(Unit, Module),
  810    term_variables(Generator, Vars),
  811    forall(Module:Generator,
  812           run_test_once(Unit, @(Name,Vars), Line, Options, Body)).
  813run_test(Unit, Name, Line, Options, Body) :-
  814    run_test_once(Unit, Name, Line, Options, Body).
  815
  816run_test_once(Unit, Name, Line, Options, Body) :-
  817    current_test_flag(test_options, GlobalOptions),
  818    option(sto(false), GlobalOptions, false),
  819    !,
  820    current_unification_capability(Type),
  821    begin_test(Unit, Name, Line, Type),
  822    run_test_6(Unit, Name, Line, Options, Body, Result),
  823    end_test(Unit, Name, Line, Type),
  824    report_result(Result, Options).
  825run_test_once(Unit, Name, Line, Options, Body) :-
  826    current_unit(Unit, _Module, _Supers, UnitOptions),
  827    option(sto(Type), UnitOptions),
  828    \+ option(sto(_), Options),
  829    !,
  830    current_unification_capability(Cap0),
  831    call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body),
  832                 set_unification_capability(Cap0)).
  833run_test_once(Unit, Name, Line, Options, Body) :-
  834    current_unification_capability(Cap0),
  835    call_cleanup(run_test_cap(Unit, Name, Line, Options, Body),
  836                 set_unification_capability(Cap0)).
  837
  838run_test_cap(Unit, Name, Line, Options, Body) :-
  839    (   option(sto(Type), Options)
  840    ->  unification_capability(Type),
  841        set_unification_capability(Type),
  842        begin_test(Unit, Name, Line, Type),
  843        run_test_6(Unit, Name, Line, Options, Body, Result),
  844        end_test(Unit, Name, Line, Type),
  845        report_result(Result, Options)
  846    ;   findall(Key-(Type+Result),
  847                test_caps(Type, Unit, Name, Line, Options, Body, Result, Key),
  848                Pairs),
  849        group_pairs_by_key(Pairs, Keyed),
  850        (   Keyed == []
  851        ->  true
  852        ;   Keyed = [_-Results]
  853        ->  Results = [_Type+Result|_],
  854            report_result(Result, Options)          % consistent results
  855        ;   pairs_values(Pairs, ResultByType),
  856            report_result(sto(Unit, Name, Line, ResultByType), Options)
  857        )
  858    ).
 test_caps(-Type, +Unit, +Name, +Line, +Options, +Body, -Result, -Key) is nondet
  862test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :-
  863    unification_capability(Type),
  864    set_unification_capability(Type),
  865    begin_test(Unit, Name, Line, Type),
  866    run_test_6(Unit, Name, Line, Options, Body, Result),
  867    end_test(Unit, Name, Line, Type),
  868    result_to_key(Result, Key),
  869    Key \== setup_failed.
  870
  871result_to_key(blocked(_, _, _, _), blocked).
  872result_to_key(failure(_, _, _, How0), failure(How1)) :-
  873    ( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ).
  874result_to_key(success(_, _, _, Determinism, _), success(Determinism)).
  875result_to_key(setup_failed(_,_,_), setup_failed).
  876
  877report_result(blocked(Unit, Name, Line, Reason), _) :-
  878    !,
  879    assert(blocked(Unit, Name, Line, Reason)).
  880report_result(failure(Unit, Name, Line, How), Options) :-
  881    !,
  882    failure(Unit, Name, Line, How, Options).
  883report_result(success(Unit, Name, Line, Determinism, Time), Options) :-
  884    !,
  885    success(Unit, Name, Line, Determinism, Time, Options).
  886report_result(setup_failed(_Unit, _Name, _Line), _Options).
  887report_result(sto(Unit, Name, Line, ResultByType), Options) :-
  888    assert(sto(Unit, Name, Line, ResultByType)),
  889    print_message(error, plunit(sto(Unit, Name, Line))),
  890    report_sto_results(ResultByType, Options).
  891
  892report_sto_results([], _).
  893report_sto_results([Type+Result|T], Options) :-
  894    print_message(error, plunit(sto(Type, Result))),
  895    report_sto_results(T, Options).
 run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det
Result is one of:
  907run_test_6(Unit, Name, Line, Options, _Body,
  908           blocked(Unit, Name, Line, Reason)) :-
  909    option(blocked(Reason), Options),
  910    !.
  911run_test_6(Unit, Name, Line, Options, Body, Result) :-
  912    option(all(Answer), Options),                  % all(Bindings)
  913    !,
  914    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
  915run_test_6(Unit, Name, Line, Options, Body, Result) :-
  916    option(set(Answer), Options),                  % set(Bindings)
  917    !,
  918    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
  919run_test_6(Unit, Name, Line, Options, Body, Result) :-
  920    option(fail, Options),                         % fail
  921    !,
  922    unit_module(Unit, Module),
  923    (   setup(Module, test(Unit,Name,Line), Options)
  924    ->  statistics(runtime, [T0,_]),
  925        (   catch(Module:Body, E, true)
  926        ->  (   var(E)
  927            ->  statistics(runtime, [T1,_]),
  928                Time is (T1 - T0)/1000.0,
  929                Result = failure(Unit, Name, Line, succeeded(Time)),
  930                cleanup(Module, Options)
  931            ;   Result = failure(Unit, Name, Line, E),
  932                cleanup(Module, Options)
  933            )
  934        ;   statistics(runtime, [T1,_]),
  935            Time is (T1 - T0)/1000.0,
  936            Result = success(Unit, Name, Line, true, Time),
  937            cleanup(Module, Options)
  938        )
  939    ;   Result = setup_failed(Unit, Name, Line)
  940    ).
  941run_test_6(Unit, Name, Line, Options, Body, Result) :-
  942    option(true(Cmp), Options),
  943    !,
  944    unit_module(Unit, Module),
  945    (   setup(Module, test(Unit,Name,Line), Options) % true(Binding)
  946    ->  statistics(runtime, [T0,_]),
  947        (   catch(call_det(Module:Body, Det), E, true)
  948        ->  (   var(E)
  949            ->  statistics(runtime, [T1,_]),
  950                Time is (T1 - T0)/1000.0,
  951                (   catch(Module:Cmp, E, true)
  952                ->  (   var(E)
  953                    ->  Result = success(Unit, Name, Line, Det, Time)
  954                    ;   Result = failure(Unit, Name, Line, cmp_error(Cmp, E))
  955                    )
  956                ;   Result = failure(Unit, Name, Line, wrong_answer(Cmp))
  957                ),
  958                cleanup(Module, Options)
  959            ;   Result = failure(Unit, Name, Line, E),
  960                cleanup(Module, Options)
  961            )
  962        ;   Result = failure(Unit, Name, Line, failed),
  963            cleanup(Module, Options)
  964        )
  965    ;   Result = setup_failed(Unit, Name, Line)
  966    ).
  967run_test_6(Unit, Name, Line, Options, Body, Result) :-
  968    option(throws(Expect), Options),
  969    !,
  970    unit_module(Unit, Module),
  971    (   setup(Module, test(Unit,Name,Line), Options)
  972    ->  statistics(runtime, [T0,_]),
  973        (   catch(Module:Body, E, true)
  974        ->  (   var(E)
  975            ->  Result = failure(Unit, Name, Line, no_exception),
  976                cleanup(Module, Options)
  977            ;   statistics(runtime, [T1,_]),
  978                Time is (T1 - T0)/1000.0,
  979                (   match_error(Expect, E)
  980                ->  Result = success(Unit, Name, Line, true, Time)
  981                ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E))
  982                ),
  983                cleanup(Module, Options)
  984            )
  985        ;   Result = failure(Unit, Name, Line, failed),
  986            cleanup(Module, Options)
  987        )
  988    ;   Result = setup_failed(Unit, Name, Line)
  989    ).
 non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)
Run tests on non-deterministic predicates.
  996nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
  997    unit_module(Unit, Module),
  998    result_vars(Expected, Vars),
  999    statistics(runtime, [T0,_]),
 1000    (   setup(Module, test(Unit,Name,Line), Options)
 1001    ->  (   catch(findall(Vars, Module:Body, Bindings), E, true)
 1002        ->  (   var(E)
 1003            ->  statistics(runtime, [T1,_]),
 1004                Time is (T1 - T0)/1000.0,
 1005                (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1006                ->  Result = success(Unit, Name, Line, true, Time)
 1007                ;   Result = failure(Unit, Name, Line, wrong_answer(Expected, Bindings))
 1008                ),
 1009                cleanup(Module, Options)
 1010            ;   Result = failure(Unit, Name, Line, E),
 1011                cleanup(Module, Options)
 1012            )
 1013        )
 1014    ;   Result = setup_failed(Unit, Name, Line)
 1015    ).
 result_vars(+Expected, -Vars) is det
Create a term v(V1, ...) containing all variables at the left side of the comparison operator on Expected.
 1023result_vars(Expected, Vars) :-
 1024    arg(1, Expected, CmpOp),
 1025    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
 1035nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1036    cmp(Cmp, _Vars, Op, Values),
 1037    cmp_list(Values, Bindings, Op).
 1038nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1039    cmp(Cmp, _Vars, Op, Values0),
 1040    sort(Bindings0, Bindings),
 1041    sort(Values0, Values),
 1042    cmp_list(Values, Bindings, Op).
 1043
 1044cmp_list([], [], _Op).
 1045cmp_list([E0|ET], [V0|VT], Op) :-
 1046    call(Op, E0, V0),
 1047    cmp_list(ET, VT, Op).
 cmp(+CmpTerm, -Left, -Op, -Right) is det
 1051cmp(Var  == Value, Var,  ==, Value).
 1052cmp(Var =:= Value, Var, =:=, Value).
 1053cmp(Var  =  Value, Var,  =,  Value).
 1054:- if(swi). 1055cmp(Var =@= Value, Var, =@=, Value).
 1056:- else. 1057:- if(sicstus). 1058cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1059:- endif. 1060:- endif.
 call_det(:Goal, -Det) is nondet
True if Goal succeeded. Det is unified to true if Goal left no choicepoints and false otherwise.
 1068:- if((swi|sicstus)). 1069call_det(Goal, Det) :-
 1070    call_cleanup(Goal,Det0=true),
 1071    ( var(Det0) -> Det = false ; Det = true ).
 1072:- else. 1073call_det(Goal, true) :-
 1074    call(Goal).
 1075:- endif.
 match_error(+Expected, +Received) is semidet
True if the Received errors matches the expected error. Matching is based on subsumes_term/2.
 1082match_error(Expect, Rec) :-
 1083    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
 1096setup(Module, Context, Options) :-
 1097    option(condition(Condition), Options),
 1098    option(setup(Setup), Options),
 1099    !,
 1100    setup(Module, Context, [condition(Condition)]),
 1101    setup(Module, Context, [setup(Setup)]).
 1102setup(Module, Context, Options) :-
 1103    option(setup(Setup), Options),
 1104    !,
 1105    (   catch(call_ex(Module, Setup), E, true)
 1106    ->  (   var(E)
 1107        ->  true
 1108        ;   print_message(error, plunit(error(setup, Context, E))),
 1109            fail
 1110        )
 1111    ;   print_message(error, error(goal_failed(Setup), _)),
 1112        fail
 1113    ).
 1114setup(Module, Context, Options) :-
 1115    option(condition(Setup), Options),
 1116    !,
 1117    (   catch(call_ex(Module, Setup), E, true)
 1118    ->  (   var(E)
 1119        ->  true
 1120        ;   print_message(error, plunit(error(condition, Context, E))),
 1121            fail
 1122        )
 1123    ;   fail
 1124    ).
 1125setup(_,_,_).
 call_ex(+Module, +Goal)
Call Goal in Module after applying goal expansion.
 1131call_ex(Module, Goal) :-
 1132    Module:(expand_goal(Goal, GoalEx),
 1133                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.
 1140cleanup(Module, Options) :-
 1141    option(cleanup(Cleanup), Options, true),
 1142    (   catch(call_ex(Module, Cleanup), E, true)
 1143    ->  (   var(E)
 1144        ->  true
 1145        ;   print_message(warning, E)
 1146        )
 1147    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1148    ).
 1149
 1150success(Unit, Name, Line, Det, _Time, Options) :-
 1151    memberchk(fixme(Reason), Options),
 1152    !,
 1153    (   (   Det == true
 1154        ;   memberchk(nondet, Options)
 1155        )
 1156    ->  put_char(user_error, +),
 1157        Ok = passed
 1158    ;   put_char(user_error, !),
 1159        Ok = nondet
 1160    ),
 1161    flush_output(user_error),
 1162    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1163success(Unit, Name, Line, _, _, Options) :-
 1164    failed_assertion(Unit, Name, Line, _,_,_,_),
 1165    !,
 1166    failure(Unit, Name, Line, assertion, Options).
 1167success(Unit, Name, Line, Det, Time, Options) :-
 1168    assert(passed(Unit, Name, Line, Det, Time)),
 1169    (   (   Det == true
 1170        ;   memberchk(nondet, Options)
 1171        )
 1172    ->  put_char(user_error, .)
 1173    ;   unit_file(Unit, File),
 1174        print_message(warning, plunit(nondet(File, Line, Name)))
 1175    ),
 1176    flush_output(user_error).
 1177
 1178failure(Unit, Name, Line, _, Options) :-
 1179    memberchk(fixme(Reason), Options),
 1180    !,
 1181    put_char(user_error, -),
 1182    flush_output(user_error),
 1183    assert(fixme(Unit, Name, Line, Reason, failed)).
 1184failure(Unit, Name, Line, E, Options) :-
 1185    report_failure(Unit, Name, Line, E, Options),
 1186    assert_cyclic(failed(Unit, Name, Line, E)).
 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.
 1196:- if(swi). 1197assert_cyclic(Term) :-
 1198    acyclic_term(Term),
 1199    !,
 1200    assert(Term).
 1201assert_cyclic(Term) :-
 1202    Term =.. [Functor|Args],
 1203    recorda(cyclic, Args, Id),
 1204    functor(Term, _, Arity),
 1205    length(NewArgs, Arity),
 1206    Head =.. [Functor|NewArgs],
 1207    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1208:- else. 1209:- if(sicstus). 1210:- endif. 1211assert_cyclic(Term) :-
 1212    assert(Term).
 1213:- endif. 1214
 1215
 1216                 /*******************************
 1217                 *            REPORTING         *
 1218                 *******************************/
 begin_test(Unit, Test, Line, STO) is det
 end_test(Unit, Test, Line, STO) is det
Maintain running/5 and report a test has started/is ended using a silent message:
See also
- message_hook/3 for intercepting these messages
 1231begin_test(Unit, Test, Line, STO) :-
 1232    thread_self(Me),
 1233    assert(running(Unit, Test, Line, STO, Me)),
 1234    unit_file(Unit, File),
 1235    print_message(silent, plunit(begin(Unit:Test, File:Line, STO))).
 1236
 1237end_test(Unit, Test, Line, STO) :-
 1238    thread_self(Me),
 1239    retractall(running(_,_,_,_,Me)),
 1240    unit_file(Unit, File),
 1241    print_message(silent, plunit(end(Unit:Test, File:Line, STO))).
 running_tests is det
Print the currently running test.
 1247running_tests :-
 1248    running_tests(Running),
 1249    print_message(informational, plunit(running(Running))).
 1250
 1251running_tests(Running) :-
 1252    findall(running(Unit:Test, File:Line, STO, Thread),
 1253            (   running(Unit, Test, Line, STO, Thread),
 1254                unit_file(Unit, File)
 1255            ), Running).
 check_for_test_errors is semidet
True if there are no errors, otherwise false.
 1262check_for_test_errors :-
 1263    number_of_clauses(failed/4, Failed),
 1264    number_of_clauses(failed_assertion/7, FailedAssertion),
 1265    number_of_clauses(sto/4, STO),
 1266    Failed+FailedAssertion+STO =:= 0.     % fail on errors
 report is det
Print a summary of the tests that ran.
 1273report :-
 1274    number_of_clauses(passed/5, Passed),
 1275    number_of_clauses(failed/4, Failed),
 1276    number_of_clauses(failed_assertion/7, FailedAssertion),
 1277    number_of_clauses(blocked/4, Blocked),
 1278    number_of_clauses(sto/4, STO),
 1279    (   Passed+Failed+FailedAssertion+Blocked+STO =:= 0
 1280    ->  info(plunit(no_tests))
 1281    ;   Failed+FailedAssertion+Blocked+STO =:= 0
 1282    ->  report_fixme,
 1283        info(plunit(all_passed(Passed)))
 1284    ;   report_blocked,
 1285        report_fixme,
 1286        report_failed_assertions,
 1287        report_failed,
 1288        report_sto,
 1289        info(plunit(passed(Passed)))
 1290    ).
 1291
 1292number_of_clauses(F/A,N) :-
 1293    (   current_predicate(F/A)
 1294    ->  functor(G,F,A),
 1295        findall(t, G, Ts),
 1296        length(Ts, N)
 1297    ;   N = 0
 1298    ).
 1299
 1300report_blocked :-
 1301    number_of_clauses(blocked/4,N),
 1302    N > 0,
 1303    !,
 1304    info(plunit(blocked(N))),
 1305    (   blocked(Unit, Name, Line, Reason),
 1306        unit_file(Unit, File),
 1307        print_message(informational,
 1308                      plunit(blocked(File:Line, Name, Reason))),
 1309        fail ; true
 1310    ).
 1311report_blocked.
 1312
 1313report_failed :-
 1314    number_of_clauses(failed/4, N),
 1315    info(plunit(failed(N))).
 1316
 1317report_failed_assertions :-
 1318    number_of_clauses(failed_assertion/7, N),
 1319    info(plunit(failed_assertions(N))).
 1320
 1321report_sto :-
 1322    number_of_clauses(sto/4, N),
 1323    info(plunit(sto(N))).
 1324
 1325report_fixme :-
 1326    report_fixme(_,_,_).
 1327
 1328report_fixme(TuplesF, TuplesP, TuplesN) :-
 1329    fixme(failed, TuplesF, Failed),
 1330    fixme(passed, TuplesP, Passed),
 1331    fixme(nondet, TuplesN, Nondet),
 1332    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1333
 1334
 1335fixme(How, Tuples, Count) :-
 1336    findall(fixme(Unit, Name, Line, Reason, How),
 1337            fixme(Unit, Name, Line, Reason, How), Tuples),
 1338    length(Tuples, Count).
 1339
 1340
 1341report_failure(_, _, _, assertion, _) :-
 1342    !,
 1343    put_char(user_error, 'A').
 1344report_failure(Unit, Name, Line, Error, _Options) :-
 1345    print_message(error, plunit(failed(Unit, Name, Line, Error))).
 test_report(What) is det
Produce reports on test results after the run.
 1352test_report(fixme) :-
 1353    !,
 1354    report_fixme(TuplesF, TuplesP, TuplesN),
 1355    append([TuplesF, TuplesP, TuplesN], Tuples),
 1356    print_message(informational, plunit(fixme(Tuples))).
 1357test_report(What) :-
 1358    throw_error(domain_error(report_class, What), _).
 1359
 1360
 1361                 /*******************************
 1362                 *             INFO             *
 1363                 *******************************/
 current_test_set(?Unit) is nondet
True if Unit is a currently loaded test-set.
 1369current_test_set(Unit) :-
 1370    current_unit(Unit, _Module, _Context, _Options).
 unit_file(+Unit, -File) is det
unit_file(-Unit, +File) is nondet
 1375unit_file(Unit, File) :-
 1376    current_unit(Unit, Module, _Context, _Options),
 1377    current_module(Module, File).
 1378unit_file(Unit, PlFile) :-
 1379    nonvar(PlFile),
 1380    test_file_for(TestFile, PlFile),
 1381    current_module(Module, TestFile),
 1382    current_unit(Unit, Module, _Context, _Options).
 1383
 1384
 1385                 /*******************************
 1386                 *             FILES            *
 1387                 *******************************/
 load_test_files(+Options) is det
Load .plt test-files related to loaded source-files.
 1393load_test_files(_Options) :-
 1394    (   source_file(File),
 1395        file_name_extension(Base, Old, File),
 1396        Old \== plt,
 1397        file_name_extension(Base, plt, TestFile),
 1398        exists_file(TestFile),
 1399        (   test_file_for(TestFile, File)
 1400        ->  true
 1401        ;   load_files(TestFile,
 1402                       [ if(changed),
 1403                         imports([])
 1404                       ]),
 1405            asserta(test_file_for(TestFile, File))
 1406        ),
 1407        fail ; true
 1408    ).
 1409
 1410
 1411
 1412                 /*******************************
 1413                 *           MESSAGES           *
 1414                 *******************************/
 info(+Term)
Runs print_message(Level, Term), where Level is one of silent or informational (default).
 1421info(Term) :-
 1422    message_level(Level),
 1423    print_message(Level, Term).
 1424
 1425message_level(Level) :-
 1426    current_test_flag(test_options, Options),
 1427    option(silent(Silent), Options, false),
 1428    (   Silent == false
 1429    ->  Level = informational
 1430    ;   Level = silent
 1431    ).
 1432
 1433locationprefix(File:Line) -->
 1434    !,
 1435    [ '~w:~d:\n\t'-[File,Line]].
 1436locationprefix(test(Unit,_Test,Line)) -->
 1437    !,
 1438    { unit_file(Unit, File) },
 1439    locationprefix(File:Line).
 1440locationprefix(unit(Unit)) -->
 1441    !,
 1442    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1443locationprefix(FileLine) -->
 1444    { throw_error(type_error(locationprefix,FileLine), _) }.
 1445
 1446:- discontiguous
 1447    message//1. 1448
 1449message(error(context_error(plunit_close(Name, -)), _)) -->
 1450    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1451message(error(context_error(plunit_close(Name, Start)), _)) -->
 1452    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1453message(plunit(nondet(File, Line, Name))) -->
 1454    locationprefix(File:Line),
 1455    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1456message(error(plunit(incompatible_options, Tests), _)) -->
 1457    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1458
 1459                                        % Unit start/end
 1460:- if(swi). 1461message(plunit(begin(Unit))) -->
 1462    [ 'PL-Unit: ~w '-[Unit], flush ].
 1463message(plunit(end(_Unit))) -->
 1464    [ at_same_line, ' done' ].
 1465:- else. 1466message(plunit(begin(Unit))) -->
 1467    [ 'PL-Unit: ~w '-[Unit]/*, flush-[]*/ ].
 1468message(plunit(end(_Unit))) -->
 1469    [ ' done'-[] ].
 1470:- endif. 1471message(plunit(blocked(unit(Unit, Reason)))) -->
 1472    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1473message(plunit(running([]))) -->
 1474    !,
 1475    [ 'PL-Unit: no tests running' ].
 1476message(plunit(running([One]))) -->
 1477    !,
 1478    [ 'PL-Unit: running ' ],
 1479    running(One).
 1480message(plunit(running(More))) -->
 1481    !,
 1482    [ 'PL-Unit: running tests:', nl ],
 1483    running(More).
 1484message(plunit(fixme([]))) --> !.
 1485message(plunit(fixme(Tuples))) -->
 1486    !,
 1487    fixme_message(Tuples).
 1488
 1489                                        % Blocked tests
 1490message(plunit(blocked(1))) -->
 1491    !,
 1492    [ 'one test is blocked:'-[] ].
 1493message(plunit(blocked(N))) -->
 1494    [ '~D tests are blocked:'-[N] ].
 1495message(plunit(blocked(Pos, Name, Reason))) -->
 1496    locationprefix(Pos),
 1497    test_name(Name),
 1498    [ ': ~w'-[Reason] ].
 1499
 1500                                        % fail/success
 1501message(plunit(no_tests)) -->
 1502    !,
 1503    [ 'No tests to run' ].
 1504message(plunit(all_passed(1))) -->
 1505    !,
 1506    [ 'test passed' ].
 1507message(plunit(all_passed(Count))) -->
 1508    !,
 1509    [ 'All ~D tests passed'-[Count] ].
 1510message(plunit(passed(Count))) -->
 1511    !,
 1512    [ '~D tests passed'-[Count] ].
 1513message(plunit(failed(0))) -->
 1514    !,
 1515    [].
 1516message(plunit(failed(1))) -->
 1517    !,
 1518    [ '1 test failed'-[] ].
 1519message(plunit(failed(N))) -->
 1520    [ '~D tests failed'-[N] ].
 1521message(plunit(failed_assertions(0))) -->
 1522    !,
 1523    [].
 1524message(plunit(failed_assertions(1))) -->
 1525    !,
 1526    [ '1 assertion failed'-[] ].
 1527message(plunit(failed_assertions(N))) -->
 1528    [ '~D assertions failed'-[N] ].
 1529message(plunit(sto(0))) -->
 1530    !,
 1531    [].
 1532message(plunit(sto(N))) -->
 1533    [ '~D test results depend on unification mode'-[N] ].
 1534message(plunit(fixme(0,0,0))) -->
 1535    [].
 1536message(plunit(fixme(Failed,0,0))) -->
 1537    !,
 1538    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1539message(plunit(fixme(Failed,Passed,0))) -->
 1540    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1541message(plunit(fixme(Failed,Passed,Nondet))) -->
 1542    { TotalPassed is Passed+Nondet },
 1543    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1544      [Failed, TotalPassed, Nondet] ].
 1545message(plunit(failed(Unit, Name, Line, Failure))) -->
 1546    { unit_file(Unit, File) },
 1547    locationprefix(File:Line),
 1548    test_name(Name),
 1549    [': '-[] ],
 1550    failure(Failure).
 1551:- if(swi). 1552message(plunit(failed_assertion(Unit, Name, Line, AssertLoc,
 1553                                _STO, Reason, Goal))) -->
 1554    { unit_file(Unit, File) },
 1555    locationprefix(File:Line),
 1556    test_name(Name),
 1557    [ ': assertion'-[] ],
 1558    assertion_location(AssertLoc, File),
 1559    assertion_reason(Reason), ['\n\t'],
 1560    assertion_goal(Unit, Goal).
 1561
 1562assertion_location(File:Line, File) -->
 1563    [ ' at line ~w'-[Line] ].
 1564assertion_location(File:Line, _) -->
 1565    [ ' at ~w:~w'-[File, Line] ].
 1566assertion_location(unknown, _) -->
 1567    [].
 1568
 1569assertion_reason(fail) -->
 1570    !,
 1571    [ ' failed'-[] ].
 1572assertion_reason(Error) -->
 1573    { message_to_string(Error, String) },
 1574    [ ' raised "~w"'-[String] ].
 1575
 1576assertion_goal(Unit, Goal) -->
 1577    { unit_module(Unit, Module),
 1578      unqualify(Goal, Module, Plain)
 1579    },
 1580    [ 'Assertion: ~p'-[Plain] ].
 1581
 1582unqualify(Var, _, Var) :-
 1583    var(Var),
 1584    !.
 1585unqualify(M:Goal, Unit, Goal) :-
 1586    nonvar(M),
 1587    unit_module(Unit, M),
 1588    !.
 1589unqualify(M:Goal, _, Goal) :-
 1590    callable(Goal),
 1591    predicate_property(M:Goal, imported_from(system)),
 1592    !.
 1593unqualify(Goal, _, Goal).
 1594
 1595:- endif. 1596                                        % Setup/condition errors
 1597message(plunit(error(Where, Context, Exception))) -->
 1598    locationprefix(Context),
 1599    { message_to_string(Exception, String) },
 1600    [ 'error in ~w: ~w'-[Where, String] ].
 1601
 1602                                        % STO messages
 1603message(plunit(sto(Unit, Name, Line))) -->
 1604    { unit_file(Unit, File) },
 1605       locationprefix(File:Line),
 1606       test_name(Name),
 1607       [' is subject to occurs check (STO): '-[] ].
 1608message(plunit(sto(Type, Result))) -->
 1609    sto_type(Type),
 1610    sto_result(Result).
 1611
 1612                                        % Interrupts (SWI)
 1613:- if(swi). 1614message(interrupt(begin)) -->
 1615    { thread_self(Me),
 1616      running(Unit, Test, Line, STO, Me),
 1617      !,
 1618      unit_file(Unit, File)
 1619    },
 1620    [ 'Interrupted test '-[] ],
 1621    running(running(Unit:Test, File:Line, STO, Me)),
 1622    [nl],
 1623    '$messages':prolog_message(interrupt(begin)).
 1624message(interrupt(begin)) -->
 1625    '$messages':prolog_message(interrupt(begin)).
 1626:- endif. 1627
 1628test_name(@(Name,Bindings)) -->
 1629    !,
 1630    [ 'test ~w (forall bindings = ~p)'-[Name, Bindings] ].
 1631test_name(Name) -->
 1632    !,
 1633    [ 'test ~w'-[Name] ].
 1634
 1635sto_type(sto_error_incomplete) -->
 1636    [ 'Finite trees (error checking): ' ].
 1637sto_type(rational_trees) -->
 1638    [ 'Rational trees: ' ].
 1639sto_type(finite_trees) -->
 1640    [ 'Finite trees: ' ].
 1641
 1642sto_result(success(_Unit, _Name, _Line, Det, Time)) -->
 1643    det(Det),
 1644    [ ' success in ~2f seconds'-[Time] ].
 1645sto_result(failure(_Unit, _Name, _Line, How)) -->
 1646    failure(How).
 1647
 1648det(true) -->
 1649    [ 'deterministic' ].
 1650det(false) -->
 1651    [ 'non-deterministic' ].
 1652
 1653running(running(Unit:Test, File:Line, STO, Thread)) -->
 1654    thread(Thread),
 1655    [ '~q:~q at ~w:~d'-[Unit, Test, File, Line] ],
 1656    current_sto(STO).
 1657running([H|T]) -->
 1658    ['\t'], running(H),
 1659    (   {T == []}
 1660    ->  []
 1661    ;   [nl], running(T)
 1662    ).
 1663
 1664thread(main) --> !.
 1665thread(Other) -->
 1666    [' [~w] '-[Other] ].
 1667
 1668current_sto(sto_error_incomplete) -->
 1669    [ ' (STO: error checking)' ].
 1670current_sto(rational_trees) -->
 1671    [].
 1672current_sto(finite_trees) -->
 1673    [ ' (STO: occurs check enabled)' ].
 1674
 1675:- if(swi). 1676write_term(T, OPS) -->
 1677    ['~@'-[write_term(T,OPS)]].
 1678:- else. 1679write_term(T, _OPS) -->
 1680    ['~q'-[T]].
 1681:- endif. 1682
 1683expected_got_ops_(Ex, E, OPS, Goals) -->
 1684    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 1685    ['    Got:      '-[]], write_term(E,  OPS), [nl],
 1686    ( { Goals = [] } -> []
 1687    ; ['       with: '-[]], write_term(Goals, OPS), [nl]
 1688    ).
 1689
 1690
 1691failure(Var) -->
 1692    { var(Var) },
 1693    !,
 1694    [ 'Unknown failure?' ].
 1695failure(succeeded(Time)) -->
 1696    !,
 1697    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 1698failure(wrong_error(Expected, Error)) -->
 1699    !,
 1700    { copy_term(Expected-Error, Ex-E, Goals),
 1701      numbervars(Ex-E-Goals, 0, _),
 1702      write_options(OPS)
 1703    },
 1704    [ 'wrong error'-[], nl ],
 1705    expected_got_ops_(Ex, E, OPS, Goals).
 1706failure(wrong_answer(Cmp)) -->
 1707    { Cmp =.. [Op,Answer,Expected],
 1708      !,
 1709      copy_term(Expected-Answer, Ex-A, Goals),
 1710      numbervars(Ex-A-Goals, 0, _),
 1711      write_options(OPS)
 1712    },
 1713    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 1714    expected_got_ops_(Ex, A, OPS, Goals).
 1715failure(wrong_answer(CmpExpected, Bindings)) -->
 1716    { (   CmpExpected = all(Cmp)
 1717      ->  Cmp =.. [_Op1,_,Expected],
 1718          Got = Bindings,
 1719          Type = all
 1720      ;   CmpExpected = set(Cmp),
 1721          Cmp =.. [_Op2,_,Expected0],
 1722          sort(Expected0, Expected),
 1723          sort(Bindings, Got),
 1724          Type = set
 1725      )
 1726    },
 1727    [ 'wrong "~w" answer:'-[Type] ],
 1728    [ nl, '    Expected: ~q'-[Expected] ],
 1729    [ nl, '       Found: ~q'-[Got] ].
 1730:- if(swi). 1731failure(cmp_error(_Cmp, Error)) -->
 1732    { message_to_string(Error, Message) },
 1733    [ 'Comparison error: ~w'-[Message] ].
 1734failure(Error) -->
 1735    { Error = error(_,_),
 1736      !,
 1737      message_to_string(Error, Message)
 1738    },
 1739    [ 'received error: ~w'-[Message] ].
 1740:- endif. 1741failure(Why) -->
 1742    [ '~p~n'-[Why] ].
 1743
 1744fixme_message([]) --> [].
 1745fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 1746    { unit_file(Unit, File) },
 1747    fixme_message(File:Line, Reason, How),
 1748    (   {T == []}
 1749    ->  []
 1750    ;   [nl],
 1751        fixme_message(T)
 1752    ).
 1753
 1754fixme_message(Location, Reason, failed) -->
 1755    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 1756fixme_message(Location, Reason, passed) -->
 1757    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 1758fixme_message(Location, Reason, nondet) -->
 1759    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 1760
 1761
 1762write_options([ numbervars(true),
 1763                quoted(true),
 1764                portray(true),
 1765                max_depth(100),
 1766                attributes(portray)
 1767              ]).
 1768
 1769:- if(swi). 1770
 1771:- multifile
 1772    prolog:message/3,
 1773    user:message_hook/3. 1774
 1775prolog:message(Term) -->
 1776    message(Term).
 1777
 1778%       user:message_hook(+Term, +Kind, +Lines)
 1779
 1780user:message_hook(make(done(Files)), _, _) :-
 1781    make_run_tests(Files),
 1782    fail.                           % give other hooks a chance
 1783
 1784:- endif. 1785
 1786:- if(sicstus). 1787
 1788user:generate_message_hook(Message) -->
 1789    message(Message),
 1790    [nl].                           % SICStus requires nl at the end
 user:message_hook(+Severity, +Message, +Lines) is semidet
Redefine printing some messages. It appears SICStus has no way to get multiple messages at the same line, so we roll our own. As there is a lot pre-wired and checked in the SICStus message handling we cannot reuse the lines. Unless I miss something ...
 1799user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
 1800    format(user_error, '% PL-Unit: ~w ', [Unit]),
 1801    flush_output(user_error).
 1802user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
 1803    format(user, ' done~n', []).
 1804
 1805:- endif.