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