chr_test.pl

   1 /*  $Id$
   2
   3     E-mail: jan@swi.psy.uva.nl
   4
   5     Copyright (C) 1996 University of Amsterdam. All rights reserved.
   6 */
   7
   8 :- asserta(user:file_search_path(chr, '.')).
   9 :- asserta(user:file_search_path(library, '.')).
  10 :- use_module(chr).                     % == library(chr)
  11
  12 :- set_prolog_flag(optimise, true).
  13 %:- set_prolog_flag(trace_gc, true).
  14
  15 :- format('CHR test suite.  To run all tests run ?- test.~n~n', []).
  16
  17 % Required to get this always running regardless of user LANG setting.
  18 % Without this the tests won't run on machines with -for example- LANG=ja
  19 % according to NIDE Naoyuki, nide@ics.nara-wu.ac.jp.  Thanks!
  20
  21 :- getenv('LANG', _) -> setenv('LANG', 'C'); true.
  22
  23
  24                  /*******************************
  25                  *            SCRIPTS           *
  26                  *******************************/
  27
  28
  29 :- dynamic
  30         script_dir/1.
  31
  32 set_script_dir :-
  33         script_dir(_), !.
  34 set_script_dir :-
  35         find_script_dir(Dir),
  36         assert(script_dir(Dir)).
  37
  38 find_script_dir(Dir) :-
  39         prolog_load_context(file, File),
  40         follow_links(File, RealFile),
  41         file_directory_name(RealFile, Dir).
  42
  43 follow_links(File, RealFile) :-
  44         read_link(File, _, RealFile), !.
  45 follow_links(File, File).
  46
  47
  48 :- set_script_dir.
  49
  50 run_test_script(Script) :-
  51         file_base_name(Script, Base),
  52         file_name_extension(Pred, _, Base),
  53         load_files(Script, []), %[silent(true)]),
  54         Pred.
  55
  56 run_test_scripts(Directory) :-
  57         (   script_dir(ScriptDir),
  58             concat_atom([ScriptDir, /, Directory], Dir),
  59             exists_directory(Dir)
  60         ->  true
  61         ;   Dir = Directory
  62         ),
  63         atom_concat(Dir, '/*.chr', Pattern),
  64         expand_file_name(Pattern, Files),
  65         file_base_name(Dir, BaseDir),
  66         format('Running scripts from ~w ', [BaseDir]), flush,
  67         run_scripts(Files),
  68         format(' done~n').
  69
  70 run_scripts([]).
  71 run_scripts([H|T]) :-
  72         (   catch(run_test_script(H), Except, true)
  73         ->  (   var(Except)
  74             ->  put(.), flush
  75             ;   Except = blocked(Reason)
  76             ->  assert(blocked(H, Reason)),
  77                 put(!), flush
  78             ;   script_failed(H, Except)
  79             )
  80         ;   script_failed(H, fail)
  81         ),
  82         run_scripts(T).
  83
  84 script_failed(File, fail) :-
  85         format('~NScript ~w failed~n', [File]),
  86         assert(failed(script(File))).
  87 script_failed(File, Except) :-
  88         message_to_string(Except, Error),
  89         format('~NScript ~w failed: ~w~n', [File, Error]),
  90         assert(failed(script(File))).
  91
  92
  93                  /*******************************
  94                  *        TEST MAIN-LOOP        *
  95                  *******************************/
  96
  97 testdir('Tests').
  98
  99 :- dynamic
 100         failed/1,
 101         blocked/2.
 102
 103 test :-
 104         retractall(failed(_)),
 105         retractall(blocked(_,_)),
 106         scripts,
 107         report_blocked,
 108         report_failed.
 109
 110 scripts :-
 111         forall(testdir(Dir), run_test_scripts(Dir)).
 112
 113
 114 report_blocked :-
 115         findall(Head-Reason, blocked(Head, Reason), L),
 116         (   L \== []
 117         ->  format('~nThe following tests are blocked:~n', []),
 118             (   member(Head-Reason, L),
 119                 format('    ~p~t~40|~w~n', [Head, Reason]),
 120                 fail
 121             ;   true
 122             )
 123         ;   true
 124         ).
 125 report_failed :-
 126         findall(X, failed(X), L),
 127         length(L, Len),
 128         (   Len > 0
 129         ->  format('~n*** ~w tests failed ***~n', [Len]),
 130             fail
 131         ;   format('~nAll tests passed~n', [])
 132         ).
 133
 134 test_failed(R, Except) :-
 135         clause(Head, _, R),
 136         functor(Head, Name, 1),
 137         arg(1, Head, TestName),
 138         clause_property(R, line_count(Line)),
 139         clause_property(R, file(File)),
 140         (   Except == fail
 141         ->  format('~N~w:~d: Test ~w(~w) failed~n',
 142                    [File, Line, Name, TestName])
 143         ;   message_to_string(Except, Error),
 144             format('~N~w:~d: Test ~w(~w):~n~t~8|ERROR: ~w~n',
 145                    [File, Line, Name, TestName, Error])
 146         ),
 147         assert(failed(Head)).
 148
 149 blocked(Reason) :-
 150         throw(blocked(Reason)).
 151