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