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

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

 current_test_flag(?Name, ?Value) is nondet

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

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

 set_test_flag(+Name, +Value) is det

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

 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.

concurrent(+Bool)

If true (default =false), run all tests in a block concurrently.

  233set_test_options(Options) :-
  234    valid_options(Options, global_test_option),
  235    set_test_flag(test_options, Options).
  236
  237global_test_option(load(Load)) :-
  238    must_be(oneof([never,always,normal]), Load).
  239global_test_option(run(When)) :-
  240    must_be(oneof([manual,make,make(all)]), When).
  241global_test_option(silent(Bool)) :-
  242    must_be(boolean, Bool).
  243global_test_option(sto(Bool)) :-
  244    must_be(boolean, Bool).
  245global_test_option(cleanup(Bool)) :-
  246    must_be(boolean, Bool).
  247global_test_option(concurrent(Bool)) :-
  248    must_be(boolean, Bool).

 loading_tests

True if tests must be loaded.

  255loading_tests :-
  256    current_test_flag(test_options, Options),
  257    option(load(Load), Options, normal),
  258    (   Load == always
  259    ->  true
  260    ;   Load == normal,
  261        \+ current_test_flag(optimise, true)
  262    ).
  263
  264                 /*******************************
  265                 *            MODULE            *
  266                 *******************************/
  267
  268:- dynamic
  269    loading_unit/4,                 % Unit, Module, File, OldSource
  270    current_unit/4,                 % Unit, Module, Context, Options
  271    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).

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

 end_tests(+Name) is det

Close a unit-test module.

To be done

- Run tests/clean module?

- End of file?

  340end_tests(Unit) :-
  341    loading_unit(StartUnit, _, _, _),
  342    !,
  343    (   Unit == StartUnit
  344    ->  once(retract(loading_unit(StartUnit, _, _, Old))),
  345        '$set_source_module'(_, Old)
  346    ;   throw_error(context_error(plunit_close(Unit, StartUnit)), _)
  347    ).
  348end_tests(Unit) :-
  349    throw_error(context_error(plunit_close(Unit, -)), _).

 make_unit_module(+Name, -ModuleName) is det

 unit_module(+Name, -ModuleName) is det

  354:- if(swi).  355
  356unit_module(Unit, Module) :-
  357    atom_concat('plunit_', Unit, Module).
  358
  359make_unit_module(Unit, Module) :-
  360    unit_module(Unit, Module),
  361    (   current_module(Module),
  362        \+ current_unit(_, Module, _, _),
  363        predicate_property(Module:H, _P),
  364        \+ predicate_property(Module:H, imported_from(_M))
  365    ->  throw_error(permission_error(create, plunit, Unit),
  366                    'Existing module')
  367    ;  true
  368    ).
  369
  370:- else.  371
  372:- dynamic
  373    unit_module_store/2.  374
  375unit_module(Unit, Module) :-
  376    unit_module_store(Unit, Module),
  377    !.
  378
  379make_unit_module(Unit, Module) :-
  380    prolog_load_context(module, Module),
  381    assert(unit_module_store(Unit, Module)).
  382
  383:- endif.  384
  385                 /*******************************
  386                 *           EXPANSION          *
  387                 *******************************/

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

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

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

 expand(+Term, -Clauses) is semidet

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

  512valid_options(Options, Pred) :-
  513    must_be(list, Options),
  514    verify_options(Options, Pred).
  515
  516verify_options([], _).
  517verify_options([H|T], Pred) :-
  518    (   call(Pred, H)
  519    ->  verify_options(T, Pred)
  520    ;   throw_error(domain_error(Pred, H), _)
  521    ).

 test_option(+Option) is semidet

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

  528test_option(Option) :-
  529    test_set_option(Option),
  530    !.
  531test_option(true(_)).
  532test_option(fail).
  533test_option(throws(_)).
  534test_option(all(_)).
  535test_option(set(_)).
  536test_option(nondet).
  537test_option(fixme(_)).
  538test_option(forall(X)) :-
  539    must_be(callable, X).

 test_option(+Option) is semidet

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

  546test_set_option(blocked(X)) :-
  547    must_be(ground, X).
  548test_set_option(condition(X)) :-
  549    must_be(callable, X).
  550test_set_option(setup(X)) :-
  551    must_be(callable, X).
  552test_set_option(cleanup(X)) :-
  553    must_be(callable, X).
  554test_set_option(sto(V)) :-
  555    nonvar(V), member(V, [finite_trees, rational_trees]).
  556test_set_option(concurrent(V)) :-
  557    must_be(boolean, V).
  558
  559
  560                 /*******************************
  561                 *        RUNNING TOPLEVEL      *
  562                 *******************************/
  563
  564:- thread_local
  565    passed/5,                       % Unit, Test, Line, Det, Time
  566    failed/4,                       % Unit, Test, Line, Reason
  567    failed_assertion/7,             % Unit, Test, Line, ALoc, STO, Reason, Goal
  568    blocked/4,                      % Unit, Test, Line, Reason
  569    sto/4,                          % Unit, Test, Line, Results
  570    fixme/5.                        % Unit, Test, Line, Reason, Status
  571
  572:- dynamic
  573    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.

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

 run_tests_in_files(+Files:list) is det

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

  687run_tests_in_files(Files) :-
  688    findall(Unit, unit_in_files(Files, Unit), Units),
  689    (   Units == []
  690    ->  true
  691    ;   run_tests(Units)
  692    ).
  693
  694unit_in_files(Files, Unit) :-
  695    is_list(Files),
  696    !,
  697    member(F, Files),
  698    absolute_file_name(F, Source,
  699                       [ file_type(prolog),
  700                         access(read),
  701                         file_errors(fail)
  702                       ]),
  703    unit_file(Unit, Source).
  704
  705
  706                 /*******************************
  707                 *         HOOKING MAKE/0       *
  708                 *******************************/

 make_run_tests(+Files)

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

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

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

