testing.ml

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