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

   56:- autoload(library(apply),[maplist/3,include/3]).   57:- autoload(library(lists),[member/2,append/2]).   58:- autoload(library(option),[option/3,option/2]).   59:- autoload(library(ordsets),[ord_intersection/3]).   60:- autoload(library(pairs),[group_pairs_by_key/2,pairs_values/2]).   61:- autoload(library(error),[must_be/2]).   62
   63:- meta_predicate valid_options(+, 1).   64
   65
   66                 /*******************************
   67                 *    CONDITIONAL COMPILATION   *
   68                 *******************************/
   69
   70:- discontiguous
   71    user:term_expansion/2.   72
   73:- dynamic
   74    include_code/1.   75
   76including :-
   77    include_code(X),
   78    !,
   79    X == true.
   80including.
   81
   82if_expansion((:- if(G)), []) :-
   83    (   including
   84    ->  (   catch(G, E, (print_message(error, E), fail))
   85        ->  asserta(include_code(true))
   86        ;   asserta(include_code(false))
   87        )
   88    ;   asserta(include_code(else_false))
   89    ).
   90if_expansion((:- else), []) :-
   91    (   retract(include_code(X))
   92    ->  (   X == true
   93        ->  X2 = false
   94        ;   X == false
   95        ->  X2 = true
   96        ;   X2 = X
   97        ),
   98        asserta(include_code(X2))
   99    ;   throw_error(context_error(no_if),_)
  100    ).
  101if_expansion((:- endif), []) :-
  102    retract(include_code(_)),
  103    !.
  104
  105if_expansion(_, []) :-
  106    \+ including.
  107
  108user:term_expansion(In, Out) :-
  109    prolog_load_context(module, plunit),
  110    if_expansion(In, Out).
  111
  112swi     :- catch(current_prolog_flag(dialect, swi), _, fail), !.
  113swi     :- catch(current_prolog_flag(dialect, yap), _, fail).
  114sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
  115
  116
  117:- if(swi).  118throw_error(Error_term,Impldef) :-
  119    throw(error(Error_term,context(Impldef,_))).
  120
  121:- set_prolog_flag(generate_debug_info, false).  122current_test_flag(Name, Value) :-
  123    current_prolog_flag(Name, Value).
  124
  125set_test_flag(Name, Value) :-
  126    create_prolog_flag(Name, Value, []).
  127
  128% ensure expansion to avoid tracing
  129goal_expansion(forall(C,A),
  130               \+ (C, \+ A)).
  131goal_expansion(current_module(Module,File),
  132               module_property(Module, file(File))).
  133
  134:- if(current_prolog_flag(dialect, yap)).  135
  136'$set_predicate_attribute'(_, _, _).
  137
  138:- endif.  139:- endif.  140
  141:- if(sicstus).  142throw_error(Error_term,Impldef) :-
  143    throw(error(Error_term,i(Impldef))). % SICStus 3 work around
  144
  145% SWI-Compatibility
  146:- op(700, xfx, =@=).  147
  148'$set_source_module'(_, _).

 current_test_flag(?Name, ?Value) is nondet

Query flags that control the testing process. Emulates SWI-Prologs flags.

  155:- dynamic test_flag/2. % Name, Val
  156
  157current_test_flag(optimise, Val) :-
  158    current_prolog_flag(compiling, Compiling),
  159    (   Compiling == debugcode ; true % TBD: Proper test
  160    ->  Val = false
  161    ;   Val = true
  162    ).
  163current_test_flag(Name, Val) :-
  164    test_flag(Name, Val).

 set_test_flag(+Name, +Value) is det

  169set_test_flag(Name, Val) :-
  170    var(Name),
  171    !,
  172    throw_error(instantiation_error, set_test_flag(Name,Val)).
  173set_test_flag( Name, Val ) :-
  174    retractall(test_flag(Name,_)),
  175    asserta(test_flag(Name, Val)).
  176
  177:- op(1150, fx, thread_local).  178
  179user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :-
  180    prolog_load_context(module, plunit).
  181
  182:- endif.  183
  184                 /*******************************
  185                 *            IMPORTS           *
  186                 *******************************/
  187
  188:- initialization
  189   (   current_test_flag(test_options, _)
  190   ->  true
  191   ;   set_test_flag(test_options,
  192                 [ run(make),       % run tests on make/0
  193                   sto(false)
  194                 ])
  195   ).

 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.

  226set_test_options(Options) :-
  227    valid_options(Options, global_test_option),
  228    set_test_flag(test_options, Options).
  229
  230global_test_option(load(Load)) :-
  231    must_be(oneof([never,always,normal]), Load).
  232global_test_option(run(When)) :-
  233    must_be(oneof([manual,make,make(all)]), When).
  234global_test_option(silent(Bool)) :-
  235    must_be(boolean, Bool).
  236global_test_option(sto(Bool)) :-
  237    must_be(boolean, Bool).
  238global_test_option(cleanup(Bool)) :-
  239    must_be(boolean, Bool).

 loading_tests

