3 (*****************************************************************************)
5 (*****************************************************************************)
7 (* There can be multiple .c for the same cocci file. The convention
8 * is to have one base.cocci and a base.c and some optional
11 * If want to test without iso, use -iso_file empty.iso option.
13 let testone x compare_with_expected_flag
=
14 let x = if x =~
"\\(.*\\)_ver0$" then matched1
x else x in
15 let base = if x =~
"\\(.*\\)_ver[0-9]+$" then matched1
x else x in
17 let cfile = "tests/" ^
x ^
".c" in
18 let cocci_file = "tests/" ^
base ^
".cocci" in
20 let expected_res = "tests/" ^
x ^
".res" in
22 let cocci_infos = Cocci.pre_engine
(cocci_file, !Config.std_iso
) in
23 let res = Cocci.full_engine
cocci_infos [cfile] in
24 Cocci.post_engine
cocci_infos;
26 match Common.optionise
(fun () -> List.assoc
cfile res) with
27 | Some
(Some outfile
) ->
28 if List.length
res > 1
29 then pr2
("note that not just " ^
cfile ^
" was involved");
31 let tmpfile = "/tmp/"^
Common.basename
cfile in
32 pr2
(sprintf
"One file modified. Result is here: %s" tmpfile);
33 Common.command2
("mv "^outfile^
" "^
tmpfile);
36 pr2
"no modification on the input file";
38 | None
-> raise Impossible
40 if compare_with_expected_flag
42 Compare_c.compare_default
generated expected_res
43 +> Compare_c.compare_result_to_string
48 (* ------------------------------------------------------------------------ *)
49 (* note: if you get some weird results in -testall, and not in -test,
50 * it is possible that a test file work in -test but may not
51 * work while used inside a -testall. If we have some bugs in our
52 * parser that modify some global state and that those states
53 * are not reseted between each test file, then having run previous
54 * test files may have an influence on another test file which mean
55 * than a test may work in isolation (via -test) but not otherwise
56 * (via -testall). Fortunately such bugs are rare.
59 let testall ?
(expected_score_file
="tests/SCORE_expected.sexp") () =
61 let score = empty_score
() in
63 let expected_result_files =
64 Common.glob
"tests/*.res"
65 +> List.filter
(fun f
-> Common.filesize f
> 0)
66 +> List.map
Filename.basename
71 expected_result_files +> List.iter
(fun res ->
73 if res =~
"\\(.*\\).res" then matched1
res else raise Impossible
in
74 let base = if x =~
"\\(.*\\)_ver[0-9]+" then matched1
x else x in
75 let cfile = "tests/" ^
x ^
".c" in
76 let cocci_file = "tests/" ^
base ^
".cocci" in
77 let expected = "tests/" ^
res in
79 let timeout_testall = 30 in
82 Common.timeout_function
timeout_testall (fun () ->
86 let cocci_infos = Cocci.pre_engine
(cocci_file, !Config.std_iso
) in
87 let xs = Cocci.full_engine
cocci_infos [cfile] in
88 Cocci.post_engine
cocci_infos;
91 match List.assoc
cfile xs with
92 | Some
generated -> generated
96 let (correct
, diffxs
) = Compare_c.compare_default
generated expected
99 (* I don't use Compare_c.compare_result_to_string because
100 * I want to indent a little more the messages.
103 | Compare_c.Correct
-> Hashtbl.add
score res Common.Ok
;
105 let s = Str.global_replace
106 (Str.regexp
"\"/tmp/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
108 (* on macos the temporary files are stored elsewhere *)
109 let s = Str.global_replace
110 (Str.regexp
"\"/var/folders/.*/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
113 "INCORRECT:" ^
s ^
"\n" ^
114 " diff (result(<) vs expected_result(>)) = \n" ^
115 (diffxs
+> List.map
(fun s -> " "^
s^
"\n") +> Common.join
"")
117 Hashtbl.add
score res (Common.Pb
s)
118 | Compare_c.PbOnlyInNotParsedCorrectly
s ->
120 "seems incorrect, but only because of code that " ^
121 "was not parsable" ^
s
123 Hashtbl.add
score res (Common.Pb
s)
128 Common.reset_pr_indent
();
129 let s = "PROBLEM\n" ^
(" exn = " ^
Printexc.to_string exn ^
"\n") in
130 Hashtbl.add
score res (Common.Pb
s)
134 pr2
"--------------------------------";
136 pr2
"--------------------------------";
138 Common.hash_to_list
score +> List.iter
(fun (s, v
) ->
139 pr_no_nl
(Printf.sprintf
"%-30s: " s);
142 | Common.Ok
-> "CORRECT\n"
146 flush stdout
; flush stderr
;
148 pr2
"--------------------------------";
149 pr2
"regression testing information";
150 pr2
"--------------------------------";
152 (* now default argument of testall:
153 let expected_score_file = "tests/SCORE_expected.sexp" in
155 let expected_score_file_orig = "tests/SCORE_expected_orig.sexp" in
156 let best_of_both_file = "tests/SCORE_best_of_both.sexp" in
157 let actual_score_file = "tests/SCORE_actual.sexp" in
159 pr2
("regression file: "^
expected_score_file);
160 let (expected_score
: score) =
161 if Sys.file_exists
expected_score_file
163 let sexp = Sexp.load_sexp
expected_score_file in
164 Sexp_common.score_of_sexp
sexp
166 if Sys.file_exists
expected_score_file_orig
168 pr2
(spf
"use expected orig file (%s)" expected_score_file_orig);
169 Common.command2
(spf
"cp %s %s" expected_score_file_orig
170 expected_score_file);
171 let sexp = Sexp.load_sexp
expected_score_file in
172 Sexp_common.score_of_sexp
sexp
178 let new_bestscore = Common.regression_testing_vs
score expected_score
in
181 let xs = Common.hash_to_list
score in
182 let sexp = Sexp_common.sexp_of_score_list
xs in
183 let s_score = Sexp.to_string_hum
sexp in
184 Common.write_file ~file
:(actual_score_file) s_score;
186 let xs2 = Common.hash_to_list
new_bestscore in
187 let sexp2 = Sexp_common.sexp_of_score_list
xs2 in
188 let s_score2 = Sexp.to_string_hum
sexp2 in
189 Common.write_file ~file
:(best_of_both_file) s_score2;
191 Common.print_total_score
score;
193 let (good
, total
) = Common.total_scores
score in
194 let (expected_good
, expected_total
) = Common.total_scores expected_score
in
196 if good
= expected_good
198 pr2
"Current score is equal to expected score; everything is fine";
202 if good
< expected_good
204 pr2
"Current score is lower than expected :(";
205 pr2
(spf
"(was expecting %d but got %d)" expected_good good
);
207 pr2
"If you think it's normal, then maybe you need to update the";
208 pr2
(spf
"score file %s, copying info from %s."
209 expected_score_file actual_score_file);
213 pr2
"Current score is greater than expected :)";
214 pr2
(spf
"(was expecting %d but got %d)" expected_good good
);
215 pr2
"Generating new expected score file and saving old one";
216 Common.command2_y_or_no_exit_if_no
217 (spf
"mv %s %s" expected_score_file (expected_score_file ^
".save"));
218 Common.command2_y_or_no_exit_if_no
219 (spf
"mv %s %s" best_of_both_file expected_score_file);
225 (* ------------------------------------------------------------------------ *)
227 type okfailed
= Ok
| SpatchOK
| Failed
230 let t_to_s = function
232 | SpatchOK
-> ".spatch_ok"
233 | Failed
-> ".failed"
235 let delete_previous_result_files infile
=
236 [Ok
;SpatchOK
;Failed
] +> List.iter
(fun kind
->
237 Common.command2
("rm -f " ^ infile ^
t_to_s kind
)
240 (* quite similar to compare_with_expected below *)
241 let test_okfailed cocci_file cfiles
=
242 cfiles
+> List.iter
delete_previous_result_files;
244 (* final_files contain the name of an output file (a .ok or .failed
245 * or .spatch_ok), and also some additionnal strings to be printed in
246 * this output file in addition to the general error message of
248 let final_files = ref [] in
252 Common.new_temp_file
"cocci" ".stdout"
255 let t = Unix.gettimeofday
() in
256 let time_per_file_str () =
257 let t'
= Unix.gettimeofday
() in
258 let tdiff = t'
-. t in
259 let tperfile = tdiff /. (float_of_int
(List.length cfiles
)) in
260 spf
"time: %f" tperfile
263 Common.redirect_stdout_stderr
newout (fun () ->
265 Common.timeout_function_opt
!Flag_cocci.timeout
(fun () ->
267 let cocci_infos = Cocci.pre_engine
(cocci_file, !Config.std_iso
) in
268 let outfiles = Cocci.full_engine
cocci_infos cfiles
in
269 Cocci.post_engine
cocci_infos;
271 let time_str = time_per_file_str () in
273 outfiles +> List.iter
(fun (infile
, outopt
) ->
274 let (dir
, base, ext
) = Common.dbe_of_filename infile
in
275 let expected_suffix =
279 | s -> pr2
("WEIRD: not a .c or .h :" ^
base ^
"." ^
s);
280 "" (* no extension, will compare to same file *)
283 Common.filename_of_dbe
(dir
, base, expected_suffix) in
285 Common.filename_of_dbe
(dir
,"corrected_"^
base,expected_suffix)
288 (* can delete more than the first delete_previous_result_files
289 * because here we can have more files than in cfiles, for instance
292 delete_previous_result_files infile
;
294 match outopt
, Common.lfile_exists
expected_res with
297 | Some outfile
, false ->
298 let s =("PB: input file " ^ infile ^
" modified but no .res") in
299 push2
(infile^
t_to_s Failed
, [s;time_str]) final_files
304 | Some
outfile -> outfile
308 let diff = Compare_c.compare_default
outfile expected_res in
309 let s1 = (Compare_c.compare_result_to_string
diff) in
310 if fst
diff =*= Compare_c.Correct
311 then push2
(infile ^
(t_to_s Ok
), [s1;time_str]) final_files
313 if Common.lfile_exists
expected_res2
315 let diff = Compare_c.compare_default
outfile expected_res2 in
316 let s2 = Compare_c.compare_result_to_string
diff in
317 if fst
diff =*= Compare_c.Correct
318 then push2
(infile ^
(t_to_s SpatchOK
),[s2;s1;time_str])
320 else push2
(infile ^
(t_to_s Failed
), [s2;s1;time_str])
323 else push2
(infile ^
(t_to_s Failed
), [s1;time_str]) final_files
329 Str.global_replace
(Str.regexp
"\\\\n") "\n"
330 (Str.global_replace
(Str.regexp
("\\\\\"")) "\""
331 (Str.global_replace
(Str.regexp
"\\\\t") "\t" s)) in
332 let s = "PROBLEM\n"^
(" exn = " ^
clean(Printexc.to_string exn
) ^
"\n")
334 let time_str = time_per_file_str ()
336 (* we may miss some file because cfiles is shorter than outfiles.
337 * For instance the detected local headers are not in cfiles, so
338 * may have less failed. But at least have some failed.
340 cfiles
+> List.iter
(fun infile
->
341 push2
(infile ^
(t_to_s Failed
), [s;time_str]) final_files;
344 !final_files +> List.iter
(fun (file
, additional_strs
) ->
345 Common.command2
("cp " ^
newout ^
" " ^ file
);
346 with_open_outfile file
(fun (pr
, chan
) ->
347 additional_strs
+> List.iter
(fun s -> pr
(s ^
"\n"))
353 let test_regression_okfailed () =
356 let chop_ext f
= f
+> Filename.chop_extension
in
358 let newscore = Common.empty_score
() in
360 Common.cmd_to_list
("find -name \"*.ok\"")
362 Common.cmd_to_list
("find -name \"*.spatch_ok\"")
364 let failed = Common.cmd_to_list
("find -name \"*.failed\"") in
366 if null
(oks ++ failed)
367 then failwith
"no ok/failed file, you certainly did a make clean"
369 oks +> List.iter
(fun s ->
370 Hashtbl.add
newscore (chop_ext s) Common.Ok
372 failed +> List.iter
(fun s ->
373 Hashtbl.add
newscore (chop_ext s) (Common.Pb
"fail")
375 pr2
"--------------------------------";
376 pr2
"regression testing information";
377 pr2
"--------------------------------";
378 Common.regression_testing
newscore ("score_failed.marshalled")
382 (* ------------------------------------------------------------------------ *)
383 (* quite similar to test_ok_failed. Maybe could factorize code *)
384 let compare_with_expected outfiles =
386 outfiles +> List.iter
(fun (infile
, outopt
) ->
387 let (dir
, base, ext
) = Common.dbe_of_filename infile
in
388 let expected_suffix =
392 | s -> failwith
("weird C file, not a .c or .h :" ^
s)
395 Common.filename_of_dbe
(dir
, base, expected_suffix) in
397 Common.filename_of_dbe
(dir
,"corrected_"^
base,expected_suffix)
400 match outopt
, Common.lfile_exists
expected_res with
402 | Some
outfile, false ->
403 let s =("PB: input file " ^ infile ^
" modified but no .res") in
408 | Some
outfile -> outfile
411 let diff = Compare_c.compare_default
outfile expected_res in
412 let s1 = (Compare_c.compare_result_to_string
diff) in
413 if fst
diff =*= Compare_c.Correct
414 then pr2_no_nl
(infile ^
" " ^
s1)
416 if Common.lfile_exists
expected_res2
418 let diff = Compare_c.compare_default
outfile expected_res2 in
419 let s2 = Compare_c.compare_result_to_string
diff in
420 if fst
diff =*= Compare_c.Correct
421 then pr2
(infile ^
" is spatchOK " ^
s2)
422 else pr2
(infile ^
" is failed " ^
s2)
424 else pr2
(infile ^
" is failed " ^
s1)
427 (*****************************************************************************)
428 (* Subsystem testing *)
429 (*****************************************************************************)
431 let test_parse_cocci file
=
432 if not
(file
=~
".*\\.cocci")
433 then pr2
"warning: seems not a .cocci file";
435 let (_
,xs,_
,_
,_
,_
,grep_tokens
,query
) =
436 Parse_cocci.process file
(Some
!Config.std_iso
) false in
437 xs +> List.iter
Pretty_print_cocci.unparse
;
438 Printf.printf
"grep tokens\n";
439 List.iter
(function x -> Printf.printf
"%s\n" (String.concat
" " x))
441 match !Flag.scanner
with
443 | Flag.Glimpse
| Flag.Google _
->
445 None
-> pr
"No query"
446 | Some
x -> pr
(String.concat
" || " x))
450 (*****************************************************************************)
451 (* to be called by ocaml toplevel, to test. *)
452 (*****************************************************************************)
454 (* no point to memoize this one *)
455 let sp_of_file file iso
= Parse_cocci.process file iso
false
461 let flows_of_ast astc =
462 astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e)
467 let one_ctl ctls = List.hd (List.hd ctls)