1		% (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(self_check,
6		[assert_pre/2, assert_post/2,pp_mnf/1, pp_cll/1, mnf/1, mnf/2,
7		mnf_det/1, det_call/1, force_det_call/1,
8		assert_must_succeed/1,assert_must_fail/1,
9		assert_must_succeed_multiple/1, assert_must_succeed_any/1,
10		must_fail/1, must_succeed/1, must_succeed_without_residue/1,
11		must_succeed_without_residue_and_time_out/1,
12
13		run_time_type_check_mode/1,
14		turn_on_run_time_type_checks/0,turn_off_run_time_type_checks/0,
15
16		get_module_list/1,
17
18		perform_self_check/0, perform_self_check/1, perform_self_check/2,
19		perform_verbose_self_check/0, perform_verbose_self_check/1,
20		portray_self_checks/0,
21
22		disable_interaction_on_errors/0,
23
24		% time_out_call/2, time_out_with_factor_call/3, time_out_call/1, % now in tools_timeout
25
26		check_deterministic/1, check_det/1,
27
28		list_skeleton/1,
29
30		self_checks_exist/0,
31		check_eq/2,
32		check_eqeq/2
33
34		]).
35
36		:- meta_predicate nonvar_call(0).
37		:- meta_predicate assert_post(0,0).
38		:- meta_predicate(get_call_module(0, *)).
39		:- meta_predicate assert_must_succeed_any(0).
40		:- meta_predicate assert_must_succeed(0).
41		:- meta_predicate assert_must_succeed_multiple(0).
42		:- meta_predicate assert_must_fail(0).
43		%:- meta_predicate kernel_waitflags:assert_must_abort_wf(0,*).
44		:- meta_predicate pp_mnf(0), pp_cll(0), mnf(0), mnf(-,0), det_call(0).
45		:- meta_predicate mnf_call(0), mnf_call_with_pp(-,0), prepost_mnf_call(0).
46		:- meta_predicate prepost_call(0).
47		:- meta_predicate check_exception_call(0).
48		:- meta_predicate rt_timeout_call(0).
49		:- meta_predicate mnf_det(0).
50		:- meta_predicate force_det_call(0).
51		:- meta_predicate residue_check_call(0).
52		:- meta_predicate must_fail(0).
53		:- meta_predicate must_succeed(0).
54		:- meta_predicate must_succeed_without_residue_and_time_out(0).
55		:- meta_predicate must_succeed_without_residue(0).
56		:- meta_predicate must_succeed_multiple_without_residue(0).
57		:- meta_predicate safe_call(0).
58		:- meta_predicate check_deterministic(0).
59		:- meta_predicate check_det(0).
60		:- meta_predicate check_det2(0,-).
61
62		:- use_module(debugging_calls).
63		%:- disable_debugging_calls.
64
65		:- use_module(module_information,[module_info/2]).
66		:- module_info(group,testing).
67		:- module_info(description,'This module provides predicates to define and run unit tests.').
68
69		:- use_module(tools_printing,[format_with_colour/4, print_goal/1]).
70
71		% first code which asserts pre-, post-conditions and self-checks
72
73		% first a copy of print_error; so that this bit of self-check does not rely on other modules
74		my_print_error(Error) :-
75		(var(Error)
76		-> print_message(error,'_')
77		; write(user_error,'! '),write_term(user_error,Error,[max_depth(50),numbervars(true)]),nl(user_error)
78		).
79
80		my_portray_error(Query) :- safe_numbervars(Query,0,_),
81		write_term(user_error,Query,[portrayed(true),numbervars(true),max_depth(50),indented(true)]),fail.
82		my_portray_error(_).
83		%my_portray_error(Query) :- portray_clause(user_error,Query). % goes into loop for cyclic terms
84
85		:- dynamic pre_condition/2, post_condition/2.
86		:- meta_predicate assert_pre(0,0).
87		assert_pre(X,Pre) :- % print(adding_pre(X)),nl,
88		(nonvar_call(X),nonvar_call(Pre)
89		-> retractall(pre_condition(X,_)),assertz(pre_condition(X,Pre))
90		; my_print_error('### illegal variable(s) in: '),
91		my_print_error(assert_pre(X,Pre)),fail
92		).
93		assert_post(X,Post) :-
94		(nonvar_call(X),nonvar_call(Post)
95		-> retractall(post_condition(X,_)),assertz(post_condition(X,Post))
96		; my_print_error('### illegal variable(s) in: '),
97		my_print_error(assert_post(X,Post)),fail
98		).
99
100		nonvar_call(Call) :-
101		nonvar(Call),
102		(Call = M:P -> nonvar(M), nonvar(P) ; true).
103
104		:- dynamic self_check/4.
105		:- dynamic self_check_module/2.
106		:- volatile self_check/4, self_check_module/2. % this means that self-check cannot be run in the compiled versions !
107
108		self_check_module(Module) :- self_check_module(Module,_NrTests).
109
110		% increase number of tests for a module and return new number as id
111		inc_self_check_module(Module,Res) :-
112		(retract(self_check_module(Module,N1)) -> true ; N1=0),
113		Nr is N1+1,
114		assertz(self_check_module(Module,Nr)),
115		Res = Nr.
116
117		% used to check if there are self checks. if not, tcl/tk interface does not show the button
118		self_checks_exist :- self_check(_,_,_,_).
119
120		% has a strange behaviour; investigate :- meta_predicate self_check(:,*).
121
122	?	self_check(X,Module) :- self_check(X,Module,_,_).
123
124		:- load_files(library(system), [when(compile_time), imports([environ/2])]).
125		:- if(environ(prob_release,true)).
126		add_self_check(_,_) :- !. % comment in to not include self-checks in distribution
127		:- endif.
128		add_self_check(Module,X) :-
129		(nonvar(X) ->
130	?	(self_check(X,Module) -> true
131		; inc_self_check_module(Module,Nr),
132		get_current_term_position(Line,_Col),
133		assertz(self_check(X,Module,Nr,Line))
134		)
135		;
136		my_print_error('### trying to assert variable as self_check: '),my_print_error(X),fail
137		).
138
139		get_current_term_position(Line,Col) :-
140		%prolog_load_context(file, File),
141		prolog_load_context(term_position,TPos),
142		!,
143		(stream_position_data(line_count,TPos,LineM1) -> Line is LineM1+1 ; Line='?'),
144		(stream_position_data(line_position,TPos,Col) -> true ; Col='?').
145		get_current_term_position('?','?').
146
147
148		:- if(predicate_property(current_logtalk_flag(_, _), _)).
149		get_call_module(_, Module) :-
150		sender(Module).
151		:- else.
152		get_call_module(Module:_, Module).
153		:- endif.
154
155		assert_must_succeed_any(Call) :-
156		get_call_module(Call,M),
157		add_self_check(M,must_succeed(Call)).
158		assert_must_succeed(Call) :-
159		get_call_module(Call,M),
160		add_self_check(M,must_succeed_without_residue(Call)).
161		assert_must_succeed_multiple(Call) :-
162		get_call_module(Call,M),
163		add_self_check(M,must_succeed_multiple_without_residue(Call)).
164		assert_must_fail(Call) :-
165		get_call_module(Call,M),
166		add_self_check(M,must_fail(Call)).
167
168
169		% ------------------------
170
171		:- use_module(debug).
172		:- use_module(tools_printing).
173		:- use_module(error_manager).
174		:- use_module(junit_tests).
175		:- use_module(library(lists)).
176		:- use_module(tools_meta,[call_residue/2,safe_numbervars/3]).
177
178		/* Example use:
179
180		:- assert_pre(user:b_fd_type(_G,_L,_U),true).
181		:- assert_post(user:b_fd_type(G,L,U),(atomic(G),(integer(L),integer(U)))).
182
183		*/
184
185
186
187		/* some auxilary predicates that can be used for pre,post conditions: */
188
189		% used in some pre- and post-conditions
190		list_skeleton(X) :-
191		(nonvar(X),list_skel2(X) -> true
192		; (my_print_error('### not list skeleton: '), my_print_error(X),fail)).
193		list_skel2([]).
194		list_skel2([_H|T]) :- nonvar(T), list_skel2(T).
195
196
197
198		:- dynamic run_time_type_check_mode/1.
199		run_time_type_check_mode(on).
200
201		turn_on_run_time_type_checks :-
202		retract(run_time_type_check_mode(_)),
203		assertz(run_time_type_check_mode(on)).
204
205		turn_off_run_time_type_checks :-
206		retract(run_time_type_check_mode(_)),
207		assertz(run_time_type_check_mode(off)).
208
209
210		/* ===================================================== */
211
212		:- dynamic prepost_no_error_so_far/0.
213
214		prepost_no_error_so_far. % :- fail.
215		/* as errors are now displayed by error_manager, no need for interaction ?? */
216
217		disable_interaction_on_errors :-
218		retractall(prepost_no_error_so_far).
219
220
221		/* ===================================================== */
222
223		:- register_debugging_calls([pp_mnf(*), pp_cll(*), mnf(*), mnf(-,*), det_call(*)]).
224
225		pp_mnf(X) :- prepost_mnf_call(X).
226		pp_cll(X) :- prepost_call(X).
227		mnf(X) :- mnf_call(X).
228		mnf(ProgramPoint,X) :- mnf_call_with_pp(ProgramPoint,X).
229
230
231		/* ===================================================== */
232
233
234		:- use_module(library(timeout)).
235
236	?	rt_timeout_call(Call) :- run_time_type_check_mode(off),!,check_exception_call(Call).
237		rt_timeout_call(Call) :- time_out(check_exception_call(Call),5000,TimeOutRes),
238		(TimeOutRes = success -> true ; inc_error_count, add_error(self_check,'### TIMEOUT: ',Call),fail).
239
240		% just catch exceptions and print them nicely
241		check_exception_call(X) :-
242	?	catch(call(X), Error, (
243		format_with_colour(user_error,[red,bold],'! *** EXCEPTION *** :~n',[]),
244		write('! '),print_numbervars(X),nl,
245		write_exception_error(Error),nl,
246		throw(Error)
247		)).
248
249		write_exception_error(error(existence_error(procedure,CALL),_)) :-
250		format_with_colour(user_error,[red,bold],'! EXISTENCE ERROR: ~w~n',[CALL]),fail.
251		write_exception_error(Error) :- write('! '),write_term(Error,[max_depth(20),numbervars(true)]),nl.
252
253		print_numbervars(X) :- safe_numbervars(X,0,_), print(X),fail.
254		print_numbervars(_).
255
256		prepost_call(X) :-
257		/* print(pre(X)),nl, */
258		(verify_pre(X) -> true ; my_print_error(verify_pre_failed(X))),
259		rt_timeout_call(X),
260		/* print(post(X)),nl, */
261		(verify_post(X) -> true ; my_print_error(verify_post_failed(X))).
262
263		verify_pre(Call) :-
264		(run_time_type_check_mode(off) -> true
265		; pre_condition(Call,Pre) ->
266		( \+ rt_timeout_call(Pre)
267		-> get_predicate_arity(Call,Pred,Arity),
268		add_error(verify_pre,'### PRE-CONDITION ERROR OCCURRED: ',Pred/Arity),
269		add_error(verify_pre,'### CALL: ',Call),nl,
270		prepost_user_interaction
271		; true
272		)
273		; get_predicate_arity(Call,Pred,Arity),
274		add_error(verify_pre,'### No PRE-CONDITION for ',Pred/Arity),
275		print_term_summary(Call),
276		prepost_user_interaction
277		).
278
279		verify_post(Call) :-
280		(run_time_type_check_mode(off) -> true
281		; post_condition(Call,Post) ->
282		( \+ rt_timeout_call(Post)
283		-> get_predicate_arity(Call,Pred,Arity),
284		add_error(verify_post,'### POST-CONDITION ERROR OCCURRED: ',Pred/Arity),
285		add_error(verify_post,'### CALL: ',Call),nl,
286		prepost_user_interaction
287		; true
288		)
289		; get_predicate_arity(Call,Pred,Arity),
290		add_error(verify_post,'### No POST-CONDITION for ',Pred/Arity),
291		prepost_user_interaction
292		).
293
294
295		prepost_user_interaction :- prepost_no_error_so_far,!,
296		my_print_error('### => Stop at next error (y/n/halt/trace) => '),
297		read(Answer),
298		(Answer='y' -> true
299		; Answer='halt' -> halt
300		; Answer='trace' -> trace
301		; retract(prepost_no_error_so_far)).
302		prepost_user_interaction.
303
304
305		get_predicate_arity(':'(Module,Call),Res,Arity) :- !,Res=Module:Pred,
306		functor(Call,Pred,Arity).
307		get_predicate_arity(Call,Pred,Arity) :-
308		functor(Call,Pred,Arity).
309
310		/* ===================================================== */
311
312		prepost_mnf_call(X) :- % print(prepost_mnf_call(X)),nl,
313		(run_time_type_check_mode(off)
314		-> call(X)
315		; if(prepost_call(X),true,
316		(add_error(mnf,'### WARNING CALL HAS FAILED: ',X),
317		print_call(X),
318		prepost_user_interaction,
319		fail)
320		)
321		).
322
323		mnf_call(X) :-
324		(run_time_type_check_mode(off)
325		-> call(X)
326		; if(call(X),true,
327		(add_error(mnf,'### WARNING CALL HAS FAILED: ',X),
328		print_call(X),
329		prepost_user_interaction,
330		fail)
331		)
332		).
333
334		print_call(X) :-
335		print('### Call: '),print_quoted_with_max_depth(X,10),nl,
336		print('### Summary: '),print_term_summary(X),nl,
337		print('### Predicate: '),
338		(X = ':'(M,C) -> (print(M),print(':')) ; C=X),
339		functor(C,F,N),
340		print(F), print('/'), print(N),nl.
341
342
343		mnf_call_with_pp(ProgramPoint,X) :-
344		(run_time_type_check_mode(off)
345		-> call(X)
346		; if(rt_timeout_call(X),true,
347		(add_error(mnf,'### WARNING CALL HAS FAILED: ',(X,ProgramPoint)),
348		print_call(X),
349		print('### at program point:'),print(ProgramPoint),nl,
350		prepost_user_interaction,
351		fail)
352		)
353		).
354
355		:- volatile found_det_sol/4.
356		:- dynamic found_det_sol/4.
357
358		mnf_det(X) :-
359		(run_time_type_check_mode(off)
360		-> call(X)
361		; (get_functor_module(X,Module,F,Arity),
362		retractall(found_det_sol(F,Arity,Module,_)), /* cannot be nested for same predicate !*/
363		copy_term(X,CopyX),
364		mnf_call(X),
365		(found_det_sol(F,Arity,Module,Previous) ->
366		(add_error(mnf,'### WARNING CALL HAS MULTIPLE SOLUTIONS: ',CopyX),nl,
367		print('### Solution 1: '),print_quoted_with_max_depth(Previous,60),nl,nl,
368		print('### Solution 2: '),print_quoted_with_max_depth(X,60),nl,nl,
369		prepost_user_interaction)
370		; assertz(found_det_sol(F,Arity,Module,X))
371		)
372		)
373		).
374
375		% det_call(';'(X=a,X=b)).
376		get_functor_module(Module:Call,Module,F,Arity) :- !, functor(Call,F,Arity).
377		get_functor_module(Call,unknown,F,Arity) :- functor(Call,F,Arity).
378
379		det_call(X) :-
380		(run_time_type_check_mode(off)
381		-> call(X)
382		; force_det_call(X)
383		).
384
385		residue_check_call(X) :-
386		copy_term(X,CX),
387	?	call_residue(X,CallResidue),
388		(maplist(acceptable_residue,CallResidue) -> true
389		; add_error(must_succeed_without_residue,'### Call has residue: ',X),
390		add_error(must_succeed_without_residue,'### Residue: ',CallResidue),
391		inc_error_count,
392		print_goal(CallResidue),nl,
393		safe_numbervars(CX,0,_),
394		format('### Original call: ~w~n',[CX])
395		).
396
397		% if we use ground_det_wait_flag: we can have these residues
398		acceptable_residue(kernel_waitflags:copy_wfe_to_inner(_,_)).
399		% Default representation returned by SWI for attributes from modules
400		% that don't define attribute_goals//1.
401		acceptable_residue(put_attr(_,_,_)).
402		acceptable_residue((A,B)) :- acceptable_residue(A),acceptable_residue(B).
403
404		force_det_call(X) :-
405		get_functor_module(X,Module,F,Arity),
406		retractall(found_det_sol(F,Arity,Module,_)), /* cannot be nested for same predicate !*/
407		copy_term(X,CopyX),
408		%print(det_call(X)),nl,
409		residue_check_call(X), % was rt_timeout_call(X)
410		(found_det_sol(F,Arity,Module,Previous) ->
411		(add_error(mnf,'### WARNING CALL HAS MULTIPLE SOLUTIONS: ',CopyX),nl,
412		print('### Solution 1: '),print_quoted_with_max_depth(Previous,60),nl,nl,
413		print('### Solution 2: '),print_quoted_with_max_depth(X,60),nl,nl,
414		prepost_user_interaction)
415		; assertz(found_det_sol(F,Arity,Module,X))
416		).
417
418		/* ===================================================== */
419
420		must_fail(X) :-
421		copy_term(X,Y),
422		rt_timeout_call(X),!,
423		%(safe_numbervars(Y,0,_) -> true ; true), % portray already does a numbervars
424		inc_error_count(Module,_NrErr),
425		add_error(must_fail,'Unit Test Failed, a call unexpectedly succeeded in module:',Module),
426		my_print_error('! The call: '),
427		my_portray_error(Y),
428		my_print_error('! should have failed but succeeded with:'),
429		my_portray_error(X).
430		must_fail(_X).
431
432
433
434		must_succeed(X) :- %print(must_suceed(X)),nl,
435	?	\+ rt_timeout_call(X),!,
436		%(safe_numbervars(X,0,_) -> true ; true), % portray already does a numbervars
437		inc_error_count(Module,_NrErr),
438		add_error(must_succeed,'Unit Test Failed, a call unexpectedly failed in module:',Module),
439		my_print_error('! The call failed but should have succeeded: '),
440		my_portray_error(X),
441		%trace, X, % and comment out safe_numbervars above
442		nl.
443		must_succeed(_X). % :- print(ok_must_succeed(_X)),nl.
444
445		:- volatile found_must_succeed_sol/1, found_id/1.
446		:- dynamic found_must_succeed_sol/1, found_id/1.
447		found_id(0).
448		get_found_id(Nr) :- retract(found_id(Nr)), N1 is Nr+1, assertz(found_id(N1)).
449		reset_found_id :- retractall(found_must_succeed_sol(_)),
450		retractall(found_id(_)), assertz(found_id(0)).
451
452		must_succeed_without_residue_and_time_out(X) :-
453	?	time_out(check_exception_call(X),2000,TimeOutRes),
454		(TimeOutRes = success -> true
455		; inc_error_count,
456		add_error(self_check,'### TIMEOUT: ',X), portray_clause(X),nl,
457		fail).
458
459		must_succeed_without_residue(X) :- get_found_id(ID),
460		must_succeed(residue_check_call(X)),
461		retractall(found_must_succeed_sol(ID)),
462		%residue_check_call(X),
463		(found_must_succeed_sol(ID)
464		-> add_error(must_succeed_without_residue,'### Self-Check has multiple solutions: ',X),
465		inc_error_count,
466		!
467		; assertz(found_must_succeed_sol(ID)),fail
468		).
469		must_succeed_without_residue(_).
470
471		:- public must_succeed_multiple_without_residue/1. % used by assert_must_succeed_multiple
472		must_succeed_multiple_without_residue(X) :- get_found_id(ID),
473		must_succeed(X),
474		retractall(found_must_succeed_sol(ID)),
475	?	call_residue(X,CallResidue),
476		(maplist(acceptable_residue,CallResidue) -> true -> true
477		; add_error(must_succeed_multiple_without_residue,'### Self-Check has residue: ',X),
478		add_error(must_succeed_multiple_without_residue,'### Residue: ',CallResidue),
479		inc_error_count,
480		print_goal(CallResidue),nl
481		),
482		(found_must_succeed_sol(ID)
483		-> (true,!)
484		; assertz(found_must_succeed_sol(ID)),fail
485		).
486		must_succeed_multiple_without_residue(X) :-
487		inc_error_count,
488		add_error(must_succeed_multiple_without_residue,
489		'### Self-Check did not succeed multiple times: ',X).
490
491
492
493		safe_call(X) :-
494		catch(call(X), Exception, (
495		print(exception(X,Exception)),nl,nl,
496		inc_error_count,
497		add_error(safe_call,'### Exception occurred during self-check: ',X:Exception)
498		)).
499
500		:- dynamic starttime/1.
501
502		get_module_list(ML) :- findall(Module,self_check_module(Module),Modules), sort(Modules,ML).
503
504
505
506
507		:- dynamic errors_in_module/2, current_module_under_test/1, tests_in_module/2.
508		set_current_module(M) :- var(M),!, my_print_error('Module is variable').
509		set_current_module(M) :-
510		retractall(current_module_under_test(_)),
511		assertz(current_module_under_test(M)).
512		get_error_count(Module,Nr) :- errors_in_module(Module,Nr), !.
513		get_error_count(_,0).
514		inc_error_count :- inc_error_count(_,_).
515		inc_error_count(Module,N1) :- current_module_under_test(Module),!,
516		(retract(errors_in_module(Module,Nr)) -> true ; Nr=0),
517		N1 is Nr+1,
518		assertz(errors_in_module(Module,N1)).
519		inc_error_count(unknown,1) :- print('No current module.'),nl.
520
521		:- dynamic unit_test_failed_in_module/2.
522		register_failure(Module,TestNr) :- assertz(unit_test_failed_in_module(Module,TestNr)).
523
524		print_error_summary :- errors_in_module(Module,Nr),
525		findall(TestNr,unit_test_failed_in_module(Module,TestNr),List),
526		length(List,Len),
527		format('Module ~w has ~w errors and ~w failed test(s): ~w.~n',[Module,Nr,Len,List]),
528		fail.
529		print_error_summary.
530
531		print_summary :- findall(T,tests_in_module(_,T),NrTests),
532		length(NrTests,NrModules),
533		sumlist(NrTests,TotTests),
534		format('Number of Unit Tests: ~w in ~w modules~n',[TotTests,NrModules]).
535
536		reset_error_summary :-
537		retractall(errors_in_module(_,_)),
538		retractall(unit_test_failed_in_module(_,_)),
539		retractall(tests_in_module(_,_)).
540
541		run_module_tests(Module,Results,Options) :-
542		findall(testcase(Module,TestNr,Line,X), included_self_check(X,Module,TestNr,Line,Options), Calls),
543		length(Calls,Len),
544		assertz(tests_in_module(Module,Len)),
545		%maplist(check_test_case, Calls, Results).
546		check_test_cases(Calls,Results,0,Module,Options).
547
548		included_self_check(X,Module,TestNr,Line,Options) :-
549	?	self_check(X,Module,TestNr,Line),
550		(member(run_only_nr(Nr),Options) -> TestNr=Nr ; true).
551
552
553		check_test_cases([],[],Nr,Module,_Options) :-
554		format('Number of unit tests run in ~w: ~w~n',[Module,Nr]).
555		check_test_cases([H|T],[V|VT],Nr,Module,Options) :-
556		N1 is Nr+1,
557		get_error_count(Module,NrBefore),
558		check_test_case(H,N1,V,Options),
559		get_error_count(Module,NrAfter),
560		(NrBefore=NrAfter -> true
561		% ; NrBefore > 0 -> true % we already have a previous unit test failure
562		; H=testcase(_,TestNr,LineNr,_Call),
563		format_with_colour(user_error,[red,bold],
564		'~n*** UNIT TEST ~w FAILED in module ~w (line ~w)~n',[TestNr,Module,LineNr]),
565		format_with_colour(user_error,[red,bold],
566		'*** Rerun this test with: probcli -selfcheck_module ~w:~w~n~n',[Module,TestNr]),
567		register_failure(Module,TestNr)
568		%,portray_testcase(H)
569		%%% ,trace %%%
570		),
571		check_test_cases(T,VT,N1,Module,Options).
572
573		:- use_module(tools_printing,[start_terminal_colour/2, reset_terminal_colour/1]).
574		portray_testcase(testcase(Module,TestNr,Line,Call)) :- !,
575		start_terminal_colour([blue],user_error),
576		format(user_error,'UNIT TEST ~w in module ~w at line ~w:~n :- ',[TestNr,Module,Line]),
577		portray_clause(user_error,Call),nl,
578		reset_terminal_colour(user_error).
579		portray_testcase(X) :- print(unknown_testcase(X)),nl.
580
581
582		check_test_case(testcase(Module,Nr,Line,Call), TotNr, Verdict,Options) :-
583		(member(silent,Options) -> true ; format('Running unit test ~w in module ~w (line ~w)~n',[Nr,Module,Line])),
584		set_error_context(unit_test_context(Module,TotNr,Line,Call)),
585		statistics(runtime,[T1,_]),
586		(member(verbose,Options) -> portray_clause(Call) ; true),
587		safe_call(Call),
588		flush_output,
589		statistics(runtime,[T2,_]),
590		Time is T2-T1,
591		(member(verbose,Options) -> format('Runtime for unit test ~w: ~w ms~n',[TotNr,Time])
592		; Time>20 -> format('*~w ms*~n',[Time]) ; true),
593		(Time>2000 -> format_with_colour(user_output,[blue],'Warning: long unit test ~w: ~w ms in module ~w (line ~w)~n ~w~n',[TotNr,Time,Module,Line,Call]) ; true),
594		(get_all_errors_and_reset(Errors) -> V=error(Errors) ; V=pass),
595		create_junit_result(Call, Time, V, Verdict).
596
597
598		perform_self_check(M) :- perform_self_check(M,[]).
599		perform_self_check :- perform_self_check(_).
600		perform_verbose_self_check :- perform_verbose_self_check(_).
601		perform_verbose_self_check(M) :- perform_self_check(M,[verbose]).
602
603		:- use_module(eventhandling,[announce_event/1]).
604		perform_self_check(Module,Options) :- nl, reset_found_id,
605		reset_error_summary,
606		announce_event(start_unit_tests),
607		flush_output,
608		print('% '),
609		retractall(starttime(_)),
610		statistics(runtime,[Start,_]), assertz(starttime(Start)),
611	?	if(self_check_module(Module,NrTests),true,
612		(my_print_error(illegal_module(Module)),inc_error_count,
613		fail)
614		),
615		set_current_module(Module),
616		(member(silent,Options) -> true ; format_with_colour(user_output,[blue],'~n~nPerforming ~w unit tests for module ~w~n',[NrTests,Module])),
617		run_module_tests(Module,TestResults,Options),
618		print_junit(['Selfcheck',Module], TestResults),
619		fail.
620		perform_self_check(_,_) :-
621		statistics(runtime,[End,_]),
622		starttime(Start), Tot is End-Start,
623		nl, print('Runtime for Performing Unit Tests: '), print(Tot), print(' ms'),
624		nl,
625		announce_event(stop_unit_tests),
626		clear_error_context,
627		print_summary,
628		(errors_in_module(_,_)
629		-> format_with_colour(user_error,[red,bold],'~n! Unit Tests FAILED !!!~n',[]),
630		print_error_summary,
631		fail
632		; true),
633		format_with_colour(user_output,[green],'~nUnit Tests Successful.~n',[]),
634		flush_output.
635
636
637		portray_self_checks :- portray_self_checks(_).
638
639		/* self_check:portray_self_checks */
640		portray_self_checks(Module) :-
641		self_check_module(Module,NrTests),
642		format_with_colour(user_output,[blue],'~n~nUnit Tests (~w) for Module ~w~n',[NrTests,Module]),
643		self_check(X,Module,Nr,Line),
644		format_with_colour(user_output,[blue],' ~w (line ~w): ',[Nr, Line]),
645		portray_clause(X),
646		fail.
647		portray_self_checks(_) :- nl.
648
649		% ------------------------
650
651		:- dynamic det_counter/1.
652		det_counter(0).
653		check_deterministic(Call) :-
654		retract(det_counter(X)), X1 is X+1, assertz(det_counter(X1)),
655		check_det2(Call,X).
656		check_det(Call) :- check_deterministic(Call).
657
658		:- volatile calling/1.
659		:- dynamic calling/1.
660		check_det2(Call,X) :- assertz(calling(X)),
661		call(Call),
662		(retract(calling(X)) -> true
663		; nl,
664		print('### Call has multiple solutions: '),nl,
665		print('### '), print(Call),nl,
666		nl
667		).
668		check_det2(Call,X) :- (retract(calling(X)) -> print(fails(Call)),nl ; fail).
669
670
671		% ------------------------
672
673		check_eq(A,B) :- (A=B -> true ; format(user_error,'! Not unifiable:~n ~w~n ~w~n',[A,B]),fail).
674		check_eqeq(A,B) :- (A==B -> true ; format(user_error,'! Not identical:~n ~w~n ~w~n',[A,B]),fail).