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		%:- use_module('../extensions/profiler/profiler.pl').
6
7		:- module(test_runner, [
8		test_repl/0,
9		run_silently/0,
10		run_safely/0,
11		run_last_test/0, last/0,
12		run_tests_by_id/1, ids/1, run_id/1,
13		run_tests_all/0, run_tests_all_except/1,
14		run_tests_by_category/1, run_tests_by_category/2, category/1,
15		run_tests_by_first_category/1,
16		makefile_by_category/2, copy/1,
17		generate_makefile_all_tests/0,
18		generate_makefile_for_coverage/0,
19		full_flush/0,
20		jenkins_sanity_check/0,
21		sanity_check/1,
22		v/0, vv/0,
23		cache/0, % enable caching
24		all_categories/1,
25		all_ids/1,
26		ids_in_category/2,
27		set_prob_examples_location/1,
28		halt_tests/0 % use to call halt with proper exit code; however, normally test predicates will call halt1 directly, mainly useful in junit mode
29		]).
30
31		:- if(predicate_property(expects_dialect(_), _)).
32		:- expects_dialect(sicstus4).
33		:- endif.
34
35		% Some errors, such as syntax errors, are only printed through the message mechanism and not thrown as exceptions.
36		% These errors also don't terminate SICStus or affect the exit code,
37		% which makes it easy for them to go unnoticed in CI runs.
38		% As a workaround, add a portray_message hook to detect error messages
39		% and halt the test runner at an appropriate time.
40
41		:- dynamic(prolog_error_occurred/0).
42
43		:- multifile(user:portray_message/2).
44		user:portray_message(error, _) :-
45		\+ prolog_error_occurred,
46		assertz(prolog_error_occurred),
47		fail. % to let SICStus portray the error
48
49		check_no_prolog_startup_error :-
50		prolog_error_occurred,
51		!,
52		format('*** Error(s) from Prolog while starting test runner! Aborting. ***~n', []),
53		halt(1).
54		check_no_prolog_startup_error.
55		:- initialization(check_no_prolog_startup_error).
56
57		:- use_module('../src/pathes', []). % set up library search paths
58
59		% comment in to ensure that plspec loaded first:
60		% :- use_module('../extensions/plspec/plspec/plspec_core').
61
62		:- use_module(probsrc(prob_cli)). % we call go_cli
63
64		%:- set_prolog_flag(compiling,debugcode).
65		%:- set_prolog_flag(source_info,on).
66		%:- set_prolog_flag(profiling,on).
67
68		/*
69		:- use_module('../extensions/profiler/profiler.pl'). % (adds the profiler himself)
70		:- use_module('../extensions/profiler/profiler_te.pl'). % (adds the term expander)
71		%:- use_module('../extensions/profiler/profiler_gui.pl'). % (adds the term expander)
72		:- enable_profiling_all(b_expression_sharing).
73		:- enable_profiling(bsyntaxtree:transform_bexpr_with_acc/5).
74		:- enable_profiling(bsyntaxtree:transform_bexpr/3).
75		:- enable_profiling(b_ast_cleanup:recompute_used_ids_info/2).
76		:- enable_profiling(bsyntaxtree:sub_expression_contains_wd_condition/1).
77
78		for starting from Spider:
79		set_prob_examples_location('../../prob_examples'), run_silently, test_repl.
80		or use test_runner_cov.pl
81		*/
82
83
84		:- use_module(library(system)).
85		:- use_module(library(lists)).
86		:- use_module(library(sets), [intersect/2]).
87		:- use_module(library(file_systems)).
88
89		:- use_module(probsrc(junit_tests), [set_junit_dir/1, create_junit_result/4, print_junit/2]).
90		:- use_module(testcases).
91		:- use_module(probsrc(system_call)).
92		:- use_module(probsrc(tools),[safe_number_codes/2,get_options/5,ajoin_with_sep/3,
93		arg_is_number/2,split_atom_at_separator/4,
94		get_parent_directory/2]).
95		:- use_module(probsrc(tools_strings),[string_concatenate/3]).
96		:- use_module(probsrc(tools_commands),[edit_file/1]).
97		:- use_module(probsrc(tools_printing), [start_terminal_colour/2, reset_terminal_colour/1, format_with_colour/4, format_with_colour_nl/4]).
98		:- use_module(probsrc(error_manager),[get_total_number_of_errors/1, get_all_errors/1]).
99		:- use_module(probsrc(debug),[formatsilent/3, debug_mode/1, debug_println/2]).
100		:- use_module(probsrc(performance_messages),[toggle_perfmessages/0]).
101
102		:- use_module(probsrc(module_information)).
103		:- module_info(group,testing).
104		:- module_info(description,'This module runs the tests stored in testcases.pl.').
105
106		:- set_prolog_flag(double_quotes, codes).
107
108
109		generate_makefile(RegenerateGoal,Filename,TargetCommand) :-
110		tell(Filename),
111		all_first_categories(AllTestCategories),
112		ajoin_with_sep(AllTestCategories, ' \\\n\t', JoinedCategories),
113		write('# This Makefile is generated automatically. DO NOT EDIT.\n'),
114		write('# If you have added/removed a test category, regenerate using this command:\n'),
115		format('# ./prolog.sh --file tests/test_runner.pl --goal "~q, halt ; halt(1)."\n\n', [RegenerateGoal]),
116		format('categories = \\\n\t~w\n\n', [JoinedCategories]),
117		write('.PHONY: test_all_source\n'),
118		write('test_all_source: $(categories)\n\n'),
119		write('.PHONY: $(categories)\n'),
120		format('$(categories):\n\t~w\n', [TargetCommand]),
121		told,
122		format(user_output,'Generated Makefile: ~w~n',[Filename]).
123
124		%write_subtargets([G]) :- write(G).
125		%write_subtargets([G|Gs]) :-
126		% write(G), write(' '),
127		% write_subtargets(Gs).
128
129		generate_makefile_all_tests :-
130		% run tests where category G is the first category to avoid running tests multiple times
131		% also avoids concurrency issues when test run multiple times in parallel with diff checking of output
132		generate_makefile(generate_makefile_all_tests, 'tests/Makefile_All_Tests',
133		% Makefile_All_Tests is (indirectly) included from the top-level Makefile,
134		% so the working directory is the repository root
135		% and the test_runner.pl path must include the tests/ directory prefix.
136		'./prolog.sh --file tests/test_runner.pl --goal "run_silently, run_tests_by_first_category($@), halt_tests ; halt(1)."').
137
138		:- use_module(probsrc(tools_platform), [host_platform/1]).
139		% TODO Do we want to install SWI-Prolog on all CI runners?
140		group_cannot_be_checked_on_ci_server(setlog,'setlog not installed').
141		group_cannot_be_checked_on_ci_server(cvc5,'cvc5 not installed').
142		group_cannot_be_checked_on_ci_server(clingo,'clingo not installed').
143		group_cannot_be_checked_on_ci_server(smt_solver_integration,'Z3 not installed on Gitlab CI Windows runner') :-
144		host_platform(windows). % TODO Install Z3 on GitLab CI Windows runner
145		group_cannot_be_checked_on_ci_server(cdclt,'cdclt requires SICStus 4.10.2 or newer') :-
146		\+ (current_prolog_flag(dialect, sicstus),
147		current_prolog_flag(version_data, sicstus(4,VN,VM,_,_)),
148		VN>=10, VM >= 2). % disable cdclt tests due to segmentation faults (SPRM-21543), fixed in 4.10.2
149
150		generate_makefile_for_coverage :-
151		generate_makefile(generate_makefile_for_coverage, 'Makefile_Coverage_Groups', './prolog.sh --file tests/prob_cov_runner.pl --goal "coverage_group_data($@), halt ; halt(1)."').
152
153		all_first_categories(X) :- % only categories that appear as first category
154		findall(Group1,
155		cli_testcase(_Id,[Group1|_],_Conf,_Args,_Desc),
156		ListOfGroups),
157		remove_dups(ListOfGroups,X).
158		all_categories(X) :-
159		findall(Groups,
160		cli_testcase(_Id,Groups,_Conf,_Args,_Desc),
161		List),
162		append(List,ListOfGroups),
163		remove_dups(ListOfGroups,X).
164
165		all_ids(X) :-
166		findall(Id,
167		cli_testcase(Id,_Groups,_Conf,_Args,_Desc),
168		List),
169		remove_dups(List,X).
170
171		ids_in_category(Category,IDs) :-
172		findall(Id,
173		(cli_testcase(Id,Groups,_Conf,_Args,_Desc),member(Category,Groups)),
174		List),
175		remove_dups(List,IDs).
176
177		junit_test_suite_prefix_for_category_and_id(Category, Id, JUnitSuiteName) :-
178		ajoin([Category, '.', Id], JUnitSuiteName).
179
180		prob_junit_dir(JUnitDir) :- environ('PROB_JUNIT_DIR', JUnitDir).
181
182		prob_junit_args(JUnitSuiteName, JUnitArgs) :-
183		prob_junit_dir(JUnitDir), !,
184		JUnitArgs = ['-junit', JUnitDir, '-junit_test_suite', JUnitSuiteName].
185		prob_junit_args(_, []).
186
187		halt1_allowed :- \+ repl_mode.
188
189		tests_multiply_timeout(Var) :-
190		environ('TESTS_MULTIPLY_TIMEOUT', Var2), !, arg_is_number(Var2,Var).
191		tests_multiply_timeout(Var) :- multiply_timeout(Var).
192
193		:- dynamic multiply_timeout/1.
194
195		% call updir from within Spider, when you are in the src subdirectory
196		set_cur_dir :- (directory_exists('./src') -> true /* we seem to be in the right directory */
197		; directory_exists('./cia') -> current_directory(_Old,'./..')
198		; print('Please start tests from ProB directory or ProB/src directory'),nl,
199		print('Current directory: '),
200		current_directory(CD), print(CD), nl).
201
202		reset_test_runner(SessionInfo) :-
203		reset_nr_of_tests, set_cur_dir,
204		retractall(test_skipped(_)), retractall(test_failed(_)), retractall(last_test_failed(_)),
205		retractall(test_diff_failed(_,_,_)),
206		statistics(walltime,[WStart,_]),
207		bb_put(reset_test_runner_wtime,WStart),
208		bb_put(reset_test_runner_info,SessionInfo).
209
210		% a category has been selected for running
211		currently_selected_category(X) :-
212		bb_get(reset_test_runner_info,SessionInfo),
213		SessionInfo = category(Cat,_FirstOnly),
214		(is_list(Cat) -> member(X,Cat) ; X=Cat).
215
216		ids(Nr) :- show_command(Nr).
217		show_command(Nr) :- cli_testcase(Nr,_,_,L,Desc),
218		print('# '), print(Desc),nl, l_pr([probcli|L]).
219		l_pr([]) :- nl.
220		l_pr([H|T]) :- print(' '),print(H), l_pr(T).
221
222		:- volatile sanity_check_failed/0.
223		:- dynamic sanity_check_failed/0.
224		jenkins_sanity_check :-
225		sanity_check(true),
226		(sanity_check_failed -> halt1 ; halt(0)).
227		sanity_check(_Jenkins) :-
228		cli_testcase(Id,Categories,_,Args,_Comm1),
229		\+ member('-strict',Args),
230		format_warning('*** test does not use -strict option: ',[]), print_test(Id,Categories),nl,
231		assertz(sanity_check_failed), fail.
232		sanity_check(Jenkins) :-
233		Jenkins == false,
234		cli_testcase_diff_check_output(Id,_F1,_F2),
235		cli_testcase(Id,Categories,_I1,_A1,_Comm1),
236		(Categories = [_]
237		-> true
238		; format_warning('*** multiple categories for test with output file; can generate race conditions when run in parallel: ',[]),
239		print_test(Id,Categories),
240		nl /* can generate race conditions when run in parallel */),
241		assertz(sanity_check_failed), fail.
242		sanity_check(_Jenkins) :-
243		cli_testcase_diff_check_output(Id,_F1,_F2),
244		\+ (cli_testcase(Id,_Categories,_I1,_A1,_Comm1)),
245		format_warning_nl('*** no cli_testcase, but diff output defined for id: ~w',[Id]),
246		assertz(sanity_check_failed), fail.
247		sanity_check(_Jenkins) :-
248		cli_testcase(Id,C1,I1,A1,Comm1),
249		cli_testcase(Id,C2,I2,A2,Comm2),
250		[C1,I1,A1,Comm1] \= [C2,I2,A2,Comm2],
251		format_warning_nl('*** multiple cli_testcases for id: ~w',[Id]),
252		assertz(sanity_check_failed), fail.
253		sanity_check(_Jenkins).
254
255
256		format_error_nl(F,Args) :- format_with_colour_nl(user_output,[red,bold],F,Args).
257		format_warning(F,Args) :- format_with_colour(user_output,[red],F,Args).
258		format_warning_nl(F,Args) :- format_with_colour_nl(user_output,[red],F,Args).
259		format_progress_nl(F,Args) :- format_with_colour_nl(user_output,[blue],F,Args).
260
261		print_test(Id,Comment) :- print(Id),print(' : '), print(Comment).
262
263		% run the latest test (with highest id)
264		last :- run_last_test.
265		run_last_test :- get_last_test_id(Id),
266		run_tests_by_id(Id,_,no_skipping).
267
268		get_last_test_id(Id) :- set_last_test_id, last_test_id(Id).
269
270		set_last_test_id :-
271		retractall(last_test_id(_)), assertz(last_test_id(-1)),
272		cli_testcase(Id,C1,I1,A1,Comm1),
273		(cli_testcase(Id,C2,I2,A2,Comm2),
274		(C1,I1,A1,Comm1) \= (C2,I2,A2,Comm2)
275		-> format_warning_nl('~n*** multiple entries for test id: ~w',[Id])
276		; true),
277		update_last(Id),
278		fail.
279		set_last_test_id.
280
281		:- volatile last_test_id/1.
282		:- dynamic last_test_id/1.
283		update_last(Id) :- number(Id),!, % debug_print(9,Id), debug_print(9,' '),
284		retract(last_test_id(L)),
285		(Id>L -> Max = Id ; Max = L),
286		assertz(last_test_id(Max)).
287		update_last(Id) :- format_warning_nl('~n*** test id not a number: ~w',[Id]).
288
289		repeat_id(ID,Nr) :- repeat_id_aux(ID,0,Nr,success,10000000,0,0).
290		repeat_id_aux(ID,Nr,TotNr,Status1,Min,Max,Tot) :- Nr<TotNr, !, N1 is Nr+1,
291		statistics(walltime,[Start,_]),
292		run_tests_by_id(ID,Status,no_skipping),
293		(Status=success -> Status2=Status1, Col=blue ; Status2=Status, Col=red),
294		statistics(walltime,[Stop,_]),
295		WT is Stop - Start,
296		NewMin is min(Min,WT), NewMax is max(Max,WT), NewTot is Tot+WT,
297		Average is NewTot / N1,
298		format_with_colour_nl(user_output,[Col],'Test ~w repeated ~w/~w times~n Walltime Minumum = ~w ms, Maximum = ~w ms, Average = ~w ms~n Status=~w',[ID,N1,TotNr,NewMin,NewMax,Average,Status]),
299		repeat_id_aux(ID,N1,TotNr,Status2,NewMin,NewMax,NewTot).
300		repeat_id_aux(_,_,_TotNr,_Status,_Min,_Max,_).
301
302		% run a test with a specific id
303		run_id(X) :- run_tests_by_id(X,_,no_skipping).
304		run_tests_by_id(X) :- run_tests_by_id(X,_,allow_skipping).
305		run_tests_by_id(X,Status,AllowSkipping) :- reset_test_runner(id(X)),
306		phrase(tests_by_id(X), Testcases),
307		run_list(Testcases, custom_test_list, AllowSkipping),
308		check_failed(Status).
309		tests_by_id([]) --> [].
310		tests_by_id(From-To) --> !,
311		({From>To} -> []
312		; tests_by_id(From), {F1 is From+1},
313		tests_by_id(F1-To)).
314		tests_by_id([Id | Ids]) --> !,
315		tests_by_id(Id),
316		tests_by_id(Ids).
317		tests_by_id(Id) -->
318		{cli_testcase(Id,TestCategories,TestInfos,Arguments,Comment)}, !,
319		[testcase(Id,TestCategories,TestInfos,Arguments,Comment)].
320		tests_by_id(Id) -->
321		{\+(cli_testcase(Id,_Category,_Infos,_Arguments,_Comment))}, !,
322		{format_warning_nl('*** No testcase with ID ~w found', [Id])}.
323
324		:- use_module(library(random),[random_select/3]).
325		run_random_tests(Nr) :-
326		findall(testcase(Id,TestCategories,TestInfos,Arguments,Comment),
327		cli_testcase(Id,TestCategories,TestInfos,Arguments,Comment),AllTests),
328		select_random_tests(Nr,AllTests,Tests),
329		reset_test_runner(random(Nr)),
330		run_list(Tests,random), check_failed(_).
331		select_random_tests(N,_,[]) :- N<1,!.
332		select_random_tests(_,[],[]) :- !.
333		select_random_tests(N,All,[X|Tests]) :-
334		random_select(X,All,Rest),
335		N1 is N-1,
336		select_random_tests(N1,Rest,Tests).
337
338
339		run_tests_all :- run_tests_all_except([]).
340
341		:- use_module(library(ordsets)).
342		run_tests_all_except(Categories) :- reset_test_runner(all_except(Categories)),
343		findall(Test, test_not_in_categories(Categories, Test), Tests),
344		run_list(Tests,all_except),
345		check_failed(_).
346
347		test_not_in_categories(Categories, Test) :-
348		sort(Categories, SC),
349		test_not_in_categories_aux(SC, Test).
350
351		:- use_module(library(ordsets), [ord_intersect/2]).
352		test_not_in_categories_aux(SC, testcase(Id,TestCategories,Infos,Arguments,Comment)) :-
353		cli_testcase(Id,TestCategories,Infos,Arguments,Comment),
354		sort(TestCategories,TC),
355		\+ ord_intersect(TC,SC).
356
357
358		:- dynamic silent_running/0, no_strict_running/0.
359		run_silently :- silent_running, !.
360		run_silently :- add_additional_arguments(['-silent']), assertz(silent_running).
361		run_no_strict :- (no_strict_running -> true ; assertz(no_strict_running)). % useful to see all errors of a test
362
363		% perform additional checks (e.g., used_ids info in AST) and throw errors when something is wrong
364		run_safely :- add_additional_preference('PROB_SAFE_MODE','TRUE').
365
366		% run all tests with a specific category
367		category(X) :- run_tests_by_category(X).
368		run_tests_by_category(X) :- run_tests_by_category(X,all).
369		run_tests_by_first_category(X) :- % used as entry in Jenkins when running all tests in parallel by category
370		run_tests_by_category(X,first).
371		run_tests_by_category(X,FirstOnly) :-
372		reset_test_runner(category(X,FirstOnly)),
373		(is_list(X) -> run_tests_by_category_aux(X,FirstOnly) ; run_tests_by_category_aux([X],FirstOnly)),
374		check_failed(_).
375		run_tests_by_category_aux(Categories,FirstOnly) :-
376		get_tests_for_categories(Categories,FirstOnly,List),
377		( List=[] -> format_warning_nl('*** No testcase with categories ~w found', [Categories])
378		;
379		Categories = [FirstCategory|MoreCategories],
380		(MoreCategories = [] ->
381		SuiteCategory = FirstCategory
382		;
383		length(MoreCategories, MoreCount),
384		ajoin([FirstCategory, '_and_', MoreCount, '_more'], SuiteCategory)
385		),
386		run_list(List, SuiteCategory)
387		).
388
389		get_tests_for_categories(Categories,List) :-
390		get_tests_for_categories(Categories,all,List).
391		get_tests_for_categories(Categories,FirstOnly,List) :-
392		findall(testcase(Id, TestCategories, Infos, Arguments, Comment),
393		(cli_testcase(Id, TestCategories, Infos, Arguments, Comment),
394		(FirstOnly=first -> TestCategories=[C1|_], member(C1,Categories)
395		; intersect(Categories, TestCategories)) ),
396		List).
397
398		run_tests_using_command(Command) :- reset_test_runner(cmd(Command)),
399		findall(testcase(Id, TestCategories, Infos, Arguments, Comment),
400		(cli_testcase(Id, TestCategories, Infos, Arguments, Comment),
401		member(Command, Arguments)),
402		List),
403		( List=[] -> format_warning_nl('*** No testcase using command ~w found', [Command])
404		; run_list(List,cmd), check_failed(_)).
405
406		run_tests_using_preference(Pref,Val) :- reset_test_runner(using_pref(Pref,Val)),
407		findall(testcase(Id, TestCategories, Infos, Arguments, Comment),
408		(cli_testcase(Id, TestCategories, Infos, Arguments, Comment),
409		append(_,['-p',CmdPref,Val|_],Arguments),
410		match_preference(Pref,CmdPref) ),
411		List),
412		( List=[] -> format_warning_nl('*** No testcase using preference ~w with value ~w found', [Pref,Val])
413		; run_list(List,using_pref), check_failed(_)).
414
415		:- use_module(probsrc(preferences),[eclipse_preference/2]).
416		match_preference(A,A).
417		match_preference(A,B) :- eclipse_preference(A,B) ; eclipse_preference(B,A).
418
419		% Generate file list (for copying) of a category :
420		show_files(Cat) :-
421		cli_testcase(Id, TestCategories, _Infos, Arguments, _Comment),
422		member(Cat, TestCategories), % print(Arguments),nl,
423		( file_in_arguments(File,Arguments)
424		;
425		get_testcase_diff_check_output(Id,_GeneratedFile,File)),
426		format('~w ',[File]),
427		fail.
428		show_files(_) :- nl.
429
430		file_in_arguments(F,['-p',_,_|T]) :- !, file_in_arguments(F,T).
431		file_in_arguments(F,[C,_|T]) :- binary_command(C),!, file_in_arguments(F,T).
432		file_in_arguments(F,[H|T]) :- is_file(H),H=F ; file_in_arguments(F,T).
433		binary_command(eval). binary_command(evalt). binary_command(evalf).
434		binary_command('-mc').
435		is_file(F) :- atom(F), atom_codes(F,Codes), member(47,Codes),!.
436
437
438		% Generate a Makefile for all listed Categories
439		% example: makefile_by_category('AlstomMakefile',[animate,history,sptxt,rel_fnc])
440		% the Makefile can be run to perform the listed tests on a compiled version of probcli
441		makefile_by_category(File, Categories) :-
442		(is_list(Categories) -> Cats = Categories ; Cats = [Categories]),
443		my_open(File, Stream),
444		format(Stream, 'PROBCLI=probcli~n',[]),
445		format(Stream, 'test_all:', []),
446		makefile_write_categories(Stream, Cats),
447		makefile_by_category_aux(Stream, Cats),
448		my_close(Stream).
449		makefile_by_category_aux(_Stream, []).
450		makefile_by_category_aux(Stream, [Cat | Cats]) :-
451		makefile_by_category_single(Stream, Cat),
452		makefile_by_category_aux(Stream, Cats).
453		makefile_by_category_single(Stream, Cat) :-
454		findall(testcase(Id, TestCategories, Infos, Arguments, Comment),
455		(cli_testcase(Id, TestCategories, Infos, Arguments, Comment),
456		member(Cat, TestCategories)),
457		List),
458		(List=[] -> format_warning_nl('*** No testcase with category ~w found', [Cat])
459		; format(Stream, '~n~w:~n', [Cat]), makefile_write_calls(Stream, List)).
460
461		my_open(user_output,S) :- !, S=user_output.
462		my_open(File,S) :- open(File,write,S).
463		my_close(user_output) :- !.
464		my_close(S) :- close(S).
465
466		makefile_write_categories(Stream, []) :-
467		format(Stream, '~n', []).
468		makefile_write_categories(Stream, [Cat | Cats]) :-
469		format(Stream, ' ~a', [Cat]),
470		makefile_write_categories(Stream, Cats).
471
472		makefile_write_calls(_Stream, []).
473		makefile_write_calls(Stream, [testcase(Id, _TestCategories, _Infos, Arguments, Comment) | Tests]) :-
474		(Comment='' -> true ; format(Stream,'\techo \"Test ~w : ~w\"~n',[Id,Comment])),
475		format(Stream, '\t$(PROBCLI)', []),
476		makefile_write_arguments(Stream, Arguments),
477		makefile_write_diff(Stream, Id),
478		makefile_write_calls(Stream, Tests).
479
480		makefile_write_arguments(Stream, []) :-
481		format(Stream, '~n', []).
482		makefile_write_arguments(Stream, [Arg | Args]) :-
483		format(Stream, ' ~w', [Arg]),
484		(quote_next_arg(Arg) -> makefile_write_arguments_quoted(Stream,Args)
485		; makefile_write_arguments(Stream, Args)).
486
487		quote_next_arg('-goal'). % this will contain spaces ,... surround in "" for shell
488		quote_next_arg('--check_goal').
489		quote_next_arg('-check_goal').
490		quote_next_arg('-cbc_deadlock_pred').
491		quote_next_arg('-eval').
492		quote_next_arg('-evalt').
493		quote_next_arg('-evalf').
494		quote_next_arg('-cbc_sequence_with_target'). % actually quotes next two !
495		quote_next_arg('-cbc_sequence_with_target_all'). % ditto <- TO DO
496
497
498		makefile_write_arguments_quoted(Stream, []) :-
499		format(Stream, '~n', []).
500		makefile_write_arguments_quoted(Stream, [Arg | Args]) :-
501		format(Stream, ' \"~w\"', [Arg]),
502		makefile_write_arguments(Stream, Args).
503
504		makefile_write_diff(Stream, ID) :-
505		get_testcase_diff_check_output(ID, File1, File2),
506		format(Stream, '\tdiff -b ~w ~w~n', [File1, File2]),
507		fail.
508		makefile_write_diff(_Stream, _ID).
509
510		% -------------------------
511
512		copy(Cat) :- (Cat=[_|_] -> C=Cat ; C=[Cat]),
513		generate_copy_commands(C,'testarchive/').
514
515		:- use_module(probsrc(b_trace_checking),[get_default_trace_file/2]).
516		generate_copy_commands(Categories,Dest) :-
517		cli_testcase(ID, TestCategories, _Infos, Arguments, _Comment),
518		non_empty_inter(Categories,TestCategories), %print(ID),nl,
519		Arguments=[MainFile|_], generate_copy_command(MainFile,Dest), % print(MainFile),nl,
520		additional_testcase_file(ID,MainFile,Arguments,ExtraFile),
521		generate_copy_command(ExtraFile,Dest),
522		fail.
523		generate_copy_commands(_,_).
524
525		additional_testcase_file(ID,_,_,EFile) :- extra_testcase_file(ID,EFile).
526		additional_testcase_file(_ID,File,Arguments,TFile) :- member('-t',Arguments),
527		get_default_trace_file(File,TFile).
528		additional_testcase_file(ID,_,_,RefFile2) :- get_testcase_diff_check_output(ID,_File1,RefFile2).
529
530		non_empty_inter(A,B) :- member(X,A), member(X,B),!.
531
532		generate_copy_command(File,Dest) :-
533		safe_file_exists(File),
534		get_parent_directory(File,Dir),!,
535		string_concatenate(Dest,Dir,DestDir),
536		string_concatenate(Dest,File,DestFile),
537		format(user_output,'\tmkdir -p ~w~n',[DestDir]),
538		get_command_path(mkdir,MkCmdPath),
539		system_call(MkCmdPath, ['-p',DestDir],_Text1,_JExit1),
540		format(user_output,'\tcp ~w ~w~n',[File,DestFile]),
541		get_command_path(cp,CpCmdPath),
542		system_call(CpCmdPath, [File,DestFile],_Text2,_JExit2).
543		generate_copy_command(_,_).
544
545		% -------------------------
546
547		:- dynamic test_failed/1, last_test_failed/1, test_diff_failed/3, test_skipped/1.
548		halt_tests :-
549		prolog_error_occurred,
550		!,
551		halt1.
552		halt_tests :- test_failed(_),!,
553		halt1.
554		halt_tests :-
555		nl,print('TEST RUN SUCCESSFUL'),nl,
556		halt. % regular halt
557		halt1 :-
558		format_error_nl('TEST RUN FAILED',[]),
559		halt(1).
560
561		check_failed(failure) :- test_failed(X),!,print_failed_tests,
562		print('Use the following command to run individual tests: '),nl,
563		print(' ./prolog.sh --file tests/test_runner.pl --goal "run_id('),print(X),print(')."'),nl,
564		(halt1_allowed -> halt1 ; print('halt(1) :: dontstop mode'),nl).
565		check_failed(success) :- number_of_tests_run(Nr),
566		start_terminal_colour([green,bold],user_output),
567		findall(Y,test_skipped(Y),Skips), length(Skips,NrSkips),
568		bb_get(reset_test_runner_info,Info),
569		(Nr=1,NrSkips=0,Info\=category(_,_) -> format(user_output,'Test successful.~n',[])
570		; NrSkips>0 -> format(user_output,'All ~w tests successful, ~w skipped (for ~w).~n',[Nr,NrSkips,Info])
571		; format(user_output,'All ~w tests successful (for ~w).~n',[Nr,Info])),
572		reset_terminal_colour(user_output).
573		print_failed_tests :- number_of_tests_run(Nr),
574		findall(Y,test_failed(Y),Fails), length(Fails,NrFails),
575		findall(Y,test_skipped(Y),Skips), length(Skips,NrSkips),
576		start_terminal_colour([red,bold],user_error),
577		bb_get(reset_test_runner_info,Info),
578		format(user_error,'*** Tests run: ~w, skipped: ~w, failed: ~w (for ~w) ***~n*** Failed tests:~n',[Nr,NrSkips,NrFails,Info]),
579		test_failed(X), lookup_test_description(X,Desc),
580		format(user_error,'~w ~w~n',[X,Desc]),
581		fail.
582		print_failed_tests :- nl(user_error),
583		(user_interrupt_signal_received -> format(user_error,'Tests were interrupted by CTRL-C (user_interrupt)~n',[])
584		; true),
585		reset_terminal_colour(user_error).
586
587		lookup_test_description(Id,Desc) :- cli_testcase(Id,_,_,_,Desc).
588
589		:- dynamic user_interrupt_signal_received/0.
590		run_list(List,SuiteCategory) :- run_list(List,SuiteCategory,allow_skipping).
591		run_list(List,SuiteCategory,AllowSkipping) :-
592		init_test_runner,
593		retractall(user_interrupt_signal_received),
594		length(List,Len),
595		run_single_testcase_list_aux(List,Len,SuiteCategory,AllowSkipping).
596		run_single_testcase_list_aux([],_,_,_) :- !.
597		run_single_testcase_list_aux(List,_Len,_Category,allow_skipping) :- user_interrupt_signal_received,!,
598		length(List,RestLen),
599		format('Skipping ~w remaining tests~n',[RestLen]),
600		maplist(assert_test_skipped,List).
601		run_single_testcase_list_aux([TC|Tail],Len,SuiteCategory,AllowSkipping) :-
602		print_progress_stats(Len),
603		run_single_testcase(TC,SuiteCategory,AllowSkipping),
604		run_single_testcase_list_aux(Tail,Len,SuiteCategory,AllowSkipping).
605		assert_test_skipped(Id) :- assertz(test_skipped(Id)).
606
607		print_progress_stats(All) :- number_of_tests_run(Nr), Nr>0,!,
608		findall(Y,test_failed(Y),Fails), length(Fails,NrFails),
609		(last_test_failed(Failed) -> ajoin(['(e.g. ', Failed, ')'],FailInfo) ; FailInfo = ''),
610		findall(Y,test_skipped(Y),Skips), length(Skips,NrSkips),
611		bb_get(reset_test_runner_wtime,WStart),
612		statistics(walltime,[WNow,_]), Delta is round((WNow - WStart) / 1000),
613		bb_get(reset_test_runner_info,Info),
614		(NrFails = 0, FailInfo = ''
615		-> format_progress_nl('Progress: ~w/~w tests run, ~w skipped, all successful (running since ~w sec for ~w)',[Nr,All,NrSkips,Delta,Info])
616		; format_progress_nl('Progress: ~w/~w tests run, ~w skipped, ~w failed ~w (running since ~w sec for ~w)',[Nr,All,NrSkips,NrFails,FailInfo,Delta,Info])
617		).
618		print_progress_stats(_).
619
620		cache :- add_additional_arguments(['-cache','/Users/leuschel/svn_root/NewProB/examples/cache/']).
621		v :- add_additional_arguments(['-v']). % verbose
622		vv :- add_additional_arguments(['-vv']). % very_verbose
623
624		:- volatile additional_arguments/1.
625		:- dynamic additional_arguments/1.
626		% add additional cli arguments when running tests:
627		add_additional_arguments(List) :-
628		(retract(additional_arguments(Old)) -> true ; Old=[]),
629		append(Old,List,New),
630		assertz(additional_arguments(New)).
631
632		reset_additional_arguments :- retractall(additional_arguments(_)).
633
634		% auto complete a preference name and print error if no match found
635		get_preference_name(Prefix,Name) :- auto_complete_preference(Prefix,Name),!.
636		get_preference_name(Prefix,_) :-
637		format_warning_nl('No matching preference found for: ~w',[Prefix]),fail.
638
639		:- use_module(probsrc(preferences),[eclipse_preference/2]).
640		auto_complete_preference(Prefix,Name) :-
641		atom_codes(Prefix,PC),
642		eclipse_preference(EP,Name),
643		(atom_codes(EP,EPC) ; atom_codes(Name,EPC)),
644		append(PC,_,EPC).
645
646		% add additional preference when running tests:
647		add_additional_preference(PREF,PREFVAL) :-
648		(retract(additional_arguments(Old0)) -> remove_matching_pref(Old0,PREF,Old) ; Old=[]),
649		New = ['-p',PREF,PREFVAL|Old],
650		format('New additional arguments: ~w~n',[New]),
651		assertz(additional_arguments(New)).
652
653		% remove all preferences conflicting with PREF
654		remove_matching_pref([],_PREF,[]).
655		remove_matching_pref(['-p',P,OLD|T],PREF,Res) :- !,
656		(P=PREF -> Res=T ; Res = ['-p',P,OLD|RT], remove_matching_pref(T,PREF,RT)).
657		remove_matching_pref([H|T],PREF,[H|RT]) :- remove_matching_pref(T,PREF,RT).
658
659		% remove all preferencs conflicting with other list of prefs
660		remove_matching_prefs([],P,P).
661		remove_matching_prefs(['-cache',_File|T],InPrefs,Res) :- !,
662		remove_matching_prefs(T,InPrefs,Res).
663		remove_matching_prefs(['-p',PREF,_|T],InPrefs,Res) :-
664		remove_matching_pref(InPrefs,PREF,In2),
665		remove_matching_prefs(T,In2,Res).
666		remove_matching_prefs([_|T],InPrefs,Res) :-
667		remove_matching_prefs(T,InPrefs,Res).
668
669		:- use_module(probsrc(pathes_lib), [unavailable_extension/2]).
670		unavailable_extension_for_test(Id,TestCategories,Ext,Reason) :-
671	?	test_requires_extension(Id,TestCategories,Ext),
672		unavailable_extension(Ext,Reason).
673
674		:- dynamic skip_all_tests/0.
675
676		skip_test(_, _, _, ReasonMsg, ReasonTerm) :-
677		skip_all_tests,
678		!,
679		ReasonMsg = 'skipping all tests',
680		ReasonTerm = skip_all_tests.
681		skip_test(_Id, _TestCategories, TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
682		member(skip,TestConfigurationInfos),
683		!,
684		ReasonMsg = 'test marked as skipped',
685		ReasonTerm = skip.
686		skip_test(_Id, _TestCategories, TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
687		member(conditional_skip(Callable), TestConfigurationInfos),
688		% Evaluate the condition in the context of the testcases module,
689		% where it was defined, so that imports are visible to the condition.
690		% We can't use a meta_predicate declaration here,
691		% because the goal is nested inside a term.
692		call(testcases:Callable),
693		!,
694		ReasonMsg = 'skip condition is true',
695		ReasonTerm = conditional_skip(Callable).
696		skip_test(_Id, TestCategories, _TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
697		member(private, TestCategories),
698		\+ absolute_file_name(prob_examples(examples), _, [access(exist), file_type(directory), file_errors(fail)]),
699		!,
700		ReasonMsg = 'test requires non-public examples which are not available',
701		ReasonTerm = private.
702		skip_test(_Id, TestCategories, _TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
703		member(private_source_not_available, TestCategories),
704		\+ directory_exists('../private_examples'),
705		!,
706		ReasonMsg = 'test requires private examples which are not available',
707		ReasonTerm = private_source_not_available.
708		skip_test(_Id, _TestCategories, TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
709		current_prolog_flag(dialect, swi),
710		% TODO Handle swi_expected_failure differently.
711		% Ideally, tests that are expected to fail on SWI should not be skipped,
712		% but instead should be run normally with any failures ignored.
713		% This would allow detecting when tests unexpectedly succeed
714		% (i. e. have been fixed, but not unmarked as expected failure yet).
715		member(swi_expected_failure, TestConfigurationInfos),
716		!,
717		ReasonMsg = 'test expected to fail on SWI-Prolog',
718		ReasonTerm = swi_expected_failure.
719		skip_test(Id, TestCategories, _TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
720		unavailable_extension_for_test(Id,TestCategories,Ext,Reason),
721		!,
722		ajoin(['test requires an unavailable extension (',Reason,')'],ReasonMsg),
723		ReasonTerm = Ext.
724		skip_test(_Id, TestCategories, _TestConfigurationInfos, ReasonMsg, ReasonTerm) :-
725	?	group_cannot_be_checked_on_ci_server(Category,Reason),
726		member(Category, TestCategories),
727		(repl_mode, currently_selected_category(Category)
728		-> debug_println(19,forcing_category(Category)), % if a user explicitly selects a category to run; we run it
729		fail
730		; true),
731		!,
732		ajoin(['category ',Category,' cannot be checked on CI (',Reason,')'],ReasonMsg),
733		ReasonTerm = Category.
734
735		% RUNNING SINGLE TESTCASE:
736		% ------------------------
737
738		:- dynamic previous_test_run/1.
739		previous_test_run(none).
740
741		:- use_module(library(timeout), [time_out/3]).
742
743		run_single_testcase(TestCase, SuiteCategory, AllowSkipping) :-
744		TestCase = testcase(Id,_,_,_,_),
745		junit_test_suite_prefix_for_category_and_id(SuiteCategory, Id, JUnitSuiteName),
746		run_single_testcase_aux(TestCase, JUnitSuiteName, AllowSkipping).
747
748		run_single_testcase_aux(testcase(Id,TestCategories,Infos,_Arguments,Comment), JUnitSuiteName, AllowSkipping) :-
749		skip_test(Id,TestCategories,Infos,ReasonMsg,ReasonTerm),
750		(AllowSkipping = allow_skipping -> true
751		; % Skipping disabled - print message, then continue to next clause to run the test anyway.
752		format_progress_nl('Running test that would normally be skipped - ~w: ~q', [ReasonMsg,ReasonTerm]),
753		fail),
754		!,
755		full_flush,
756		format_with_colour_nl(user_output,[blue,bold],'Skipping test ~w (~w) because ~w: ~q', [Id,Comment,ReasonMsg,ReasonTerm]),
757		print_junit_skip(JUnitSuiteName),
758		assertz(test_skipped(Id)),
759		full_flush.
760		run_single_testcase_aux(testcase(Id,_TestCategories,_Infos,_Arguments,Comment), JUnitSuiteName, AllowSkipping) :-
761		test_requires_previous_test(Id,ReqPreviousId),
762		previous_test_run(PreviousId),
763		PreviousId \= ReqPreviousId,!,
764		format_warning_nl('~n*** Test id ~w requires test ~w to be run just before, but previous test is ~w',
765		[Id,ReqPreviousId,PreviousId]),
766		(AllowSkipping = allow_skipping -> true
767		; format_progress_nl('Running test that would normally be skipped', []),fail),
768		!,
769		full_flush,
770		format_with_colour_nl(user_output,[blue,bold],'Skipping test ~w (~w)', [Id,Comment]),
771		print_junit_skip(JUnitSuiteName),
772		assertz(test_skipped(Id)),
773		full_flush.
774		run_single_testcase_aux(testcase(Id,_TestCategories,_Infos,Arguments,Comment), JUnitSuiteName, _) :-
775		full_flush,
776		format_progress_nl('Running test ~w ~n ~w',[Id,Comment]),
777		retractall(previous_test_run(_)), assert(previous_test_run(Id)),
778		(debug_mode(off) -> true ; print('testcase: probcli '), print_args(Arguments),nl),
779		clear_diff_output(Id),
780		clear_logxml_output(Id),
781		prob_junit_args(JUnitSuiteName,JUnitArgs),
782		maplist(patch_prob_examples_loc,Arguments,Arguments0), % update path to prob_examples if necessary
783		append(Arguments0, JUnitArgs, Arguments1),
784		(additional_arguments(ExtraArgs)
785		-> remove_matching_prefs(ExtraArgs,Arguments1,RemArguments1), % remove conflicting arguments now overriden
786		append(ExtraArgs,RemArguments1,Arguments2)
787		; Arguments1=Arguments2),
788	?	(tests_multiply_timeout(Factor) -> modify_timeout(Factor,Arguments2,Arguments3) ; Arguments3 = Arguments2),
789		(no_strict_running, select('-strict',Arguments3,Arguments4) -> true ; Arguments4=Arguments3),
790		(silent_running -> true ; print('executing: probcli '), print_args(Arguments4),nl),
791		full_flush,
792		test_started(Id),
793		time_out(catch(prob_cli:run_probcli(Arguments4,[test_runner]), Exception, true),
794		2147483646,TO_Result), !,
795		test_finished(Id,Walltime),
796		(TO_Result \= success % time_out occured, possibly due to throw(time_out);
797		-> Exception = TO_Result % et Exception to time_out
798		; true),
799		(test_exception_is_success(Exception)
800		-> check_diff_output(Id,JUnitSuiteName),
801		check_logxml(Id,JUnitSuiteName)
802		; format_warning_nl('Exception in test ~w: ~w',[Id,Exception]),
803		handle_test_exception(Exception),
804		print_test_failed(Id,JUnitSuiteName,probcli,Exception)
805		),
806		(prolog_error_occurred ->
807		print_test_failed(Id,JUnitSuiteName,probcli,'Error(s) from Prolog during test! See console log for details. Aborting test run.'),
808		halt1
809		; true),
810		!,
811		(test_failed(Id) % asserted by check_diff_output/check_logxml/print_test_failed
812		-> true % messages already printed above
813		; format_with_colour_nl(user_output,[green],'Test ~w completed successfully (in ~w ms)~n',[Id,Walltime])
814		),
815		safe_reset_cli(Id,JUnitSuiteName),
816		full_flush.
817
818		test_exception_is_success(Exception) :- var(Exception), !. % No exception was actually thrown
819		test_exception_is_success(Exception) :- Exception == halt(0). % can be thrown by typechecker_test
820
821		handle_test_exception(Exception) :-
822		( Exception = error(_,_) -> Type = 'Error'
823		; Exception = enumeration_warning(_,_,_,_,_) -> Type = 'Enumeration exception'
824		; Exception = solver_and_provers_too_weak -> Type = 'Solver exception'
825		; fail
826		),
827		!,
828		(halt1_allowed
829		-> format_warning_nl('~w during test execution: ~w',[Type,Exception]),
830		halt1
831		; true).
832		handle_test_exception(halt(1)) :- !.
833		handle_test_exception(parse_errors(_)) :- !.
834		handle_test_exception(time_out) :- !.
835		handle_test_exception(user_interrupt_signal) :- !,
836		assertz(user_interrupt_signal_received),
837		format_warning_nl('CTRL-C received, aborting tests',[]).
838		handle_test_exception(Exception) :-
839		format_warning_nl('Exception not caught in test_runner: ~w',[Exception]),
840		halt1.
841
842		safe_reset_cli(Id,JUnitSuiteName) :-
843		catch(prob_cli:reset_cli, % when bundles/extensions are missing we can get exceptions here
844		Exception,
845		(halt1_allowed
846		-> format_warning_nl('Exception while resetting probcli: ~w',[Exception]),
847		halt1
848		;
849		ajoin([JUnitSuiteName,'.reset_cli'], ResetSuiteName),
850		print_test_failed(Id,ResetSuiteName,reset_cli,Exception)
851		)).
852
853		:- dynamic test_took_aux/2.
854		:- dynamic last_testcase_run/1, number_of_tests_run/1.
855		number_of_tests_run(0).
856		reset_nr_of_tests :- retractall(number_of_tests_run(_)), assertz(number_of_tests_run(0)).
857
858		:- use_module(library(system),[now/1, datime/2]).
859		:- dynamic performance_session_running/1, performance_session_stats/4.
860
861		performance_session_start :-
862		now(When),
863		datime(When,datime(Year,Month,Day,Hour,Min,Sec)),
864		format('~nStarting Codespeed Performance Monitoring session ~w:~w:~w:~w:~w:~w~n',[Year,Month,Day,Hour,Min,Sec]),
865		retractall(performance_session_running(_)),
866		assertz(performance_session_running(When)).
867
868		:- use_module(probsrc(parsercall),[get_parser_version/1]).
869		:- use_module(probsrc(version), [version_str/1, revision/1, lastchangeddate/1,
870		format_prolog_version/1, format_prob_version/1]).
871		performance_session_end(FilePrefix) :-
872		performance_session_running(When),
873		datime(When,datime(Year,Month,Day,Hour,Min,Sec)),
874		%tools:ajoin([FilePrefix,':',Year,Month,Day,Hour,Min,Sec],FileName),
875		format('~nFinishing Codespeed session ~w:~w:~w:~w:~w:~w~n -> File : ~w~n',[Year,Month,Day,Hour,Min,Sec,FilePrefix]),
876		open(FilePrefix,append,S),
877		format(S,'~n/* Codespeed session ~w:~w:~w:~w:~w:~w */~n',[Year,Month,Day,Hour,Min,Sec]),
878		version_str(Vers), portray_clause(S, session_prob_version(When,Vers)),
879		revision(Rev), portray_clause(S, session_prob_revision(When,Rev)),
880		lastchangeddate(DD), portray_clause(S, session_prob_lastchangeddate(When,DD)),
881		get_parser_version(PV), portray_clause(S, session_prob_parser_version(When,PV)),
882		current_prolog_flag(version, PrologVString),
883		portray_clause(S, session_prolog_version_string(When,PrologVString)),
884		current_prolog_flag(version_data, PrologVData),
885		portray_clause(S, session_prolog_version_data(When,PrologVData)),
886		current_prolog_flag(host_type, HostType),
887		portray_clause(S, session_prolog_host_type(When,HostType)),
888		write_perf_data(When,S).
889
890		write_perf_data(When,S) :- additional_arguments(New),
891		portray_clause(S, stored_additional_arguments(When,New)),
892		fail.
893		write_perf_data(When,S) :- performance_session_stats(When,Id,Time,WTime),
894		portray_clause(S, stored_performance_test_stats(When,Id,Time,WTime)),
895		fail.
896		write_perf_data(_When,S) :- nl(S), nl(S), close(S).
897
898
899
900		test_started(Id) :-
901		retractall(last_testcase_run(_)), assertz(last_testcase_run(Id)),
902		retractall(test_took_aux(_,_)),
903		statistics(runtime,[Start,_]),
904		statistics(walltime,[WStart,_]),
905		bb_put(test_started,Start),
906		bb_put(test_started_wtime,WStart),
907		bb_put(test_target_coverage,0). % a special value which can be increased in ProB's source code
908		% useful to measure the number of tests that cover a new feature
909
910		:- public inc_test_target_coverage/0.
911		% call this from prob_prolog if some code point you wish to test is covered
912		% using the stats repl command you can then see how many tests have covered this code point
913		inc_test_target_coverage :-
914		bb_get(test_target_coverage,X),
915		X1 is X+1,
916		bb_put(test_target_coverage,X1).
917
918		:- dynamic test_stats/6.
919		test_finished(Id,WTime) :-
920		statistics(runtime,[End,_]),
921		statistics(walltime,[WEnd,_]),
922		bb_get(test_started,Start),
923		bb_get(test_started_wtime,WStart),
924		bb_get(test_target_coverage,Covered),
925		Time is End - Start, WTime is WEnd- WStart,
926		retractall(test_took_aux(_,_)),
927		assertz(test_took_aux(Time,WTime)),
928		(retract(number_of_tests_run(Nr)) -> N1 is Nr+1 ; N1=1),
929		assertz(number_of_tests_run(N1)),
930		(retract(test_stats(Id,PrevTime,PrevWTime,_,_,_))
931		-> assertz(test_stats(Id,Time,WTime,PrevTime,PrevWTime,Covered))
932		; assertz(test_stats(Id,Time,WTime,-1,-1,Covered))
933		),
934		(performance_session_running(When)
935		-> assertz(performance_session_stats(When,Id,Time,WTime))
936		; true).
937
938		print_delta_stats :- print('Comparing walltimes with previous test run: '),nl,
939		findall(delta(DeltaPerc,DeltaWTime,Id),test_delta_stat(Id,DeltaPerc,DeltaWTime),L),
940		(L=[] -> print('No previous run information available'),nl
941		; print(' ID | % (delta absolute) | walltime (runtime)~n'),nl,
942		sort(L,SL),
943		maplist(print_delta,SL)).
944		test_delta_stat(Id,DeltaPerc,DeltaWTime) :-
945		test_stats(Id,_RTime,WTime,_PrevRTime,PrevWTime,_),
946		PrevWTime>0,
947		DeltaWTime is WTime - PrevWTime,
948		DeltaPerc is (100*DeltaWTime) / PrevWTime.
949		print_delta(delta(DeltaPerc,DeltaWTime,Id)) :-
950		test_stats(Id,RTime,WTime,_PrevRTime,PrevWTime,_Cov),
951		format(' ~w | ~2f % (~w ms) | ~w ms (~w ms runtime) [~w walltime ms previously]~n',
952		[Id,DeltaPerc,DeltaWTime,WTime,RTime,PrevWTime]).
953
954		:- use_module(probsrc(tools),[print_memory_used_wo_gc/0]).
955		print_current_stats :- print_current_stats(user_output,' | ').
956		print_current_stats(Stream,Sep) :-
957		print_memory_used_wo_gc,nl,
958		bb_put(test_target_coverage_nr,0),
959		bb_put(test_target_coverage_count,0),
960		bb_put(test_counter_nr,0),
961		format(Stream,' ID~wOK~wWALLTIME (ms)~wRUNTIME (ms)~wCOV~wDESCRIPTION~n',[Sep,Sep,Sep,Sep,Sep]),
962		test_stats(Id,RTime,WTime,_PrevRTime,_PrevWTime,NrTargetCoverage),
963		cli_testcase(Id,_Cat,_,_Args,Desc),
964		(test_failed(Id) -> OK = '*FAILED*' ; OK = ' OK '),
965		format(Stream,' ~w~w~w~w~w~w~w~w~w~w~w~n',
966		[Id,Sep,OK,Sep,WTime,Sep,RTime,Sep,NrTargetCoverage,Sep,Desc]),
967		bb_get(test_counter_nr,Nr), Nr1 is Nr+1, bb_put(test_counter_nr,Nr1),
968		(NrTargetCoverage>0
969		-> bb_get(test_target_coverage_nr,TN), TN1 is TN+1, bb_put(test_target_coverage_nr,TN1),
970		bb_get(test_target_coverage_count,NC), NC1 is NC+NrTargetCoverage,
971		bb_put(test_target_coverage_count,NC1)
972		),
973		fail.
974		print_current_stats(_,_) :-
975		bb_get(test_counter_nr,NrT),
976		format('Number of tests: ~w~n',[NrT]),
977		(bb_get(test_target_coverage_nr,Nr), Nr>0 ->
978		bb_get(test_target_coverage_count,NrC),
979		Perc is (100.0 * Nr) / NrT,
980		format('Number of tests reaching test source code target: ~w (~2f %, total hits: ~w)~n',[Nr, Perc, NrC])
981		; true).
982
983		test_took(Time,WTime) :- test_took_aux(Time,WTime), !.
984		test_took(0,0) :-
985		format_warning_nl('test_took/2 called before test_finished/2, this should not happen!',[]).
986
987		print_junit_skip(JUnitSuiteName) :-
988		prob_junit_dir(Dir)
989		-> set_junit_dir(Dir),
990		create_junit_result(probcli, 0, skip, Result),
991		print_junit(JUnitSuiteName, [Result])
992		; true.
993
994		% if the test expects a time_out error, the timeout is not expanded
995		% otherwise, timeout is increased to allow coverage analysis / junit / etc to finish
996		:- use_module(probsrc(tools_meta), [no_time_out_value/1]).
997		multiply_and_truncate_timeout(OrigTimeout, Factor, NewTimeout) :-
998		no_time_out_value(NoTimeout),
999		% Make sure that the new timeout never exceeds the special "no timeout" value,
1000		% otherwise ProB prints lots of warnings about the timeout being too high.
1001		(Factor = disable_time_out -> NewTimeout = NoTimeout
1002		; NewTimeout is min(round(Factor * OrigTimeout), NoTimeout)). % Factor could be float
1003
1004		modify_timeout(_,OldOptions,New) :-
1005		append(_,['-expcterr','time_out'|_],OldOptions), !, New=OldOptions. % we expect a time_out
1006		modify_timeout(Factor,[],['-p','TIME_OUT',NVal]) :-
1007		% timeout was not set at all - set it to Factor*Default
1008		% Note: there is a potential problem when the time_out is set inside the machine and not in the test !! TO DO: fix
1009		preferences:preference_default_value(time_out,DEFAULT),
1010		multiply_and_truncate_timeout(DEFAULT, Factor, NVal).
1011		modify_timeout(Factor,[GTC,OLD|T],[GTC,NewT|MT]) :- is_global_time_out_cmd(GTC),!,
1012		arg_is_number(OLD,OLDT),
1013		multiply_and_truncate_timeout(OLDT,Factor, NewT),
1014		modify_timeout(Factor,T,MT).
1015		modify_timeout(Factor,['-p','TIME_OUT',OLD|T],['-p','TIME_OUT',NewT|T]) :-
1016		arg_is_number(OLD,OLDT), !,
1017		multiply_and_truncate_timeout(OLDT, Factor, NewT). % TODO: we currently assume global_time_out appears before
1018	?	modify_timeout(Factor,[H|T],[H|MT]) :- modify_timeout(Factor,T,MT).
1019
1020		is_global_time_out_cmd('-global_time_out').
1021		is_global_time_out_cmd('--global_time_out').
1022		is_global_time_out_cmd('-time_out'). % old version
1023
1024		full_flush :- flush_output(user_output), flush_output(user_error).
1025
1026		print_args(List) :- print_args(List,15,15).
1027		print_args([],_,_).
1028		print_args([H|T],Nr,MaxPerLine) :- print(H),
1029		(Nr<1 -> write(' \\'),nl, N1=MaxPerLine ; N1 is Nr-1),
1030		write(' '), print_args(T,N1,MaxPerLine).
1031
1032		print_test_failed(Id,JUnitSuiteName,JUnitTestName,Msg) :-
1033		print_test_failed(Id,JUnitSuiteName,JUnitTestName,Msg,'').
1034		print_test_failed(Id,JUnitSuiteName,JUnitTestName,Msg1,Msg2) :-
1035		(Msg1 = user_interrupt_signal -> assertz(user_interrupt_signal_received) ; true),
1036		test_took(RunTime,WallTime),
1037		cli_testcase(Id,Categories,_Infos,Arguments,Comment),
1038		!,
1039		ErrorMessage = ['Test with Id',Id,'failed.','Test Categories: ',Categories,'Test Arguments: ',Arguments,'Test Comment: ',Comment,'Error Messages in Test Runner: ',Msg1,Msg2,'Content of Error Manager: '],
1040		(get_all_errors(AllErrors) -> true ; AllErrors = []),
1041		append(ErrorMessage,AllErrors,FullErrorMessage),
1042		create_junit_result(JUnitTestName,RunTime,error(FullErrorMessage),Result),
1043		print_junit(JUnitSuiteName,[Result]),
1044		assert_test_failed(Id),
1045		start_terminal_colour(red,user_error),
1046		format(user_error,'*** Test ~w FAILED (after ~w ms runtime, ~w ms walltime): ~w~w~n',
1047		[Id,RunTime,WallTime,Msg1,Msg2]),
1048		write('***'),print_memory_used_wo_gc,nl,
1049		reset_terminal_colour(user_error).
1050
1051		assert_test_failed(Id) :-
1052		assertz(test_failed(Id)),
1053		retractall(last_test_failed(_)),
1054		assertz(last_test_failed(Id)).
1055
1056		diff_failed(Id,DiffSuiteName,F1,F2,DiffOutputText,CmpOutputText) :-
1057		test_took(Time,_),
1058		atom_codes(DiffOutputAtom,DiffOutputText),
1059		atom_codes(CmpOutputAtom,CmpOutputText),
1060		ErrMsg = ['Diff for test with Id\n',Id,'\nfailed:\n','Output file\n',F1,'\ndoes not correspond to stored version\n',F2,
1061		'\nOutput of Diff:\n',DiffOutputAtom,
1062		'\nOutput of Cmp:\n',CmpOutputAtom],
1063		create_junit_result(diff,Time,error(ErrMsg),Result),
1064		print_junit(DiffSuiteName,[Result]),
1065		assert_test_failed(Id),
1066		assertz(test_diff_failed(Id,F1,F2)),
1067		start_terminal_colour(red,user_error),
1068		format(user_error,'*** Test ~w FAILED: Diff failed:~nOutput file ~w~ndoes not correspond to stored version~n~w~n', [Id,F1,F2]),
1069		format(user_error,'Diff:~n~s~n',[DiffOutputText]),
1070		format(user_error,'Cmp:~n~s~n',[CmpOutputText]),
1071		reset_terminal_colour(user_error).
1072
1073		:- use_module(probsrc(tools_commands),[diff_files_with_editor/2]).
1074		diff_in_editor :- findall(I,test_diff_failed(I,_,_),LI), sort(LI,SI),
1075		format('Opening failed diff files in editor: ~w~n',[SI]),
1076		test_diff_failed(Id,F1,F2),
1077		format('Test ~w~n~w ~w~n',[Id,F1,F2]),
1078		diff_files_with_editor(F1,F2),
1079		fail.
1080		diff_in_editor.
1081
1082
1083		clear_diff_output(Id) :- % clear all files that should be generated
1084		get_testcase_diff_check_output(Id,GeneratedFile,_StoredReferenceFile),
1085		safe_file_exists(GeneratedFile),
1086		(get_testcase_do_not_delete(Id,GeneratedFile) -> formatsilent(user_output,'% Keeping: ~w~n',[GeneratedFile])
1087		; formatsilent(user_output,'% Deleting: ~w~n',[GeneratedFile]),
1088		delete_file(GeneratedFile)
1089		),fail.
1090		clear_diff_output(_).
1091
1092		check_diff_output(Id,JUnitSuiteName) :-
1093		ajoin([JUnitSuiteName, '.diff'], DiffSuiteName),
1094		findall(diff(Id,DiffSuiteName,GeneratedFile,StoredReferenceFile),
1095		get_testcase_diff_check_output(Id,GeneratedFile,StoredReferenceFile),
1096		ListOfDiffsToCheck),
1097		maplist(check_diff_output2, ListOfDiffsToCheck).
1098
1099		check_diff_output2(diff(Id,DiffSuiteName,GeneratedFile,StoredReferenceFile)) :-
1100		\+ safe_file_exists(GeneratedFile) -> print_test_failed(Id,DiffSuiteName,diff,'Output file does not exist:',GeneratedFile) ;
1101		\+ safe_file_exists(StoredReferenceFile) -> print_test_failed(Id,DiffSuiteName,diff,'Stored file does not exist:',StoredReferenceFile) ;
1102		check_diff_output3(Id,DiffSuiteName,GeneratedFile,StoredReferenceFile).
1103
1104		check_diff_output3(Id,DiffSuiteName,F1,F2) :-
1105		formatsilent(user_output,'% Checking: diff / cmp ~w ~w~n',[F1,F2]),
1106		get_command_path(diff,DiffPath),
1107		get_command_path(cmp,CmpPath),
1108		(system_call(DiffPath,['-b',F1,F2],DiffOutputText,_ErrTextDiff,ExitDiff) % use -q for quiet
1109		-> true
1110		; DiffOutputText = "*** CALLING DIFF FAILED !", ExitDiff = fail
1111		),
1112		formatsilent(user_output,'% Checking: cmp ~w ~w~n',[F1,F2]),
1113		(system_call(CmpPath,['-b',F1,F2],CmpOutputText,_ErrTextCmp,_ExitCmp)
1114		-> true
1115		; CmpOutputText = "*** CALLING CMP FAILED !"
1116		),
1117		(ExitDiff = exit(0)%, ExitCmp = exit(0)
1118		-> true
1119		; diff_failed(Id,DiffSuiteName,F1,F2,DiffOutputText,CmpOutputText)).
1120
1121
1122		% ----------------
1123		:- volatile logxml_file/1.
1124		% logxml file used automatically when started by test_runner
1125		:- dynamic logxml_file/1.
1126		clear_logxml_output(_Id) :- logxml_file(GeneratedFile),
1127		safe_file_exists(GeneratedFile),
1128		delete_file(GeneratedFile),
1129		fail.
1130		clear_logxml_output(_).
1131
1132		set_logxml_file(File) :- retractall(logxml_file(_)), assertz(logxml_file(File)),
1133		format('Adding -logxml ~w.~n',[File]),
1134		add_additional_arguments(['-logxml',File]).
1135
1136		:- use_module(probsrc(logger),[read_xml_log_file/2]).
1137		check_logxml(Id,JUnitSuiteName) :-
1138		logxml_file(File),!,
1139		ajoin([JUnitSuiteName,'.check_logxml'], LogxmlSuiteName),
1140		xmllint(Id,LogxmlSuiteName,File),
1141		check_logxml_file(Id,LogxmlSuiteName,File).
1142		check_logxml(_,_JUnitSuiteName).
1143
1144		xmllint(Id,LogxmlSuiteName,File) :-
1145		(call_xmllint(File,ErrText,ExitLint)
1146		-> (ExitLint = exit(0) -> true
1147		; print_test_failed(Id,LogxmlSuiteName,check_logxml,'xmllint reported errors for file:',File),
1148		formatsilent(user_error,'% xmllint result~n~s~n',[ErrText])
1149		)
1150		; print_test_failed(Id,LogxmlSuiteName,check_logxml,'Calling xmllint failed for file:',File)
1151		).
1152
1153		:- dynamic use_logxml_schema/0.
1154		set_use_logxml_schema :- (use_logxml_schema -> true ; assertz(use_logxml_schema)).
1155		call_xmllint(File,ErrText,ExitLint) :- use_logxml_schema,
1156		absolute_file_name(prob_home('doc/logxml_xsd.xml'),SchemaFile),
1157		file_exists(SchemaFile),!,
1158		get_command_path(xmllint,LintPath),
1159		format('Calling ~w with schema ~w for logxml file ~w~n',[LintPath,SchemaFile,File]),
1160		system_call(LintPath,['--schema', SchemaFile, File, '-noout'],_OutputText,ErrText,ExitLint).
1161		call_xmllint(File,ErrText,ExitLint) :-
1162		get_command_path(xmllint,LintPath),
1163		format('Calling ~w without schema for logxml file ~w~n',[LintPath,File]),
1164		system_call(LintPath,[File],_OutputText,ErrText,ExitLint).
1165
1166		check_logxml_file(Id,LogxmlSuiteName,File) :-
1167		catch(read_xml_log_file(File,Infos), E,
1168		print_test_failed(Id,LogxmlSuiteName,check_logxml,'Exception trying to read logxml file:',E)),
1169		!,
1170		format_progress_nl('Read logxml file ~w, contains ~w.',[File,Infos]),
1171		check_error_cound(Id,LogxmlSuiteName,Infos).
1172		check_logxml_file(Id,LogxmlSuiteName,File) :-
1173		print_test_failed(Id,LogxmlSuiteName,check_logxml,'Logxml file could not be read:',File).
1174
1175		check_error_cound(Id,LogxmlSuiteName,Infos) :-
1176		testcase_expects_errors(Id),!,
1177		(member(expected_errors/E,Infos),E>0 -> true ; print_test_failed(Id,LogxmlSuiteName,check_logxml,'Logxml file does not report errors:',Infos)).
1178		check_error_cound(Id,LogxmlSuiteName,Infos) :-
1179		(member(errors/0,Infos),member(expected_errors/0,Infos) -> true
1180		; print_test_failed(Id,LogxmlSuiteName,check_logxml,'Logxml file reports errors:',Infos)).
1181
1182		testcase_expects_errors(Id) :-
1183		cli_testcase(Id,_Cat,_Infos,Arguments,_Comment),
1184		member(A,Arguments), expect_error_arg(A).
1185
1186		expect_error_arg('-expcterr').
1187		expect_error_arg('-expecterr').
1188		expect_error_arg('-expect').
1189		expect_error_arg('-expcterrpos').
1190
1191		% ------------------
1192
1193		:- volatile repl_mode/0.
1194		:- dynamic repl_mode/0.
1195
1196		:- use_module(test_paths, [get_prob_examples_override/1, set_prob_examples_override/1]).
1197
1198		set_prob_examples_location(Dir) :-
1199		(atom(Dir) -> DirAtom = Dir ; atom_codes(DirAtom, Dir)),
1200		format('Setting location of prob_examples directory to: ~s~n',[DirAtom]),
1201		set_prob_examples_override(DirAtom).
1202
1203		% Prefixes of arguments that contain file paths,
1204		% which may need to be patched to an alternate prob_examples location.
1205		path_arg_prefix("#file ").
1206		path_arg_prefix(":cdclt #file ").
1207		path_arg_prefix(":cdclt-file ").
1208		path_arg_prefix(":cdclt-free #file ").
1209		path_arg_prefix(":cdclt-double-check #file ").
1210		path_arg_prefix(":cdclt-free-double-check #file ").
1211		path_arg_prefix(":prob-file ").
1212		path_arg_prefix(":z3 #file ").
1213		path_arg_prefix(":z3-double-check #file ").
1214		path_arg_prefix(":z3-free-double-check #file ").
1215		path_arg_prefix(":z3-file ").
1216		path_arg_prefix(":z3-free #file ").
1217		path_arg_prefix(":z3-free-file ").
1218		path_arg_prefix("").
1219
1220		% update path to prob_examples if necessary:
1221		patch_prob_examples_loc_0(NewLoc,Arg,PatchedArg) :-
1222		path_arg_prefix(Prefix),
1223		append(Prefix, ArgTail, Arg),
1224		append("../prob_examples", PathTail, ArgTail),
1225		!,
1226		append(NewLoc, PathTail, PatchedArgTail),
1227		append(Prefix, PatchedArgTail, PatchedArg).
1228
1229		patch_prob_examples_loc(Arg,PatchedArg) :-
1230		get_prob_examples_override(NewLocAtom),
1231		atom_codes(NewLocAtom, NewLoc),
1232		atom(Arg),
1233		atom_codes(Arg,ArgC),
1234		patch_prob_examples_loc_0(NewLoc,ArgC,PatchedArgC),
1235		!,
1236		atom_codes(PatchedArg,PatchedArgC),
1237		format('Patched ~w to ~w~n',[Arg,PatchedArg]).
1238		patch_prob_examples_loc(A,A).
1239
1240		get_testcase_do_not_delete(Id,PF) :-
1241		cli_testcase_do_not_delete(Id,F),
1242		patch_prob_examples_loc(F,PF).
1243
1244		get_testcase_diff_check_output(Id,PF1,PF2) :-
1245		cli_testcase_diff_check_output(Id,F1,F2),
1246		patch_prob_examples_loc(F1,PF1),
1247		patch_prob_examples_loc(F2,PF2).
1248
1249		:- use_module(extension('counter/counter'),[counter_init/0]).
1250		:- use_module(probsrc(prob_startup), [startup_prob/0]).
1251		init_test_runner :- startup_prob,counter_init.
1252		:- use_module(library(lists),[maplist/2]).
1253		% a minimal shell to execute tests:
1254		test_repl :-
1255		init_test_runner,
1256		format_prob_version(user_output),nl,
1257		format_prolog_version(user_output),nl,
1258		assertz(repl_mode),
1259		current_prolog_flag(argv,ArgV), treat_argv(ArgV),
1260		test_repl_loop,
1261		retractall(repl_mode).
1262
1263
1264
1265		treat_argv(['-prob-examples',Dir|T]) :- !, set_prob_examples_location(Dir),
1266		treat_argv(T).
1267		treat_argv(Args) :- maplist(eval_argv,Args).
1268
1269		% execute tests provided on the command-line:
1270		eval_argv(Cmd) :- format('ARGV ==> ~w~n',[Cmd]),
1271		atom_codes(Cmd,C), safe_number_codes(Nr,C), !, test_eval(Nr).
1272		eval_argv(Cmd) :- test_eval(Cmd),!.
1273
1274		test_repl_loop :- safe_read(T), test_eval(T), !, test_repl_loop.
1275		test_repl_loop.
1276
1277		safe_read(T) :-
1278		catch(
1279		(prompt(OldPrompt, 'TEST ==> '), call_cleanup(read(T), prompt(_, OldPrompt))),
1280		error(syntax_error(E),_),
1281		(format_warning_nl('*** Syntax error: ~w~n*** Type Prolog term followed by a dot(.) and enter.',[E]),
1282		safe_read(T))).
1283
1284		:- use_module(probsrc(translate),[print_open_stream_stats/0]).
1285		:- meta_predicate wall(0).
1286		wall(Call) :-
1287		statistics(walltime,[Start,_]),
1288		call(Call),
1289		statistics(walltime,[Stop,_]), WT is Stop-Start,
1290		format('Walltime: ~w ms~n',[WT]),
1291		print_memory_used_wo_gc,nl,
1292		(debug_mode(off) -> true ; print_open_stream_stats).
1293
1294		% -------------------------
1295
1296		:- use_module(library(file_systems)).
1297		:- use_module(probsrc(tools),[get_options/5]).
1298		% true for test_files
1299		test_file(Id,File,AbsFileName) :- cli_testcase(Id,_Cat,_Infos,Arguments,_Comment),
1300		get_options(Arguments,prob_cli:recognised_cli_option,_Options,Files,fail),
1301		member(File,Files),
1302		is_existing_file(File),
1303		absolute_file_name(File,AbsFileName).
1304
1305		is_existing_file(X) :- \+ number(X), atom(X),
1306		atom_codes(X,Codes),[BS] = "/", (member(BS,Codes) -> true),
1307		file_exists(X).
1308
1309		% obtain a list of all files used in tests
1310		all_files(Files) :- findall(F,test_file(_,_,F),A), sort(A,Files).
1311
1312		% a test file that can be loaded:
1313		valid_test_file(Id,File,AbsFileName,XT) :-
1314		test_file(Id,File,AbsFileName),
1315		cli_testcase(Id,_Cat,_Infos,Arguments,_Comment),
1316		\+ append(_,['-expcterr', load_main_file |_],Arguments),
1317		tools:get_filename_extension(File,XT).
1318		all_valid_files(Files,Mode) :-
1319		findall(F, (valid_test_file(_,_,F,XT),
1320		relevant_extension(XT,Mode)),
1321		A),
1322		sort(A,Files).
1323
1324		% traverse a directory and indicate which specification files are used in tests and which ones not
1325		traverse :- traverse('../prob_examples/public_examples/').
1326		traverse(SD) :- all_files(Files), absolute_file_name(SD,StartDir),
1327		format('Examining files in ~w~n + means file is used in some test~n~n',[StartDir]),
1328		traverse(StartDir,Files).
1329
1330		traverse(Dir,AllFiles) :- file_member_of_directory(Dir,_,FullFile),
1331		tools:get_filename_extension(FullFile,XT),
1332		(member(FullFile,AllFiles) -> format(' + ~w~n',[FullFile])
1333		; relevant_extension(XT,_) -> format('--- ~w~n',[FullFile])),
1334		fail.
1335		traverse(Dir,AllFiles) :- directory_member_of_directory(Dir,_,SubDir),
1336		%format('~nSTART ~w~n',[SubDir]),
1337		traverse(SubDir,AllFiles),
1338		%format('~n END ~w~n',[SubDir]),
1339		fail.
1340		traverse(_,_).
1341
1342		relevant_extension('mch',b).
1343		relevant_extension('ref',b).
1344		relevant_extension('imp',b).
1345		relevant_extension('tla',tla).
1346		relevant_extension('fuzz',z).
1347		relevant_extension('tex',z).
1348		relevant_extension('csp',csp).
1349		relevant_extension('cspm',csp).
1350		relevant_extension('eventb',eventb).
1351
1352		% --------------------------
1353
1354		test_eval(quit) :- !,fail.
1355		test_eval(q) :- !,fail.
1356		test_eval(end_of_file) :- !,fail. % Ctrl-D
1357		test_eval(Cmd) :- test_eval1(Cmd),!.
1358		test_eval(Cmd) :-
1359		format_warning_nl('Error executing command: ~w',[Cmd]).
1360
1361		test_eval1(N) :- number(N),!, wall(run_id(N)).
1362		test_eval1(last) :- !, wall(run_last_test).
1363		test_eval1(N-M) :- number(N), number(M),!, wall(run_tests_by_id(N-M)).
1364		test_eval1('..'(N,M)) :- !, test_eval1(N-M).
1365		test_eval1(repeat(ID,M)) :- !, repeat_id(ID,M).
1366		test_eval1(r) :- !, run_random_tests(25).
1367		test_eval1(v) :- !,v.
1368		test_eval1(verbose) :- !,v.
1369		test_eval1(all_files) :- !, all_files(Files), length(Files,Len),
1370		format('~nFiles = ~n~w~n # Files = ~w~n',[Files,Len]).
1371		test_eval1(valid_files(Mode)) :- !, all_valid_files(Files,Mode), length(Files,Len),
1372		format('~nValid ~w Files = ~n~w~n # Files = ~w~n',[Mode,Files,Len]).
1373		test_eval1(files) :- !, traverse.
1374		test_eval1(files(Dir)) :- !, traverse(Dir).
1375		test_eval1(ex(Dir)) :- !, set_prob_examples_location(Dir).
1376		test_eval1(cache) :- !,print('Enabling cache'),nl,
1377		cache.
1378		test_eval1(debug) :- !,print('Enabling Prolog debugging mode (use -v or -vv for ProB debugging info)'),nl,
1379		debug,
1380		retractall(multiply_timeout(_)),
1381		assertz(multiply_timeout(10)).
1382		test_eval1(factor(X)) :- !,
1383		retractall(multiply_timeout(_)),
1384		format('Setting timeout factor to ~w~n',[X]),
1385		assertz(multiply_timeout(X)).
1386		test_eval1(disable_time_out) :- !, test_eval1(factor(disable_time_out)).
1387		test_eval1(timeout(X)) :- !,
1388		format('Adding -timeout ~w for model checking, disproving~nUse factor(X) to set TIME_OUT factor.~n',[X]),
1389		add_additional_arguments(['-timeout',X]).
1390		test_eval1(coverage) :- !,
1391		format('Adding -coverage to all commands.~n',[]),
1392		add_additional_arguments(['-coverage']).
1393		test_eval1(opreuse) :- !,
1394		format('Adding operation reuse to all commands.~n',[]),
1395		add_additional_arguments(['-p', 'OPERATION_REUSE',true]).
1396		test_eval1(opc) :- !,
1397		format('Adding operation reuse and compression to all commands.~n',[]),
1398		add_additional_arguments(['-p', 'COMPRESSION', 'TRUE', '-p', 'OPERATION_REUSE',true]).
1399		test_eval1(opcf) :- !,
1400		format('Adding operation reuse and compression to all commands.~n',[]),
1401		add_additional_arguments(['-p', 'COMPRESSION', 'TRUE', '-p', 'OPERATION_REUSE',full]).
1402		test_eval1(gc_trace) :- !,
1403		format('Adding -gc_trace to all commands.~n',[]),
1404		add_additional_arguments(['-gc_trace']).
1405		test_eval1(reset) :- !, reset_additional_arguments.
1406		test_eval1(logxml) :- !, File = './test_runner_logxml.xml',
1407		set_logxml_file(File).
1408		test_eval1(xsd) :- !, File = './test_runner_logxml.xml',
1409		set_logxml_file(File), set_use_logxml_schema.
1410		test_eval1(debug_off) :- !,print('Disabling Prolog debugging mode'),nl,
1411		nodebug,
1412		retractall(multiply_timeout(_)).
1413		test_eval1(fast) :- !,print('Enabling jvm_parser_fastrw'),nl,
1414		% TODO: only works at the very beginning; we need to be able to switch parser?
1415		add_additional_preference('jvm_parser_fastrw','true'),
1416		add_additional_preference('jvm_parser_force_parsing','true').
1417		test_eval1(force) :- !,print('Setting jvm_parser_force_parsing'),nl,
1418		add_additional_preference('jvm_parser_force_parsing','true').
1419		test_eval1(clpfd) :- !,print('Enabling CLPFD'),nl,
1420		add_additional_preference('CLPFD','TRUE').
1421		test_eval1(clpfd_off) :- !,print('Disabling CLPFD'),nl,
1422		add_additional_preference('CLPFD','FALSE').
1423		test_eval1(smt) :- !,print('Enabling SMT'),nl,
1424		add_additional_preference('SMT','TRUE').
1425		test_eval1(smt_off) :- !,print('Disabling SMT'),nl,
1426		add_additional_preference('SMT','FALSE').
1427		test_eval1(chr) :- !,print('Enabling CHR'),nl,
1428		add_additional_preference('CHR','TRUE').
1429		test_eval1(chr_off) :- !,print('Disabling CHR'),nl,
1430		add_additional_preference('CHR','FALSE').
1431		test_eval1(cse_off) :- !,print('Disabling CSE'),nl,
1432		add_additional_preference('CSE','FALSE').
1433		test_eval1(cse) :- !,print('Enabling CSE'),nl,
1434		add_additional_preference('CSE','TRUE').
1435		test_eval1(cse_subst) :- !,print('Enabling CSE_SUBST'),nl,
1436		add_additional_preference('CSE','TRUE'),
1437		add_additional_preference('CSE_SUBST','TRUE').
1438		test_eval1(trace_info) :- !,print('Enabling TRACE_INFO'),nl,
1439		add_additional_preference('TRACE_INFO','TRUE').
1440		%
1441		test_eval1(p(PREF)) :- !,
1442		get_preference_name(PREF,PName),
1443		print('Enabling Preference '),print(PName),nl,
1444		add_additional_preference(PName,'true').
1445		test_eval1(p(PREF,VAL)) :- !,
1446		get_preference_name(PREF,PName),
1447		print('Setting Preference '),print(PName),nl,
1448		add_additional_preference(PName,VAL).
1449		test_eval1(random) :- !,print('Enabling RANDOMISE_ENUMERATION_ORDER'),nl,
1450		add_additional_preference('RANDOMISE_ENUMERATION_ORDER','TRUE').
1451		test_eval1(random_off) :- !,print('Enabling RANDOMISE_ENUMERATION_ORDER'),nl,
1452		add_additional_preference('RANDOMISE_ENUMERATION_ORDER','FALSE').
1453		test_eval1(safe) :- !,print('Setting PROB_SAFE_MODE'),nl,
1454		run_safely.
1455		test_eval1(sanity_check) :- !, sanity_check(false).
1456		test_eval1(sc) :- !, sanity_check(false).
1457		test_eval1(trace) :- !, print('Enabling TRACE_UPON_ERROR'),nl,
1458		add_additional_preference('TRACE_UPON_ERROR','TRUE').
1459		test_eval1(trace_off) :- !, print('Disabling TRACE_UPON_ERROR'),nl,
1460		add_additional_preference('TRACE_UPON_ERROR','FALSE').
1461		test_eval1(raise) :- !,print('Enabling STRICT_RAISE_ENUM_WARNINGS'),nl,
1462		add_additional_preference('STRICT_RAISE_ENUM_WARNINGS','TRUE').
1463		test_eval1(nopt) :- !,print('Disabling OPTIMIZE_AST'),nl,
1464		add_additional_preference('OPTIMIZE_AST','FALSE').
1465		test_eval1(vv) :- !,vv.
1466		test_eval1(version(X)) :- !, print_version(X). %cpp, java, full, lib
1467		test_eval1(version) :- !, print_version(full_verbose).
1468		test_eval1(silent) :- !, run_silently.
1469		test_eval1(nostrict) :- !, run_no_strict.
1470		test_eval1(no_strict) :- !, run_no_strict.
1471		test_eval1(strict) :- !, retractall(no_strict_running).
1472		test_eval1(skip) :- !, (retract(skip_all_tests) -> X=false ; assertz(skip_all_tests),X=true),
1473		format('Marking all tests as skipped: ~w~n',[X]).
1474		test_eval1(x) :- !,halt.
1475		test_eval1(reload) :- !,use_module(probsrc(test_runner)), use_module(probsrc(testcases)).
1476		:- if(predicate_property(make, _)).
1477		test_eval1(make) :- !, make.
1478		:- else.
1479		test_eval1(make) :- !,
1480		print('make/0 is only supported on SWI-Prolog - reloading just the testcases instead.'),nl,
1481		test_eval1(reload).
1482		:- endif.
1483		test_eval1(edit) :- last_testcase_run(Id),
1484		get_file_for_testcase(Id,File),!,
1485		edit_file(File).
1486		test_eval1(e) :- !, test_eval1(edit).
1487		test_eval1(diff) :- !, diff_in_editor.
1488		test_eval1(halt) :- !,halt.
1489		test_eval1(info) :- !, get_total_number_of_errors(X), format('~nTotal number of errors: ~w~n~n',[X]).
1490		test_eval1(cat) :- !, print('Categories: '),
1491		findall(Cat,
1492		(cli_testcase(_, TestCategories, _, _, _), member(Cat, TestCategories)), List),
1493		sort(List,SL), print(SL),nl,
1494		format('Type cat(Cat) or name of category to run it.~n',[]),
1495		format('Note: priv is an alias for private_source_not_available.~n',[]).
1496		test_eval1(all) :- !, wall(run_tests_all).
1497		test_eval1(cata) :- !, category_analysis.
1498		test_eval1(cat(Category)) :- !,
1499		wall(run_tests_by_category(Category,all)).
1500		test_eval1(priv) :- !, test_eval1(cat(private_source_not_available)).
1501		test_eval1(first(Category)) :- !,
1502		wall(run_tests_by_first_category(Category)).
1503		test_eval1(list(Category)) :- !,
1504		get_tests_for_categories([Category],TList),
1505		findall(Id,member(testcase(Id, _, _, _, _),TList),List),
1506		format('Tests for category: ~w~n',[List]).
1507		test_eval1(make(Categories)) :- !,
1508		wall(makefile_by_category(user_output,Categories)).
1509		test_eval1(make(File,Categories)) :- !,
1510		wall(makefile_by_category(File,Categories)).
1511		test_eval1(files(Category)) :- !, show_files(Category).
1512		test_eval1(uses(Command)) :- !, wall(run_tests_using_command(Command)).
1513		test_eval1(uses(Pref,Val)) :- !, wall(run_tests_using_preference(Pref,Val)).
1514		test_eval1(p) :- !, test_eval1(profile).
1515		test_eval1(ps) :- !, test_eval1(print_profile).
1516		test_eval1(pc) :- !, test_eval1(print_coverage).
1517		test_eval1(delta) :- !, print_delta_stats.
1518		test_eval1(stats) :- !, print_current_stats.
1519		test_eval1(statscsv) :- !, print_current_stats(user_output,',').
1520		test_eval1(start) :- !, performance_session_start.
1521		test_eval1(stop) :- !, performance_session_end('log/test_runner_performance_log.pl').
1522		test_eval1(codespeed) :- !,
1523		performance_session_start,
1524		test_eval1(cat(codespeed)),
1525		performance_session_end('log/test_runner_performance_codespeed_log.pl').
1526		test_eval1(prob_profile) :- !,
1527		cli_print_statistics(prob_profile),
1528		cli_print_statistics(disprover_profile).
1529		test_eval1(profile) :- !, print('PROFILING : '), %spy([avl:avl_size/2]),
1530		(current_prolog_flag(profiling,on)
1531		-> set_prolog_flag(profiling,off), print('OFF') ;
1532		set_prolog_flag(profiling,on), print('ON')),
1533		nl,print('USE ps to print_profile or pc to print_coverage info'),nl.
1534		test_eval1(profile_stats) :- !, test_eval1(print_profile).
1535		test_eval1(print_profile) :- !, nl,print('PROFILE INFORMATION:'), nl,
1536		catch(print_profile,
1537		error(existence_error(_,_),_),
1538		print('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
1539		nl, debug:timer_statistics.
1540		test_eval1(print_coverage) :- !, nl,print('COVERAGE INFORMATION:'), nl,
1541		(current_prolog_flag(source_info,on) -> true ; format_warning_nl('Only useful when current_prolog_flag(source_info,on)!',[])),
1542		catch(print_coverage,
1543		error(existence_error(_,_),_),
1544		print('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
1545		nl.
1546		test_eval1(profile_reset) :- !, nl,print('RESETTING PROFILE INFORMATION'), nl,
1547		catch(profile_reset,
1548		error(existence_error(_,_),_),
1549		print('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
1550		nl.
1551		test_eval1(perf) :- !, toggle_perfmessages.
1552		test_eval1(Category) :- valid_category(Category),!,
1553		wall(run_tests_by_category(Category,all)).
1554
1555		test_eval1(codespeed(Id)) :- !, codespeed_id(Id).
1556		test_eval1(module(Module)) :- !,
1557		prob_cli:run_probcli(['-selfcheck_module',Module],[test_runner]), safe_reset_cli(Module,test_repl_selfcheck_module), full_flush.
1558		test_eval1(cs(Id)) :- !, codespeed_id(Id).
1559		test_eval1('-'(ProBCLICommand)) :- atom(ProBCLICommand),
1560		atom_concat('-',ProBCLICommand,Atom),
1561		(prob_cli:recognised_option(Atom,Call) -> true % from probcli.pl
1562		; format('Unknown probcli command: -~w~n',[ProBCLICommand]),fail),
1563		!,
1564		format('Executing probcli command ~w~n',[Call]),
1565		call(prob_cli:Call).
1566		test_eval1([H|T]) :- number(H),!, wall(run_tests_by_id([H|T],_,no_skipping)).
1567		test_eval1([Category|T]) :- valid_category(Category),!,
1568		wall(run_tests_by_category([Category|T],all)).
1569		test_eval1(Atom) :- atom(Atom),
1570		(split_atom_at_separator(Atom,'-',Left,Right) -> true),
1571		arg_is_number(Left,From), arg_is_number(Right,To),!,
1572		test_eval1(From-To).
1573		test_eval1(C) :-
1574		(C=help -> true ; format('*** Unknown command ~w~n',[C])),
1575		print(' Commands: Nr, Nr-Nr, last, q, x, v, vv, uses(Cmd), uses(Pref,Val),'),nl,
1576		print(' repeat(id,nr), timeout(ms),factor(f), e,edit,diff, r (for 25 random tests),'),nl,
1577		print(' cat, cat(Cats),make(Cats),make(File,Cats),files(Cat),'),nl,
1578		print(' profile, profile_stats, (to turn Prolog profiling on and print info)'),nl,
1579		print(' debug,debug_off, (to turn Prolog debug mode on or off)'),nl,
1580		print(' perf, reload, sc,'),nl,
1581		print(' -CMD, (for probcli commands like -profile)'),nl,
1582		print(' * for setting preferences:'),nl,
1583		print(' p(PREF), p(PREF,VAL),'),nl,
1584		print(' clpfd,clpfd_off, smt,smt_off, chr,chr_off, cse,cse_subst,cse_off,'),nl,
1585		print(' random,random_off, trace_info, nopt,'),nl,
1586		print(' cache, perf, (turn ProB caching or performance messages on)'),nl,
1587		print(' trace,trace_off, (set TRACE_UPON_ERROR preference)'),nl,
1588		print(' * statistics:'),nl,
1589		print(' delta, stats, info.'),nl.
1590
1591
1592		safe_file_exists(F) :- atom(F), file_exists(F).
1593
1594		get_file_for_testcase(Id,File) :-
1595		cli_testcase(Id,_,_Infos,Arguments,_Comment),
1596		member(File,Arguments), safe_file_exists(File).
1597
1598		valid_category(Cat) :-
1599		cli_testcase(_Id, TestCategories, _Infos, _Arguments, _Comment),
1600		member(Cat, TestCategories).
1601
1602
1603		% ---------------------------
1604
1605		% run test using binary
1606		% binaries are registered in a file probcli_bak/codespeed_versions.pl
1607		% results for test ID are written to probcli_bak/codespeed/res_ID.csv
1608
1609		:- use_module(probsrc(tools), [ajoin/2,ajoin_with_sep/3]).
1610		codespeed_id(Ids) :- codespeed_id(Ids,[min_date(date(2020,1,1))]).
1611		codespeed_id([],_) :- !.
1612		codespeed_id([H|T],Options) :- !, codespeed_id(H,Options),!, codespeed_id(T,Options).
1613		codespeed_id(Cat,Options) :- atom(Cat),!,
1614		get_tests_for_categories([Cat],List),
1615		codespeed_id(List,Options).
1616		codespeed_id(testcase(Id, _, _, _, _),Options) :- !, codespeed_id(Id,Options).
1617		codespeed_id(Id,Options) :-
1618		use_module('probcli_bak/codespeed_versions.pl'), % contains probcli_binary
1619		cli_testcase(Id,_TestCategories,_TestInfos,Arguments,Comment),
1620		format('Benchmarking test ~w using probcli binaries ~w~nTest Description: ~w~n',[Id,Options,Comment]),
1621		maplist(convert_arg_to_atom,Arguments,Args2),
1622		findall(probcli_binary(V1,V2,V3,F,Path,Sics,Date),
1623		get_probcli_binary_info(Options,V1,V2,V3,F,Path,_Hash,Sics,Date),Binaries),
1624		Repeats=3,
1625		maplist(bench_probcli_binary_testcase(Id,Args2,Repeats),Binaries,Walltimes,Oks),
1626
1627		ajoin(['codespeed/res_',Id,'.csv'],FName),
1628		absolute_file_name(FName,AF,[relative_to(probcli_bak)]),
1629		format('Writing codespeed results for ~w to ~w~n',[Id,AF]),
1630		open(AF,write,Stream),
1631		format(Stream,'\"Test ~w\"~n',[Id]),
1632		format(Stream,'\"~w\"~n',[Comment]),
1633		ajoin_with_sep(Arguments,' ',ArgsStr),
1634		format(Stream,'Command:,\"probcli ~w\"~n~n',[ArgsStr]),
1635		format(Stream,'\"~w.~w.~w-~w\",~w,~w,~w,~w,~w,~w,\"~w\"~n',[v1,v2,v3,f,sics,date,avg,min,max,ok,walltimes]),
1636		maplist(print_codespeed_results(Stream,Repeats),Binaries,Walltimes,Oks),
1637		close(Stream),
1638		maplist(print_codespeed_results(user_output,Repeats),Binaries,Walltimes,Oks).
1639
1640		get_probcli_binary_info(Options,V1,V2,V3,F,Path,Hash,Sics,Date) :-
1641		probcli_binary(V1,V2,V3,F,Path,Hash,Sics,Date), % from codespeed_versions.pl
1642		(( member(min_date(D2),Options), D2 @> Date
1643		; member(max_date(D3),Options), D3 @< Date
1644		; member(min_version(V12,V22,V32),Options), v(V12,V22,V32) @> v(V1,V2,V3)
1645		)
1646		-> format('Excluding version ~w.~w.~w-~w ~w~n',[V1,V2,V3,F,Options]),
1647		fail
1648		; % format('Including version ~w.~w.~w-~w ~w~n',[V1,V2,V3,F,Options]),
1649		true).
1650
1651
1652		%:- use_module(library(statistics),[min_max/3]).
1653		print_codespeed_results(Stream,Repeats,probcli_binary(V1,V2,V3,F,_Path,sicstus(S1,S2,S3),date(Y,M,D)),Walltimes,Ok) :-
1654		sumlist(Walltimes,Sum),
1655		Average is Sum / Repeats,
1656		min_member(Min,Walltimes),
1657		max_member(Max,Walltimes),
1658		ajoin([S1,'.',S2,'.',S3],Sics),
1659		ajoin([Y,'/',M,'/',D],Date),
1660		format(Stream,'\"~w.~w.~w-~w\",~w,~w,~w,~w,~w,~w,\"~w\"~n',[V1,V2,V3,F,Sics,Date,Average,Min,Max,Ok,Walltimes]).
1661
1662		%bench_probcli_binary_testcase(Id,_Args,_Repeats,probcli_binary(V1,V2,V3,F,Path,_,_),Walltimes,Ok) :-
1663		% format('~nDry run test ~w using version ~w.~w.~w-~w (~w)~n',[Id,V1,V2,V3,F,Path]),!, Ok=skipped, Walltimes=[0].
1664		bench_probcli_binary_testcase(Id,Args,Repeats,probcli_binary(V1,V2,V3,F,Path,_,_),Walltimes,Ok) :-
1665		format('~nRunning test ~w using version ~w.~w.~w-~w (~w)~n',[Id,V1,V2,V3,F,Path]),
1666		run_probcli_binary_testcase(Id,Path,Args,_WT,Ok), % run once for parser
1667		rep_bench(Repeats,Id,Path,Args,Walltimes).
1668
1669		rep_bench(0,_,_,_,[]).
1670		rep_bench(Nr,Id,Path,Args,[WT1|WTR]) :- Nr>0,
1671		run_probcli_binary_testcase(Id,Path,Args,WT1,_),
1672		N1 is Nr-1,
1673		rep_bench(N1,Id,Path,Args,WTR).
1674
1675		:- use_module(probsrc(system_call), [system_call/5]).
1676		run_probcli_binary_testcase(Id,Path,Arguments,WT,Ok) :-
1677		statistics(walltime,[Start,_]),
1678		% absolute_file_name('probcli_bak/',BakPath),
1679		% atom_concat(BakPath,Path,Cmd),
1680		absolute_file_name(Path,Cmd,[relative_to(probcli_bak)]),
1681		format(' Test ~w :: ~w ~w~n',[Id,Cmd,Arguments]),
1682		system_call(Cmd,Arguments,_OutputText,ErrText,Exit),
1683		statistics(walltime,[Stop,_]), WT is Stop-Start,
1684		format(' Walltime: ~w ms; ~w~n',[WT,Exit]),
1685		(Exit=exit(0), ErrText = [] -> Ok=true
1686		; format_error_nl('STD-ERROR (~w):~n~s',[Exit,ErrText]), Ok=false
1687		).
1688
1689		% convert for system_call/process_create which do not accept numbers:
1690		convert_arg_to_atom(Nr,Atom) :- number(Nr), number_codes(Nr,C),!,atom_codes(Atom,C).
1691		convert_arg_to_atom(A,A).
1692
1693
1694		% --------------------
1695
1696		category_analysis :-
1697		format('Analysing test categories:~n',[]),
1698		findall(Cat-Id,(cli_testcase(Id,Categories,_,_Args,_Comm1),member(Cat,Categories)),L),
1699		sort(L,SL),
1700		keyclumped(SL,Groups), % Groups = [ Cat1 - [TestNr1, ...], Cat2 - [...], ...]
1701		maplist(print_cat_group,Groups).
1702
1703		nr_of_files(Cat,Id,Nr,DistinctNr) :-
1704		findall(File,(cli_testcase(Id,Categories,_,Args,_Comm1),
1705		member(Cat,Categories),
1706		file_in_arguments(File,Args)),Files),
1707		length(Files,Nr),
1708		sort(Files,SFile),
1709		length(SFile,DistinctNr).
1710
1711		print_cat_group(Cat-Tests) :-
1712		Tests = [First|T],
1713		nr_of_files(Cat,_,NrFiles,Distinct),
1714		(T=[]
1715		-> format(' ~w : 1 test : [~w] : ~w files, ~w distinct~n',[Cat,First,NrFiles,Distinct])
1716		; length(Tests,Len),
1717		last(T,Last),
1718		format(' ~w : ~w tests : [~w .. ~w] : ~w files, ~w distinct~n',[Cat,Len,First,Last,NrFiles,Distinct])
1719		).
1720