| 1 | (* |
| 2 | * Copyright 2010, INRIA, University of Copenhagen |
| 3 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix |
| 4 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen |
| 5 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix |
| 6 | * This file is part of Coccinelle. |
| 7 | * |
| 8 | * Coccinelle is free software: you can redistribute it and/or modify |
| 9 | * it under the terms of the GNU General Public License as published by |
| 10 | * the Free Software Foundation, according to version 2 of the License. |
| 11 | * |
| 12 | * Coccinelle is distributed in the hope that it will be useful, |
| 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | * GNU General Public License for more details. |
| 16 | * |
| 17 | * You should have received a copy of the GNU General Public License |
| 18 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. |
| 19 | * |
| 20 | * The authors reserve the right to distribute this or future versions of |
| 21 | * Coccinelle under other licenses. |
| 22 | *) |
| 23 | |
| 24 | |
| 25 | open Common |
| 26 | open Sexplib |
| 27 | |
| 28 | (*****************************************************************************) |
| 29 | (* Test framework *) |
| 30 | (*****************************************************************************) |
| 31 | |
| 32 | (* There can be multiple .c for the same cocci file. The convention |
| 33 | * is to have one base.cocci and a base.c and some optional |
| 34 | * base_vernn.[c,res]. |
| 35 | * |
| 36 | * If want to test without iso, use -iso_file empty.iso option. |
| 37 | *) |
| 38 | let testone prefix x compare_with_expected_flag = |
| 39 | let x = if x =~ "\\(.*\\)_ver0$" then matched1 x else x in |
| 40 | let base = if x =~ "\\(.*\\)_ver[0-9]+$" then matched1 x else x in |
| 41 | |
| 42 | let cfile = prefix ^ x ^ ".c" in |
| 43 | let cocci_file = prefix ^ base ^ ".cocci" in |
| 44 | |
| 45 | let expected_res = prefix ^ x ^ ".res" in |
| 46 | begin |
| 47 | let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in |
| 48 | let res = Cocci.full_engine cocci_infos [cfile] in |
| 49 | Cocci.post_engine cocci_infos; |
| 50 | let generated = |
| 51 | match Common.optionise (fun () -> List.assoc cfile res) with |
| 52 | | Some (Some outfile) -> |
| 53 | if List.length res > 1 |
| 54 | then pr2 ("note that not just " ^ cfile ^ " was involved"); |
| 55 | |
| 56 | let tmpfile = "/tmp/"^Common.basename cfile in |
| 57 | pr2 (sprintf "One file modified. Result is here: %s" tmpfile); |
| 58 | Common.command2 ("mv "^outfile^" "^tmpfile); |
| 59 | tmpfile |
| 60 | | Some None -> |
| 61 | pr2 "no modification on the input file"; |
| 62 | cfile |
| 63 | | None -> raise Impossible |
| 64 | in |
| 65 | if compare_with_expected_flag |
| 66 | then |
| 67 | Compare_c.compare_default generated expected_res |
| 68 | +> Compare_c.compare_result_to_string |
| 69 | +> pr2; |
| 70 | end |
| 71 | |
| 72 | |
| 73 | (* ------------------------------------------------------------------------ *) |
| 74 | (* note: if you get some weird results in -testall, and not in -test, |
| 75 | * it is possible that a test file work in -test but may not |
| 76 | * work while used inside a -testall. If we have some bugs in our |
| 77 | * parser that modify some global state and that those states |
| 78 | * are not reseted between each test file, then having run previous |
| 79 | * test files may have an influence on another test file which mean |
| 80 | * than a test may work in isolation (via -test) but not otherwise |
| 81 | * (via -testall). Fortunately such bugs are rare. |
| 82 | * |
| 83 | *) |
| 84 | let testall ?(expected_score_file="tests/SCORE_expected.sexp") () = |
| 85 | |
| 86 | let score = empty_score () in |
| 87 | |
| 88 | let expected_result_files = |
| 89 | Common.glob "tests/*.res" |
| 90 | +> List.filter (fun f -> Common.filesize f > 0) |
| 91 | +> List.map Filename.basename |
| 92 | +> List.sort compare |
| 93 | in |
| 94 | |
| 95 | begin |
| 96 | expected_result_files +> List.iter (fun res -> |
| 97 | let x = |
| 98 | if res =~ "\\(.*\\).res" then matched1 res else raise Impossible in |
| 99 | let base = if x =~ "\\(.*\\)_ver[0-9]+" then matched1 x else x in |
| 100 | let cfile = "tests/" ^ x ^ ".c" in |
| 101 | let cocci_file = "tests/" ^ base ^ ".cocci" in |
| 102 | let expected = "tests/" ^ res in |
| 103 | |
| 104 | let timeout_testall = 30 in |
| 105 | |
| 106 | try ( |
| 107 | Common.timeout_function timeout_testall (fun () -> |
| 108 | |
| 109 | pr2 res; |
| 110 | |
| 111 | let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in |
| 112 | let xs = Cocci.full_engine cocci_infos [cfile] in |
| 113 | Cocci.post_engine cocci_infos; |
| 114 | |
| 115 | let generated = |
| 116 | match List.assoc cfile xs with |
| 117 | | Some generated -> generated |
| 118 | | None -> cfile |
| 119 | in |
| 120 | |
| 121 | let (correct, diffxs) = Compare_c.compare_default generated expected |
| 122 | in |
| 123 | |
| 124 | (* I don't use Compare_c.compare_result_to_string because |
| 125 | * I want to indent a little more the messages. |
| 126 | *) |
| 127 | (match correct with |
| 128 | | Compare_c.Correct -> Hashtbl.add score res Common.Ok; |
| 129 | | Compare_c.Pb s -> |
| 130 | let s = Str.global_replace |
| 131 | (Str.regexp "\"/tmp/cocci-output.*\"") "<COCCIOUTPUTFILE>" s |
| 132 | in |
| 133 | (* on macos the temporary files are stored elsewhere *) |
| 134 | let s = Str.global_replace |
| 135 | (Str.regexp "\"/var/folders/.*/cocci-output.*\"") "<COCCIOUTPUTFILE>" s |
| 136 | in |
| 137 | let s = |
| 138 | "INCORRECT:" ^ s ^ "\n" ^ |
| 139 | " diff (result(<) vs expected_result(>)) = \n" ^ |
| 140 | (diffxs +> List.map(fun s -> " "^s^"\n") +> Common.join "") |
| 141 | in |
| 142 | Hashtbl.add score res (Common.Pb s) |
| 143 | | Compare_c.PbOnlyInNotParsedCorrectly s -> |
| 144 | let s = |
| 145 | "seems incorrect, but only because of code that " ^ |
| 146 | "was not parsable" ^ s |
| 147 | in |
| 148 | Hashtbl.add score res (Common.Pb s) |
| 149 | ) |
| 150 | ) |
| 151 | ) |
| 152 | with exn -> |
| 153 | Common.reset_pr_indent(); |
| 154 | let s = "PROBLEM\n" ^ (" exn = " ^ Printexc.to_string exn ^ "\n") in |
| 155 | Hashtbl.add score res (Common.Pb s) |
| 156 | ); |
| 157 | |
| 158 | |
| 159 | pr2 "--------------------------------"; |
| 160 | pr2 "statistics"; |
| 161 | pr2 "--------------------------------"; |
| 162 | |
| 163 | Common.hash_to_list score +> List.iter (fun (s, v) -> |
| 164 | pr_no_nl (Printf.sprintf "%-30s: " s); |
| 165 | pr_no_nl ( |
| 166 | match v with |
| 167 | | Common.Ok -> "CORRECT\n" |
| 168 | | Common.Pb s -> s |
| 169 | ) |
| 170 | ); |
| 171 | flush stdout; flush stderr; |
| 172 | |
| 173 | pr2 "--------------------------------"; |
| 174 | pr2 "regression testing information"; |
| 175 | pr2 "--------------------------------"; |
| 176 | |
| 177 | (* now default argument of testall: |
| 178 | let expected_score_file = "tests/SCORE_expected.sexp" in |
| 179 | *) |
| 180 | let expected_score_file_orig = "tests/SCORE_expected_orig.sexp" in |
| 181 | let best_of_both_file = "tests/SCORE_best_of_both.sexp" in |
| 182 | let actual_score_file = "tests/SCORE_actual.sexp" in |
| 183 | |
| 184 | pr2 ("regression file: "^ expected_score_file); |
| 185 | let (expected_score : score) = |
| 186 | if Sys.file_exists expected_score_file |
| 187 | then |
| 188 | let sexp = Sexp.load_sexp expected_score_file in |
| 189 | Sexp_common.score_of_sexp sexp |
| 190 | else |
| 191 | if Sys.file_exists expected_score_file_orig |
| 192 | then begin |
| 193 | pr2 (spf "use expected orig file (%s)" expected_score_file_orig); |
| 194 | Common.command2 (spf "cp %s %s" expected_score_file_orig |
| 195 | expected_score_file); |
| 196 | let sexp = Sexp.load_sexp expected_score_file in |
| 197 | Sexp_common.score_of_sexp sexp |
| 198 | end |
| 199 | else |
| 200 | empty_score() |
| 201 | in |
| 202 | |
| 203 | let new_bestscore = Common.regression_testing_vs score expected_score in |
| 204 | |
| 205 | |
| 206 | let xs = Common.hash_to_list score in |
| 207 | let sexp = Sexp_common.sexp_of_score_list xs in |
| 208 | let s_score = Sexp.to_string_hum sexp in |
| 209 | Common.write_file ~file:(actual_score_file) s_score; |
| 210 | |
| 211 | let xs2 = Common.hash_to_list new_bestscore in |
| 212 | let sexp2 = Sexp_common.sexp_of_score_list xs2 in |
| 213 | let s_score2 = Sexp.to_string_hum sexp2 in |
| 214 | Common.write_file ~file:(best_of_both_file) s_score2; |
| 215 | |
| 216 | Common.print_total_score score; |
| 217 | |
| 218 | let (good, total) = Common.total_scores score in |
| 219 | let (expected_good, expected_total) = Common.total_scores expected_score in |
| 220 | |
| 221 | if good = expected_good |
| 222 | then begin |
| 223 | pr2 "Current score is equal to expected score; everything is fine"; |
| 224 | raise (UnixExit 0); |
| 225 | end |
| 226 | else |
| 227 | if good < expected_good |
| 228 | then begin |
| 229 | pr2 "Current score is lower than expected :("; |
| 230 | pr2 (spf "(was expecting %d but got %d)" expected_good good); |
| 231 | pr2 ""; |
| 232 | pr2 "If you think it's normal, then maybe you need to update the"; |
| 233 | pr2 (spf "score file %s, copying info from %s." |
| 234 | expected_score_file actual_score_file); |
| 235 | raise (UnixExit 1); |
| 236 | end |
| 237 | else begin |
| 238 | pr2 "Current score is greater than expected :)"; |
| 239 | pr2 (spf "(was expecting %d but got %d)" expected_good good); |
| 240 | pr2 "Generating new expected score file and saving old one"; |
| 241 | Common.command2_y_or_no_exit_if_no |
| 242 | (spf "mv %s %s" expected_score_file (expected_score_file ^ ".save")); |
| 243 | Common.command2_y_or_no_exit_if_no |
| 244 | (spf "mv %s %s" best_of_both_file expected_score_file); |
| 245 | raise (UnixExit 0); |
| 246 | end |
| 247 | |
| 248 | end |
| 249 | |
| 250 | (* ------------------------------------------------------------------------ *) |
| 251 | |
| 252 | type okfailed = Ok | SpatchOK | Failed |
| 253 | |
| 254 | (* test_to_string *) |
| 255 | let t_to_s = function |
| 256 | | Ok -> ".ok" |
| 257 | | SpatchOK -> ".spatch_ok" |
| 258 | | Failed -> ".failed" |
| 259 | |
| 260 | let delete_previous_result_files infile = |
| 261 | [Ok;SpatchOK;Failed] +> List.iter (fun kind -> |
| 262 | Common.command2 ("rm -f " ^ infile ^ t_to_s kind) |
| 263 | ) |
| 264 | |
| 265 | (* quite similar to compare_with_expected below *) |
| 266 | let test_okfailed cocci_file cfiles = |
| 267 | cfiles +> List.iter delete_previous_result_files; |
| 268 | |
| 269 | (* final_files contain the name of an output file (a .ok or .failed |
| 270 | * or .spatch_ok), and also some additionnal strings to be printed in |
| 271 | * this output file in addition to the general error message of |
| 272 | * full_engine. *) |
| 273 | let final_files = ref [] in |
| 274 | |
| 275 | |
| 276 | let newout = |
| 277 | Common.new_temp_file "cocci" ".stdout" |
| 278 | in |
| 279 | |
| 280 | let t = Unix.gettimeofday () in |
| 281 | let time_per_file_str () = |
| 282 | let t' = Unix.gettimeofday () in |
| 283 | let tdiff = t' -. t in |
| 284 | let tperfile = tdiff /. (float_of_int (List.length cfiles)) in |
| 285 | spf "time: %f" tperfile |
| 286 | in |
| 287 | |
| 288 | Common.redirect_stdout_stderr newout (fun () -> |
| 289 | try ( |
| 290 | Common.timeout_function_opt !Flag_cocci.timeout (fun () -> |
| 291 | |
| 292 | let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in |
| 293 | let outfiles = Cocci.full_engine cocci_infos cfiles in |
| 294 | Cocci.post_engine cocci_infos; |
| 295 | |
| 296 | let time_str = time_per_file_str () in |
| 297 | |
| 298 | outfiles +> List.iter (fun (infile, outopt) -> |
| 299 | let (dir, base, ext) = Common.dbe_of_filename infile in |
| 300 | let expected_suffix = |
| 301 | match ext with |
| 302 | | "c" -> "res" |
| 303 | | "h" -> "h.res" |
| 304 | | s -> pr2 ("WEIRD: not a .c or .h :" ^ base ^ "." ^ s); |
| 305 | "" (* no extension, will compare to same file *) |
| 306 | in |
| 307 | let expected_res = |
| 308 | Common.filename_of_dbe (dir, base, expected_suffix) in |
| 309 | let expected_res2 = |
| 310 | Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) |
| 311 | in |
| 312 | |
| 313 | (* can delete more than the first delete_previous_result_files |
| 314 | * because here we can have more files than in cfiles, for instance |
| 315 | * the header files |
| 316 | *) |
| 317 | delete_previous_result_files infile; |
| 318 | |
| 319 | match outopt, Common.lfile_exists expected_res with |
| 320 | | None, false -> |
| 321 | () |
| 322 | | Some outfile, false -> |
| 323 | let s =("PB: input file " ^ infile ^ " modified but no .res") in |
| 324 | push2 (infile^t_to_s Failed, [s;time_str]) final_files |
| 325 | |
| 326 | | x, true -> |
| 327 | let outfile = |
| 328 | match x with |
| 329 | | Some outfile -> outfile |
| 330 | | None -> infile |
| 331 | in |
| 332 | |
| 333 | let diff = Compare_c.compare_default outfile expected_res in |
| 334 | let s1 = (Compare_c.compare_result_to_string diff) in |
| 335 | if fst diff =*= Compare_c.Correct |
| 336 | then push2 (infile ^ (t_to_s Ok), [s1;time_str]) final_files |
| 337 | else |
| 338 | if Common.lfile_exists expected_res2 |
| 339 | then begin |
| 340 | let diff = Compare_c.compare_default outfile expected_res2 in |
| 341 | let s2 = Compare_c.compare_result_to_string diff in |
| 342 | if fst diff =*= Compare_c.Correct |
| 343 | then push2 (infile ^ (t_to_s SpatchOK),[s2;s1;time_str]) |
| 344 | final_files |
| 345 | else push2 (infile ^ (t_to_s Failed), [s2;s1;time_str]) |
| 346 | final_files |
| 347 | end |
| 348 | else push2 (infile ^ (t_to_s Failed), [s1;time_str]) final_files |
| 349 | ) |
| 350 | ); |
| 351 | ) |
| 352 | with exn -> |
| 353 | let clean s = |
| 354 | Str.global_replace (Str.regexp "\\\\n") "\n" |
| 355 | (Str.global_replace (Str.regexp ("\\\\\"")) "\"" |
| 356 | (Str.global_replace (Str.regexp "\\\\t") "\t" s)) in |
| 357 | let s = "PROBLEM\n"^(" exn = " ^ clean(Printexc.to_string exn) ^ "\n") |
| 358 | in |
| 359 | let time_str = time_per_file_str () |
| 360 | in |
| 361 | (* we may miss some file because cfiles is shorter than outfiles. |
| 362 | * For instance the detected local headers are not in cfiles, so |
| 363 | * may have less failed. But at least have some failed. |
| 364 | *) |
| 365 | cfiles +> List.iter (fun infile -> |
| 366 | push2 (infile ^ (t_to_s Failed), [s;time_str]) final_files; |
| 367 | ); |
| 368 | ); |
| 369 | !final_files +> List.iter (fun (file, additional_strs) -> |
| 370 | Common.command2 ("cp " ^ newout ^ " " ^ file); |
| 371 | with_open_outfile file (fun (pr, chan) -> |
| 372 | additional_strs +> List.iter (fun s -> pr (s ^ "\n")) |
| 373 | ); |
| 374 | |
| 375 | ) |
| 376 | |
| 377 | |
| 378 | let test_regression_okfailed () = |
| 379 | |
| 380 | (* it's xxx.c.ok *) |
| 381 | let chop_ext f = f +> Filename.chop_extension in |
| 382 | |
| 383 | let newscore = Common.empty_score () in |
| 384 | let oks = |
| 385 | Common.cmd_to_list ("find -name \"*.ok\"") |
| 386 | ++ |
| 387 | Common.cmd_to_list ("find -name \"*.spatch_ok\"") |
| 388 | in |
| 389 | let failed = Common.cmd_to_list ("find -name \"*.failed\"") in |
| 390 | |
| 391 | if null (oks ++ failed) |
| 392 | then failwith "no ok/failed file, you certainly did a make clean" |
| 393 | else begin |
| 394 | oks +> List.iter (fun s -> |
| 395 | Hashtbl.add newscore (chop_ext s) Common.Ok |
| 396 | ); |
| 397 | failed +> List.iter (fun s -> |
| 398 | Hashtbl.add newscore (chop_ext s) (Common.Pb "fail") |
| 399 | ); |
| 400 | pr2 "--------------------------------"; |
| 401 | pr2 "regression testing information"; |
| 402 | pr2 "--------------------------------"; |
| 403 | Common.regression_testing newscore ("score_failed.marshalled") |
| 404 | end |
| 405 | |
| 406 | |
| 407 | (* ------------------------------------------------------------------------ *) |
| 408 | (* quite similar to test_ok_failed. Maybe could factorize code *) |
| 409 | let compare_with_expected outfiles = |
| 410 | pr2 ""; |
| 411 | outfiles +> List.iter (fun (infile, outopt) -> |
| 412 | let (dir, base, ext) = Common.dbe_of_filename infile in |
| 413 | let expected_suffix = |
| 414 | match ext with |
| 415 | | "c" -> "res" |
| 416 | | "h" -> "h.res" |
| 417 | | s -> failwith ("weird C file, not a .c or .h :" ^ s) |
| 418 | in |
| 419 | let expected_res = |
| 420 | Common.filename_of_dbe (dir, base, expected_suffix) in |
| 421 | let expected_res2 = |
| 422 | Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) |
| 423 | in |
| 424 | |
| 425 | match outopt, Common.lfile_exists expected_res with |
| 426 | | None, false -> () |
| 427 | | Some outfile, false -> |
| 428 | let s =("PB: input file " ^ infile ^ " modified but no .res") in |
| 429 | pr2 s |
| 430 | | x, true -> |
| 431 | let outfile = |
| 432 | match x with |
| 433 | | Some outfile -> outfile |
| 434 | | None -> infile |
| 435 | in |
| 436 | let diff = Compare_c.compare_default outfile expected_res in |
| 437 | let s1 = (Compare_c.compare_result_to_string diff) in |
| 438 | if fst diff =*= Compare_c.Correct |
| 439 | then pr2_no_nl (infile ^ " " ^ s1) |
| 440 | else |
| 441 | if Common.lfile_exists expected_res2 |
| 442 | then begin |
| 443 | let diff = Compare_c.compare_default outfile expected_res2 in |
| 444 | let s2 = Compare_c.compare_result_to_string diff in |
| 445 | if fst diff =*= Compare_c.Correct |
| 446 | then pr2 (infile ^ " is spatchOK " ^ s2) |
| 447 | else pr2 (infile ^ " is failed " ^ s2) |
| 448 | end |
| 449 | else pr2 (infile ^ " is failed " ^ s1) |
| 450 | ) |
| 451 | |
| 452 | (*****************************************************************************) |
| 453 | (* Subsystem testing *) |
| 454 | (*****************************************************************************) |
| 455 | |
| 456 | let test_parse_cocci file = |
| 457 | if not (file =~ ".*\\.cocci") |
| 458 | then pr2 "warning: seems not a .cocci file"; |
| 459 | |
| 460 | let (_,xs,_,_,_,_,(grep_tokens,query,_)) = |
| 461 | Parse_cocci.process file (Some !Config.std_iso) false in |
| 462 | xs +> List.iter Pretty_print_cocci.unparse; |
| 463 | Format.print_newline(); |
| 464 | (* compile ocaml script code *) |
| 465 | (match Prepare_ocamlcocci.prepare file xs with |
| 466 | None -> () |
| 467 | | Some ocaml_script_file -> |
| 468 | (* compile file *) |
| 469 | Prepare_ocamlcocci.load_file ocaml_script_file; |
| 470 | (* remove file *) |
| 471 | (if not !Common.save_tmp_files |
| 472 | then Prepare_ocamlcocci.clean_file ocaml_script_file); |
| 473 | (* Print the list of registered functions *) |
| 474 | Prepare_ocamlcocci.test ()); |
| 475 | Printf.printf "grep tokens\n"; |
| 476 | (match grep_tokens with |
| 477 | None -> pr "No query" |
| 478 | | Some x -> pr (String.concat " || " x)); |
| 479 | match !Flag.scanner with |
| 480 | Flag.NoScanner | Flag.Grep -> () |
| 481 | | Flag.Glimpse | Flag.IdUtils | Flag.Google _ -> |
| 482 | Printf.printf "%s tokens\n" |
| 483 | (if !Flag.scanner = Flag.Glimpse then "glimpse" else "google"); |
| 484 | (match query with |
| 485 | None -> pr "No query" |
| 486 | | Some x -> pr (String.concat " ||\n" x)) |
| 487 | |
| 488 | |
| 489 | |
| 490 | (*****************************************************************************) |
| 491 | (* to be called by ocaml toplevel, to test. *) |
| 492 | (*****************************************************************************) |
| 493 | |
| 494 | (* no point to memoize this one *) |
| 495 | let sp_of_file file iso = Parse_cocci.process file iso false |
| 496 | |
| 497 | (* TODO: Remove |
| 498 | *) |
| 499 | |
| 500 | (* |
| 501 | let flows_of_ast astc = |
| 502 | astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e) |
| 503 | |
| 504 | let one_flow flows = |
| 505 | List.hd flows |
| 506 | |
| 507 | let one_ctl ctls = List.hd (List.hd ctls) |
| 508 | *) |
| 509 | |