1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1999-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): IC-Parc, Imperal College London and ICL 21% 22% END LICENSE BLOCK 23% 24% System: ECLiPSe Constraint Logic Programming System 25% Version: $Id: t_all.pl,v 1.6 2015/01/14 01:31:09 jschimpf Exp $ 26% ---------------------------------------------------------------------- 27 28%----------------------------------------------------------------------- 29% ECLiPSe II generic test program tool 30% 31% Author: Owen Evans, IC-Parc 32% OVDE IC-parc 26 Feb 1999/03 33% Modified Kish Shen 15 July 1999 34% Kish Shen 21 March 20001: 35% Output to error stream sent to output file: tests may 36% need to provoke error messages as part of the test 37%----------------------------------------------------------------------- 38 39:- module(t_all). 40 41:- 42 import 43 set_default_error_handler/2, 44 trimcore/0 45 from sepia_kernel. 46 47:- export 48 test1/2, 49 similar_files/2, 50 cputime/1, 51 statistics/2. 52 53 54%------------------------------------------------------------------------- 55 56:- lib(time_log). 57 58:- local variable(error_file). 59 60 61% Dummy definitions for cputime/1 and statistics/2 62% to achieve reproducable test outputs 63 64cputime(1). 65 66statistics(runtime, [0, 0]). 67 68 69:- tool(test1/2, test1/3). 70 71 72my_halt :- 73% writeln('Test complete'), 74 exit(1). 75 76user_start :- 77 writeln(test_log_output, '***** PROBLEM : trying to restart'), 78 write_error, 79 nl(test_log_output), 80 my_halt. 81 82ab_big(Int) :- 83 write(test_log_output, '***** BIG PROBLEM - interrupt '), 84 writeln(test_log_output, Int), 85 write_error, 86 nl(test_log_output), 87 my_halt. 88 89ab_loop :- 90 writeln(test_log_output, '***** PROBLEM : too long (loop ?)'), 91 write_error, 92 nl(test_log_output), 93 my_halt. 94 95ab_pgm(X) :- 96 write(test_log_output, '***** PROBLEM : program aborts : throw('), 97 write(test_log_output, X), 98 writeln(test_log_output, ')'), 99 write_error, 100 nl(test_log_output), 101 my_halt. 102 103ab_test(X) :- 104 write(test_log_output, '***** PROBLEM : test aborts : throw('), 105 write(test_log_output, X), 106 writeln(test_log_output, ')'), 107 write_error, 108 nl(test_log_output), 109 my_halt. 110 111ab_query_fail :- 112 writeln(test_log_output, '***** PROBLEM : a query fails'), 113 write_error, 114 nl(test_log_output), 115 my_halt. 116 117end_test(Ball) :- 118 writeln(test_log_output, '***** PROBLEM IN THE RECOVERY PROCEDURE':Ball), 119 nl(test_log_output), 120 my_halt. 121 122write_error :- 123 getval(error_file, FileErr), 124 string(FileErr), 125 exists(FileErr), 126 !, 127 file_print(test_log_output, FileErr). 128write_error. 129 130?- 131 set_error_handler(76, true/0), % turn off new warning messages 132 set_error_handler(77, true/0), 133 set_default_error_handler(75,true/0), % preliminary 134 set_default_error_handler(133,true/0), 135 set_default_error_handler(139,true/0), 136% set_default_error_handler(143,ab_query_fail/0), 137 set_default_error_handler(151, user_start/0), 138 reset_error_handlers. 139 140:- export ab_big/1, ab_loop/0. 141 142:- ( current_interrupt(_, xcpu) -> 143 set_interrupt_handler(xcpu, ab_loop/0) 144 ; 145 true 146 ). 147 148 149 150test1(File, Header, M) :- 151 catch(test2(File, Header, consult, top, M),Ball,end_test(Ball)). 152 153test2(File, Header, CompileGoal, RunGoal, M) :- 154 155 set_stream(test_log_output, output), 156 printf(test_log_output, "%w%n%b", [Header]), 157 158 concat_string([File,'.rlt'], FileOut), 159 concat_string([File,'.err'], FileErr), 160 setval(error_file, FileErr), 161 concat_string([File,'.ref'], Reference), 162 del_if_exists(FileErr), 163 del_if_exists(FileOut), 164 open(FileOut, write, OutputStream, [end_of_line(lf)]), 165 set_stream(error, test_log_output), % compilation error messages to output 166 167 set_flag(variable_names, off), % prepare for compile 168 169 catch( 170 ( call(CompileGoal)@M -> % compile the test 171 CompilationOk = true 172 ; 173 writeln(test_log_output, '***** PROBLEM: COMPILATION FAILS') 174 ), 175 ExitTag, 176 ( 177 write(test_log_output, '***** PROBLEM: COMPILATION ABORTS WITH '), 178 writeln(test_log_output, throw(ExitTag)) 179 ) 180 ), 181 182 ( CompilationOk == true -> 183 184 set_stream(output, OutputStream), % prepare for run 185 set_stream(error, OutputStream), 186 set_stream(warning_output, OutputStream), 187 set_stream(log_output, OutputStream), 188 set_stream(user_output, OutputStream), 189 set_stream(user_error, OutputStream), 190 191 set_flag(strip_variables, on), 192 set_flag(variable_names, off), 193 set_flag(print_depth, 100000), 194 cputime(StartTime), 195 get_priority(OldPrio), 196 197 catch( 198 ( 199 call(RunGoal)@M, % run test goal 200 garbage_collect, 201 trimcore, 202 check_state(OldPrio) 203 -> 204 set_flag(prefer_rationals, off), % set by some tests 205 cputime(EndTime), 206 Time is fix((EndTime - StartTime) * 10)/10, 207 RunOk = true 208 ; 209 writeln(test_log_output, '***** PROBLEM: TEST FAILS') 210 ), 211 ExitTag, 212 ( 213 write(test_log_output, '***** PROBLEM: TEST ABORTS WITH '), 214 writeln(test_log_output, throw(ExitTag)) 215 ) 216 ), 217 218 close(user_output), % undo output redirections 219 close(user_error), 220 close(log_output), 221 close(warning_output), 222 close(output), 223 close(error) 224 ; 225 true 226 ), 227 228 ( RunOk == true -> % if success, verify output 229 ( similar_files(Reference,FileOut) -> 230 printf(test_log_output,"Ok, time = %.2f%n",Time), 231 log_time_local(File, Time) 232 ; 233 writeln(test_log_output, '***** PROBLEM - INCORRECT OUTPUT') 234 ) 235 ; 236 true 237 ), 238 flush(test_log_output), 239 close(test_log_output). 240 241 242check_state(OldPrio) :- 243 ( get_priority(OldPrio) -> 244 true 245 ; 246 throw(test_terminated_with_modified_priority) 247 ), 248 ( events_defer -> 249 events_nodefer 250 ; 251 events_nodefer, 252 throw(test_terminated_with_events_deferred) 253 ). 254 255 256%---------------------------------------------------------------------- 257 258read_argument(X) :- 259 argc(N), 260 find_t(1, N, X). 261 262find_t(N, N, true) :- !. 263find_t(I, N, X) :- 264 argv(I, "+t"), 265 !, 266 I1 is I + 1, 267 (I1 < N -> 268 argv(I1, A), 269 open(string(A), read, S), 270 read(S, X), 271 close(S) 272 ; 273 X = true 274 ). 275find_t(I, N, X) :- 276 I1 is I + 1, 277 find_t(I1, N, X). 278 279file_print(Stream, File) :- 280 open(File,read,S), 281 (read_string(S, "", 512, StartOfFile) -> 282 write(Stream, StartOfFile), 283 ( string_length(StartOfFile) < 512 -> 284 true 285 ; 286 writeln(Stream, " ... (TRUNCATED)") 287 ) 288 ; true 289 ), 290 close(S). 291 292write_file(X):- 293 write_to_eof(X). 294write_file(_). 295 296write_to_eof(X) :- 297 get_char(X, C), % fails on eof 298 put_char(test_log_output, C), 299 write_to_eof(X). 300 301del_if_exists(File) :- 302 (exists(File) -> 303 delete(File) 304 ; 305 true 306 ). 307 308reset_int_handler :- 309 set_interrupt_handler(int, abort/0). 310 311 312%---------------------------------------------------------------------- 313% Auxiliary: check whether two files are similar. 314% If not, print first difference and fail 315%---------------------------------------------------------------------- 316 317similar_files(F1,F2):- 318 open(F1,read,S1), open(F2,read,S2), 319 ( similar_streams(S1, S2) -> 320 close(S1), close(S2) 321 ; 322 close(S1), close(S2), 323 fail 324 ). 325 326similar_streams(S1, S2) :- 327 at_eof(S1), at_eof(S2), !. 328similar_streams(S1, S2) :- 329 get_stream_info(S1, line, LineNr), 330 ( read_string(S1, end_of_line, _, Line1) -> true ; Line1 = "" ), 331 ( read_string(S2, end_of_line, _, Line2) -> true ; Line2 = "" ), 332 string_list(Line1, List1), 333 string_list(Line2, List2), 334 ( similar_lists(List1, List2) -> 335 similar_streams(S1, S2) 336 ; 337 printf("--- Files differ in line %d:%n", LineNr), 338 writeln(Line1), 339 writeln("---"), 340 writeln(Line2), 341 fail 342 ). 343 344similar_lists([], []) :- !. % finished 345similar_lists([C1|T1], [C2|T2]) :- % treat space sequences as equal 346 blank_space(C1), 347 blank_space(C2), 348 !, 349 skip_spaces(T1, NextT1), 350 skip_spaces(T2, NextT2), 351 similar_lists(NextT1, NextT2). 352similar_lists([C|T1], [C|T2]) :- !, % skip identical characters 353 similar_lists(T1, T2). 354similar_lists([C1|T1], T2) :- % skip one left 355 ignored_char(C1), 356 !, 357 similar_lists(T1, T2). 358similar_lists(T1, [C2|T2]) :- % skip one right 359 ignored_char(C2), 360 !, 361 similar_lists(T1, T2). 362 363 ignored_char(13). 364 365 blank_space(0' ). 366 blank_space(0' ). 367 368 skip_spaces([], []). 369 skip_spaces([C|T], L) :- 370 ( blank_space(C) -> skip_spaces(T, L) ; L = [C|T] ). 371 372 373:- untraceable reset_int_handler/0. 374:- skipped reset_int_handler/0. 375