1732 lines
46 KiB
Prolog
1732 lines
46 KiB
Prolog
/* Part of SWI-Prolog
|
|
|
|
Author: Jan Wielemaker
|
|
E-mail: J.Wielemaker@cs.vu.nl
|
|
WWW: http://www.swi-prolog.org
|
|
Copyright (C): 2006-2013, University of Amsterdam
|
|
VU University Amsterdam
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU General Public License
|
|
as published by the Free Software Foundation; either version 2
|
|
of the License, or (at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
As a special exception, if you link this library with other files,
|
|
compiled with a Free Software compiler, to produce an executable, this
|
|
library does not by itself cause the resulting executable to be covered
|
|
by the GNU General Public License. This exception does not however
|
|
invalidate any other reasons why the executable file might be covered by
|
|
the GNU General Public License.
|
|
|
|
Alternatively, this program may be distributed under the Perl
|
|
Artistic License, version 2.0.
|
|
*/
|
|
|
|
:- module(plunit,
|
|
[ set_test_options/1, % +Options
|
|
begin_tests/1, % +Name
|
|
begin_tests/2, % +Name, +Options
|
|
end_tests/1, % +Name
|
|
run_tests/0, % Run all tests
|
|
run_tests/1, % Run named test-set
|
|
load_test_files/1, % +Options
|
|
running_tests/0, % Prints currently running test
|
|
test_report/1 % +What
|
|
]).
|
|
|
|
/** <module> Unit Testing
|
|
|
|
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage,
|
|
please visit http://www.swi-prolog.org/pldoc/package/plunit.html.
|
|
|
|
@author Jan Wielemaker
|
|
@license GPL+SWI-exception or Artistic 2.0
|
|
*/
|
|
|
|
:- use_module(library(apply)).
|
|
:- use_module(library(ordsets), [ord_intersection/3]).
|
|
:- meta_predicate valid_options(+, 1).
|
|
|
|
|
|
/*******************************
|
|
* CONDITIONAL COMPILATION *
|
|
*******************************/
|
|
|
|
:- discontiguous
|
|
user:term_expansion/2.
|
|
|
|
:- dynamic
|
|
include_code/1.
|
|
|
|
including :-
|
|
include_code(X), !,
|
|
X == true.
|
|
including.
|
|
|
|
if_expansion((:- if(G)), []) :-
|
|
( including
|
|
-> ( catch(G, E, (print_message(error, E), fail))
|
|
-> asserta(include_code(true))
|
|
; asserta(include_code(false))
|
|
)
|
|
; asserta(include_code(else_false))
|
|
).
|
|
if_expansion((:- else), []) :-
|
|
( retract(include_code(X))
|
|
-> ( X == true
|
|
-> X2 = false
|
|
; X == false
|
|
-> X2 = true
|
|
; X2 = X
|
|
),
|
|
asserta(include_code(X2))
|
|
; throw_error(context_error(no_if),_)
|
|
).
|
|
if_expansion((:- endif), []) :-
|
|
retract(include_code(_)), !.
|
|
|
|
if_expansion(_, []) :-
|
|
\+ including.
|
|
|
|
user:term_expansion(In, Out) :-
|
|
prolog_load_context(module, plunit),
|
|
if_expansion(In, Out).
|
|
|
|
swi :- catch(current_prolog_flag(dialect, swi), _, fail), !.
|
|
swi :- catch(current_prolog_flag(dialect, yap), _, fail).
|
|
sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
|
|
|
|
|
|
:- if(swi).
|
|
throw_error(Error_term,Impldef) :-
|
|
throw(error(Error_term,Impldef)).
|
|
|
|
:- set_prolog_flag(generate_debug_info, false).
|
|
:- use_module(library(option)).
|
|
:- use_module(library(pairs)).
|
|
|
|
current_test_flag(Name, Value) :-
|
|
current_prolog_flag(Name, Value).
|
|
|
|
set_test_flag(Name, Value) :-
|
|
create_prolog_flag(Name, Value, []).
|
|
|
|
:- endif.
|
|
|
|
:- if(sicstus).
|
|
throw_error(Error_term,Impldef) :-
|
|
throw(error(Error_term,i(Impldef))). % SICStus 3 work around
|
|
|
|
%:- use_module(swi). % SWI-Compatibility
|
|
:- use_module(library(terms)).
|
|
%:- op(700, xfx, =@=).
|
|
|
|
'$set_source_module'( In, Out) :-
|
|
current_source_module(In, Out).
|
|
|
|
%% current_test_flag(?Name, ?Value) is nondet.
|
|
%
|
|
% Query flags that control the testing process. Emulates
|
|
% SWI-Prologs flags.
|
|
|
|
:- dynamic test_flag/2. % Name, Val
|
|
|
|
current_test_flag(optimise, Val) :-
|
|
current_prolog_flag(compiling, Compiling),
|
|
( Compiling == debugcode ; true % TBD: Proper test
|
|
-> Val = false
|
|
; Val = true
|
|
).
|
|
current_test_flag(Name, Val) :-
|
|
test_flag(Name, Val).
|
|
|
|
|
|
%% set_test_flag(+Name, +Value) is det.
|
|
|
|
set_test_flag(Name, Val) :-
|
|
var(Name), !,
|
|
throw_error(instantiation_error, set_test_flag(Name,Val)).
|
|
set_test_flag( Name, Val ) :-
|
|
retractall(test_flag(Name,_)),
|
|
asserta(test_flag(Name, Val)).
|
|
|
|
%:- op(1150, fx, thread_local).
|
|
|
|
user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :-
|
|
prolog_load_context(module, plunit).
|
|
|
|
:- endif.
|
|
|
|
/*******************************
|
|
* IMPORTS *
|
|
*******************************/
|
|
|
|
:- use_module(library(lists)).
|
|
|
|
:- initialization
|
|
( current_test_flag(test_options, _)
|
|
-> true
|
|
; set_test_flag(test_options,
|
|
[ run(make), % run tests on make/0
|
|
sto(false)
|
|
])
|
|
).
|
|
|
|
%% 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 dmwfc.
|
|
|
|
set_test_options(Options) :-
|
|
valid_options(Options, global_test_option),
|
|
set_test_flag(test_options, Options).
|
|
|
|
global_test_option(load(Load)) :-
|
|
must_be(oneof([never,always,normal]), Load).
|
|
global_test_option(run(When)) :-
|
|
must_be(oneof([manual,make,make(all)]), When).
|
|
global_test_option(silent(Bool)) :-
|
|
must_be(boolean, Bool).
|
|
global_test_option(sto(Bool)) :-
|
|
must_be(boolean, Bool).
|
|
global_test_option(cleanup(Bool)) :-
|
|
must_be(boolean, Bool).
|
|
|
|
|
|
%% loading_tests
|
|
%
|
|
% True if tests must be loaded.
|
|
|
|
loading_tests :-
|
|
current_test_flag(test_options, Options),
|
|
option(load(Load), Options, normal),
|
|
( Load == always
|
|
-> true
|
|
; Load == normal,
|
|
\+ current_test_flag(optimise, true)
|
|
).
|
|
|
|
/*******************************
|
|
* MODULE *
|
|
*******************************/
|
|
|
|
:- dynamic
|
|
loading_unit/4, % Unit, Module, File, OldSource
|
|
current_unit/4, % Unit, Module, Context, Options
|
|
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).
|
|
|
|
begin_tests(Unit) :-
|
|
begin_tests(Unit, []).
|
|
|
|
begin_tests(Unit, Options) :-
|
|
% writeln('*************'+ Unit), trace,
|
|
valid_options(Options, test_set_option),
|
|
make_unit_module(Unit, Name),
|
|
source_location(File, Line),
|
|
begin_tests(Unit, Name, File:Line, Options).
|
|
|
|
:- if(swi).
|
|
begin_tests(Unit, Name, File:Line, Options) :-
|
|
loading_tests, !,
|
|
prolog_flag(typein_module,Context, Context),
|
|
( current_unit(Unit, Name, Context, Options)
|
|
-> true
|
|
; retractall(current_unit(Unit, Name, _, _)),
|
|
assert(current_unit(Unit, Name, Context, Options))
|
|
),
|
|
prolog_flag(typein_module,Old, Name),
|
|
declare_module(Name, test, Context, File, Line, false),
|
|
discontiguous(Name:'unit test'/4),
|
|
discontiguous(Name:'unit body'/2),
|
|
multifile(Name:'unit test'/4),
|
|
multifile(Name:'unit body'/2),
|
|
asserta(loading_unit(Unit, Name, File, Old)).
|
|
begin_tests(Unit, Name, File:_Line, _Options) :-
|
|
prolog_flag(typein_module,Old, Old),
|
|
asserta(loading_unit(Unit, Name, File, Old)).
|
|
|
|
declare_module( Name, Class, Context, File, Line, _AllowFile ) :-
|
|
Name \= Context,
|
|
!,
|
|
set_module_property( Name, base(Context) ),
|
|
set_module_property( Name, class(Class) ),
|
|
set_module_property( Name, exports([], File, Line) ).
|
|
declare_module( Name, _Class, Name, _File, _Line, _AllowFile ) .
|
|
|
|
:- else.
|
|
|
|
% we cannot use discontiguous as a goal in SICStus Prolog.
|
|
|
|
user:term_expansion((:- begin_tests(Set)),
|
|
[ (:- begin_tests(Set)),
|
|
(:- discontiguous(test/2)),
|
|
(:- discontiguous('unit body'/2)),
|
|
(:- discontiguous('unit test'/4))
|
|
]).
|
|
|
|
begin_tests(Unit, Name, File:_Line, Options) :-
|
|
loading_tests, !,
|
|
( current_unit(Unit, Name, _, Options)
|
|
-> true
|
|
; retractall(current_unit(Unit, Name, _, _)),
|
|
assert(current_unit(Unit, Name, -, Options))
|
|
),
|
|
asserta(loading_unit(Unit, Name, File, -)).
|
|
begin_tests(Unit, Name, File:_Line, _Options) :-
|
|
asserta(loading_unit(Unit, Name, File, -)).
|
|
|
|
:- endif.
|
|
|
|
%% end_tests(+Name) is det.
|
|
%
|
|
% Close a unit-test module.
|
|
%
|
|
% @tbd Run tests/clean module?
|
|
% @tbd End of file?
|
|
|
|
end_tests(Unit) :-
|
|
loading_unit(StartUnit, _, _, _), !,
|
|
( Unit == StartUnit
|
|
-> once(retract(loading_unit(StartUnit, _, _, Old))),
|
|
prolog_flag(typein_module,_, Old)
|
|
; throw_error(context_error(plunit_close(Unit, StartUnit)), _)
|
|
).
|
|
end_tests(Unit) :-
|
|
throw_error(context_error(plunit_close(Unit, -)), _).
|
|
|
|
%% make_unit_module(+Name, -ModuleName) is det.
|
|
%% unit_module(+Name, -ModuleName) is det.
|
|
|
|
:- if(swi).
|
|
|
|
unit_module(Unit, Module) :-
|
|
atom_concat('plunit_', Unit, Module).
|
|
|
|
make_unit_module(Unit, Module) :-
|
|
unit_module(Unit, Module),
|
|
( current_module(Module),
|
|
\+ current_unit(_, Module, _, _),
|
|
predicate_property(Module:H, _P),
|
|
\+ predicate_property(Module:H, imported_from(_M))
|
|
-> throw_error(permission_error(create, plunit, Unit),
|
|
'Existing module')
|
|
; true
|
|
).
|
|
|
|
:- else.
|
|
|
|
:- dynamic
|
|
unit_module_store/2.
|
|
|
|
unit_module(Unit, Module) :-
|
|
unit_module_store(Unit, Module), !.
|
|
|
|
make_unit_module(Unit, Module) :-
|
|
prolog_load_context(module, Module),
|
|
assert(unit_module_store(Unit, Module)).
|
|
|
|
:- endif.
|
|
|
|
/*******************************
|
|
* EXPANSION *
|
|
*******************************/
|
|
|
|
%% expand_test(+Name, +Options, +Body, -Clause) is det.
|
|
%
|
|
% Expand test(Name, Options) :- Body into a clause for
|
|
% 'unit test'/4 and 'unit body'/2.
|
|
|
|
expand_test(Name, Options0, Body,
|
|
[ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
|
|
('unit body'(Id, Vars) :- !, Body)
|
|
]) :-
|
|
source_location(_File, Line),
|
|
prolog_load_context(module, Module),
|
|
atomic_list_concat([Name, '@line ', Line], Id),
|
|
term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
|
|
term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
|
|
ord_intersection(OptionVars, BodyVars, VarList),
|
|
Vars =.. [vars|VarList],
|
|
( is_list(Options0) % allow for single option without list
|
|
-> Options1 = Options0
|
|
; Options1 = [Options0]
|
|
),
|
|
maplist(expand_option, Options1, Options2),
|
|
valid_options(Options2, test_option),
|
|
valid_test_mode(Options2, Options).
|
|
% writeln([ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
|
|
% ('unit body'(Id, Vars) :- !, Body)
|
|
% ]).
|
|
|
|
expand_option(Var, _) :-
|
|
var(Var), !,
|
|
throw_error(instantiation_error,_).
|
|
expand_option(A == B, true(A==B)) :- !.
|
|
expand_option(A = B, true(A=B)) :- !.
|
|
expand_option(A =@= B, true(A=@=B)) :- !.
|
|
expand_option(A =:= B, true(A=:=B)) :- !.
|
|
expand_option(error(X), throws(error(X, _))) :- !.
|
|
expand_option(exception(X), throws(X)) :- !. % SICStus 4 compatibility
|
|
expand_option(error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility
|
|
expand_option(true, true(true)) :- !.
|
|
expand_option(O, O).
|
|
|
|
valid_test_mode(Options0, Options) :-
|
|
include(test_mode, Options0, Tests),
|
|
( Tests == []
|
|
-> Options = [true(true)|Options0]
|
|
; Tests = [_]
|
|
-> Options = Options0
|
|
; throw_error(plunit(incompatible_options, Tests), _)
|
|
).
|
|
|
|
test_mode(true(_)).
|
|
test_mode(all(_)).
|
|
test_mode(set(_)).
|
|
test_mode(fail).
|
|
test_mode(throws(_)).
|
|
|
|
|
|
%% expand(+Term, -Clauses) is semidet.
|
|
|
|
expand(end_of_file, _) :-
|
|
loading_unit(Unit, _, _, _), !,
|
|
end_tests(Unit), % warn?
|
|
fail.
|
|
expand((:-end_tests(_)), _) :- !,
|
|
fail.
|
|
expand(_Term, []) :-
|
|
\+ loading_tests.
|
|
expand((test(Name) :- Body), Clauses) :- !,
|
|
expand_test(Name, [], Body, Clauses).
|
|
expand((test(Name, Options) :- Body), Clauses) :- !,
|
|
expand_test(Name, Options, Body, Clauses).
|
|
expand(test(Name), _) :- !,
|
|
throw_error(existence_error(body, test(Name)), _).
|
|
expand(test(Name, _Options), _) :- !,
|
|
throw_error(existence_error(body, test(Name)), _).
|
|
|
|
:- if(swi).
|
|
:- multifile
|
|
user:term_expansion/2.
|
|
:- endif.
|
|
|
|
user:term_expansion(Term, Expanded) :-
|
|
%writeln(Term),
|
|
( loading_unit(_, _, File, _)
|
|
-> source_location(File, _),
|
|
expand(Term, Expanded)
|
|
).
|
|
|
|
|
|
/*******************************
|
|
* OPTIONS *
|
|
*******************************/
|
|
|
|
:- if(swi).
|
|
:- use_module(library(error)).
|
|
:- else.
|
|
must_be(list, X) :- !,
|
|
( is_list(X)
|
|
-> true
|
|
; is_not(list, X)
|
|
).
|
|
must_be(Type, X) :-
|
|
( call(Type, X)
|
|
-> true
|
|
; is_not(Type, X)
|
|
).
|
|
|
|
is_not(Type, X) :-
|
|
( ground(X)
|
|
-> throw_error(type_error(Type, X), _)
|
|
; throw_error(instantiation_error, _)
|
|
).
|
|
:- 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=.
|
|
|
|
valid_options(Options, Pred) :-
|
|
must_be(list, Options),
|
|
verify_options(Options, Pred).
|
|
|
|
verify_options([], _).
|
|
verify_options([H|T], Pred) :-
|
|
( call(Pred, H)
|
|
-> verify_options(T, Pred)
|
|
; throw_error(domain_error(Pred, H), _)
|
|
).
|
|
|
|
|
|
%% test_option(+Option) is semidet.
|
|
%
|
|
% True if Option is a valid option for test(Name, Options).
|
|
|
|
test_option(Option) :-
|
|
test_set_option(Option), !.
|
|
test_option(true(_)).
|
|
test_option(fail).
|
|
test_option(throws(_)).
|
|
test_option(all(_)).
|
|
test_option(set(_)).
|
|
test_option(nondet).
|
|
test_option(fixme(_)).
|
|
test_option(forall(X)) :-
|
|
must_be(callable, X).
|
|
|
|
%% test_option(+Option) is semidet.
|
|
%
|
|
% True if Option is a valid option for :- begin_tests(Name,
|
|
% Options).
|
|
|
|
test_set_option(blocked(X)) :-
|
|
must_be(ground, X).
|
|
test_set_option(condition(X)) :-
|
|
must_be(callable, X).
|
|
test_set_option(setup(X)) :-
|
|
must_be(callable, X).
|
|
test_set_option(cleanup(X)) :-
|
|
must_be(callable, X).
|
|
test_set_option(sto(V)) :-
|
|
nonvar(V), member(V, [finite_trees, rational_trees]).
|
|
|
|
|
|
/*******************************
|
|
* RUNNING TOPLEVEL *
|
|
*******************************/
|
|
|
|
:- thread_local
|
|
passed/5, % Unit, Test, Line, Det, Time
|
|
failed/4, % Unit, Test, Line, Reason
|
|
failed_assertion/7, % Unit, Test, Line, ALoc, STO, Reason, Goal
|
|
blocked/4, % Unit, Test, Line, Reason
|
|
sto/4, % Unit, Test, Line, Results
|
|
fixme/5. % Unit, Test, Line, Reason, Status
|
|
|
|
:- dynamic
|
|
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.
|
|
|
|
run_tests :-
|
|
cleanup,
|
|
setup_call_cleanup(
|
|
setup_trap_assertions(Ref),
|
|
( forall(current_test_set(Set),
|
|
run_unit(Set)),
|
|
check_for_test_errors
|
|
),
|
|
( cleanup_trap_assertions(Ref),
|
|
report,
|
|
cleanup_after_test
|
|
)).
|
|
|
|
run_tests(Set) :-
|
|
cleanup,
|
|
setup_call_cleanup(
|
|
setup_trap_assertions(Ref),
|
|
( run_unit(Set),
|
|
% writeln(done),
|
|
check_for_test_errors
|
|
),
|
|
( cleanup_trap_assertions(Ref),
|
|
report,
|
|
cleanup_after_test
|
|
)).
|
|
|
|
run_unit([]) :- !.
|
|
run_unit([H|T]) :- !,
|
|
run_unit(H),
|
|
run_unit(T).
|
|
run_unit(Spec) :-
|
|
unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
|
|
( option(blocked(Reason), UnitOptions)
|
|
-> info(plunit(blocked(unit(Unit, Reason))))
|
|
; setup(Module, unit(Unit), UnitOptions)
|
|
-> info(plunit(begin(Spec))),
|
|
forall((Module:'unit test'(Name, Line, Options, Body),
|
|
matching_test(Name, Tests)),
|
|
run_test(Unit, Name, Line, Options, Body)),
|
|
info(plunit(end(Spec))),
|
|
( message_level(silent)
|
|
-> true
|
|
; format(user_error, '~N', [])
|
|
),
|
|
cleanup(Module, UnitOptions)
|
|
; true
|
|
).
|
|
|
|
unit_from_spec(Unit, Unit, _, Module, Options) :-
|
|
atom(Unit), !,
|
|
( current_unit(Unit, Module, _Supers, Options)
|
|
-> true
|
|
; throw_error(existence_error(unit_test, Unit), _)
|
|
).
|
|
unit_from_spec(Unit:Tests, Unit, Tests, Module, Options) :-
|
|
atom(Unit), !,
|
|
( current_unit(Unit, Module, _Supers, Options)
|
|
-> true
|
|
; throw_error(existence_error(unit_test, Unit), _)
|
|
).
|
|
|
|
|
|
matching_test(X, X) :- !.
|
|
matching_test(Name, Set) :-
|
|
is_list(Set),
|
|
memberchk(Name, Set).
|
|
|
|
cleanup :-
|
|
thread_self(Me),
|
|
retractall(passed(_, _, _, _, _)),
|
|
retractall(failed(_, _, _, _)),
|
|
retractall(failed_assertion(_, _, _, _, _, _, _)),
|
|
retractall(blocked(_, _, _, _)),
|
|
retractall(sto(_, _, _, _)),
|
|
retractall(fixme(_, _, _, _, _)),
|
|
retractall(running(_,_,_,_,Me)).
|
|
|
|
cleanup_after_test :-
|
|
current_test_flag(test_options, Options),
|
|
option(cleanup(Cleanup), Options, false),
|
|
( Cleanup == true
|
|
-> cleanup
|
|
; true
|
|
).
|
|
|
|
|
|
%% run_tests_in_files(+Files:list) is det.
|
|
%
|
|
% Run all test-units that appear in the given Files.
|
|
|
|
run_tests_in_files(Files) :-
|
|
findall(Unit, unit_in_files(Files, Unit), Units),
|
|
( Units == []
|
|
-> true
|
|
; run_tests(Units)
|
|
).
|
|
|
|
unit_in_files(Files, Unit) :-
|
|
is_list(Files), !,
|
|
member(F, Files),
|
|
absolute_file_name(F, Source,
|
|
[ file_type(prolog),
|
|
access(read),
|
|
file_errors(fail)
|
|
]),
|
|
unit_file(Unit, Source).
|
|
|
|
|
|
/*******************************
|
|
* HOOKING MAKE/0 *
|
|
*******************************/
|
|
|
|
%% make_run_tests(+Files)
|
|
%
|
|
% Called indirectly from make/0 after Files have been reloaded.
|
|
|
|
make_run_tests(Files) :-
|
|
current_test_flag(test_options, Options),
|
|
option(run(When), Options, manual),
|
|
( When == make
|
|
-> run_tests_in_files(Files)
|
|
; When == make(all)
|
|
-> run_tests
|
|
; true
|
|
).
|
|
|
|
:- if(swi).
|
|
|
|
%unification_capability(sto_error_incomplete).
|
|
% can detect some (almost all) STO runs
|
|
unification_capability(rational_trees).
|
|
unification_capability(finite_trees).
|
|
|
|
set_unification_capability(Cap) :-
|
|
cap_to_flag(Cap, Flag),
|
|
set_prolog_flag(occurs_check, Flag).
|
|
|
|
current_unification_capability(Cap) :-
|
|
current_prolog_flag(occurs_check, Flag),
|
|
cap_to_flag(Cap, Flag), !.
|
|
current_unification_capability(false).
|
|
|
|
cap_to_flag(sto_error_incomplete, error).
|
|
cap_to_flag(rational_trees, false).
|
|
cap_to_flag(finite_trees, true).
|
|
|
|
:- else.
|
|
:- if(sicstus).
|
|
|
|
unification_capability(rational_trees).
|
|
set_unification_capability(rational_trees).
|
|
current_unification_capability(rational_trees).
|
|
|
|
:- else.
|
|
|
|
unification_capability(_) :-
|
|
fail.
|
|
|
|
:- endif.
|
|
:- endif.
|
|
|
|
/*******************************
|
|
* ASSERTION HANDLING *
|
|
*******************************/
|
|
|
|
:- if(swi).
|
|
|
|
:- dynamic user:assertion_failed/2.
|
|
|
|
setup_trap_assertions(Ref) :-
|
|
asserta((user:assertion_failed(Reason, Goal) :-
|
|
test_assertion_failed(Reason, Goal)),
|
|
Ref).
|
|
|
|
cleanup_trap_assertions(Ref) :-
|
|
erase(Ref).
|
|
|
|
test_assertion_failed(Reason, Goal) :-
|
|
thread_self(Me),
|
|
running(Unit, Test, Line, STO, Me),
|
|
( catch(get_prolog_backtrace(10, Stack), _, fail),
|
|
assertion_location(Stack, AssertLoc)
|
|
-> true
|
|
; AssertLoc = unknown
|
|
),
|
|
current_test_flag(test_options, Options),
|
|
report_failed_assertion(Unit, Test, Line, AssertLoc,
|
|
STO, Reason, Goal, Options),
|
|
assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
|
|
STO, Reason, Goal)).
|
|
|
|
assertion_location(Stack, File:Line) :-
|
|
append(_, [AssertFrame,CallerFrame|_], Stack),
|
|
prolog_stack_frame_property(AssertFrame,
|
|
predicate(prolog_debug:assertion/1)), !,
|
|
prolog_stack_frame_property(CallerFrame, location(File:Line)).
|
|
|
|
report_failed_assertion(Unit, Test, Line, AssertLoc,
|
|
STO, Reason, Goal, _Options) :-
|
|
print_message(
|
|
error,
|
|
plunit(failed_assertion(Unit, Test, Line, AssertLoc,
|
|
STO, Reason, Goal))).
|
|
|
|
:- else.
|
|
|
|
setup_trap_assertions(_).
|
|
cleanup_trap_assertions(_).
|
|
|
|
:- endif.
|
|
|
|
|
|
|
|
|
|
|
|
/*******************************
|
|
* RUNNING A TEST *
|
|
*******************************/
|
|
|
|
%% run_test(+Unit, +Name, +Line, +Options, +Body) is det.
|
|
%
|
|
% Run a single test.
|
|
|
|
run_test(Unit, Name, Line, Options, Body) :-
|
|
option(forall(Generator), Options), !,
|
|
unit_module(Unit, Module),
|
|
term_variables(Generator, Vars),
|
|
forall(Module:Generator,
|
|
run_test_once(Unit, @(Name,Vars), Line, Options, Body)).
|
|
run_test(Unit, Name, Line, Options, Body) :-
|
|
run_test_once(Unit, Name, Line, Options, Body).
|
|
|
|
run_test_once(Unit, Name, Line, Options, Body) :-
|
|
current_test_flag(test_options, GlobalOptions),
|
|
option(sto(false), GlobalOptions, false), !,
|
|
current_unification_capability(Type),
|
|
begin_test(Unit, Name, Line, Type),
|
|
run_test_6(Unit, Name, Line, Options, Body, Result),
|
|
end_test(Unit, Name, Line, Type),
|
|
report_result(Result, Options).
|
|
run_test_once(Unit, Name, Line, Options, Body) :-
|
|
current_unit(Unit, _Module, _Supers, UnitOptions),
|
|
option(sto(Type), UnitOptions),
|
|
\+ option(sto(_), Options), !,
|
|
current_unification_capability(Cap0),
|
|
call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body),
|
|
set_unification_capability(Cap0)).
|
|
run_test_once(Unit, Name, Line, Options, Body) :-
|
|
current_unification_capability(Cap0),
|
|
call_cleanup(run_test_cap(Unit, Name, Line, Options, Body),
|
|
set_unification_capability(Cap0)).
|
|
|
|
run_test_cap(Unit, Name, Line, Options, Body) :-
|
|
( option(sto(Type), Options)
|
|
-> unification_capability(Type),
|
|
set_unification_capability(Type),
|
|
begin_test(Unit, Name, Line, Type),
|
|
run_test_6(Unit, Name, Line, Options, Body, Result),
|
|
end_test(Unit, Name, Line, Type),
|
|
report_result(Result, Options)
|
|
; findall(Key-(Type+Result),
|
|
test_caps(Type, Unit, Name, Line, Options, Body, Result, Key),
|
|
Pairs),
|
|
group_pairs_by_key(Pairs, Keyed),
|
|
( Keyed == []
|
|
-> true
|
|
; Keyed = [_-Results]
|
|
-> Results = [_Type+Result|_],
|
|
report_result(Result, Options) % consistent results
|
|
; pairs_values(Pairs, ResultByType),
|
|
report_result(sto(Unit, Name, Line, ResultByType), Options)
|
|
)
|
|
).
|
|
|
|
%% test_caps(-Type, +Unit, +Name, +Line, +Options, +Body, -Result, -Key) is nondet.
|
|
|
|
test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :-
|
|
unification_capability(Type),
|
|
set_unification_capability(Type),
|
|
begin_test(Unit, Name, Line, Type),
|
|
run_test_6(Unit, Name, Line, Options, Body, Result),
|
|
end_test(Unit, Name, Line, Type),
|
|
result_to_key(Result, Key),
|
|
Key \== setup_failed.
|
|
|
|
result_to_key(blocked(_, _, _, _), blocked).
|
|
result_to_key(failure(_, _, _, How0), failure(How1)) :-
|
|
( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ).
|
|
result_to_key(success(_, _, _, Determinism, _), success(Determinism)).
|
|
result_to_key(setup_failed(_,_,_), setup_failed).
|
|
|
|
report_result(blocked(Unit, Name, Line, Reason), _) :- !,
|
|
assert(blocked(Unit, Name, Line, Reason)).
|
|
report_result(failure(Unit, Name, Line, How), Options) :- !,
|
|
failure(Unit, Name, Line, How, Options).
|
|
report_result(success(Unit, Name, Line, Determinism, Time), Options) :- !,
|
|
success(Unit, Name, Line, Determinism, Time, Options).
|
|
report_result(setup_failed(_Unit, _Name, _Line), _Options).
|
|
report_result(sto(Unit, Name, Line, ResultByType), Options) :-
|
|
assert(sto(Unit, Name, Line, ResultByType)),
|
|
print_message(error, plunit(sto(Unit, Name, Line))),
|
|
report_sto_results(ResultByType, Options).
|
|
|
|
report_sto_results([], _).
|
|
report_sto_results([Type+Result|T], Options) :-
|
|
print_message(error, plunit(sto(Type, Result))),
|
|
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)
|
|
|
|
run_test_6(Unit, Name, Line, Options, _Body,
|
|
blocked(Unit, Name, Line, Reason)) :-
|
|
option(blocked(Reason), Options), !.
|
|
run_test_6(Unit, Name, Line, Options, Body, Result) :-
|
|
option(all(Answer), Options), !, % all(Bindings)
|
|
nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
|
|
run_test_6(Unit, Name, Line, Options, Body, Result) :-
|
|
option(set(Answer), Options), !, % set(Bindings)
|
|
nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
|
|
run_test_6(Unit, Name, Line, Options, Body, Result) :-
|
|
option(fail, Options), !, % fail
|
|
unit_module(Unit, Module),
|
|
( setup(Module, test(Unit,Name,Line), Options)
|
|
-> statistics(runtime, [T0,_]),
|
|
( catch(Module:Body, E, true)
|
|
-> ( var(E)
|
|
-> statistics(runtime, [T1,_]),
|
|
Time is (T1 - T0)/1000.0,
|
|
Result = failure(Unit, Name, Line, succeeded(Time)),
|
|
cleanup(Module, Options)
|
|
; Result = failure(Unit, Name, Line, E),
|
|
cleanup(Module, Options)
|
|
)
|
|
; statistics(runtime, [T1,_]),
|
|
Time is (T1 - T0)/1000.0,
|
|
Result = success(Unit, Name, Line, true, Time),
|
|
cleanup(Module, Options)
|
|
)
|
|
; Result = setup_failed(Unit, Name, Line)
|
|
).
|
|
run_test_6(Unit, Name, Line, Options, Body, Result) :-
|
|
option(true(Cmp), Options), !,
|
|
unit_module(Unit, Module),
|
|
( setup(Module, test(Unit,Name,Line), Options) % true(Binding)
|
|
-> statistics(runtime, [T0,_]),
|
|
( catch(call_det(Module:Body, Det), E, true)
|
|
-> ( var(E)
|
|
-> statistics(runtime, [T1,_]),
|
|
Time is (T1 - T0)/1000.0,
|
|
( catch(Module:Cmp, E, true)
|
|
-> ( var(E)
|
|
-> Result = success(Unit, Name, Line, Det, Time)
|
|
; Result = failure(Unit, Name, Line, cmp_error(Cmp, E))
|
|
)
|
|
; Result = failure(Unit, Name, Line, wrong_answer(Cmp))
|
|
),
|
|
cleanup(Module, Options)
|
|
; Result = failure(Unit, Name, Line, E),
|
|
cleanup(Module, Options)
|
|
)
|
|
; Result = failure(Unit, Name, Line, failed),
|
|
cleanup(Module, Options)
|
|
)
|
|
; Result = setup_failed(Unit, Name, Line)
|
|
).
|
|
run_test_6(Unit, Name, Line, Options, Body, Result) :-
|
|
option(throws(Expect), Options), !,
|
|
unit_module(Unit, Module),
|
|
( setup(Module, test(Unit,Name,Line), Options)
|
|
-> statistics(runtime, [T0,_]),
|
|
( catch(Module:Body, E, true)
|
|
-> ( var(E)
|
|
-> Result = failure(Unit, Name, Line, no_exception),
|
|
cleanup(Module, Options)
|
|
; statistics(runtime, [T1,_]),
|
|
Time is (T1 - T0)/1000.0,
|
|
( match_error(Expect, E)
|
|
-> Result = success(Unit, Name, Line, true, Time)
|
|
; Result = failure(Unit, Name, Line, wrong_error(Expect, E))
|
|
),
|
|
cleanup(Module, Options)
|
|
)
|
|
; Result = failure(Unit, Name, Line, failed),
|
|
cleanup(Module, Options)
|
|
)
|
|
; Result = setup_failed(Unit, Name, Line)
|
|
).
|
|
|
|
|
|
%% non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result)
|
|
%
|
|
% Run tests on non-deterministic predicates.
|
|
|
|
nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
|
|
unit_module(Unit, Module),
|
|
result_vars(Expected, Vars),
|
|
statistics(runtime, [T0,_]),
|
|
( setup(Module, test(Unit,Name,Line), Options)
|
|
-> ( catch(findall(Vars, Module:Body, Bindings), E, true)
|
|
-> ( var(E)
|
|
-> statistics(runtime, [T1,_]),
|
|
Time is (T1 - T0)/1000.0,
|
|
( nondet_compare(Expected, Bindings, Unit, Name, Line)
|
|
-> Result = success(Unit, Name, Line, true, Time)
|
|
; Result = failure(Unit, Name, Line, wrong_answer(Expected, Bindings))
|
|
),
|
|
cleanup(Module, Options)
|
|
; Result = failure(Unit, Name, Line, E),
|
|
cleanup(Module, Options)
|
|
)
|
|
)
|
|
; Result = setup_failed(Unit, Name, Line)
|
|
).
|
|
|
|
|
|
%% result_vars(+Expected, -Vars) is det.
|
|
%
|
|
% Create a term v(V1, ...) containing all variables at the left
|
|
% side of the comparison operator on Expected.
|
|
|
|
result_vars(Expected, Vars) :-
|
|
arg(1, Expected, CmpOp),
|
|
arg(1, CmpOp, Vars).
|
|
|
|
%% nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet.
|
|
%
|
|
% Compare list/set results for non-deterministic predicates.
|
|
%
|
|
% @tbd Properly report errors
|
|
% @bug Sort should deal with equivalence on the comparison
|
|
% operator.
|
|
|
|
nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
|
|
cmp(Cmp, _Vars, Op, Values),
|
|
cmp_list(Values, Bindings, Op).
|
|
nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
|
|
cmp(Cmp, _Vars, Op, Values0),
|
|
sort(Bindings0, Bindings),
|
|
sort(Values0, Values),
|
|
cmp_list(Values, Bindings, Op).
|
|
|
|
cmp_list([], [], _Op).
|
|
cmp_list([E0|ET], [V0|VT], Op) :-
|
|
call(Op, E0, V0),
|
|
cmp_list(ET, VT, Op).
|
|
|
|
%% cmp(+CmpTerm, -Left, -Op, -Right) is det.
|
|
|
|
cmp(Var == Value, Var, ==, Value).
|
|
cmp(Var =:= Value, Var, =:=, Value).
|
|
cmp(Var = Value, Var, =, Value).
|
|
:- if(swi).
|
|
cmp(Var =@= Value, Var, =@=, Value).
|
|
:- else.
|
|
:- if(sicstus).
|
|
cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@=
|
|
:- endif.
|
|
:- endif.
|
|
|
|
|
|
%% call_det(:Goal, -Det) is nondet.
|
|
%
|
|
% True if Goal succeeded. Det is unified to =true= if Goal left
|
|
% no choicepoints and =false= otherwise.
|
|
|
|
:- if((swi)).
|
|
call_det(Goal, Det) :-
|
|
call_cleanup(Goal,Det0=true),
|
|
( var(Det0) -> Det = false ; Det = true ).
|
|
:- else.
|
|
call_det(Goal, true) :-
|
|
call(Goal).
|
|
:- endif.
|
|
|
|
%% match_error(+Expected, +Received) is semidet.
|
|
%
|
|
% True if the Received errors matches the expected error. Matching
|
|
% is based on subsumes_term/2.
|
|
|
|
match_error(Expect, Rec) :-
|
|
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
|
|
|
|
setup(Module, Context, Options) :-
|
|
option(condition(Condition), Options),
|
|
option(setup(Setup), Options), !,
|
|
setup(Module, Context, [condition(Condition)]),
|
|
setup(Module, Context, [setup(Setup)]).
|
|
setup(Module, Context, Options) :-
|
|
option(setup(Setup), Options), !,
|
|
( catch(call_ex(Module, Setup), E, true)
|
|
-> ( var(E)
|
|
-> true
|
|
; print_message(error, plunit(error(setup, Context, E))),
|
|
fail
|
|
)
|
|
; print_message(error, error(goal_failed(Setup), _)),
|
|
fail
|
|
).
|
|
setup(Module, Context, Options) :-
|
|
option(condition(Setup), Options), !,
|
|
( catch(call_ex(Module, Setup), E, true)
|
|
-> ( var(E)
|
|
-> true
|
|
; print_message(error, plunit(error(condition, Context, E))),
|
|
fail
|
|
)
|
|
; fail
|
|
).
|
|
setup(_,_,_).
|
|
|
|
%% call_ex(+Module, +Goal)
|
|
%
|
|
% Call Goal in Module after applying goal expansion.
|
|
|
|
call_ex(Module, Goal) :-
|
|
Module:(expand_goal(Goal, GoalEx),
|
|
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.
|
|
|
|
cleanup(Module, Options) :-
|
|
option(cleanup(Cleanup), Options, true),
|
|
( catch(call_ex(Module, Cleanup), E, true)
|
|
-> ( var(E)
|
|
-> true
|
|
; print_message(warning, E)
|
|
)
|
|
; print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
|
|
).
|
|
|
|
success(Unit, Name, Line, Det, _Time, Options) :-
|
|
memberchk(fixme(Reason), Options), !,
|
|
( ( Det == true
|
|
; memberchk(nondet, Options)
|
|
)
|
|
-> put_char(user_error, +),
|
|
Ok = passed
|
|
; put_char(user_error, !),
|
|
Ok = nondet
|
|
),
|
|
flush_output(user_error),
|
|
assert(fixme(Unit, Name, Line, Reason, Ok)).
|
|
success(Unit, Name, Line, _, _, Options) :-
|
|
failed_assertion(Unit, Name, Line, _,_,_,_), !,
|
|
failure(Unit, Name, Line, assertion, Options).
|
|
success(Unit, Name, Line, Det, Time, Options) :-
|
|
assert(passed(Unit, Name, Line, Det, Time)),
|
|
( ( Det == true
|
|
; memberchk(nondet, Options)
|
|
)
|
|
-> put_char(user_error, .)
|
|
; unit_file(Unit, File),
|
|
print_message(warning, plunit(nondet(File, Line, Name)))
|
|
),
|
|
flush_output(user_error).
|
|
|
|
failure(Unit, Name, Line, _, Options) :-
|
|
memberchk(fixme(Reason), Options), !,
|
|
put_char(user_error, -),
|
|
flush_output(user_error),
|
|
assert(fixme(Unit, Name, Line, Reason, failed)).
|
|
failure(Unit, Name, Line, E, Options) :-
|
|
report_failure(Unit, Name, Line, E, Options),
|
|
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.
|
|
%
|
|
% @tbd Implement cycle-safe assert and remove this.
|
|
|
|
:- if(swi).
|
|
assert_cyclic(Term) :-
|
|
acyclic_term(Term), !,
|
|
assert(Term).
|
|
assert_cyclic(Term) :-
|
|
Term =.. [Functor|Args],
|
|
recorda(cyclic, Args, Id),
|
|
functor(Term, _, Arity),
|
|
length(NewArgs, Arity),
|
|
Head =.. [Functor|NewArgs],
|
|
assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
|
|
:- else.
|
|
:- if(sicstus).
|
|
:- endif.
|
|
assert_cyclic(Term) :-
|
|
assert(Term).
|
|
:- endif.
|
|
|
|
|
|
/*******************************
|
|
* REPORTING *
|
|
*******************************/
|
|
|
|
%% 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 message_hook/3 for intercepting these messages
|
|
|
|
begin_test(Unit, Test, Line, STO) :-
|
|
thread_self(Me),
|
|
assert(running(Unit, Test, Line, STO, Me)),
|
|
unit_file(Unit, File),
|
|
print_message(silent, plunit(begin(Unit:Test, File:Line, STO))).
|
|
|
|
end_test(Unit, Test, Line, STO) :-
|
|
thread_self(Me),
|
|
retractall(running(_,_,_,_,Me)),
|
|
unit_file(Unit, File),
|
|
print_message(silent, plunit(end(Unit:Test, File:Line, STO))).
|
|
|
|
%% running_tests is det.
|
|
%
|
|
% Print the currently running test.
|
|
|
|
running_tests :-
|
|
running_tests(Running),
|
|
print_message(informational, plunit(running(Running))).
|
|
|
|
running_tests(Running) :-
|
|
findall(running(Unit:Test, File:Line, STO, Thread),
|
|
( running(Unit, Test, Line, STO, Thread),
|
|
unit_file(Unit, File)
|
|
), Running).
|
|
|
|
|
|
%% check_for_test_errors is semidet.
|
|
%
|
|
% True if there are no errors, otherwise false.
|
|
|
|
check_for_test_errors :-
|
|
number_of_clauses(failed/4, Failed),
|
|
number_of_clauses(failed_assertion/7, FailedAssertion),
|
|
number_of_clauses(sto/4, STO),
|
|
Failed+FailedAssertion+STO =:= 0. % fail on errors
|
|
|
|
|
|
%% report is det.
|
|
%
|
|
% Print a summary of the tests that ran.
|
|
|
|
report :-
|
|
number_of_clauses(passed/5, Passed),
|
|
number_of_clauses(failed/4, Failed),
|
|
number_of_clauses(failed_assertion/7, FailedAssertion),
|
|
number_of_clauses(blocked/4, Blocked),
|
|
number_of_clauses(sto/4, STO),
|
|
( Passed+Failed+FailedAssertion+Blocked+STO =:= 0
|
|
-> info(plunit(no_tests))
|
|
; Failed+FailedAssertion+Blocked+STO =:= 0
|
|
-> report_fixme,
|
|
info(plunit(all_passed(Passed)))
|
|
; report_blocked,
|
|
report_fixme,
|
|
report_failed_assertions,
|
|
report_failed,
|
|
report_sto,
|
|
info(plunit(passed(Passed)))
|
|
).
|
|
|
|
number_of_clauses(F/A,N) :-
|
|
( current_predicate(F/A) %, writeln(F/A)
|
|
-> functor(G,F,A),
|
|
% writeln( G:F/A),
|
|
findall(t, G, Ts),
|
|
length(Ts, N)
|
|
; N = 0
|
|
).
|
|
|
|
report_blocked :-
|
|
number_of_clauses(blocked/4,N),
|
|
N > 0, !,
|
|
info(plunit(blocked(N))),
|
|
( blocked(Unit, Name, Line, Reason),
|
|
unit_file(Unit, File),
|
|
print_message(informational,
|
|
plunit(blocked(File:Line, Name, Reason))),
|
|
fail ; true
|
|
).
|
|
report_blocked.
|
|
|
|
report_failed :-
|
|
number_of_clauses(failed/4, N),
|
|
info(plunit(failed(N))).
|
|
|
|
report_failed_assertions :-
|
|
number_of_clauses(failed_assertion/7, N),
|
|
info(plunit(failed_assertions(N))).
|
|
|
|
report_sto :-
|
|
number_of_clauses(sto/4, N),
|
|
info(plunit(sto(N))).
|
|
|
|
report_fixme :-
|
|
report_fixme(_,_,_).
|
|
|
|
report_fixme(TuplesF, TuplesP, TuplesN) :-
|
|
fixme(failed, TuplesF, Failed),
|
|
fixme(passed, TuplesP, Passed),
|
|
fixme(nondet, TuplesN, Nondet),
|
|
print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
|
|
|
|
|
|
fixme(How, Tuples, Count) :-
|
|
findall(fixme(Unit, Name, Line, Reason, How),
|
|
fixme(Unit, Name, Line, Reason, How), Tuples),
|
|
length(Tuples, Count).
|
|
|
|
|
|
report_failure(_, _, _, assertion, _) :- !,
|
|
put_char(user_error, 'A').
|
|
report_failure(Unit, Name, Line, Error, _Options) :-
|
|
print_message(error, plunit(failed(Unit, Name, Line, Error))).
|
|
|
|
|
|
%% test_report(What) is det.
|
|
%
|
|
% Produce reports on test results after the run.
|
|
|
|
test_report(fixme) :- !,
|
|
report_fixme(TuplesF, TuplesP, TuplesN),
|
|
append([TuplesF, TuplesP, TuplesN], Tuples),
|
|
print_message(informational, plunit(fixme(Tuples))).
|
|
test_report(What) :-
|
|
throw_error(domain_error(report_class, What), _).
|
|
|
|
|
|
/*******************************
|
|
* INFO *
|
|
*******************************/
|
|
|
|
%% current_test_set(?Unit) is nondet.
|
|
%
|
|
% True if Unit is a currently loaded test-set.
|
|
|
|
current_test_set(Unit) :-
|
|
current_unit(Unit, _Module, _Context, _Options).
|
|
|
|
%% unit_file(+Unit, -File) is det.
|
|
%% unit_file(-Unit, +File) is nondet.
|
|
|
|
unit_file(Unit, File) :-
|
|
current_unit(Unit, Module, _Context, _Options),
|
|
current_module(Module, File).
|
|
unit_file(Unit, PlFile) :-
|
|
nonvar(PlFile),
|
|
test_file_for(TestFile, PlFile),
|
|
current_module(Module, TestFile),
|
|
current_unit(Unit, Module, _Context, _Options).
|
|
|
|
|
|
/*******************************
|
|
* FILES *
|
|
*******************************/
|
|
|
|
%% load_test_files(+Options) is det.
|
|
%
|
|
% Load .plt test-files related to loaded source-files.
|
|
|
|
load_test_files(_Options) :-
|
|
( source_file(File),
|
|
file_name_extension(Base, Old, File),
|
|
Old \== plt,
|
|
file_name_extension(Base, plt, TestFile),
|
|
exists_file(TestFile),
|
|
( test_file_for(TestFile, File)
|
|
-> true
|
|
; load_files(TestFile,
|
|
[ if(changed),
|
|
imports([])
|
|
]),
|
|
asserta(test_file_for(TestFile, File))
|
|
),
|
|
fail ; true
|
|
).
|
|
|
|
|
|
|
|
/*******************************
|
|
* MESSAGES *
|
|
*******************************/
|
|
|
|
%% info(+Term)
|
|
%
|
|
% Runs print_message(Level, Term), where Level is one of =silent=
|
|
% or =informational= (default).
|
|
|
|
info(Term) :-
|
|
message_level(Level),
|
|
print_message(Level, Term).
|
|
|
|
message_level(Level) :-
|
|
current_test_flag(test_options, Options),
|
|
option(silent(Silent), Options, false),
|
|
( Silent == false
|
|
-> Level = informational
|
|
; Level = silent
|
|
).
|
|
|
|
locationprefix(File:Line) --> !,
|
|
[ '~w:~d:\n\t'-[File,Line]].
|
|
locationprefix(test(Unit,_Test,Line)) --> !,
|
|
{ unit_file(Unit, File) },
|
|
locationprefix(File:Line).
|
|
locationprefix(unit(Unit)) --> !,
|
|
[ 'PL-Unit: unit ~w: '-[Unit] ].
|
|
locationprefix(FileLine) -->
|
|
{ throw_error(type_error(locationprefix,FileLine), _) }.
|
|
|
|
:- discontiguous message//1.
|
|
|
|
message(error(context_error(plunit_close(Name, -)), _)) -->
|
|
[ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
|
|
message(error(context_error(plunit_close(Name, Start)), _)) -->
|
|
[ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
|
|
message(plunit(nondet(File, Line, Name))) -->
|
|
locationprefix(File:Line),
|
|
[ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
|
|
message(error(plunit(incompatible_options, Tests), _)) -->
|
|
[ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
|
|
|
|
% Unit start/end
|
|
:- if(swi).
|
|
message(plunit(begin(Unit))) -->
|
|
[ 'PL-Unit: ~w '-[Unit], flush ].
|
|
message(plunit(end(_Unit))) -->
|
|
[ at_same_line, ' done' ].
|
|
:- else.
|
|
message(plunit(begin(Unit))) -->
|
|
[ 'PL-Unit: ~w '-[Unit]/*, flush-[]*/ ].
|
|
message(plunit(end(_Unit))) -->
|
|
[ ' done'-[] ].
|
|
:- endif.
|
|
message(plunit(blocked(unit(Unit, Reason)))) -->
|
|
[ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
|
|
message(plunit(running([]))) --> !,
|
|
[ 'PL-Unit: no tests running' ].
|
|
message(plunit(running([One]))) --> !,
|
|
[ 'PL-Unit: running ' ],
|
|
running(One).
|
|
message(plunit(running(More))) --> !,
|
|
[ 'PL-Unit: running tests:', nl ],
|
|
running(More).
|
|
message(plunit(fixme([]))) --> !.
|
|
message(plunit(fixme(Tuples))) --> !,
|
|
fixme_message(Tuples).
|
|
|
|
% Blocked tests
|
|
message(plunit(blocked(1))) --> !,
|
|
[ 'one test is blocked:'-[] ].
|
|
message(plunit(blocked(N))) -->
|
|
[ '~D tests are blocked:'-[N] ].
|
|
message(plunit(blocked(Pos, Name, Reason))) -->
|
|
locationprefix(Pos),
|
|
test_name(Name),
|
|
[ ': ~w'-[Reason] ].
|
|
|
|
% fail/success
|
|
message(plunit(no_tests)) --> !,
|
|
[ 'No tests to run' ].
|
|
message(plunit(all_passed(1))) --> !,
|
|
[ 'test passed' ].
|
|
message(plunit(all_passed(Count))) --> !,
|
|
[ 'All ~D tests passed'-[Count] ].
|
|
message(plunit(passed(Count))) --> !,
|
|
[ '~D tests passed'-[Count] ].
|
|
message(plunit(failed(0))) --> !,
|
|
[].
|
|
message(plunit(failed(1))) --> !,
|
|
[ '1 test failed'-[] ].
|
|
message(plunit(failed(N))) -->
|
|
[ '~D tests failed'-[N] ].
|
|
message(plunit(failed_assertions(0))) --> !,
|
|
[].
|
|
message(plunit(failed_assertions(1))) --> !,
|
|
[ '1 assertion failed'-[] ].
|
|
message(plunit(failed_assertions(N))) -->
|
|
[ '~D assertions failed'-[N] ].
|
|
message(plunit(sto(0))) --> !,
|
|
[].
|
|
message(plunit(sto(N))) -->
|
|
[ '~D test results depend on unification mode'-[N] ].
|
|
message(plunit(fixme(0,0,0))) -->
|
|
[].
|
|
message(plunit(fixme(Failed,0,0))) --> !,
|
|
[ 'all ~D tests flagged FIXME failed'-[Failed] ].
|
|
message(plunit(fixme(Failed,Passed,0))) -->
|
|
[ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
|
|
message(plunit(fixme(Failed,Passed,Nondet))) -->
|
|
{ TotalPassed is Passed+Nondet },
|
|
[ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
|
|
[Failed, TotalPassed, Nondet] ].
|
|
message(plunit(failed(Unit, Name, Line, Failure))) -->
|
|
{ unit_file(Unit, File) },
|
|
locationprefix(File:Line),
|
|
test_name(Name),
|
|
[': '-[] ],
|
|
failure(Failure).
|
|
:- if(swi).
|
|
message(plunit(failed_assertion(Unit, Name, Line, AssertLoc,
|
|
_STO, Reason, Goal))) -->
|
|
{ unit_file(Unit, File) },
|
|
locationprefix(File:Line),
|
|
test_name(Name),
|
|
[ ': assertion'-[] ],
|
|
assertion_location(AssertLoc, File),
|
|
assertion_reason(Reason), ['\n\t'],
|
|
assertion_goal(Unit, Goal).
|
|
|
|
assertion_location(File:Line, File) -->
|
|
[ ' at line ~w'-[Line] ].
|
|
assertion_location(File:Line, _) -->
|
|
[ ' at ~w:~w'-[File, Line] ].
|
|
assertion_location(unknown, _) -->
|
|
[].
|
|
|
|
assertion_reason(fail) --> !,
|
|
[ ' failed'-[] ].
|
|
assertion_reason(Error) -->
|
|
{ message_to_string(Error, String) },
|
|
[ ' raised "~w"'-[String] ].
|
|
|
|
assertion_goal(Unit, Goal) -->
|
|
{ unit_module(Unit, Module),
|
|
unqualify(Goal, Module, Plain)
|
|
},
|
|
[ 'Assertion: ~p'-[Plain] ].
|
|
|
|
unqualify(Var, _, Var) :-
|
|
var(Var), !.
|
|
unqualify(M:Goal, Unit, Goal) :-
|
|
nonvar(M),
|
|
unit_module(Unit, M), !.
|
|
unqualify(M:Goal, _, Goal) :-
|
|
callable(Goal),
|
|
predicate_property(M:Goal, imported_from(system)), !.
|
|
unqualify(Goal, _, Goal).
|
|
|
|
:- endif.
|
|
% Setup/condition errors
|
|
message(plunit(error(Where, Context, Exception))) -->
|
|
locationprefix(Context),
|
|
{ message_to_string(Exception, String) },
|
|
[ 'error in ~w: ~w'-[Where, String] ].
|
|
|
|
% STO messages
|
|
message(plunit(sto(Unit, Name, Line))) -->
|
|
{ unit_file(Unit, File) },
|
|
locationprefix(File:Line),
|
|
test_name(Name),
|
|
[' is subject to occurs check (STO): '-[] ].
|
|
message(plunit(sto(Type, Result))) -->
|
|
sto_type(Type),
|
|
sto_result(Result).
|
|
|
|
% Interrupts (SWI)
|
|
:- if(swi).
|
|
message(interrupt(begin)) -->
|
|
{ thread_self(Me),
|
|
running(Unit, Test, Line, STO, Me), !,
|
|
unit_file(Unit, File)
|
|
},
|
|
[ 'Interrupted test '-[] ],
|
|
running(running(Unit:Test, File:Line, STO, Me)),
|
|
[nl],
|
|
'$messages':prolog_message(interrupt(begin)).
|
|
message(interrupt(begin)) -->
|
|
'$messages':prolog_message(interrupt(begin)).
|
|
:- endif.
|
|
|
|
test_name(@(Name,Bindings)) --> !,
|
|
[ 'test ~w (forall bindings = ~p)'-[Name, Bindings] ].
|
|
test_name(Name) --> !,
|
|
[ 'test ~w'-[Name] ].
|
|
|
|
sto_type(sto_error_incomplete) -->
|
|
[ 'Finite trees (error checking): ' ].
|
|
sto_type(rational_trees) -->
|
|
[ 'Rational trees: ' ].
|
|
sto_type(finite_trees) -->
|
|
[ 'Finite trees: ' ].
|
|
|
|
sto_result(success(_Unit, _Name, _Line, Det, Time)) -->
|
|
det(Det),
|
|
[ ' success in ~2f seconds'-[Time] ].
|
|
sto_result(failure(_Unit, _Name, _Line, How)) -->
|
|
failure(How).
|
|
|
|
det(true) -->
|
|
[ 'deterministic' ].
|
|
det(false) -->
|
|
[ 'non-deterministic' ].
|
|
|
|
running(running(Unit:Test, File:Line, STO, Thread)) -->
|
|
thread(Thread),
|
|
[ '~q:~q at ~w:~d'-[Unit, Test, File, Line] ],
|
|
current_sto(STO).
|
|
running([H|T]) -->
|
|
['\t'], running(H),
|
|
( {T == []}
|
|
-> []
|
|
; [nl], running(T)
|
|
).
|
|
|
|
thread(main) --> !.
|
|
thread(Other) -->
|
|
[' [~w] '-[Other] ].
|
|
|
|
current_sto(sto_error_incomplete) -->
|
|
[ ' (STO: error checking)' ].
|
|
current_sto(rational_trees) -->
|
|
[].
|
|
current_sto(finite_trees) -->
|
|
[ ' (STO: occurs check enabled)' ].
|
|
|
|
:- if(swi).
|
|
write_term(T, OPS) -->
|
|
['~@'-[write_term(T,OPS)]].
|
|
:- else.
|
|
write_term(T, _OPS) -->
|
|
['~q'-[T]].
|
|
:- endif.
|
|
|
|
expected_got_ops_(Ex, E, OPS, Goals) -->
|
|
[' Expected: '-[]], write_term(Ex, OPS), [nl],
|
|
[' Got: '-[]], write_term(E, OPS), [nl],
|
|
( { Goals = [] } -> []
|
|
; [' with: '-[]], write_term(Goals, OPS), [nl]
|
|
).
|
|
|
|
|
|
failure(Var) -->
|
|
{ var(Var) }, !,
|
|
[ 'Unknown failure?' ].
|
|
failure(succeeded(Time)) --> !,
|
|
[ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
|
|
failure(wrong_error(Expected, Error)) --> !,
|
|
{ copy_term(Expected-Error, Ex-E, Goals),
|
|
numbervars(Ex-E-Goals, 0, _),
|
|
write_options(OPS)
|
|
},
|
|
[ 'wrong error'-[], nl ],
|
|
expected_got_ops_(Ex, E, OPS, Goals).
|
|
failure(wrong_answer(Cmp)) -->
|
|
{ Cmp =.. [Op,Answer,Expected], !,
|
|
copy_term(Expected-Answer, Ex-A, Goals),
|
|
numbervars(Ex-A-Goals, 0, _),
|
|
write_options(OPS)
|
|
},
|
|
[ 'wrong answer (compared using ~w)'-[Op], nl ],
|
|
expected_got_ops_(Ex, A, OPS, Goals).
|
|
failure(wrong_answer(CmpExpected, Bindings)) -->
|
|
{ ( CmpExpected = all(Cmp)
|
|
-> Cmp =.. [_Op1,_,Expected],
|
|
Got = Bindings,
|
|
Type = all
|
|
; CmpExpected = set(Cmp),
|
|
Cmp =.. [_Op2,_,Expected0],
|
|
sort(Expected0, Expected),
|
|
sort(Bindings, Got),
|
|
Type = set
|
|
)
|
|
},
|
|
[ 'wrong "~w" answer:'-[Type] ],
|
|
[ nl, ' Expected: ~q'-[Expected] ],
|
|
[ nl, ' Found: ~q'-[Got] ].
|
|
:- if(swi).
|
|
failure(cmp_error(_Cmp, Error)) -->
|
|
{ message_to_string(Error, Message) },
|
|
[ 'Comparison error: ~w'-[Message] ].
|
|
failure(Error) -->
|
|
{ Error = error(_,_), !,
|
|
message_to_string(Error, Message)
|
|
},
|
|
[ 'received error: ~w'-[Message] ].
|
|
:- endif.
|
|
failure(Why) -->
|
|
[ '~p~n'-[Why] ].
|
|
|
|
fixme_message([]) --> [].
|
|
fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
|
|
{ unit_file(Unit, File) },
|
|
fixme_message(File:Line, Reason, How),
|
|
( {T == []}
|
|
-> []
|
|
; [nl],
|
|
fixme_message(T)
|
|
).
|
|
|
|
fixme_message(Location, Reason, failed) -->
|
|
[ 'FIXME: ~w: ~w'-[Location, Reason] ].
|
|
fixme_message(Location, Reason, passed) -->
|
|
[ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
|
|
fixme_message(Location, Reason, nondet) -->
|
|
[ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
|
|
|
|
|
|
write_options([ numbervars(true),
|
|
quoted(true),
|
|
portray(true),
|
|
max_depth(10),
|
|
attributes(portray)
|
|
]).
|
|
|
|
:- if(swi).
|
|
|
|
:- multifile
|
|
message/3,
|
|
user:message_hook/3.
|
|
|
|
% user:message_hook(+Term, +Kind, +Lines)
|
|
|
|
user:message_hook(make(done(Files)), _, _) :-
|
|
make_run_tests(Files),
|
|
fail. % give other hooks a chance
|
|
|
|
:- endif.
|
|
|
|
:- if(sicstus).
|
|
|
|
user:generate_message_hook(Message) -->
|
|
message(Message),
|
|
[nl]. % SICStus requires nl at the end
|
|
|
|
%% user:message_hook(+Severity, +Message, +Lines) is semidet.
|
|
%
|
|
% Redefine printing some messages. It appears SICStus has no way
|
|
% to get multiple messages at the same line, so we roll our own.
|
|
% As there is a lot pre-wired and checked in the SICStus message
|
|
% handling we cannot reuse the lines. Unless I miss something ...
|
|
|
|
user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
|
|
format(user_error, '% PL-Unit: ~w ', [Unit]),
|
|
flush_output(user_error).
|
|
user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
|
|
format(user, ' done~n', []).
|
|
|
|
:- endif.
|