6
7:- module(test_util_iso,
8 [ test/1, 9 test/2 10 ]). 11
89
90report(brief).
91
92:- op(1200, fy, fixme). 93:- op(1110, xf, should_fail). 94:- op(1110, xfx, should_give). 95:- op(1110, xfx, should_throw). 96:- op(1110, xfx, should_raise). 97
101
102test(FileIn) :-
103 setup_call_cleanup(
104 open(FileIn, read, In),
105 test_stream(In, user_error),
106 close(In)).
107
108
113
114test(FileIn, FileOut) :-
115 setup_call_cleanup(
116 open(FileIn, read, In),
117 setup_call_cleanup(
118 open(FileOut, write, Out),
119 test_stream(In, Out),
120 close(Out)),
121 close(In)).
122
123
124 test_stream(In, Out) :-
125 stream_property(In, file_name(File)),
126 format(Out, '~N% Running ECLiPSe tests from file ~w~n', [File]),
127 counter_set(test_count, 0),
128 counter_set(non_test_count, 0),
129 counter_set(succeeded_test_count, 0),
130 counter_set(failed_test_count, 0),
131 counter_set(skipped_test_count, 0),
132 repeat,
134 catch(catch(read_term(In, Test,
135 [ module(test_util_iso)
136 ]), SyntaxError,
137 unexpected(Out, 0, valid_syntax, throw(SyntaxError))),
138 continue, fail),
139 source_location(_File, Line),
140 ( Test \== end_of_file ->
141 counter_inc(test_count),
142 counter_get(test_count, N),
144 catch(interpret_test(Test, N/Line, Out), continue, true),
145 fail
146 ;
147 counter_get(test_count, N),
148 counter_get(succeeded_test_count, TN),
149 counter_get(failed_test_count, FN),
150 counter_get(skipped_test_count, SN),
151 counter_get(non_test_count, NN),
152 format(Out, '~N% Finished tests from file ~w~n', [File]),
153 format(Out, '% ~D tests found.~n', [N]),
154 ( NN==0 -> true ; format(Out, '% ~D ignored as malformed.~n', [NN]) ),
155 format(Out, '% ~D tests succeeded.~n', [TN]),
156 ( FN==0 -> true ; format(Out, '% ~D tests failed.~n', [FN]) ),
157 ( SN==0 -> true ; format(Out, '% ~D tests skipped.~n', [SN]) )
158 ),
159 !,
160 FN =:= 0.
161
162
163interpret_test((fixme Test), Name, Stream) :- !,
164 fixme(Test, Name, Stream).
165interpret_test((Goal should_fail), Name, Stream) :- !,
166 should_fail(Goal, Name, Stream).
167interpret_test((Goal should_give Check), Name, Stream) :- !,
168 should_give(Goal, Check, Name, Stream).
169interpret_test((Goal should_throw Ball), Name, Stream) :- !,
170 should_throw(Goal, Ball, Name, Stream).
171interpret_test((Goal should_raise Exception), Name, Stream) :- !,
172 ( Exception==4 -> Ball = error(instantiation_error,_)
173 ; Exception==5 -> Ball = error(type_error(_,_),_)
174 ; Exception==24 -> Ball = error(type_error(_,_),_)
175 ; Exception==6 -> Ball = error(domain_error(_,_),_)
176 ; Ball = error(_,_)
177 ),
178 should_throw(Goal, Ball, Name, Stream).
179interpret_test(_Goal, Name, Stream) :-
180 write(Stream, 'Non-test goal '), write(Stream, Name),
181 write(Stream, ': ignored'), nl(Stream),
182 counter_inc(non_test_count).
183
184
185
186fixme(Test) :-
187 current_output(Stream),
188 catch(fixme(Test, Test, Stream), continue, true).
189
190 fixme(_Test, Name, Stream) :-
191 write(Stream, 'Test '), write(Stream, Name),
192 write(Stream, ': skipped'), nl(Stream),
193 counter_inc(skipped_test_count),
194 throw(continue).
195
196
197
198Goal should_fail :-
199 current_output(Stream),
200 catch(should_fail(Goal, Goal, Stream), continue, true).
201
202 should_fail(Goal, Name, Stream) :-
203 ( catch(Goal, Ball, unexpected(Stream,Name,failure,throw(Ball))) ->
204 unexpected(Stream, Name, failure, success)
205 ;
206 expected_outcome(Stream, Name)
207 ).
208
209
210
211Goal should_give Check :-
212 current_output(Stream),
213 catch(should_give(Goal, Check, Goal, Stream), continue, true).
214
215
216 should_give(_Goal, Check, Name, Stream) :- \+ callable(Check), !,
217 unexpected(Stream, Name, success, illegal_check(Check)).
218
219 should_give(Goal, multiple_solutions(K,TotalCheck,SolutionCheck), Name, Stream) :- !,
220 counter_set(solutions, 0),
221 (
222 catch(Goal, Ball, unexpected(Stream,Name,'success or failure',throw(Ball))),
223 counter_inc(solutions),
224 ( counter_get(solutions, K), catch(SolutionCheck, _, fail) ->
225 fail 226 ;
227 unexpected(Stream, Name, success, failed_check(SolutionCheck))
228 )
229 ;
230 ( counter_get(solutions, K), catch(TotalCheck, _, fail) ->
231 expected_outcome(Stream, Name)
232 ;
233 unexpected(Stream,Name,success,failed_check(TotalCheck))
234 )
235 ).
236
237 should_give(Goal, Check, Name, Stream) :-
238 ( catch(Goal, Ball, unexpected(Stream,Name,success,throw(Ball))) ->
239 ( catch(Check, _, fail) ->
240 expected_outcome(Stream, Name)
241 ;
242 unexpected(Stream, Name, success, failed_check(Check))
243 )
244 ;
245 unexpected(Stream, Name, success, failure)
246 ).
247
248
249
250Goal should_throw Ball :-
251 current_output(Stream),
252 catch(should_throw(Goal, Ball, Goal, Stream), continue, true).
253
254 should_throw(Goal, Expected, Name, Stream) :-
255 ( catch(Goal, Ball,
256 ( subsumes_term(Expected,Ball) ->
257 expected_outcome(Stream, Name)
258 ;
259 unexpected(Stream, Name, throw(Expected), throw(Ball))
260 )
261 )
262 ->
263 unexpected(Stream, Name, throw(Expected), success)
264 ;
265 unexpected(Stream, Name, throw(Expected), failure)
266 ).
267
268
269
270expected_outcome(Stream, Name) :-
271 ( report(brief)
272 -> put_char(Stream, '.'),
273 flush_output(Stream)
274 ; format(Stream, '~NTest ~w: OK~n', [Name])
275 ),
276 counter_inc(succeeded_test_count),
277 throw(continue).
278
279unexpected(Stream, Name, Expected, Outcome) :-
280 format(Stream, '~NTest ~w: ~n~texpected ~12|~q,~n~tgot ~12|~q~n',
281 [Name, Expected, Outcome]),
282 counter_inc(failed_test_count),
283 throw(continue).
284
285
286
290
291:- dynamic(counter/2). 292
293counter_set(Name, Value) :-
294 retractall(counter(Name,_)),
295 asserta(counter(Name,Value)).
296
297counter_inc(Name) :-
298 ( retract(counter(Name,N0)) -> N1 is N0+1 ; N1 = 1 ),
299 asserta(counter(Name,N1)).
300
301counter_get(Name, Value) :-
302 counter(Name, Value)