True if tests must be loaded.

  246loading_tests :-
  247    current_test_flag(test_options, Options),
  248    option(load(Load), Options, normal),
  249    (   Load == always
  250    ->  true
  251    ;   Load == normal,
  252        \+ current_test_flag(optimise, true)
  253    ).
  254
  255                 /*******************************
  256                 *            MODULE            *
  257                 *******************************/
  258
  259:- dynamic
  260    loading_unit/4,                 % Unit, Module, File, OldSource
  261    current_unit/4,                 % Unit, Module, Context, Options
  262    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).

  270begin_tests(Unit) :-
  271    begin_tests(Unit, []).
  272
  273begin_tests(Unit, Options) :-
  274    valid_options(Options, test_set_option),
  275    make_unit_module(Unit, Name),
  276    source_location(File, Line),
  277    begin_tests(Unit, Name, File:Line, Options).
  278
  279:- if(swi).  280begin_tests(Unit, Name, File:Line, Options) :-
  281    loading_tests,
  282    !,
  283    '$set_source_module'(Context, Context),
  284    (   current_unit(Unit, Name, Context, Options)
  285    ->  true
  286    ;   retractall(current_unit(Unit, Name, _, _)),
  287        assert(current_unit(Unit, Name, Context, Options))
  288    ),
  289    '$set_source_module'(Old, Name),
  290    '$declare_module'(Name, test, Context, File, Line, false),
  291    discontiguous(Name:'unit test'/4),
  292    '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
  293    discontiguous(Name:'unit body'/2),
  294    asserta(loading_unit(Unit, Name, File, Old)).
  295begin_tests(Unit, Name, File:_Line, _Options) :-
  296    '$set_source_module'(Old, Old),
  297    asserta(loading_unit(Unit, Name, File, Old)).
  298
  299:- else.  300
  301% we cannot use discontiguous as a goal in SICStus Prolog.
  302
  303user:term_expansion((:- begin_tests(Set)),
  304                    [ (:- begin_tests(Set)),
  305                      (:- discontiguous(test/2)),
  306                      (:- discontiguous('unit body'/2)),
  307                      (:- discontiguous('unit test'/4))
  308                    ]).
  309
  310begin_tests(Unit, Name, File:_Line, Options) :-
  311    loading_tests,
  312    !,
  313    (   current_unit(Unit, Name, _, Options)
  314    ->  true
  315    ;   retractall(current_unit(Unit, Name, _, _)),
  316        assert(current_unit(Unit, Name, -, Options))
  317    ),
  318    asserta(loading_unit(Unit, Name, File, -)).
  319begin_tests(Unit, Name, File:_Line, _Options) :-
  320    asserta(loading_unit(Unit, Name, File, -)).
  321
  322:- endif.

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  331end_tests(Unit) :-
  332    loading_unit(StartUnit, _, _, _),
  333    !,
  334    (   Unit == StartUnit
  335    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  336        '$set_source_module'(_, Old)
  337    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  338    ).
  339end_tests(Unit) :-
  340    throw_error(context_error(plunit_close(Unit, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  345:- if(swi).  346
  347unit_module(Unit, Module) :-
  348    atom_concat('plunit_', Unit, Module).
  349
  350make_unit_module(Unit, Module) :-
  351    unit_module(Unit, Module),
  352    (   current_module(Module),
  353        \+ current_unit(_, Module, _, _),
  354        predicate_property(Module:H, _P),
  355        \+ predicate_property(Module:H, imported_from(_M))
  356    ->  throw_error(permission_error(create, plunit, Unit),
  357                    'Existing module')
  358    ;  true
  359    ).
  360
  361:- else.  362
  363:- dynamic
  364    unit_module_store/2.  365
  366unit_module(Unit, Module) :-
  367    unit_module_store(Unit, Module),
  368    !.
  369
  370make_unit_module(Unit, Module) :-
  371    prolog_load_context(module, Module),
  372    assert(unit_module_store(Unit, Module)).
  373
  374:- endif.  375
  376                 /*******************************
  377                 *           EXPANSION          *
  378                 *******************************/

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

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

  385expand_test(Name, Options0, Body,
  386            [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
  387              ('unit body'(Id, Vars) :- !, Body)
  388            ]) :-
  389    source_location(_File, Line),
  390    prolog_load_context(module, Module),
  391    atomic_list_concat([Name, '@line ', Line], Id),
  392    term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
  393    term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
  394    ord_intersection(OptionVars, BodyVars, VarList),
  395    Vars =.. [vars|VarList],
  396    (   is_list(Options0)           % allow for single option without list
  397    ->  Options1 = Options0
  398    ;   Options1 = [Options0]
  399    ),
  400    maplist(expand_option, Options1, Options2),
  401    valid_options(Options2, test_option),
  402    valid_test_mode(Options2, Options).
  403
  404expand_option(Var, _) :-
  405    var(Var),
  406    !,
  407    throw_error(instantiation_error,_).
  408expand_option(A == B, true(A==B)) :- !.
  409expand_option(A = B, true(A=B)) :- !.
  410expand_option(A =@= B, true(A=@=B)) :- !.
  411expand_option(A =:= B, true(A=:=B)) :- !.
  412expand_option(error(X), throws(error(X, _))) :- !.
  413expand_option(exception(X), throws(X)) :- !. % SICStus 4 compatibility
  414expand_option(error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
  415expand_option(true, true(true)) :- !.
  416expand_option(O, O).
  417
  418valid_test_mode(Options0, Options) :-
  419    include(test_mode, Options0, Tests),
  420    (   Tests == []
  421    ->  Options = [true(true)|Options0]
  422    ;   Tests = [_]
  423    ->  Options = Options0
  424    ;   throw_error(plunit(incompatible_options, Tests), _)
  425    ).
  426
  427test_mode(true(_)).
  428test_mode(all(_)).
  429test_mode(set(_)).
  430test_mode(fail).
  431test_mode(throws(_)).

 expand(+Term, -Clauses) is semidet

  436expand(end_of_file, _) :-
  437    loading_unit(Unit, _, _, _),
  438    !,
  439    end_tests(Unit),                % warn?
  440    fail.
  441expand((:-end_tests(_)), _) :-
  442    !,
  443    fail.
  444expand(_Term, []) :-
  445    \+ loading_tests.
  446expand((test(Name) :- Body), Clauses) :-
  447    !,
  448    expand_test(Name, [], Body, Clauses).
  449expand((test(Name, Options) :- Body), Clauses) :-
  450    !,
  451    expand_test(Name, Options, Body, Clauses).
  452expand(test(Name), _) :-
  453    !,
  454    throw_error(existence_error(body, test(Name)), _).
  455expand(test(Name, _Options), _) :-
  456    !,
  457    throw_error(existence_error(body, test(Name)), _).
  458
  459:- if(swi).  460:- multifile
  461    system:term_expansion/2.  462:- endif.  463
  464system:term_expansion(Term, Expanded) :-
  465    (   loading_unit(_, _, File, _)
  466    ->  source_location(File, _),
  467        expand(Term, Expanded)
  468    ).
  469
  470
  471                 /*******************************
  472                 *             OPTIONS          *
  473                 *******************************/
  474
  475:- if(swi).  476:- else.  477must_be(list, X) :-
  478    !,
  479    (   is_list(X)
  480    ->  true
  481    ;   is_not(list, X)
  482    ).
  483must_be(Type, X) :-
  484    (   call(Type, X)
  485    ->  true
  486    ;   is_not(Type, X)
  487    ).
  488
  489is_not(Type, X) :-
  490    (   ground(X)
  491    ->  throw_error(type_error(Type, X), _)
  492    ;   throw_error(instantiation_error, _)
  493    ).
  494:- 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.

  503valid_options(Options, Pred) :-
  504    must_be(list, Options),
  505    verify_options(Options, Pred).
  506
  507verify_options([], _).
  508verify_options([H|T], Pred) :-
  509    (   call(Pred, H)
  510    ->  verify_options(T, Pred)
  511    ;   throw_error(domain_error(Pred, H), _)
  512    ).

 test_option(+Option) is semidet

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

  519test_option(Option) :-
  520    test_set_option(Option),
  521    !.
  522test_option(true(_)).
  523test_option(fail).
  524test_option(throws(_)).
  525test_option(all(_)).
  526test_option(set(_)).
  527test_option(nondet).
  528test_option(fixme(_)).
  529test_option(forall(X)) :-
  530    must_be(callable, X).

 test_option(+Option) is semidet

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

  537test_set_option(blocked(X)) :-
  538    must_be(ground, X).
  539test_set_option(condition(X)) :-
  540    must_be(callable, X).
  541test_set_option(setup(X)) :-
  542    must_be(callable, X).
  543test_set_option(cleanup(X)) :-
  544    must_be(callable, X).
  545test_set_option(sto(V)) :-
  546    nonvar(V), member(V, [finite_trees, rational_trees]).
  547
  548
  549                 /*******************************
  550                 *        RUNNING TOPLEVEL      *
  551                 *******************************/
  552
  553:- thread_local
  554    passed/5,                       % Unit, Test, Line, Det, Time
  555    failed/4,                       % Unit, Test, Line, Reason
  556    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  557    blocked/4,                      % Unit, Test, Line, Reason
  558    sto/4,                          % Unit, Test, Line, Results
  559    fixme/5.                        % Unit, Test, Line, Reason, Status
  560
  561:- dynamic
  562    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.

  575run_tests :-
  576    cleanup,
  577    setup_call_cleanup(
  578        setup_trap_assertions(Ref),
  579        run_current_units,
  580        report_and_cleanup(Ref)).
  581
  582run_current_units :-
  583    forall(current_test_set(Set),
  584           run_unit(Set)),
  585    check_for_test_errors.
  586
  587report_and_cleanup(Ref) :-
  588    cleanup_trap_assertions(Ref),
  589    report,
  590    cleanup_after_test.
  591
  592run_tests(Set) :-
  593    cleanup,
  594    setup_call_cleanup(
  595        setup_trap_assertions(Ref),
  596        run_unit_and_check_errors(Set),
  597        report_and_cleanup(Ref)).
  598
  599run_unit_and_check_errors(Set) :-
  600    run_unit(Set),
  601    check_for_test_errors.
  602
  603run_unit([]) :- !.
  604run_unit([H|T]) :-
  605    !,
  606    run_unit(H),
  607    run_unit(T).
  608run_unit(Spec) :-
  609    unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
  610    (   option(blocked(Reason), UnitOptions)
  611    ->  info(plunit(blocked(unit(Unit, Reason))))
  612    ;   setup(Module, unit(Unit), UnitOptions)
  613    ->  info(plunit(begin(Spec))),
  614        forall((Module:'unit test'(Name, Line, Options, Body),
  615                matching_test(Name, Tests)),
  616               run_test(Unit, Name, Line, Options, Body)),
  617        info(plunit(end(Spec))),
  618        (   message_level(silent)
  619        ->  true
  620        ;   format(user_error, '~N', [])
  621        ),
  622        cleanup(Module, UnitOptions)
  623    ;   true
  624    ).
  625
  626unit_from_spec(Unit, Unit, _, Module, Options) :-
  627    atom(Unit),
  628    !,
  629    (   current_unit(Unit, Module, _Supers, Options)
  630    ->  true
  631    ;   throw_error(existence_error(unit_test, Unit), _)
  632    ).
  633unit_from_spec(Unit:Tests, Unit, Tests, Module, Options) :-
  634    atom(Unit),
  635    !,
  636    (   current_unit(Unit, Module, _Supers, Options)
  637    ->  true
  638    ;   throw_error(existence_error(unit_test, Unit), _)
  639    ).
  640
  641
  642matching_test(X, X) :- !.
  643matching_test(Name, Set) :-
  644    is_list(Set),
  645    memberchk(Name, Set).
  646
  647cleanup :-
  648    thread_self(Me),
  649    retractall(passed(_, _, _, _, _)),
  650    retractall(failed(_, _, _, _)),
  651    retractall(failed_assertion(_, _, _, _, _, _, _)),
  652    retractall(blocked(_, _, _, _)),
  653    retractall(sto(_, _, _, _)),
  654    retractall(fixme(_, _, _, _, _)),
  655    retractall(running(_,_,_,_,Me)).
  656
  657cleanup_after_test :-
  658    current_test_flag(test_options, Options),
  659    option(cleanup(Cleanup), Options, false),
  660    (   Cleanup == true
  661    ->  cleanup
  662    ;   true
  663    ).

 run_tests_in_files(+Files:list) is det

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

  670run_tests_in_files(Files) :-
  671    findall(Unit, unit_in_files(Files, Unit), Units),
  672    (   Units == []
  673    ->  true
  674    ;   run_tests(Units)
  675    ).
  676
  677unit_in_files(Files, Unit) :-
  678    is_list(Files),
  679    !,
  680    member(F, Files),
  681    absolute_file_name(F, Source,
  682                       [ file_type(prolog),
  683                         access(read),
  684                         file_errors(fail)
  685                       ]),
  686    unit_file(Unit, Source).
  687
  688
  689                 /*******************************
  690                 *         HOOKING MAKE/0       *
  691                 *******************************/

 make_run_tests(+Files)

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

  697make_run_tests(Files) :-
  698    current_test_flag(test_options, Options),
  699    option(run(When), Options, manual),
  700    (   When == make
  701    ->  run_tests_in_files(Files)
  702    ;   When == make(all)
  703    ->  run_tests
  704    ;   true
  705    ).
  706
  707:- if(swi).  708
  709unification_capability(sto_error_incomplete).
  710% can detect some (almost all) STO runs
  711unification_capability(rational_trees).
  712unification_capability(finite_trees).
  713
  714set_unification_capability(Cap) :-
  715    cap_to_flag(Cap, Flag),
  716    set_prolog_flag(occurs_check, Flag).
  717
  718current_unification_capability(Cap) :-
  719    current_prolog_flag(occurs_check, Flag),
  720    cap_to_flag(Cap, Flag),
  721    !.
  722
  723cap_to_flag(sto_error_incomplete, error).
  724cap_to_flag(rational_trees, false).
  725cap_to_flag(finite_trees, true).
  726
  727:- else.  728:- if(sicstus).  729
  730unification_capability(rational_trees).
  731set_unification_capability(rational_trees).
  732current_unification_capability(rational_trees).
  733
  734:- else.  735
  736unification_capability(_) :-
  737    fail.
  738
  739:- endif.  740:- endif.  741
  742                 /*******************************
  743                 *      ASSERTION HANDLING      *
  744                 *******************************/
  745
  746:- if(swi).  747
  748:- dynamic prolog:assertion_failed/2.  749
  750setup_trap_assertions(Ref) :-
  751    asserta((prolog:assertion_failed(Reason, Goal) :-
  752                    test_assertion_failed(Reason, Goal)),
  753            Ref).
  754
  755cleanup_trap_assertions(Ref) :-
  756    erase(Ref).
  757
  758test_assertion_failed(Reason, Goal) :-
  759    thread_self(Me),
  760    running(Unit, Test, Line, STO, Me),
  761    (   catch(get_prolog_backtrace(10, Stack), _, fail),
  762        assertion_location(Stack, AssertLoc)
  763    ->  true
  764    ;   AssertLoc = unknown
  765    ),
  766    current_test_flag(test_options, Options),
  767    report_failed_assertion(Unit, Test, Line, AssertLoc,
  768                            STO, Reason, Goal, Options),
  769    assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
  770                                   STO, Reason, Goal)).
  771
  772assertion_location(Stack, File:Line) :-
  773    append(_, [AssertFrame,CallerFrame|_], Stack),
  774    prolog_stack_frame_property(AssertFrame,
  775                                predicate(prolog_debug:assertion/1)),
  776    !,
  777    prolog_stack_frame_property(CallerFrame, location(File:Line)).
  778
  779report_failed_assertion(Unit, Test, Line, AssertLoc,
  780                        STO, Reason, Goal, _Options) :-
  781    print_message(
  782        error,
  783        plunit(failed_assertion(Unit, Test, Line, AssertLoc,
  784                                STO, Reason, Goal))).
  785
  786:- else.  787
  788setup_trap_assertions(_).
  789cleanup_trap_assertions(_).
  790
  791:- endif.  792
  793
  794                 /*******************************
  795                 *         RUNNING A TEST       *
  796                 *******************************/

 run_test(+Unit, +Name, +Line, +Options, +Body) is det

Run a single test.

  802run_test(Unit, Name, Line, Options, Body) :-
  803    option(forall(Generator), Options),
  804    !,
  805    unit_module(Unit, Module),
  806    term_variables(Generator, Vars),
  807    forall(Module:Generator,
  808           run_test_once(Unit, @(Name,Vars), Line, Options, Body)).
  809run_test(Unit, Name, Line, Options, Body) :-
  810    run_test_once(Unit, Name, Line, Options, Body).
  811
  812run_test_once(Unit, Name, Line, Options, Body) :-
  813    current_test_flag(test_options, GlobalOptions),
  814    option(sto(false), GlobalOptions, false),
  815    !,
  816    current_unification_capability(Type),
  817    begin_test(Unit, Name, Line, Type),
  818    run_test_6(Unit, Name, Line, Options, Body, Result),
  819    end_test(Unit, Name, Line, Type),
  820    report_result(Result, Options).
  821run_test_once(Unit, Name, Line, Options, Body) :-
  822    current_unit(Unit, _Module, _Supers, UnitOptions),
  823    option(sto(Type), UnitOptions),
  824    \+ option(sto(_), Options),
  825    !,
  826    current_unification_capability(Cap0),
  827    call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body),
  828                 set_unification_capability(Cap0)).
  829run_test_once(Unit, Name, Line, Options, Body) :-
  830    current_unification_capability(Cap0),
  831    call_cleanup(run_test_cap(Unit, Name, Line, Options, Body),
  832                 set_unification_capability(Cap0)).
  833
  834run_test_cap(Unit, Name, Line, Options, Body) :-
  835    (   option(sto(Type), Options)
  836    ->  unification_capability(Type),
  837        set_unification_capability(Type),
  838        begin_test(Unit, Name, Line, Type),
  839        run_test_6(Unit, Name, Line, Options, Body, Result),
  840        end_test(Unit, Name, Line, Type),
  841        report_result(Result, Options)
  842    ;   findall(Key-(Type+Result),
  843                test_caps(Type, Unit, Name, Line, Options, Body, Result, Key),
  844                Pairs),
  845        group_pairs_by_key(Pairs, Keyed),
  846        (   Keyed == []
  847        ->  true
  848        ;   Keyed = [_-Results]
  849        ->  Results = [_Type+Result|_],
  850            report_result(Result, Options)          % consistent results
  851        ;   pairs_values(Pairs, ResultByType),
  852            report_result(sto(Unit, Name, Line, ResultByType), Options)
  853        )
  854    ).

 test_caps(-Type, +Unit, +Name, +Line, +Options, +Body, -Result, -Key) is nondet

  858test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :-
  859    unification_capability(Type),
  860    set_unification_capability(Type),
  861    begin_test(Unit, Name, Line, Type),
  862    run_test_6(Unit, Name, Line, Options, Body, Result),
  863    end_test(Unit, Name, Line, Type),
  864    result_to_key(Result, Key),
  865    Key \== setup_failed.
  866
  867result_to_key(blocked(_, _, _, _), blocked).
  868result_to_key(failure(_, _, _, How0), failure(How1)) :-
  869    ( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ).
  870result_to_key(success(_, _, _, Determinism, _), success(Determinism)).
  871result_to_key(setup_failed(_,_,_), setup_failed).
  872
  873report_result(blocked(Unit, Name, Line, Reason), _) :-
  874    !,
  875    assert(blocked(Unit, Name, Line, Reason)).
  876report_result(failure(Unit, Name, Line, How), Options) :-
  877    !,
  878    failure(Unit, Name, Line, How, Options).
  879report_result(success(Unit, Name, Line, Determinism, Time), Options) :-
  880    !,
  881    success(Unit, Name, Line, Determinism, Time, Options).
  882report_result(setup_failed(_Unit, _Name, _Line), _Options).
  883report_result(sto(Unit, Name, Line, ResultByType), Options) :-
  884    assert(sto(Unit, Name, Line, ResultByType)),
  885    print_message(error, plunit(sto(Unit, Name, Line))),
  886    report_sto_results(ResultByType, Options).
  887
  888report_sto_results([], _).
  889report_sto_results([Type+Result|T], Options) :-
  890    print_message(error, plunit(sto(Type, Result))),
  891    report_sto_results(T, Options).

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

