testing.ml

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