2 * Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
25 (*****************************************************************************)
27 (*****************************************************************************)
29 (* There can be multiple .c for the same cocci file. The convention
30 * is to have one base.cocci and a base.c and some optional
33 * If want to test without iso, use -iso_file empty.iso option.
35 let testone x compare_with_expected_flag
=
36 let x = if x =~
"\\(.*\\)_ver0$" then matched1
x else x in
37 let base = if x =~
"\\(.*\\)_ver[0-9]+$" then matched1
x else x in
39 let cfile = "tests/" ^
x ^
".c" in
40 let cocci_file = "tests/" ^
base ^
".cocci" in
42 let expected_res = "tests/" ^
x ^
".res" in
44 let res = Cocci.full_engine
(cocci_file, !Config.std_iso
) [cfile] in
46 match Common.optionise
(fun () -> List.assoc
cfile res) with
47 | Some
(Some outfile
) ->
48 if List.length
res > 1
49 then pr2
("note that not just " ^
cfile ^
" was involved");
51 let tmpfile = "/tmp/"^
Common.basename
cfile in
52 pr2
(sprintf
"One file modified. Result is here: %s" tmpfile);
53 Common.command2
("mv "^outfile^
" "^
tmpfile);
56 pr2
"no modification on the input file";
58 | None
-> raise Impossible
60 if compare_with_expected_flag
62 Compare_c.compare_default
generated expected_res
63 +> Compare_c.compare_result_to_string
68 (* ------------------------------------------------------------------------ *)
71 let newscore = empty_score
() in
73 let expected_result_files =
74 Common.glob
"tests/*.res"
75 +> List.filter
(fun f
-> Common.filesize f
> 0)
76 +> List.map
Filename.basename
81 expected_result_files +> List.iter
(fun res ->
82 let x = if res =~
"\\(.*\\).res" then matched1
res else raise Impossible
84 let base = if x =~
"\\(.*\\)_ver[0-9]+" then matched1
x else x in
85 let cfile = "tests/" ^
x ^
".c" in
86 let cocci_file = "tests/" ^
base ^
".cocci" in
87 let expected = "tests/" ^
res in
89 let timeout_testall = 30 in
92 Common.timeout_function
timeout_testall (fun () ->
94 let xs = Cocci.full_engine
(cocci_file, !Config.std_iso
) [cfile] in
96 match List.assoc
cfile xs with
97 | Some
generated -> generated
101 let (correct
, diffxs
) = Compare_c.compare_default
generated expected
105 (* I don't use Compare_c.compare_result_to_string because
106 * I want to indent a little more the messages.
109 | Compare_c.Correct
-> Hashtbl.add
newscore res Common.Ok
;
111 let s = Str.global_replace
112 (Str.regexp
"\"/tmp/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
115 "INCORRECT:" ^
s ^
"\n" ^
116 " diff (result(<) vs expected_result(>)) = \n" ^
117 (diffxs
+> List.map
(fun s -> " "^
s^
"\n") +> Common.join
"")
119 Hashtbl.add
newscore res (Common.Pb
s)
120 | Compare_c.PbOnlyInNotParsedCorrectly
s ->
122 "seems incorrect, but only because of code that " ^
123 "was not parsable" ^
s
125 Hashtbl.add
newscore res (Common.Pb
s)
130 Common.reset_pr_indent
();
131 let s = "PROBLEM\n" ^
(" exn = " ^
Printexc.to_string exn ^
"\n") in
132 Hashtbl.add
newscore res (Common.Pb
s)
136 pr2
"--------------------------------";
138 pr2
"--------------------------------";
140 Common.hash_to_list
newscore +> List.iter
(fun (s, v
) ->
141 pr_no_nl
(Printf.sprintf
"%-30s: " s);
144 | Common.Ok
-> "CORRECT\n"
148 flush stdout
; flush stderr
;
150 pr2
"--------------------------------";
151 pr2
"regression testing information";
152 pr2
"--------------------------------";
153 Common.regression_testing
newscore
154 (Filename.concat
Config.path
"tests/score_cocci_best.marshalled");
157 pr2
"--------------------------------";
159 pr2
"--------------------------------";
160 let total = Common.hash_to_list
newscore +> List.length
in
161 let good = Common.hash_to_list
newscore +> List.filter
162 (fun (s, v
) -> v
= Ok
) +> List.length
165 pr2
(sprintf
"good = %d/%d" good total);
169 (* ------------------------------------------------------------------------ *)
171 type okfailed
= Ok
| SpatchOK
| Failed
174 let t_to_s = function
176 | SpatchOK
-> ".spatch_ok"
177 | Failed
-> ".failed"
179 let delete_previous_result_files infile
=
180 [Ok
;SpatchOK
;Failed
] +> List.iter
(fun kind
->
181 Common.command2
("rm -f " ^ infile ^
t_to_s kind
)
184 (* quite similar to compare_with_expected below *)
185 let test_okfailed cocci_file cfiles
=
186 cfiles
+> List.iter
delete_previous_result_files;
188 (* final_files contain the name of an output file (a .ok or .failed
189 * or .spatch_ok), and also some additionnal strings to be printed in
190 * this output file in addition to the general error message of
192 let final_files = ref [] in
196 Common.new_temp_file
"cocci" ".stdout"
199 let t = Unix.gettimeofday
() in
200 let time_per_file_str () =
201 let t'
= Unix.gettimeofday
() in
202 let tdiff = t'
-. t in
203 let tperfile = tdiff /. (float_of_int
(List.length cfiles
)) in
204 spf
"time: %f" tperfile
207 Common.redirect_stdout_stderr
newout (fun () ->
209 Common.timeout_function_opt
!Flag_cocci.timeout
(fun () ->
212 let outfiles = Cocci.full_engine
(cocci_file, !Config.std_iso
) cfiles
215 let time_str = time_per_file_str () in
217 outfiles +> List.iter
(fun (infile
, outopt
) ->
218 let (dir
, base, ext
) = Common.dbe_of_filename infile
in
219 let expected_suffix =
223 | s -> pr2
("WIERD: not a .c or .h :" ^
base ^
"." ^
s);
224 "" (* no extension, will compare to same file *)
227 Common.filename_of_dbe
(dir
, base, expected_suffix) in
229 Common.filename_of_dbe
(dir
,"corrected_"^
base,expected_suffix)
232 (* can delete more than the first delete_previous_result_files
233 * because here we can have more files than in cfiles, for instance
236 delete_previous_result_files infile
;
238 match outopt
, Common.lfile_exists
expected_res with
241 | Some outfile
, false ->
242 let s =("PB: input file " ^ infile ^
" modified but no .res") in
243 push2
(infile^
t_to_s Failed
, [s;time_str]) final_files
248 | Some
outfile -> outfile
252 let diff = Compare_c.compare_default
outfile expected_res in
253 let s1 = (Compare_c.compare_result_to_string
diff) in
254 if fst
diff = Compare_c.Correct
255 then push2
(infile ^
(t_to_s Ok
), [s1;time_str]) final_files
257 if Common.lfile_exists
expected_res2
259 let diff = Compare_c.compare_default
outfile expected_res2 in
260 let s2 = Compare_c.compare_result_to_string
diff in
261 if fst
diff = Compare_c.Correct
262 then push2
(infile ^
(t_to_s SpatchOK
),[s2;s1;time_str])
264 else push2
(infile ^
(t_to_s Failed
), [s2;s1;time_str])
267 else push2
(infile ^
(t_to_s Failed
), [s1;time_str]) final_files
273 Str.global_replace
(Str.regexp
"\\\\n") "\n"
274 (Str.global_replace
(Str.regexp
("\\\\\"")) "\""
275 (Str.global_replace
(Str.regexp
"\\\\t") "\t" s)) in
276 let s = "PROBLEM\n"^
(" exn = " ^
clean(Printexc.to_string exn
) ^
"\n")
278 let time_str = time_per_file_str ()
280 (* we may miss some file because cfiles is shorter than outfiles.
281 * For instance the detected local headers are not in cfiles, so
282 * may have less failed. But at least have some failed.
284 cfiles
+> List.iter
(fun infile
->
285 push2
(infile ^
(t_to_s Failed
), [s;time_str]) final_files;
288 !final_files +> List.iter
(fun (file
, additional_strs
) ->
289 Common.command2
("cp " ^
newout ^
" " ^ file
);
290 with_open_outfile file
(fun (pr
, chan
) ->
291 additional_strs
+> List.iter
(fun s -> pr
(s ^
"\n"))
297 let test_regression_okfailed () =
300 let chop_ext f
= f
+> Filename.chop_extension
in
302 let newscore = Common.empty_score
() in
304 Common.cmd_to_list
("find -name \"*.ok\"")
306 Common.cmd_to_list
("find -name \"*.spatch_ok\"")
308 let failed = Common.cmd_to_list
("find -name \"*.failed\"") in
310 if null
(oks ++ failed)
311 then failwith
"no ok/failed file, you certainly did a make clean"
313 oks +> List.iter
(fun s ->
314 Hashtbl.add
newscore (chop_ext s) Common.Ok
316 failed +> List.iter
(fun s ->
317 Hashtbl.add
newscore (chop_ext s) (Common.Pb
"fail")
319 pr2
"--------------------------------";
320 pr2
"regression testing information";
321 pr2
"--------------------------------";
322 Common.regression_testing
newscore ("score_failed.marshalled")
326 (* ------------------------------------------------------------------------ *)
327 (* quite similar to test_ok_failed. Maybe could factorize code *)
328 let compare_with_expected outfiles =
330 outfiles +> List.iter
(fun (infile
, outopt
) ->
331 let (dir
, base, ext
) = Common.dbe_of_filename infile
in
332 let expected_suffix =
336 | s -> failwith
("wierd C file, not a .c or .h :" ^
s)
339 Common.filename_of_dbe
(dir
, base, expected_suffix) in
341 Common.filename_of_dbe
(dir
,"corrected_"^
base,expected_suffix)
344 match outopt
, Common.lfile_exists
expected_res with
346 | Some
outfile, false ->
347 let s =("PB: input file " ^ infile ^
" modified but no .res") in
352 | Some
outfile -> outfile
355 let diff = Compare_c.compare_default
outfile expected_res in
356 let s1 = (Compare_c.compare_result_to_string
diff) in
357 if fst
diff = Compare_c.Correct
358 then pr2_no_nl
(infile ^
" " ^
s1)
360 if Common.lfile_exists
expected_res2
362 let diff = Compare_c.compare_default
outfile expected_res2 in
363 let s2 = Compare_c.compare_result_to_string
diff in
364 if fst
diff = Compare_c.Correct
365 then pr2
(infile ^
" is spatchOK " ^
s2)
366 else pr2
(infile ^
" is failed " ^
s2)
368 else pr2
(infile ^
" is failed " ^
s1)
371 (*****************************************************************************)
372 (* Subsystem testing *)
373 (*****************************************************************************)
375 let test_parse_cocci file
=
376 if not
(file
=~
".*\\.cocci")
377 then pr2
"warning: seems not a .cocci file";
379 let (xs,_
,_
,_
,_
,grep_tokens
,query
) =
380 Parse_cocci.process file
(Some
!Config.std_iso
) false in
381 xs +> List.iter
Pretty_print_cocci.unparse
;
382 Printf.printf
"grep tokens\n";
383 List.iter
(function x -> Printf.printf
"%s\n" (String.concat
" " x))
386 then match query
with None
-> pr
"No query" | Some
x -> pr
x
395 (*****************************************************************************)
396 (* to be called by ocaml toplevel, to test. *)
397 (*****************************************************************************)
399 (* no point to memoize this one *)
400 let sp_of_file file iso
= Parse_cocci.process file iso
false
403 let (rule_elem_of_string: string -> filename option -> Ast_cocci.rule_elem) =
406 Common.write_file ("/tmp/__cocci.cocci") (s);
407 let (astcocci, _,_,_,_,_) = sp_of_file ("/tmp/__cocci.cocci") iso in
410 List.hd +> (function (_,_,x) -> List.hd x) +> (function x ->
411 match Ast_cocci.unwrap x with
412 | Ast_cocci.CODE stmt_dots -> Ast_cocci.undots stmt_dots +> List.hd
413 | _ -> raise Not_found)
415 match Ast_cocci.unwrap stmt with
416 | Ast_cocci.Atomic(re) -> re
417 | _ -> failwith "only atomic patterns allowed"
422 let flows_of_ast astc =
423 astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e)
428 let one_ctl ctls = List.hd (List.hd ctls)