testing.ml

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