Commit | Line | Data |
---|---|---|
0708f913 C |
1 | (* |
2 | * Copyright 2005-2009, 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. | |
5 | * | |
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. | |
9 | * | |
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. | |
14 | * | |
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/>. | |
17 | * | |
18 | * The authors reserve the right to distribute this or future versions of | |
19 | * Coccinelle under other licenses. | |
20 | *) | |
21 | ||
22 | ||
23 | open Common | |
24 | ||
25 | (*****************************************************************************) | |
26 | (* Test framework *) | |
27 | (*****************************************************************************) | |
28 | ||
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 | |
31 | * base_vernn.[c,res]. | |
32 | * | |
33 | * If want to test without iso, use -iso_file empty.iso option. | |
34 | *) | |
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 | |
38 | ||
39 | let cfile = "tests/" ^ x ^ ".c" in | |
40 | let cocci_file = "tests/" ^ base ^ ".cocci" in | |
41 | ||
42 | let expected_res = "tests/" ^ x ^ ".res" in | |
43 | begin | |
44 | let res = Cocci.full_engine (cocci_file, !Config.std_iso) [cfile] in | |
45 | let generated = | |
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"); | |
50 | ||
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); | |
54 | tmpfile | |
55 | | Some None -> | |
56 | pr2 "no modification on the input file"; | |
57 | cfile | |
58 | | None -> raise Impossible | |
59 | in | |
60 | if compare_with_expected_flag | |
61 | then | |
62 | Compare_c.compare_default generated expected_res | |
63 | +> Compare_c.compare_result_to_string | |
64 | +> pr2; | |
65 | end | |
66 | ||
67 | ||
68 | (* ------------------------------------------------------------------------ *) | |
69 | let testall () = | |
70 | ||
71 | let newscore = empty_score () in | |
72 | ||
73 | let expected_result_files = | |
74 | Common.glob "tests/*.res" | |
75 | +> List.filter (fun f -> Common.filesize f > 0) | |
76 | +> List.map Filename.basename | |
77 | +> List.sort compare | |
78 | in | |
79 | ||
80 | begin | |
81 | expected_result_files +> List.iter (fun res -> | |
82 | let x = if res =~ "\\(.*\\).res" then matched1 res else raise Impossible | |
83 | in | |
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 | |
88 | ||
89 | let timeout_testall = 30 in | |
90 | ||
91 | try ( | |
92 | Common.timeout_function timeout_testall (fun () -> | |
93 | ||
94 | let xs = Cocci.full_engine (cocci_file, !Config.std_iso) [cfile] in | |
95 | let generated = | |
96 | match List.assoc cfile xs with | |
97 | | Some generated -> generated | |
98 | | None -> cfile | |
99 | in | |
100 | ||
101 | let (correct, diffxs) = Compare_c.compare_default generated expected | |
102 | in | |
103 | ||
104 | pr2 res; | |
105 | (* I don't use Compare_c.compare_result_to_string because | |
106 | * I want to indent a little more the messages. | |
107 | *) | |
108 | (match correct with | |
109 | | Compare_c.Correct -> Hashtbl.add newscore res Common.Ok; | |
110 | | Compare_c.Pb s -> | |
111 | let s = Str.global_replace | |
112 | (Str.regexp "\"/tmp/cocci-output.*\"") "<COCCIOUTPUTFILE>" s | |
113 | in | |
114 | let s = | |
115 | "INCORRECT:" ^ s ^ "\n" ^ | |
116 | " diff (result(<) vs expected_result(>)) = \n" ^ | |
117 | (diffxs +> List.map(fun s -> " "^s^"\n") +> Common.join "") | |
118 | in | |
119 | Hashtbl.add newscore res (Common.Pb s) | |
120 | | Compare_c.PbOnlyInNotParsedCorrectly s -> | |
121 | let s = | |
122 | "seems incorrect, but only because of code that " ^ | |
123 | "was not parsable" ^ s | |
124 | in | |
125 | Hashtbl.add newscore res (Common.Pb s) | |
126 | ) | |
127 | ) | |
128 | ) | |
129 | with exn -> | |
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) | |
133 | ); | |
134 | ||
135 | ||
136 | pr2 "--------------------------------"; | |
137 | pr2 "statistics"; | |
138 | pr2 "--------------------------------"; | |
139 | ||
140 | Common.hash_to_list newscore +> List.iter (fun (s, v) -> | |
141 | pr_no_nl (Printf.sprintf "%-30s: " s); | |
142 | pr_no_nl ( | |
143 | match v with | |
144 | | Common.Ok -> "CORRECT\n" | |
145 | | Common.Pb s -> s | |
146 | ) | |
147 | ); | |
148 | flush stdout; flush stderr; | |
149 | ||
150 | pr2 "--------------------------------"; | |
151 | pr2 "regression testing information"; | |
152 | pr2 "--------------------------------"; | |
153 | Common.regression_testing newscore | |
154 | (Filename.concat Config.path "tests/score_cocci_best.marshalled"); | |
155 | ||
156 | ||
157 | pr2 "--------------------------------"; | |
158 | pr2 "total score"; | |
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 | |
163 | in | |
164 | ||
165 | pr2 (sprintf "good = %d/%d" good total); | |
166 | ||
167 | end | |
168 | ||
169 | (* ------------------------------------------------------------------------ *) | |
170 | ||
171 | type okfailed = Ok | SpatchOK | Failed | |
172 | ||
173 | (* test_to_string *) | |
174 | let t_to_s = function | |
175 | | Ok -> ".ok" | |
176 | | SpatchOK -> ".spatch_ok" | |
177 | | Failed -> ".failed" | |
178 | ||
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) | |
182 | ) | |
183 | ||
184 | (* quite similar to compare_with_expected below *) | |
185 | let test_okfailed cocci_file cfiles = | |
186 | cfiles +> List.iter delete_previous_result_files; | |
187 | ||
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 | |
191 | * full_engine. *) | |
192 | let final_files = ref [] in | |
193 | ||
194 | ||
195 | let newout = | |
196 | Common.new_temp_file "cocci" ".stdout" | |
197 | in | |
198 | ||
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 | |
205 | in | |
206 | ||
207 | Common.redirect_stdout_stderr newout (fun () -> | |
208 | try ( | |
209 | Common.timeout_function_opt !Flag_cocci.timeout (fun () -> | |
210 | ||
211 | ||
212 | let outfiles = Cocci.full_engine (cocci_file, !Config.std_iso) cfiles | |
213 | in | |
214 | ||
215 | let time_str = time_per_file_str () in | |
216 | ||
217 | outfiles +> List.iter (fun (infile, outopt) -> | |
218 | let (dir, base, ext) = Common.dbe_of_filename infile in | |
219 | let expected_suffix = | |
220 | match ext with | |
221 | | "c" -> "res" | |
222 | | "h" -> "h.res" | |
223 | | s -> pr2 ("WIERD: not a .c or .h :" ^ base ^ "." ^ s); | |
224 | "" (* no extension, will compare to same file *) | |
225 | in | |
226 | let expected_res = | |
227 | Common.filename_of_dbe (dir, base, expected_suffix) in | |
228 | let expected_res2 = | |
229 | Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) | |
230 | in | |
231 | ||
232 | (* can delete more than the first delete_previous_result_files | |
233 | * because here we can have more files than in cfiles, for instance | |
234 | * the header files | |
235 | *) | |
236 | delete_previous_result_files infile; | |
237 | ||
238 | match outopt, Common.lfile_exists expected_res with | |
239 | | None, false -> | |
240 | () | |
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 | |
244 | ||
245 | | x, true -> | |
246 | let outfile = | |
247 | match x with | |
248 | | Some outfile -> outfile | |
249 | | None -> infile | |
250 | in | |
251 | ||
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 | |
256 | else | |
257 | if Common.lfile_exists expected_res2 | |
258 | then begin | |
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]) | |
263 | final_files | |
264 | else push2 (infile ^ (t_to_s Failed), [s2;s1;time_str]) | |
265 | final_files | |
266 | end | |
267 | else push2 (infile ^ (t_to_s Failed), [s1;time_str]) final_files | |
268 | ) | |
269 | ); | |
270 | ) | |
271 | with exn -> | |
272 | let clean s = | |
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") | |
277 | in | |
278 | let time_str = time_per_file_str () | |
279 | in | |
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. | |
283 | *) | |
284 | cfiles +> List.iter (fun infile -> | |
285 | push2 (infile ^ (t_to_s Failed), [s;time_str]) final_files; | |
286 | ); | |
287 | ); | |
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")) | |
292 | ); | |
293 | ||
294 | ) | |
295 | ||
296 | ||
297 | let test_regression_okfailed () = | |
298 | ||
299 | (* it's xxx.c.ok *) | |
300 | let chop_ext f = f +> Filename.chop_extension in | |
301 | ||
302 | let newscore = Common.empty_score () in | |
303 | let oks = | |
304 | Common.cmd_to_list ("find -name \"*.ok\"") | |
305 | ++ | |
306 | Common.cmd_to_list ("find -name \"*.spatch_ok\"") | |
307 | in | |
308 | let failed = Common.cmd_to_list ("find -name \"*.failed\"") in | |
309 | ||
310 | if null (oks ++ failed) | |
311 | then failwith "no ok/failed file, you certainly did a make clean" | |
312 | else begin | |
313 | oks +> List.iter (fun s -> | |
314 | Hashtbl.add newscore (chop_ext s) Common.Ok | |
315 | ); | |
316 | failed +> List.iter (fun s -> | |
317 | Hashtbl.add newscore (chop_ext s) (Common.Pb "fail") | |
318 | ); | |
319 | pr2 "--------------------------------"; | |
320 | pr2 "regression testing information"; | |
321 | pr2 "--------------------------------"; | |
322 | Common.regression_testing newscore ("score_failed.marshalled") | |
323 | end | |
324 | ||
325 | ||
326 | (* ------------------------------------------------------------------------ *) | |
327 | (* quite similar to test_ok_failed. Maybe could factorize code *) | |
328 | let compare_with_expected outfiles = | |
329 | pr2 ""; | |
330 | outfiles +> List.iter (fun (infile, outopt) -> | |
331 | let (dir, base, ext) = Common.dbe_of_filename infile in | |
332 | let expected_suffix = | |
333 | match ext with | |
334 | | "c" -> "res" | |
335 | | "h" -> "h.res" | |
336 | | s -> failwith ("wierd C file, not a .c or .h :" ^ s) | |
337 | in | |
338 | let expected_res = | |
339 | Common.filename_of_dbe (dir, base, expected_suffix) in | |
340 | let expected_res2 = | |
341 | Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) | |
342 | in | |
343 | ||
344 | match outopt, Common.lfile_exists expected_res with | |
345 | | None, false -> () | |
346 | | Some outfile, false -> | |
347 | let s =("PB: input file " ^ infile ^ " modified but no .res") in | |
348 | pr2 s | |
349 | | x, true -> | |
350 | let outfile = | |
351 | match x with | |
352 | | Some outfile -> outfile | |
353 | | None -> infile | |
354 | in | |
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) | |
359 | else | |
360 | if Common.lfile_exists expected_res2 | |
361 | then begin | |
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) | |
367 | end | |
368 | else pr2 (infile ^ " is failed " ^ s1) | |
369 | ) | |
370 | ||
371 | (*****************************************************************************) | |
372 | (* Subsystem testing *) | |
373 | (*****************************************************************************) | |
374 | ||
375 | let test_parse_cocci file = | |
376 | if not (file =~ ".*\\.cocci") | |
377 | then pr2 "warning: seems not a .cocci file"; | |
378 | ||
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)) | |
384 | grep_tokens; | |
385 | if !Flag.use_glimpse | |
386 | then match query with None -> pr "No query" | Some x -> pr x | |
387 | ||
388 | ||
389 | ||
390 | ||
391 | ||
392 | ||
393 | ||
394 | ||
395 | (*****************************************************************************) | |
396 | (* to be called by ocaml toplevel, to test. *) | |
397 | (*****************************************************************************) | |
398 | ||
399 | (* no point to memoize this one *) | |
400 | let sp_of_file file iso = Parse_cocci.process file iso false | |
401 | ||
402 | (* TODO: Remove | |
403 | *) | |
404 | ||
405 | (* | |
406 | let flows_of_ast astc = | |
407 | astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e) | |
408 | ||
409 | let one_flow flows = | |
410 | List.hd flows | |
411 | ||
412 | let one_ctl ctls = List.hd (List.hd ctls) | |
413 | *) | |
414 |