stop using submodule
This commit is contained in:
170
packages/chr/chr_test.pl
Normal file
170
packages/chr/chr_test.pl
Normal file
@@ -0,0 +1,170 @@
|
||||
/* $Id$
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: wielemak@science.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 2005,2006, University of 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 Lesser 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.
|
||||
*/
|
||||
|
||||
:- asserta(user:file_search_path(chr, '.')).
|
||||
:- asserta(user:file_search_path(library, '.')).
|
||||
:- use_module(library(chr)).
|
||||
%% :- use_module(chr). % == library(chr)
|
||||
|
||||
:- set_prolog_flag(optimise, true).
|
||||
%:- set_prolog_flag(trace_gc, true).
|
||||
|
||||
:- format('CHR test suite. To run all tests run ?- test.~n~n', []).
|
||||
|
||||
/*******************************
|
||||
* SCRIPTS *
|
||||
*******************************/
|
||||
|
||||
|
||||
:- dynamic
|
||||
script_dir/1.
|
||||
|
||||
set_script_dir :-
|
||||
script_dir(_), !.
|
||||
set_script_dir :-
|
||||
find_script_dir(Dir),
|
||||
assert(script_dir(Dir)).
|
||||
|
||||
find_script_dir(Dir) :-
|
||||
prolog_load_context(file, File),
|
||||
follow_links(File, RealFile),
|
||||
file_directory_name(RealFile, Dir).
|
||||
|
||||
follow_links(File, RealFile) :-
|
||||
read_link(File, _, RealFile), !.
|
||||
follow_links(File, File).
|
||||
|
||||
|
||||
:- set_script_dir.
|
||||
|
||||
run_test_script(Script) :-
|
||||
file_base_name(Script, Base),
|
||||
file_name_extension(Pred, _, Base),
|
||||
format(' ~w~n',[Script]),
|
||||
load_files(Script, []), %[silent(true)]),
|
||||
Pred.
|
||||
|
||||
run_test_scripts(Directory) :-
|
||||
( script_dir(ScriptDir),
|
||||
concat_atom([ScriptDir, /, Directory], Dir),
|
||||
exists_directory(Dir)
|
||||
-> true
|
||||
; Dir = Directory
|
||||
),
|
||||
atom_concat(Dir, '/*.chr', Pattern),
|
||||
expand_file_name(Pattern, Files),
|
||||
file_base_name(Dir, BaseDir),
|
||||
format('Running scripts from ~w ', [BaseDir]), flush_output,
|
||||
run_scripts(Files),
|
||||
format(' done~n').
|
||||
|
||||
run_scripts([]).
|
||||
run_scripts([H|T]) :-
|
||||
( catch(run_test_script(H), Except, true)
|
||||
-> ( var(Except)
|
||||
-> put(.), flush_output
|
||||
; Except = blocked(Reason)
|
||||
-> assert(blocked(H, Reason)),
|
||||
put(!), flush_output
|
||||
; script_failed(H, Except)
|
||||
)
|
||||
; script_failed(H, fail)
|
||||
),
|
||||
run_scripts(T).
|
||||
|
||||
script_failed(File, fail) :-
|
||||
format('~NScript ~w failed~n', [File]),
|
||||
assert(failed(script(File))).
|
||||
script_failed(File, Except) :-
|
||||
message_to_string(Except, Error),
|
||||
format('~NScript ~w failed: ~w~n', [File, Error]),
|
||||
assert(failed(script(File))).
|
||||
|
||||
|
||||
/*******************************
|
||||
* TEST MAIN-LOOP *
|
||||
*******************************/
|
||||
|
||||
testdir('Tests').
|
||||
|
||||
:- dynamic
|
||||
failed/1,
|
||||
blocked/2.
|
||||
|
||||
test :-
|
||||
retractall(failed(_)),
|
||||
retractall(blocked(_,_)),
|
||||
scripts,
|
||||
report_blocked,
|
||||
report_failed.
|
||||
|
||||
scripts :-
|
||||
forall(testdir(Dir), run_test_scripts(Dir)).
|
||||
|
||||
|
||||
report_blocked :-
|
||||
findall(Head-Reason, blocked(Head, Reason), L),
|
||||
( L \== []
|
||||
-> format('~nThe following tests are blocked:~n', []),
|
||||
( member(Head-Reason, L),
|
||||
format(' ~p~t~40|~w~n', [Head, Reason]),
|
||||
fail
|
||||
; true
|
||||
)
|
||||
; true
|
||||
).
|
||||
report_failed :-
|
||||
findall(X, failed(X), L),
|
||||
length(L, Len),
|
||||
( Len > 0
|
||||
-> format('~n*** ~w tests failed ***~n', [Len]),
|
||||
fail
|
||||
; format('~nAll tests passed~n', [])
|
||||
).
|
||||
|
||||
test_failed(R, Except) :-
|
||||
clause(Head, _, R),
|
||||
functor(Head, Name, 1),
|
||||
arg(1, Head, TestName),
|
||||
clause_property(R, line_count(Line)),
|
||||
clause_property(R, file(File)),
|
||||
( Except == fail
|
||||
-> format('~N~w:~d: Test ~w(~w) failed~n',
|
||||
[File, Line, Name, TestName])
|
||||
; message_to_string(Except, Error),
|
||||
format('~N~w:~d: Test ~w(~w):~n~t~8|ERROR: ~w~n',
|
||||
[File, Line, Name, TestName, Error])
|
||||
),
|
||||
assert(failed(Head)).
|
||||
|
||||
blocked(Reason) :-
|
||||
throw(blocked(Reason)).
|
||||
|
Reference in New Issue
Block a user