Result is one of:

• blocked(Unit, Name, Line, Reason)
• failure(Unit, Name, Line, How)
• success(Unit, Name, Line, Determinism, Time)
• setup_failed(Unit, Name, Line)

  903run_test_6(Unit, Name, Line, Options, _Body,
  904           blocked(Unit, Name, Line, Reason)) :-
  905    option(blocked(Reason), Options),
  906    !.
  907run_test_6(Unit, Name, Line, Options, Body, Result) :-
  908    option(all(Answer), Options),                  % all(Bindings)
  909    !,
  910    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
  911run_test_6(Unit, Name, Line, Options, Body, Result) :-
  912    option(set(Answer), Options),                  % set(Bindings)
  913    !,
  914    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
  915run_test_6(Unit, Name, Line, Options, Body, Result) :-
  916    option(fail, Options),                         % fail
  917    !,
  918    unit_module(Unit, Module),
  919    (   setup(Module, test(Unit,Name,Line), Options)
  920    ->  statistics(runtime, [T0,_]),
  921        (   catch(Module:Body, E, true)
  922        ->  (   var(E)
  923            ->  statistics(runtime, [T1,_]),
  924                Time is (T1 - T0)/1000.0,
  925                Result = failure(Unit, Name, Line, succeeded(Time)),
  926                cleanup(Module, Options)
  927            ;   Result = failure(Unit, Name, Line, E),
  928                cleanup(Module, Options)
  929            )
  930        ;   statistics(runtime, [T1,_]),
  931            Time is (T1 - T0)/1000.0,
  932            Result = success(Unit, Name, Line, true, Time),
  933            cleanup(Module, Options)
  934        )
  935    ;   Result = setup_failed(Unit, Name, Line)
  936    ).
  937run_test_6(Unit, Name, Line, Options, Body, Result) :-
  938    option(true(Cmp), Options),
  939    !,
  940    unit_module(Unit, Module),
  941    (   setup(Module, test(Unit,Name,Line), Options) % true(Binding)
  942    ->  statistics(runtime, [T0,_]),
  943        (   catch(call_det(Module:Body, Det), E, true)
  944        ->  (   var(E)
  945            ->  statistics(runtime, [T1,_]),
  946                Time is (T1 - T0)/1000.0,
  947                (   catch(Module:Cmp, E, true)
  948                ->  (   var(E)
  949                    ->  Result = success(Unit, Name, Line, Det, Time)
  950                    ;   Result = failure(Unit, Name, Line, cmp_error(Cmp, E))
  951                    )
  952                ;   Result = failure(Unit, Name, Line, wrong_answer(Cmp))
  953                ),
  954                cleanup(Module, Options)
  955            ;   Result = failure(Unit, Name, Line, E),
  956                cleanup(Module, Options)
  957            )
  958        ;   Result = failure(Unit, Name, Line, failed),
  959            cleanup(Module, Options)
  960        )
  961    ;   Result = setup_failed(Unit, Name, Line)
  962    ).
  963run_test_6(Unit, Name, Line, Options, Body, Result) :-
  964    option(throws(Expect), Options),
  965    !,
  966    unit_module(Unit, Module),
  967    (   setup(Module, test(Unit,Name,Line), Options)
  968    ->  statistics(runtime, [T0,_]),
  969        (   catch(Module:Body, E, true)
  970        ->  (   var(E)
  971            ->  Result = failure(Unit, Name, Line, no_exception),
  972                cleanup(Module, Options)
  973            ;   statistics(runtime, [T1,_]),
  974                Time is (T1 - T0)/1000.0,
  975                (   match_error(Expect, E)
  976                ->  Result = success(Unit, Name, Line, true, Time)
  977                ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E))
  978                ),
  979                cleanup(Module, Options)
  980            )
  981        ;   Result = failure(Unit, Name, Line, failed),
  982            cleanup(Module, Options)
  983        )
  984    ;   Result = setup_failed(Unit, Name, Line)
  985    ).

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