Run a single test.

  819run_test(Unit, Name, Line, Options, Body) :-
  820    option(forall(Generator), Options),
  821    !,
  822    unit_module(Unit, Module),
  823    term_variables(Generator, Vars),
  824    forall(Module:Generator,
  825           run_test_once(Unit, @(Name,Vars), Line, Options, Body)).
  826run_test(Unit, Name, Line, Options, Body) :-
  827    run_test_once(Unit, Name, Line, Options, Body).
  828
  829run_test_once(Unit, Name, Line, Options, Body) :-
  830    current_test_flag(test_options, GlobalOptions),
  831    option(sto(false), GlobalOptions, false),
  832    !,
  833    current_unification_capability(Type),
  834    begin_test(Unit, Name, Line, Type),
  835    run_test_6(Unit, Name, Line, Options, Body, Result),
  836    end_test(Unit, Name, Line, Type),
  837    report_result(Result, Options).
  838run_test_once(Unit, Name, Line, Options, Body) :-
  839    current_unit(Unit, _Module, _Supers, UnitOptions),
  840    option(sto(Type), UnitOptions),
  841    \+ option(sto(_), Options),
  842    !,
  843    current_unification_capability(Cap0),
  844    call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body),
  845                 set_unification_capability(Cap0)).
  846run_test_once(Unit, Name, Line, Options, Body) :-
  847    current_unification_capability(Cap0),
  848    call_cleanup(run_test_cap(Unit, Name, Line, Options, Body),
  849                 set_unification_capability(Cap0)).
  850
  851run_test_cap(Unit, Name, Line, Options, Body) :-
  852    (   option(sto(Type), Options)
  853    ->  unification_capability(Type),
  854        set_unification_capability(Type),
  855        begin_test(Unit, Name, Line, Type),
  856        run_test_6(Unit, Name, Line, Options, Body, Result),
  857        end_test(Unit, Name, Line, Type),
  858        report_result(Result, Options)
  859    ;   findall(Key-(Type+Result),
  860                test_caps(Type, Unit, Name, Line, Options, Body, Result, Key),
  861                Pairs),
  862        group_pairs_by_key(Pairs, Keyed),
  863        (   Keyed == []
  864        ->  true
  865        ;   Keyed = [_-Results]
  866        ->  Results = [_Type+Result|_],
  867            report_result(Result, Options)          % consistent results
  868        ;   pairs_values(Pairs, ResultByType),
  869            report_result(sto(Unit, Name, Line, ResultByType), Options)
  870        )
  871    ).

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

  875test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :-
  876    unification_capability(Type),
  877    set_unification_capability(Type),
  878    begin_test(Unit, Name, Line, Type),
  879    run_test_6(Unit, Name, Line, Options, Body, Result),
  880    end_test(Unit, Name, Line, Type),
  881    result_to_key(Result, Key),
  882    Key \== setup_failed.
  883
  884result_to_key(blocked(_, _, _, _), blocked).
  885result_to_key(failure(_, _, _, How0), failure(How1)) :-
  886    ( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ).
  887result_to_key(success(_, _, _, Determinism, _), success(Determinism)).
  888result_to_key(setup_failed(_,_,_), setup_failed).
  889
  890report_result(blocked(Unit, Name, Line, Reason), _) :-
  891    !,
  892    assert(blocked(Unit, Name, Line, Reason)).
  893report_result(failure(Unit, Name, Line, How), Options) :-
  894    !,
  895    failure(Unit, Name, Line, How, Options).
  896report_result(success(Unit, Name, Line, Determinism, Time), Options) :-
  897    !,
  898    success(Unit, Name, Line, Determinism, Time, Options).
  899report_result(setup_failed(_Unit, _Name, _Line), _Options).
  900report_result(sto(Unit, Name, Line, ResultByType), Options) :-
  901    assert(sto(Unit, Name, Line, ResultByType)),
  902    print_message(error, plunit(sto(Unit, Name, Line))),
  903    report_sto_results(ResultByType, Options).
  904
  905report_sto_results([], _).
  906report_sto_results([Type+Result|T], Options) :-
  907    print_message(error, plunit(sto(Type, Result))),
  908    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)

  920run_test_6(Unit, Name, Line, Options, _Body,
  921           blocked(Unit, Name, Line, Reason)) :-
  922    option(blocked(Reason), Options),
  923    !.
  924run_test_6(Unit, Name, Line, Options, Body, Result) :-
  925    option(all(Answer), Options),                  % all(Bindings)
  926    !,
  927    nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
  928run_test_6(Unit, Name, Line, Options, Body, Result) :-
  929    option(set(Answer), Options),                  % set(Bindings)
  930    !,
  931    nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
  932run_test_6(Unit, Name, Line, Options, Body, Result) :-
  933    option(fail, Options),                         % fail
  934    !,
  935    unit_module(Unit, Module),
  936    (   setup(Module, test(Unit,Name,Line), Options)
  937    ->  statistics(runtime, [T0,_]),
  938        (   catch(Module:Body, E, true)
  939        ->  (   var(E)
  940            ->  statistics(runtime, [T1,_]),
  941                Time is (T1 - T0)/1000.0,
  942                Result = failure(Unit, Name, Line, succeeded(Time)),
  943                cleanup(Module, Options)
  944            ;   Result = failure(Unit, Name, Line, E),
  945                cleanup(Module, Options)
  946            )
  947        ;   statistics(runtime, [T1,_]),
  948            Time is (T1 - T0)/1000.0,
  949            Result = success(Unit, Name, Line, true, Time),
  950            cleanup(Module, Options)
  951        )
  952    ;   Result = setup_failed(Unit, Name, Line)
  953    ).
  954run_test_6(Unit, Name, Line, Options, Body, Result) :-
  955    option(true(Cmp), Options),
  956    !,
  957    unit_module(Unit, Module),
  958    (   setup(Module, test(Unit,Name,Line), Options) % true(Binding)
  959    ->  statistics(runtime, [T0,_]),
  960        (   catch(call_det(Module:Body, Det), E, true)
  961        ->  (   var(E)
  962            ->  statistics(runtime, [T1,_]),
  963                Time is (T1 - T0)/1000.0,
  964                (   catch(Module:Cmp, E, true)
  965                ->  (   var(E)
  966                    ->  Result = success(Unit, Name, Line, Det, Time)
  967                    ;   Result = failure(Unit, Name, Line, cmp_error(Cmp, E))
  968                    )
  969                ;   Result = failure(Unit, Name, Line, wrong_answer(Cmp))
  970                ),
  971                cleanup(Module, Options)
  972            ;   Result = failure(Unit, Name, Line, E),
  973                cleanup(Module, Options)
  974            )
  975        ;   Result = failure(Unit, Name, Line, failed),
  976            cleanup(Module, Options)
  977        )
  978    ;   Result = setup_failed(Unit, Name, Line)
  979    ).
  980run_test_6(Unit, Name, Line, Options, Body, Result) :-
  981    option(throws(Expect), Options),
  982    !,
  983    unit_module(Unit, Module),
  984    (   setup(Module, test(Unit,Name,Line), Options)
  985    ->  statistics(runtime, [T0,_]),
  986        (   catch(Module:Body, E, true)
  987        ->  (   var(E)
  988            ->  Result = failure(Unit, Name, Line, no_exception),
  989                cleanup(Module, Options)
  990            ;   statistics(runtime, [T1,_]),
  991                Time is (T1 - T0)/1000.0,
  992                (   match_error(Expect, E)
  993                ->  Result = success(Unit, Name, Line, true, Time)
  994                ;   Result = failure(Unit, Name, Line, wrong_error(Expect, E))
  995                ),
  996                cleanup(Module, Options)
  997            )
  998        ;   Result = failure(Unit, Name, Line, failed),
  999            cleanup(Module, Options)
 1000        )
 1001    ;   Result = setup_failed(Unit, Name, Line)
 1002    ).

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

