testing.ml

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