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