1:- module(test_scasp,
2 [ test_scasp/0,
3 qtest_scasp/0,
4 run_test/2 5 ]). 6:- set_prolog_flag(optimise, true). 7:- use_module(library(apply)). 8:- use_module(library(lists)). 9:- use_module(library(main)). 10:- use_module(library(option)). 11:- use_module(library(test_cover)). 12:- use_module(library(time)). 13
14scasp_dir(SCASPDir) :-
15 source_file(scasp_dir(_), File),
16 file_directory_name(File, TestDir),
17 file_directory_name(TestDir, SCASPDir).
18
19:- multifile
20 user:file_search_path/2. 21
22user:file_search_path(scasp, SCASPDir) :-
23 scasp_dir(SCASPDir).
24user:file_search_path(library, scasp(prolog)).
25
26:- use_module(library(lists), [member/2]). 27:- use_module(library(main), [main/0, argv_options/3]). 28:- use_module(library(option), [option/3, option/2]). 29:- use_module(library(time), [call_with_time_limit/2]). 30
31:- use_module(library(scasp/ops)). 32:- use_module(library(scasp/compile)). 33:- use_module(library(scasp/solve)). 34:- use_module(library(scasp/output)). 35:- use_module(library(scasp/stack)). 36:- use_module(library(scasp/model)). 37:- use_module(library(scasp/options)). 38:- use_module(library(scasp/messages)). 39:- use_module(library(scasp/source_ref)). 40:- use_module(diff). 41
42:- initialization(main, main). 43
44test_scasp :-
45 main([]).
46
47qtest_scasp :-
48 findall(File, quick_test_file(_, File), Files),
49 main(Files).
50
51quick_test_file(Test, File) :-
52 ( atom(Test)
53 -> true
54 ; quick_test(Test)
55 ),
56 absolute_file_name(scasp(test/programs/Test), File,
57 [ access(read),
58 extensions([pl])
59 ]).
60
61quick_test(pq).
62quick_test(forall_arity).
63quick_test(vars).
64quick_test(classic_negation_inconstistent).
65quick_test(birds).
66quick_test(family).
67quick_test(hamcycle).
68quick_test(hamcycle_two).
69quick_test(hanoi).
70
71:- dynamic cov_module/1. 72cov_module(scasp_solve).
73
90
91main(Argv) :-
92 set_prolog_flag(encoding, utf8),
93 argv_options(Argv, Positional, Options),
94 test_files(Positional, Files, Options),
95 scasp_set_options(Options),
96 maplist(set_option, Options),
97 ( option(cov(Dir), Options)
98 -> show_coverage(run_tests(Files, Options),
99 [ dir(Dir) ])
100 ; run_tests(Files, Options),
101 ( option(cov_by_test(true), Options)
102 -> covering_clauses(Options)
103 ; true
104 )
105 ).
106
107opt_type(q, quick, boolean).
108opt_type(timeout, timeout, number).
109opt_type(passed, passed, boolean).
110opt_type(save, save, boolean).
111opt_type(overwrite, overwrite, boolean).
112opt_type(pass, pass, boolean).
113opt_type(cov, cov, file).
114opt_type(cov_by_test, cov_by_test, boolean).
115opt_type(cov_module, cov_module, atom).
116opt_type(Flag, Option, Type) :-
117 scasp_opt_type(Flag, Option, Type).
118
119opt_help(passed, "Only run tests that have a .pass file").
120opt_help(quick, "Only run fast tests").
121opt_help(timeout, "Timeout per test in seconds").
122opt_help(save, "Save pass data if not yet present").
123opt_help(overwrite, "Save pass data if test passed").
124opt_help(pass, "Save pass data if test failed").
125opt_help(cov, "Write coverage data").
126opt_help(cov_by_test, "Analyse coverage by test and compare").
127opt_help(cov_module, "Module to for --cov-by-test analysis").
128opt_help(Option, Help) :-
129 scasp_opt_help(Option, Help).
130
131opt_meta(cov, 'DIRECTORY').
132opt_meta(timeout, 'SECONDS').
133opt_meta(cov_module, 'MODULE').
134opt_meta(Option, Meta) :-
135 scasp_opt_meta(Option, Meta).
136
137set_option(cov_module(Module)) =>
138 retractall(cov_module(_)),
139 asserta(cov_module(Module)).
140set_option(_) =>
141 true.
142
147
148run_tests(Files, Options) :-
149 run_tests(Files, Failed, Options),
150 ( Failed == 0
151 -> format(user_error, 'All tests passed!~n', [])
152 ; format(user_error, '~D tests failed~n', [Failed]),
153 ( current_prolog_flag(break_level, _)
154 -> fail
155 ; halt(1)
156 )
157 ).
158
159run_tests(Files, Failed, Options) :-
160 run_tests(Files, 0, Failed, Options).
161
162run_tests([], Failed, Failed, _).
163run_tests([H|T], Failed0, Failed, Options) :-
164 ( run_test(H, Options)
165 -> run_tests(T, Failed0, Failed, Options)
166 ; Failed1 is Failed0+1,
167 run_tests(T, Failed1, Failed, Options)
168 ).
169
181
182run_test(File, Options) :-
183 file_base_name(File, Base),
184 format("~w ~`.t ~45|", [Base]),
185 flush_output,
186 option(timeout(Time), Options, 60),
187 statistics(runtime, _),
188 catch(call_with_time_limit(
189 Time,
190 scasp_test(File, Stacks-Models, Options)),
191 Error, true),
192 statistics(runtime, [_,Used]),
193 Result = Stacks-Models,
194 pass_data(File, PassFile, PassResult),
195 ( PassResult = PassStacks-PassModels
196 -> true
197 ; PassStacks = PassResult 198 ),
199 ( nonvar(Error)
200 -> message_to_string(Error, Msg),
201 format("ERROR: ~s ~|~t~d ms~8+~n", [Msg,Used]),
202 fail
203 ; var(PassStacks)
204 -> length(Models, ModelCount),
205 format("~|~t~D models~9+~t~d ms~8+~n", [ModelCount,Used]),
206 ( option(save(true), Options)
207 -> save_test_data(PassFile, Result)
208 ; true
209 )
210 ; PassStacks =@= Stacks
211 -> format("passed ~|~t~d ms~8+\n", [Used]),
212 ( option(overwrite(true), Options)
213 -> save_test_data(PassFile, Result)
214 ; true
215 )
216 ; PassModels =@= Models
217 -> format("different stacks, same models ~|~t~d ms~8+\n", [Used]),
218 ( option(show_diff(true), Options)
219 -> diff_terms(PassStacks, Stacks)
220 ; option(pass(true), Options)
221 -> save_test_data(PassFile, Result)
222 ; true
223 )
224 ; canonical_models(PassModels, CannonicalPassModels),
225 canonical_models(Models, CannonicalModels),
226 CannonicalPassModels =@= CannonicalModels
227 -> format("different stacks, same models (different order) ~|~t~d ms~8+\n",
228 [Used]),
229 ( option(show_diff(true), Options)
230 -> diff_terms(PassStacks, Stacks)
231 ; option(pass(true), Options)
232 -> save_test_data(PassFile, Result)
233 ; true
234 )
235 ; format("FAILED ~|~t~d ms~8+\n", [Used]),
236 ( option(pass(true), Options)
237 -> save_test_data(PassFile, Result)
238 ; option(show_diff(true), Options)
239 -> diff_terms(PassStacks, Stacks)
240 ; option(show_diff(models), Options)
241 -> canonical_models(PassModels, CannonicalPassModels),
242 canonical_models(Models, CannonicalModels),
243 diff_terms(CannonicalPassModels, CannonicalModels)
244 ),
245 fail
246 ).
247
248canonical_models(Models, CannModels) :-
249 maplist(canonical_model, Models, Models1),
250 sort(Models1, CannModels).
251
253
254pass_data(File, PassFile, PassData) :-
255 pass_file(File, PassFile),
256 ( exists_file(PassFile)
257 -> setup_call_cleanup(
258 open(PassFile, read, In),
259 read_term(In, PassData,
260 [ module(scasp_ops)
261 ]),
262 close(In))
263 ; true
264 ).
265
266pass_file(File, PassFile) :-
267 file_name_extension(Base, _, File),
268 file_name_extension(Base, pass, PassFile).
269
270save_test_data(Into, Result) :-
271 setup_call_cleanup(
272 open(Into, write, Out),
273 write_term(Out, Result,
274 [ module(scasp_ops),
275 quoted(true),
276 fullstop(true),
277 nl(true)
278 ]),
279 close(Out)).
280
282
283test_files([], Files, Options) :-
284 !,
285 ( option(quick(true), Options)
286 -> findall(File, quick_test_file(_, File), Files)
287 ; absolute_file_name(scasp(test/all_programs), Dir,
288 [ file_type(directory),
289 access(read)
290 ]),
291 test_files([Dir], Files, Options)
292 ).
293test_files(Spec, Files, Options) :-
294 phrase(test_files_(Spec, Options), Files).
295
296test_files_([], _) -->
297 [].
298test_files_([Dir|T], Options) -->
299 { exists_directory(Dir) },
300 !,
301 findall(File, dir_test_file(Dir,File, Options)),
302 test_files_(T, Options).
303test_files_([File|T], Options) -->
304 { exists_file(File) },
305 !,
306 [File],
307 test_files_(T, Options).
308test_files_([H|T], Options) -->
309 { print_message(warning, error(existence_error(file, H),_)) },
310 test_files_(T, Options).
311
312dir_test_file(Dir, File, Options) :-
313 atom_concat(Dir, '/*.pl', Pattern),
314 expand_file_name(Pattern, Files),
315 member(File, Files),
316 ( option(passed(true), Options)
317 -> pass_file(File, PassFile),
318 exists_file(PassFile)
319 ; true
320 ).
321
322
326
327:- dynamic
328 scasp_current_test/1. 329
330scasp_test(File, Result, Options) :-
331 option(cov_by_test(true), Options),
332 !,
333 collect_coverage(scasp_test(File, Result), File).
334scasp_test(File, Result, _Options) :-
335 scasp_test(File, Result).
336
337scasp_test(File, Trees-Models) :-
338 retractall(scasp_source_reference(_, _, _)),
339 scasp_load(File, [unknown(fail)]),
340 scasp_query(Query, Bindings, []),
341 findall(Pair, solve(Query, Bindings, Pair), Pairs),
342 pairs_keys_values(Pairs, Trees, Models).
343
344solve(Query, Bindings, Tree-Model) :-
345 solve(Query, [], StackOut, ModelOut),
346 justification_tree(StackOut, Tree, []),
347 canonical_model(ModelOut, Model),
348 All = t(Bindings, Model, Tree),
349 ovar_set_bindings(Bindings),
350 ovar_analyze_term(All),
351 inline_constraints(All, []).
352
353 356
357:- dynamic covers/3. 358
359:- meta_predicate
360 collect_coverage(0, +). 361
362collect_coverage(Goal, Test) :-
363 setup_call_cleanup(
364 asserta(scasp_current_test(Test), Ref),
365 show_coverage(Goal, []),
366 erase(Ref)).
367
368:- multifile
369 prolog_cover:report_hook/2. 370
371prolog_cover:report_hook(Succeeded, Failed) :-
372 scasp_current_test(Test),
373 cov_module(Module),
374 module_property(Module, file(Target)),
375 convlist(tag_clause(Module, Target, +), Succeeded, STagged),
376 convlist(tag_clause(Module, Target, -), Failed, FTagged),
377 append(STagged, FTagged, Tagged),
378 sort(Tagged, Which), 379 length(Which, N),
380 assertz(covers(Test, N, Which)).
381
382tag_clause(Module, File, Symbol, Clause, cov(Line, Symbol, PI)) :-
383 clause_property(Clause, file(File)),
384 clause_property(Clause, line_count(Line)),
385 clause_property(Clause, predicate(Module:PI)).
386
387covering_clauses(Options) :-
388 minimal_set_of_files(CoveredClauses, CoverContributions),
389 retractall(covers(_,_,_)),
390 sep_line,
391 format("Coverage contribution by file\n"),
392 format("~w ~`.t ~w~66| ~t~w~72|~n", ['File','Covers','New']),
393 maplist(list_contribution, CoverContributions),
394 sep_line,
395 include(contributes, CoverContributions, MinimalSetFiles),
396 maplist(arg(1), MinimalSetFiles, Files),
397 format("Running tests on this lot\n"),
398 select_option(cov_by_test(_), Options, Options1, false),
399 run_tests(Files, Options1),
400 sep_line,
401 format("List of Clauses \nClause ~`.t State~72|~n", []),
402 covered_clauses(CoveredClauses),
403 format("\nEnd of the report\n", []).
404
405sep_line :-
406 format("~n~`=t~78|~n", []).
407
408contributes(test(_File,_Covers,New)) :- New > 0.
409
410list_contribution(test(File,Covers,New)) :-
411 contrib_style(New, Style),
412 ansi_format(Style, "~w ~`.t ~d~66| ~t~d~72|~n", [File,Covers,New]).
413
414contrib_style(0, fg(127,127,127)) :- !.
415contrib_style(_, []).
416
417covered_clauses(CoveredClauses) :-
418 cov_module(Module),
419 findall(CIF, clause_in_module(Module, CIF), CIFs),
420 sort(1, =<, CIFs, OCIFs),
421 covered_clauses(OCIFs, CoveredClauses).
422
423clause_in_module(Module, cif(Line, PI)) :-
424 module_property(Module, file(File)),
425 prolog_cover:clause_source(Clause, File, Line),
426 clause_property(Clause, predicate(Module:PI)),
427 \+ ( PI = (Name/_Arity),
428 sub_atom(Name, 0, _, _, $)
429 ).
430
431covered_clauses([], _).
432covered_clauses([cif(L, P)|RestC], Covered) :-
433 ( memberchk(cov(L,+,P), Covered)
434 -> Message = 'COVERED'
435 ; memberchk(cov(L,-,P), Covered)
436 -> Message = 'NEG COVERED'
437 ; Message = 'NO'
438 ),
439 format("~t~d~4| ~q ~46t ~w~72|~n", [L, P, Message]),
440 covered_clauses(RestC, Covered).
441
446
447minimal_set_of_files(SetOfClauses, [test(F0,N0,N0)|CFiles]) :-
448 findall(t(N,File,Which), covers(File, N, Which), Covering),
449 sort(Covering, [t(N0, F0, S0)|RestF]),
450 grow_minimal_set(RestF, CFiles, S0, SClausesCovered),
451 sort(SClausesCovered, SetOfClauses).
452
453grow_minimal_set([], [], S, S).
454grow_minimal_set([t(N1,F1,S1)|RestF], [test(F1,N1,NewCount)|CFiles],
455 Clauses0, Clauses) :-
456 ord_subtract(S1, Clauses0, New),
457 length(New, NewCount),
458 ord_union(S1, Clauses0, Clauses1),
459 grow_minimal_set(RestF, CFiles, Clauses1, Clauses)