Run tests on non-deterministic predicates.

  992nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
  993    unit_module(Unit, Module),
  994    result_vars(Expected, Vars),
  995    statistics(runtime, [T0,_]),
  996    (   setup(Module, test(Unit,Name,Line), Options)
  997    ->  (   catch(findall(Vars, Module:Body, Bindings), E, true)
  998        ->  (   var(E)
  999            ->  statistics(runtime, [T1,_]),
 1000                Time is (T1 - T0)/1000.0,
 1001                (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1002                ->  Result = success(Unit, Name, Line, true, Time)
 1003                ;   Result = failure(Unit, Name, Line, wrong_answer(Expected, Bindings))
 1004                ),
 1005                cleanup(Module, Options)
 1006            ;   Result = failure(Unit, Name, Line, E),
 1007                cleanup(Module, Options)
 1008            )
 1009        )
 1010    ;   Result = setup_failed(Unit, Name, Line)
 1011    ).

 result_vars(+Expected, -Vars) is det

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

 1019result_vars(Expected, Vars) :-
 1020    arg(1, Expected, CmpOp),
 1021    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

 1031nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1032    cmp(Cmp, _Vars, Op, Values),
 1033    cmp_list(Values, Bindings, Op).
 1034nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1035    cmp(Cmp, _Vars, Op, Values0),
 1036    sort(Bindings0, Bindings),
 1037    sort(Values0, Values),
 1038    cmp_list(Values, Bindings, Op).
 1039
 1040cmp_list([], [], _Op).
 1041cmp_list([E0|ET], [V0|VT], Op) :-
 1042    call(Op, E0, V0),
 1043    cmp_list(ET, VT, Op).

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

 1047cmp(Var  == Value, Var,  ==, Value).
 1048cmp(Var =:= Value, Var, =:=, Value).
 1049cmp(Var  =  Value, Var,  =,  Value).
 1050:- if(swi). 1051cmp(Var =@= Value, Var, =@=, Value).
 1052:- else. 1053:- if(sicstus). 1054cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1055:- endif. 1056:- endif.

 call_det(:Goal, -Det) is nondet

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

 1064:- if((swi|sicstus)). 1065call_det(Goal, Det) :-
 1066    call_cleanup(Goal,Det0=true),
 1067    ( var(Det0) -> Det = false ; Det = true ).
 1068:- else. 1069call_det(Goal, true) :-
 1070    call(Goal).
 1071:- endif.

 match_error(+Expected, +Received) is semidet

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

 1078match_error(Expect, Rec) :-
 1079    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

 1092setup(Module, Context, Options) :-
 1093    option(condition(Condition), Options),
 1094    option(setup(Setup), Options),
 1095    !,
 1096    setup(Module, Context, [condition(Condition)]),
 1097    setup(Module, Context, [setup(Setup)]).
 1098setup(Module, Context, Options) :-
 1099    option(setup(Setup), Options),
 1100    !,
 1101    (   catch(call_ex(Module, Setup), E, true)
 1102    ->  (   var(E)
 1103        ->  true
 1104        ;   print_message(error, plunit(error(setup, Context, E))),
 1105            fail
 1106        )
 1107    ;   print_message(error, error(goal_failed(Setup), _)),
 1108        fail
 1109    ).
 1110setup(Module, Context, Options) :-
 1111    option(condition(Setup), Options),
 1112    !,
 1113    (   catch(call_ex(Module, Setup), E, true)
 1114    ->  (   var(E)
 1115        ->  true
 1116        ;   print_message(error, plunit(error(condition, Context, E))),
 1117            fail
 1118        )
 1119    ;   fail
 1120    ).
 1121setup(_,_,_).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1127call_ex(Module, Goal) :-
 1128    Module:(expand_goal(Goal, GoalEx),
 1129                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.

 1136cleanup(Module, Options) :-
 1137    option(cleanup(Cleanup), Options, true),
 1138    (   catch(call_ex(Module, Cleanup), E, true)
 1139    ->  (   var(E)
 1140        ->  true
 1141        ;   print_message(warning, E)
 1142        )
 1143    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1144    ).
 1145
 1146success(Unit, Name, Line, Det, _Time, Options) :-
 1147    memberchk(fixme(Reason), Options),
 1148    !,
 1149    (   (   Det == true
 1150        ;   memberchk(nondet, Options)
 1151        )
 1152    ->  put_char(user_error, +),
 1153        Ok = passed
 1154    ;   put_char(user_error, !),
 1155        Ok = nondet
 1156    ),
 1157    flush_output(user_error),
 1158    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1159success(Unit, Name, Line, _, _, Options) :-
 1160    failed_assertion(Unit, Name, Line, _,_,_,_),
 1161    !,
 1162    failure(Unit, Name, Line, assertion, Options).
 1163success(Unit, Name, Line, Det, Time, Options) :-
 1164    assert(passed(Unit, Name, Line, Det, Time)),
 1165    (   (   Det == true
 1166        ;   memberchk(nondet, Options)
 1167        )
 1168    ->  put_char(user_error, .)
 1169    ;   unit_file(Unit, File),
 1170        print_message(warning, plunit(nondet(File, Line, Name)))
 1171    ),
 1172    flush_output(user_error).
 1173
 1174failure(Unit, Name, Line, _, Options) :-
 1175    memberchk(fixme(Reason), Options),
 1176    !,
 1177    put_char(user_error, -),
 1178    flush_output(user_error),
 1179    assert(fixme(Unit, Name, Line, Reason, failed)).
 1180failure(Unit, Name, Line, E, Options) :-
 1181    report_failure(Unit, Name, Line, E, Options),
 1182    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.

 1192:- if(swi). 1193assert_cyclic(Term) :-
 1194    acyclic_term(Term),
 1195    !,
 1196    assert(Term).
 1197assert_cyclic(Term) :-
 1198    Term =.. [Functor|Args],
 1199    recorda(cyclic, Args, Id),
 1200    functor(Term, _, Arity),
 1201    length(NewArgs, Arity),
 1202    Head =.. [Functor|NewArgs],
 1203    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1204:- else. 1205:- if(sicstus). 1206:- endif. 1207assert_cyclic(Term) :-
 1208    assert(Term).
 1209:- endif. 1210
 1211
 1212                 /*******************************
 1213                 *            REPORTING         *
 1214                 *******************************/

 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:

• plunit(begin(Unit:Test, File:Line, STO))
• plunit(end(Unit:Test, File:Line, STO))

See also

- message_hook/3 for intercepting these messages

 1227begin_test(Unit, Test, Line, STO) :-
 1228    thread_self(Me),
 1229    assert(running(Unit, Test, Line, STO, Me)),
 1230    unit_file(Unit, File),
 1231    print_message(silent, plunit(begin(Unit:Test, File:Line, STO))).
 1232
 1233end_test(Unit, Test, Line, STO) :-
 1234    thread_self(Me),
 1235    retractall(running(_,_,_,_,Me)),
 1236    unit_file(Unit, File),
 1237    print_message(silent, plunit(end(Unit:Test, File:Line, STO))).

 running_tests is det

Print the currently running test.

 1243running_tests :-
 1244    running_tests(Running),
 1245    print_message(informational, plunit(running(Running))).
 1246
 1247running_tests(Running) :-
 1248    findall(running(Unit:Test, File:Line, STO, Thread),
 1249            (   running(Unit, Test, Line, STO, Thread),
 1250                unit_file(Unit, File)
 1251            ), Running).

 current_test(?Unit, ?Test, ?Line, ?Body, ?Options)

True when a test with the specified properties is loaded.

 1258current_test(Unit, Test, Line, Body, Options) :-
 1259    current_unit(Unit, Module, _Supers, _UnitOptions),
 1260    Module:'unit test'(Test, Line, Options, Body).

 check_for_test_errors is semidet

True if there are no errors, otherwise false.

 1266check_for_test_errors :-
 1267    number_of_clauses(failed/4, Failed),
 1268    number_of_clauses(failed_assertion/7, FailedAssertion),
 1269    number_of_clauses(sto/4, STO),
 1270    Failed+FailedAssertion+STO =:= 0.     % fail on errors

 report is det

Print a summary of the tests that ran.

 1277report :-
 1278    number_of_clauses(passed/5, Passed),
 1279    number_of_clauses(failed/4, Failed),
 1280    number_of_clauses(failed_assertion/7, FailedAssertion),
 1281    number_of_clauses(blocked/4, Blocked),
 1282    number_of_clauses(sto/4, STO),
 1283    (   Passed+Failed+FailedAssertion+Blocked+STO =:= 0
 1284    ->  info(plunit(no_tests))
 1285    ;   Failed+FailedAssertion+Blocked+STO =:= 0
 1286    ->  report_fixme,
 1287        info(plunit(all_passed(Passed)))
 1288    ;   report_blocked,
 1289        report_fixme,
 1290        report_failed_assertions,
 1291        report_failed,
 1292        report_sto,
 1293        info(plunit(passed(Passed)))
 1294    ).
 1295
 1296number_of_clauses(F/A,N) :-
 1297    (   current_predicate(F/A)
 1298    ->  functor(G,F,A),
 1299        findall(t, G, Ts),
 1300        length(Ts, N)
 1301    ;   N = 0
 1302    ).
 1303
 1304report_blocked :-
 1305    number_of_clauses(blocked/4,N),
 1306    N > 0,
 1307    !,
 1308    info(plunit(blocked(N))),
 1309    (   blocked(Unit, Name, Line, Reason),
 1310        unit_file(Unit, File),
 1311        print_message(informational,
 1312                      plunit(blocked(File:Line, Name, Reason))),
 1313        fail ; true
 1314    ).
 1315report_blocked.
 1316
 1317report_failed :-
 1318    number_of_clauses(failed/4, N),
 1319    info(plunit(failed(N))).
 1320
 1321report_failed_assertions :-
 1322    number_of_clauses(failed_assertion/7, N),
 1323    info(plunit(failed_assertions(N))).
 1324
 1325report_sto :-
 1326    number_of_clauses(sto/4, N),
 1327    info(plunit(sto(N))).
 1328
 1329report_fixme :-
 1330    report_fixme(_,_,_).
 1331
 1332report_fixme(TuplesF, TuplesP, TuplesN) :-
 1333    fixme(failed, TuplesF, Failed),
 1334    fixme(passed, TuplesP, Passed),
 1335    fixme(nondet, TuplesN, Nondet),
 1336    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1337
 1338
 1339fixme(How, Tuples, Count) :-
 1340    findall(fixme(Unit, Name, Line, Reason, How),
 1341            fixme(Unit, Name, Line, Reason, How), Tuples),
 1342    length(Tuples, Count).
 1343
 1344
 1345report_failure(_, _, _, assertion, _) :-
 1346    !,
 1347    put_char(user_error, 'A').
 1348report_failure(Unit, Name, Line, Error, _Options) :-
 1349    print_message(error, plunit(failed(Unit, Name, Line, Error))).

 test_report(What) is det

Produce reports on test results after the run.

 1356test_report(fixme) :-
 1357    !,
 1358    report_fixme(TuplesF, TuplesP, TuplesN),
 1359    append([TuplesF, TuplesP, TuplesN], Tuples),
 1360    print_message(informational, plunit(fixme(Tuples))).
 1361test_report(What) :-
 1362    throw_error(domain_error(report_class, What), _).
 1363
 1364
 1365                 /*******************************
 1366                 *             INFO             *
 1367                 *******************************/

 current_test_set(?Unit) is nondet

True if Unit is a currently loaded test-set.

 1373current_test_set(Unit) :-
 1374    current_unit(Unit, _Module, _Context, _Options).

 unit_file(+Unit, -File) is det

unit_file(-Unit, +File) is nondet

 1379unit_file(Unit, File) :-
 1380    current_unit(Unit, Module, _Context, _Options),
 1381    current_module(Module, File).
 1382unit_file(Unit, PlFile) :-
 1383    nonvar(PlFile),
 1384    test_file_for(TestFile, PlFile),
 1385    current_module(Module, TestFile),
 1386    current_unit(Unit, Module, _Context, _Options).
 1387
 1388
 1389                 /*******************************
 1390                 *             FILES            *
 1391                 *******************************/

 load_test_files(+Options) is det

Load .plt test-files related to loaded source-files.

 1397load_test_files(_Options) :-
 1398    (   source_file(File),
 1399        file_name_extension(Base, Old, File),
 1400        Old \== plt,
 1401        file_name_extension(Base, plt, TestFile),
 1402        exists_file(TestFile),
 1403        (   test_file_for(TestFile, File)
 1404        ->  true
 1405        ;   load_files(TestFile,
 1406                       [ if(changed),
 1407                         imports([])
 1408                       ]),
 1409            asserta(test_file_for(TestFile, File))
 1410        ),
 1411        fail ; true
 1412    ).
 1413
 1414
 1415
 1416                 /*******************************
 1417                 *           MESSAGES           *
 1418                 *******************************/

 info(+Term)

Runs print_message(Level, Term), where Level is one of silent or informational (default).

 1425info(Term) :-
 1426    message_level(Level),
 1427    print_message(Level, Term).
 1428
 1429message_level(Level) :-
 1430    current_test_flag(test_options, Options),
 1431    option(silent(Silent), Options, false),
 1432    (   Silent == false
 1433    ->  Level = informational
 1434    ;   Level = silent
 1435    ).
 1436
 1437locationprefix(File:Line) -->
 1438    !,
 1439    [ '~w:~d:\n\t'-[File,Line]].
 1440locationprefix(test(Unit,_Test,Line)) -->
 1441    !,
 1442    { unit_file(Unit, File) },
 1443    locationprefix(File:Line).
 1444locationprefix(unit(Unit)) -->
 1445    !,
 1446    [ 'PL-Unit: unit ~w: '-[Unit] ].
 1447locationprefix(FileLine) -->
 1448    { throw_error(type_error(locationprefix,FileLine), _) }.
 1449
 1450:- discontiguous
 1451    message//1. 1452
 1453message(error(context_error(plunit_close(Name, -)), _)) -->
 1454    [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
 1455message(error(context_error(plunit_close(Name, Start)), _)) -->
 1456    [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
 1457message(plunit(nondet(File, Line, Name))) -->
 1458    locationprefix(File:Line),
 1459    [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
 1460message(error(plunit(incompatible_options, Tests), _)) -->
 1461    [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
 1462
 1463                                        % Unit start/end
 1464:- if(swi). 1465message(plunit(begin(Unit))) -->
 1466    [ 'PL-Unit: ~w '-[Unit], flush ].
 1467message(plunit(end(_Unit))) -->
 1468    [ at_same_line, ' done' ].
 1469:- else. 1470message(plunit(begin(Unit))) -->
 1471    [ 'PL-Unit: ~w '-[Unit]/*, flush-[]*/ ].
 1472message(plunit(end(_Unit))) -->
 1473    [ ' done'-[] ].
 1474:- endif. 1475message(plunit(blocked(unit(Unit, Reason)))) -->
 1476    [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
 1477message(plunit(running([]))) -->
 1478    !,
 1479    [ 'PL-Unit: no tests running' ].
 1480message(plunit(running([One]))) -->
 1481    !,
 1482    [ 'PL-Unit: running ' ],
 1483    running(One).
 1484message(plunit(running(More))) -->
 1485    !,
 1486    [ 'PL-Unit: running tests:', nl ],
 1487    running(More).
 1488message(plunit(fixme([]))) --> !.
 1489message(plunit(fixme(Tuples))) -->
 1490    !,
 1491    fixme_message(Tuples).
 1492
 1493                                        % Blocked tests
 1494message(plunit(blocked(1))) -->
 1495    !,
 1496    [ 'one test is blocked:'-[] ].
 1497message(plunit(blocked(N))) -->
 1498    [ '~D tests are blocked:'-[N] ].
 1499message(plunit(blocked(Pos, Name, Reason))) -->
 1500    locationprefix(Pos),
 1501    test_name(Name),
 1502    [ ': ~w'-[Reason] ].
 1503
 1504                                        % fail/success
 1505message(plunit(no_tests)) -->
 1506    !,
 1507    [ 'No tests to run' ].
 1508message(plunit(all_passed(1))) -->
 1509    !,
 1510    [ 'test passed' ].
 1511message(plunit(all_passed(Count))) -->
 1512    !,
 1513    [ 'All ~D tests passed'-[Count] ].
 1514message(plunit(passed(Count))) -->
 1515    !,
 1516    [ '~D tests passed'-[Count] ].
 1517message(plunit(failed(0))) -->
 1518    !,
 1519    [].
 1520message(plunit(failed(1))) -->
 1521    !,
 1522    [ '1 test failed'-[] ].
 1523message(plunit(failed(N))) -->
 1524    [ '~D tests failed'-[N] ].
 1525message(plunit(failed_assertions(0))) -->
 1526    !,
 1527    [].
 1528message(plunit(failed_assertions(1))) -->
 1529    !,
 1530    [ '1 assertion failed'-[] ].
 1531message(plunit(failed_assertions(N))) -->
 1532    [ '~D assertions failed'-[N] ].
 1533message(plunit(sto(0))) -->
 1534    !,
 1535    [].
 1536message(plunit(sto(N))) -->
 1537    [ '~D test results depend on unification mode'-[N] ].
 1538message(plunit(fixme(0,0,0))) -->
 1539    [].
 1540message(plunit(fixme(Failed,0,0))) -->
 1541    !,
 1542    [ 'all ~D tests flagged FIXME failed'-[Failed] ].
 1543message(plunit(fixme(Failed,Passed,0))) -->
 1544    [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
 1545message(plunit(fixme(Failed,Passed,Nondet))) -->
 1546    { TotalPassed is Passed+Nondet },
 1547    [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
 1548      [Failed, TotalPassed, Nondet] ].
 1549message(plunit(failed(Unit, Name, Line, Failure))) -->
 1550    { unit_file(Unit, File) },
 1551    locationprefix(File:Line),
 1552    test_name(Name),
 1553    [': '-[] ],
 1554    failure(Failure).
 1555:- if(swi). 1556message(plunit(failed_assertion(Unit, Name, Line, AssertLoc,
 1557                                _STO, Reason, Goal))) -->
 1558    { unit_file(Unit, File) },
 1559    locationprefix(File:Line),
 1560    test_name(Name),
 1561    [ ': assertion'-[] ],
 1562    assertion_location(AssertLoc, File),
 1563    assertion_reason(Reason), ['\n\t'],
 1564    assertion_goal(Unit, Goal).
 1565
 1566assertion_location(File:Line, File) -->
 1567    [ ' at line ~w'-[Line] ].
 1568assertion_location(File:Line, _) -->
 1569    [ ' at ~w:~w'-[File, Line] ].
 1570assertion_location(unknown, _) -->
 1571    [].
 1572
 1573assertion_reason(fail) -->
 1574    !,
 1575    [ ' failed'-[] ].
 1576assertion_reason(Error) -->
 1577    { message_to_string(Error, String) },
 1578    [ ' raised "~w"'-[String] ].
 1579
 1580assertion_goal(Unit, Goal) -->
 1581    { unit_module(Unit, Module),
 1582      unqualify(Goal, Module, Plain)
 1583    },
 1584    [ 'Assertion: ~p'-[Plain] ].
 1585
 1586unqualify(Var, _, Var) :-
 1587    var(Var),
 1588    !.
 1589unqualify(M:Goal, Unit, Goal) :-
 1590    nonvar(M),
 1591    unit_module(Unit, M),
 1592    !.
 1593unqualify(M:Goal, _, Goal) :-
 1594    callable(Goal),
 1595    predicate_property(M:Goal, imported_from(system)),
 1596    !.
 1597unqualify(Goal, _, Goal).
 1598
 1599:- endif. 1600                                        % Setup/condition errors
 1601message(plunit(error(Where, Context, Exception))) -->
 1602    locationprefix(Context),
 1603    { message_to_string(Exception, String) },
 1604    [ 'error in ~w: ~w'-[Where, String] ].
 1605
 1606                                        % STO messages
 1607message(plunit(sto(Unit, Name, Line))) -->
 1608    { unit_file(Unit, File) },
 1609       locationprefix(File:Line),
 1610       test_name(Name),
 1611       [' is subject to occurs check (STO): '-[] ].
 1612message(plunit(sto(Type, Result))) -->
 1613    sto_type(Type),
 1614    sto_result(Result).
 1615
 1616                                        % Interrupts (SWI)
 1617:- if(swi). 1618message(interrupt(begin)) -->
 1619    { thread_self(Me),
 1620      running(Unit, Test, Line, STO, Me),
 1621      !,
 1622      unit_file(Unit, File)
 1623    },
 1624    [ 'Interrupted test '-[] ],
 1625    running(running(Unit:Test, File:Line, STO, Me)),
 1626    [nl],
 1627    '$messages':prolog_message(interrupt(begin)).
 1628message(interrupt(begin)) -->
 1629    '$messages':prolog_message(interrupt(begin)).
 1630:- endif. 1631
 1632test_name(@(Name,Bindings)) -->
 1633    !,
 1634    [ 'test ~w (forall bindings = ~p)'-[Name, Bindings] ].
 1635test_name(Name) -->
 1636    !,
 1637    [ 'test ~w'-[Name] ].
 1638
 1639sto_type(sto_error_incomplete) -->
 1640    [ 'Finite trees (error checking): ' ].
 1641sto_type(rational_trees) -->
 1642    [ 'Rational trees: ' ].
 1643sto_type(finite_trees) -->
 1644    [ 'Finite trees: ' ].
 1645
 1646sto_result(success(_Unit, _Name, _Line, Det, Time)) -->
 1647    det(Det),
 1648    [ ' success in ~2f seconds'-[Time] ].
 1649sto_result(failure(_Unit, _Name, _Line, How)) -->
 1650    failure(How).
 1651
 1652det(true) -->
 1653    [ 'deterministic' ].
 1654det(false) -->
 1655    [ 'non-deterministic' ].
 1656
 1657running(running(Unit:Test, File:Line, STO, Thread)) -->
 1658    thread(Thread),
 1659    [ '~q:~q at ~w:~d'-[Unit, Test, File, Line] ],
 1660    current_sto(STO).
 1661running([H|T]) -->
 1662    ['\t'], running(H),
 1663    (   {T == []}
 1664    ->  []
 1665    ;   [nl], running(T)
 1666    ).
 1667
 1668thread(main) --> !.
 1669thread(Other) -->
 1670    [' [~w] '-[Other] ].
 1671
 1672current_sto(sto_error_incomplete) -->
 1673    [ ' (STO: error checking)' ].
 1674current_sto(rational_trees) -->
 1675    [].
 1676current_sto(finite_trees) -->
 1677    [ ' (STO: occurs check enabled)' ].
 1678
 1679:- if(swi). 1680write_term(T, OPS) -->
 1681    ['~@'-[write_term(T,OPS)]].
 1682:- else. 1683write_term(T, _OPS) -->
 1684    ['~q'-[T]].
 1685:- endif. 1686
 1687expected_got_ops_(Ex, E, OPS, Goals) -->
 1688    ['    Expected: '-[]], write_term(Ex, OPS), [nl],
 1689    ['    Got:      '-[]], write_term(E,  OPS), [nl],
 1690    ( { Goals = [] } -> []
 1691    ; ['       with: '-[]], write_term(Goals, OPS), [nl]
 1692    ).
 1693
 1694
 1695failure(Var) -->
 1696    { var(Var) },
 1697    !,
 1698    [ 'Unknown failure?' ].
 1699failure(succeeded(Time)) -->
 1700    !,
 1701    [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
 1702failure(wrong_error(Expected, Error)) -->
 1703    !,
 1704    { copy_term(Expected-Error, Ex-E, Goals),
 1705      numbervars(Ex-E-Goals, 0, _),
 1706      write_options(OPS)
 1707    },
 1708    [ 'wrong error'-[], nl ],
 1709    expected_got_ops_(Ex, E, OPS, Goals).
 1710failure(wrong_answer(Cmp)) -->
 1711    { Cmp =.. [Op,Answer,Expected],
 1712      !,
 1713      copy_term(Expected-Answer, Ex-A, Goals),
 1714      numbervars(Ex-A-Goals, 0, _),
 1715      write_options(OPS)
 1716    },
 1717    [ 'wrong answer (compared using ~w)'-[Op], nl ],
 1718    expected_got_ops_(Ex, A, OPS, Goals).
 1719failure(wrong_answer(CmpExpected, Bindings)) -->
 1720    { (   CmpExpected = all(Cmp)
 1721      ->  Cmp =.. [_Op1,_,Expected],
 1722          Got = Bindings,
 1723          Type = all
 1724      ;   CmpExpected = set(Cmp),
 1725          Cmp =.. [_Op2,_,Expected0],
 1726          sort(Expected0, Expected),
 1727          sort(Bindings, Got),
 1728          Type = set
 1729      )
 1730    },
 1731    [ 'wrong "~w" answer:'-[Type] ],
 1732    [ nl, '    Expected: ~q'-[Expected] ],
 1733    [ nl, '       Found: ~q'-[Got] ].
 1734:- if(swi). 1735failure(cmp_error(_Cmp, Error)) -->
 1736    { message_to_string(Error, Message) },
 1737    [ 'Comparison error: ~w'-[Message] ].
 1738failure(Error) -->
 1739    { Error = error(_,_),
 1740      !,
 1741      message_to_string(Error, Message)
 1742    },
 1743    [ 'received error: ~w'-[Message] ].
 1744:- endif. 1745failure(Why) -->
 1746    [ '~p~n'-[Why] ].
 1747
 1748fixme_message([]) --> [].
 1749fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
 1750    { unit_file(Unit, File) },
 1751    fixme_message(File:Line, Reason, How),
 1752    (   {T == []}
 1753    ->  []
 1754    ;   [nl],
 1755        fixme_message(T)
 1756    ).
 1757
 1758fixme_message(Location, Reason, failed) -->
 1759    [ 'FIXME: ~w: ~w'-[Location, Reason] ].
 1760fixme_message(Location, Reason, passed) -->
 1761    [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
 1762fixme_message(Location, Reason, nondet) -->
 1763    [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
 1764
 1765
 1766write_options([ numbervars(true),
 1767                quoted(true),
 1768                portray(true),
 1769                max_depth(100),
 1770                attributes(portray)
 1771              ]).
 1772
 1773:- if(swi). 1774
 1775:- multifile
 1776    prolog:message/3,
 1777    user:message_hook/3. 1778
 1779prolog:message(Term) -->
 1780    message(Term).
 1781
 1782%       user:message_hook(+Term, +Kind, +Lines)
 1783
 1784user:message_hook(make(done(Files)), _, _) :-
 1785    make_run_tests(Files),
 1786    fail.                           % give other hooks a chance
 1787
 1788:- endif. 1789
 1790:- if(sicstus). 1791
 1792user:generate_message_hook(Message) -->
 1793    message(Message),
 1794    [nl].                           % SICStus requires nl at the end