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