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