Run tests on non-deterministic predicates.

 1009nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
 1010    unit_module(Unit, Module),
 1011    result_vars(Expected, Vars),
 1012    statistics(runtime, [T0,_]),
 1013    (   setup(Module, test(Unit,Name,Line), Options)
 1014    ->  (   catch(findall(Vars, Module:Body, Bindings), E, true)
 1015        ->  (   var(E)
 1016            ->  statistics(runtime, [T1,_]),
 1017                Time is (T1 - T0)/1000.0,
 1018                (   nondet_compare(Expected, Bindings, Unit, Name, Line)
 1019                ->  Result = success(Unit, Name, Line, true, Time)
 1020                ;   Result = failure(Unit, Name, Line, wrong_answer(Expected, Bindings))
 1021                ),
 1022                cleanup(Module, Options)
 1023            ;   Result = failure(Unit, Name, Line, E),
 1024                cleanup(Module, Options)
 1025            )
 1026        )
 1027    ;   Result = setup_failed(Unit, Name, Line)
 1028    ).

 result_vars(+Expected, -Vars) is det

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

 1036result_vars(Expected, Vars) :-
 1037    arg(1, Expected, CmpOp),
 1038    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

 1048nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
 1049    cmp(Cmp, _Vars, Op, Values),
 1050    cmp_list(Values, Bindings, Op).
 1051nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
 1052    cmp(Cmp, _Vars, Op, Values0),
 1053    sort(Bindings0, Bindings),
 1054    sort(Values0, Values),
 1055    cmp_list(Values, Bindings, Op).
 1056
 1057cmp_list([], [], _Op).
 1058cmp_list([E0|ET], [V0|VT], Op) :-
 1059    call(Op, E0, V0),
 1060    cmp_list(ET, VT, Op).

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

 1064cmp(Var  == Value, Var,  ==, Value).
 1065cmp(Var =:= Value, Var, =:=, Value).
 1066cmp(Var  =  Value, Var,  =,  Value).
 1067:- if(swi). 1068cmp(Var =@= Value, Var, =@=, Value).
 1069:- else. 1070:- if(sicstus). 1071cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
 1072:- endif. 1073:- endif.

 call_det(:Goal, -Det) is nondet

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

 1081:- if((swi|sicstus)). 1082call_det(Goal, Det) :-
 1083    call_cleanup(Goal,Det0=true),
 1084    ( var(Det0) -> Det = false ; Det = true ).
 1085:- else. 1086call_det(Goal, true) :-
 1087    call(Goal).
 1088:- endif.

 match_error(+Expected, +Received) is semidet

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

 1095match_error(Expect, Rec) :-
 1096    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

 1109setup(Module, Context, Options) :-
 1110    option(condition(Condition), Options),
 1111    option(setup(Setup), Options),
 1112    !,
 1113    setup(Module, Context, [condition(Condition)]),
 1114    setup(Module, Context, [setup(Setup)]).
 1115setup(Module, Context, Options) :-
 1116    option(setup(Setup), Options),
 1117    !,
 1118    (   catch(call_ex(Module, Setup), E, true)
 1119    ->  (   var(E)
 1120        ->  true
 1121        ;   print_message(error, plunit(error(setup, Context, E))),
 1122            fail
 1123        )
 1124    ;   print_message(error, error(goal_failed(Setup), _)),
 1125        fail
 1126    ).
 1127setup(Module, Context, Options) :-
 1128    option(condition(Setup), Options),
 1129    !,
 1130    (   catch(call_ex(Module, Setup), E, true)
 1131    ->  (   var(E)
 1132        ->  true
 1133        ;   print_message(error, plunit(error(condition, Context, E))),
 1134            fail
 1135        )
 1136    ;   fail
 1137    ).
 1138setup(_,_,_).

 call_ex(+Module, +Goal)

