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 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