.#testing.ml.1.67

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