testing.ml

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