Call Goal in Module after applying goal expansion.

 1144call_ex(Module, Goal) :-
 1145    Module:(expand_goal(Goal, GoalEx),
 1146                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.

 1153cleanup(Module, Options) :-
 1154    option(cleanup(Cleanup), Options, true),
 1155    (   catch(call_ex(Module, Cleanup), E, true)
 1156    ->  (   var(E)
 1157        ->  true
 1158        ;   print_message(warning, E)
 1159        )
 1160    ;   print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
 1161    ).
 1162
 1163success(Unit, Name, Line, Det, _Time, Options) :-
 1164    memberchk(fixme(Reason), Options),
 1165    !,
 1166    (   (   Det == true
 1167        ;   memberchk(nondet, Options)
 1168        )
 1169    ->  progress(Unit, Name, nondet),
 1170        Ok = passed
 1171    ;   progress(Unit, Name, fixme),
 1172        Ok = nondet
 1173    ),
 1174    flush_output(user_error),
 1175    assert(fixme(Unit, Name, Line, Reason, Ok)).
 1176success(Unit, Name, Line, _, _, Options) :-
 1177    failed_assertion(Unit, Name, Line, _,_,_,_),
 1178    !,
 1179    failure(Unit, Name, Line, assertion, Options).
 1180success(Unit, Name, Line, Det, Time, Options) :-
 1181    assert(passed(Unit, Name, Line, Det, Time)),
 1182    (   (   Det == true
 1183        ;   memberchk(nondet, Options)
 1184        )
 1185    ->  progress(Unit, Name, passed)
 1186    ;   unit_file(Unit, File),
 1187        print_message(warning, plunit(nondet(File, Line, Name)))
 1188    ).
 1189
 1190failure(Unit, Name, Line, _, Options) :-
 1191    memberchk(fixme(Reason), Options),
 1192    !,
 1193    progress(Unit, Name, failed),
 1194    assert(fixme(Unit, Name, Line, Reason, failed)).
 1195failure(Unit, Name, Line, E, Options) :-
 1196    report_failure(Unit, Name, Line, E, Options),
 1197    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.

 1207:- if(swi). 1208assert_cyclic(Term) :-
 1209    acyclic_term(Term),
 1210    !,
 1211    assert(Term).
 1212assert_cyclic(Term) :-
 1213    Term =.. [Functor|Args],
 1214    recorda(cyclic, Args, Id),
 1215    functor(Term, _, Arity),
 1216    length(NewArgs, Arity),
 1217    Head =.. [Functor|NewArgs],
 1218    assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
 1219:- else. 1220:- if(sicstus). 1221:- endif. 1222assert_cyclic(Term) :-
 1223    assert(Term).
 1224:- endif. 1225
 1226
 1227                 /*******************************
 1228                 *            REPORTING         *
 1229                 *******************************/

 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

 1242begin_test(Unit, Test, Line, STO) :-
 1243    thread_self(Me),
 1244    assert(running(Unit, Test, Line, STO, Me)),
 1245    unit_file(Unit, File),
 1246    print_message(silent, plunit(begin(Unit:Test, File:Line, STO))).
 1247
 1248end_test(Unit, Test, Line, STO) :-
 1249    thread_self(Me),
 1250    retractall(running(_,_,_,_,Me)),
 1251    unit_file(Unit, File),
 1252    print_message(silent, plunit(end(Unit:Test, File:Line, STO))).

 running_tests is det

Print the currently running test.

 1258running_tests :-
 1259    running_tests(Running),
 1260    print_message(informational, plunit(running(Running))).
 1261
 1262running_tests(Running) :-
 1263    findall(running(Unit:Test, File:Line, STO, Thread),
 1264            (   running(Unit, Test, Line, STO, Thread),
 1265                unit_file(Unit, File)
 1266            ), Running).

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

True when a test with the specified properties is loaded.

 1273current_test(Unit, Test, Line, Body, Options) :-
 1274    current_unit(Unit, Module, _Supers, _UnitOptions),
 1275    Module:'unit test'(Test, Line, Options, Body).

 check_for_test_errors is semidet

True if there are no errors, otherwise false.

 1281check_for_test_errors :-
 1282    number_of_clauses(failed/4, Failed),
 1283    number_of_clauses(failed_assertion/7, FailedAssertion),
 1284    number_of_clauses(sto/4, STO),
 1285    Failed+FailedAssertion+STO =:= 0.     % fail on errors

 report is det

Print a summary of the tests that ran.

 1292report :-
 1293    number_of_clauses(passed/5, Passed),
 1294    number_of_clauses(failed/4, Failed),
 1295    number_of_clauses(failed_assertion/7, FailedAssertion),
 1296    number_of_clauses(blocked/4, Blocked),
 1297    number_of_clauses(sto/4, STO),
 1298    print_message(silent,
 1299                  plunit(summary(plunit{passed:Passed,
 1300                                        failed:Failed,
 1301                                        failed_assertions:FailedAssertion,
 1302                                        blocked:Blocked,
 1303                                        sto:STO}))),
 1304    (   Passed+Failed+FailedAssertion+Blocked+STO =:= 0
 1305    ->  info(plunit(no_tests))
 1306    ;   Failed+FailedAssertion+Blocked+STO =:= 0
 1307    ->  report_fixme,
 1308        info(plunit(all_passed(Passed)))
 1309    ;   report_blocked,
 1310        report_fixme,
 1311        report_failed_assertions,
 1312        report_failed,
 1313        report_sto,
 1314        info(plunit(passed(Passed)))
 1315    ).
 1316
 1317number_of_clauses(F/A,N) :-
 1318    (   current_predicate(F/A)
 1319    ->  functor(G,F,A),
 1320        findall(t, G, Ts),
 1321        length(Ts, N)
 1322    ;   N = 0
 1323    ).
 1324
 1325report_blocked :-
 1326    number_of_clauses(blocked/4,N),
 1327    N > 0,
 1328    !,
 1329    info(plunit(blocked(N))),
 1330    (   blocked(Unit, Name, Line, Reason),
 1331        unit_file(Unit, File),
 1332        print_message(informational,
 1333                      plunit(blocked(File:Line, Name, Reason))),
 1334        fail ; true
 1335    ).
 1336report_blocked.
 1337
 1338report_failed :-
 1339    number_of_clauses(failed/4, N),
 1340    info(plunit(failed(N))).
 1341
 1342report_failed_assertions :-
 1343    number_of_clauses(failed_assertion/7, N),
 1344    info(plunit(failed_assertions(N))).
 1345
 1346report_sto :-
 1347    number_of_clauses(sto/4, N),
 1348    info(plunit(sto(N))).
 1349
 1350report_fixme :-
 1351    report_fixme(_,_,_).
 1352
 1353report_fixme(TuplesF, TuplesP, TuplesN) :-
 1354    fixme(failed, TuplesF, Failed),
 1355    fixme(passed, TuplesP, Passed),
 1356    fixme(nondet, TuplesN, Nondet),
 1357    print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
 1358
 1359
 1360fixme(How, Tuples, Count) :-
 1361    findall(fixme(Unit, Name, Line, Reason, How),
 1362            fixme(Unit, Name, Line, Reason, How), Tuples),
 1363    length(Tuples, Count).
 1364
 1365
 1366report_failure(Unit, Name, _, assertion, _) :-
 1367    !,
 1368    progress(Unit, Name, assertion).
 1369report_failure(Unit, Name, Line, Error, _Options) :-
 1370    print_message(error, plunit(failed(Unit, Name, Line, Error))).

 test_report(What) is det

Produce reports on test results after the run.

 1377test_report(fixme) :-
 1378    !,
 1379    report_fixme(TuplesF, TuplesP, TuplesN),
 1380    append([TuplesF, TuplesP, TuplesN], Tuples),
 1381    print_message(informational, plunit(fixme(Tuples))).
 1382test_report(What) :-
 1383    throw_error(domain_error(report_class, What), _).
 1384
 1385
 1386                 /*******************************
 1387                 *             INFO             *
 1388                 *******************************/

 current_test_set(?Unit) is nondet

True if Unit is a currently loaded test-set.

 1394current_test_set(Unit) :-
 1395    current_unit(Unit, _Module, _Context, _Options).

 unit_file(+Unit, -File) is det

unit_file(-Unit, +File) is nondet

 1400unit_file(Unit, File) :-
 1401    current_unit(Unit, Module, _Context, _Options),
 1402    current_module(Module, File).
 1403unit_file(Unit, PlFile) :-
 1404    nonvar(PlFile),
 1405    test_file_for(TestFile, PlFile),
 1406    current_module(Module, TestFile),
 1407    current_unit(Unit, Module, _Context, _Options).
 1408
 1409
 1410                 /*******************************
 1411                 *             FILES            *
 1412                 *******************************/

 load_test_files(+Options) is det

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

 1418load_test_files(_Options) :-
 1419    (   source_file(File),
 1420        file_name_extension(Base, Old, File),
 1421        Old \== plt,
 1422        file_name_extension(Base, plt, TestFile),
 1423        exists_file(TestFile),
 1424        (   test_file_for(TestFile, File)
 1425        ->  true
 1426        ;   load_files(TestFile,
 1427                       [ if(changed),
 1428                         imports([])
 1429                       ]),
 1430            asserta(test_file_for(TestFile, File))
 1431        ),
 1432        fail ; true
 1433    ).
 1434
 1435
 1436
 1437                 /*******************************
 1438                 *           MESSAGES           *
 1439                 *******************************/

 info(+Term)

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

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