(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
open Common
+open Sexplib
(*****************************************************************************)
(* Test framework *)
(* There can be multiple .c for the same cocci file. The convention
* is to have one base.cocci and a base.c and some optional
* base_vernn.[c,res].
- *
+ *
* If want to test without iso, use -iso_file empty.iso option.
*)
-let testone x compare_with_expected_flag =
+let testone prefix x compare_with_expected_flag =
let x = if x =~ "\\(.*\\)_ver0$" then matched1 x else x in
let base = if x =~ "\\(.*\\)_ver[0-9]+$" then matched1 x else x in
- let cfile = "tests/" ^ x ^ ".c" in
- let cocci_file = "tests/" ^ base ^ ".cocci" in
+ let cfile = prefix ^ x ^ ".c" in
+ let cocci_file = prefix ^ base ^ ".cocci" in
- let expected_res = "tests/" ^ x ^ ".res" in
+ let expected_res = prefix ^ x ^ ".res" in
begin
let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in
let res = Cocci.full_engine cocci_infos [cfile] in
Cocci.post_engine cocci_infos;
- let generated =
+ let generated =
match Common.optionise (fun () -> List.assoc cfile res) with
- | Some (Some outfile) ->
- if List.length res > 1
+ | Some (Some outfile) ->
+ if List.length res > 1
then pr2 ("note that not just " ^ cfile ^ " was involved");
let tmpfile = "/tmp/"^Common.basename cfile in
pr2 (sprintf "One file modified. Result is here: %s" tmpfile);
Common.command2 ("mv "^outfile^" "^tmpfile);
tmpfile
- | Some None ->
+ | Some None ->
pr2 "no modification on the input file";
cfile
| None -> raise Impossible
in
if compare_with_expected_flag
- then
- Compare_c.compare_default generated expected_res
- +> Compare_c.compare_result_to_string
+ then
+ Compare_c.compare_default generated expected_res
+ +> Compare_c.compare_result_to_string
+> pr2;
end
-
+
(* ------------------------------------------------------------------------ *)
-let testall () =
+(* note: if you get some weird results in -testall, and not in -test,
+ * it is possible that a test file work in -test but may not
+ * work while used inside a -testall. If we have some bugs in our
+ * parser that modify some global state and that those states
+ * are not reseted between each test file, then having run previous
+ * test files may have an influence on another test file which mean
+ * than a test may work in isolation (via -test) but not otherwise
+ * (via -testall). Fortunately such bugs are rare.
+ *
+ *)
+let testall ?(expected_score_file="tests/SCORE_expected.sexp") () =
let score = empty_score () in
- let expected_result_files =
- Common.glob "tests/*.res"
+ let expected_result_files =
+ Common.glob "tests/*.res"
+> List.filter (fun f -> Common.filesize f > 0)
+> List.map Filename.basename
+> List.sort compare
in
begin
- expected_result_files +> List.iter (fun res ->
- let x =
+ expected_result_files +> List.iter (fun res ->
+ let x =
if res =~ "\\(.*\\).res" then matched1 res else raise Impossible in
- let base = if x =~ "\\(.*\\)_ver[0-9]+" then matched1 x else x in
+ let base = if x =~ "\\(.*\\)_ver[0-9]+" then matched1 x else x in
let cfile = "tests/" ^ x ^ ".c" in
let cocci_file = "tests/" ^ base ^ ".cocci" in
let expected = "tests/" ^ res in
let timeout_testall = 30 in
try (
- Common.timeout_function timeout_testall (fun () ->
+ Common.timeout_function timeout_testall (fun () ->
+
+ pr2 res;
let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in
let xs = Cocci.full_engine cocci_infos [cfile] in
Cocci.post_engine cocci_infos;
- let generated =
+ let generated =
match List.assoc cfile xs with
| Some generated -> generated
| None -> cfile
let (correct, diffxs) = Compare_c.compare_default generated expected
in
- pr2 res;
(* I don't use Compare_c.compare_result_to_string because
* I want to indent a little more the messages.
*)
(match correct with
| Compare_c.Correct -> Hashtbl.add score res Common.Ok;
- | Compare_c.Pb s ->
- let s = Str.global_replace
+ | Compare_c.Pb s ->
+ let s = Str.global_replace
(Str.regexp "\"/tmp/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
in
- let s =
- "INCORRECT:" ^ s ^ "\n" ^
+ (* on macos the temporary files are stored elsewhere *)
+ let s = Str.global_replace
+ (Str.regexp "\"/var/folders/.*/cocci-output.*\"") "<COCCIOUTPUTFILE>" s
+ in
+ let s =
+ "INCORRECT:" ^ s ^ "\n" ^
" diff (result(<) vs expected_result(>)) = \n" ^
(diffxs +> List.map(fun s -> " "^s^"\n") +> Common.join "")
in
Hashtbl.add score res (Common.Pb s)
- | Compare_c.PbOnlyInNotParsedCorrectly s ->
- let s =
+ | Compare_c.PbOnlyInNotParsedCorrectly s ->
+ let s =
"seems incorrect, but only because of code that " ^
"was not parsable" ^ s
in
)
)
)
- with exn ->
+ with exn ->
Common.reset_pr_indent();
let s = "PROBLEM\n" ^ (" exn = " ^ Printexc.to_string exn ^ "\n") in
Hashtbl.add score res (Common.Pb s)
pr2 "statistics";
pr2 "--------------------------------";
- Common.hash_to_list score +> List.iter (fun (s, v) ->
+ Common.hash_to_list score +> List.iter (fun (s, v) ->
pr_no_nl (Printf.sprintf "%-30s: " s);
pr_no_nl (
match v with
- | Common.Ok -> "CORRECT\n"
+ | Common.Ok -> "CORRECT\n"
| Common.Pb s -> s
)
);
pr2 "regression testing information";
pr2 "--------------------------------";
+ (* now default argument of testall:
let expected_score_file = "tests/SCORE_expected.sexp" in
+ *)
+ let expected_score_file_orig = "tests/SCORE_expected_orig.sexp" in
let best_of_both_file = "tests/SCORE_best_of_both.sexp" in
let actual_score_file = "tests/SCORE_actual.sexp" in
-
+
pr2 ("regression file: "^ expected_score_file);
- let (expected_score : score) =
+ let (expected_score : score) =
if Sys.file_exists expected_score_file
- then
+ then
let sexp = Sexp.load_sexp expected_score_file in
Sexp_common.score_of_sexp sexp
- else empty_score()
+ else
+ if Sys.file_exists expected_score_file_orig
+ then begin
+ pr2 (spf "use expected orig file (%s)" expected_score_file_orig);
+ Common.command2 (spf "cp %s %s" expected_score_file_orig
+ expected_score_file);
+ let sexp = Sexp.load_sexp expected_score_file in
+ Sexp_common.score_of_sexp sexp
+ end
+ else
+ empty_score()
in
let new_bestscore = Common.regression_testing_vs score expected_score in
let (good, total) = Common.total_scores score in
let (expected_good, expected_total) = Common.total_scores expected_score in
- if good = expected_good
- then begin
+ if good = expected_good
+ then begin
pr2 "Current score is equal to expected score; everything is fine";
raise (UnixExit 0);
end
- else
+ else
if good < expected_good
- then begin
- pr2 "Current score is lower than expected, :(";
+ then begin
+ pr2 "Current score is lower than expected :(";
+ pr2 (spf "(was expecting %d but got %d)" expected_good good);
pr2 "";
pr2 "If you think it's normal, then maybe you need to update the";
pr2 (spf "score file %s, copying info from %s."
raise (UnixExit 1);
end
else begin
- pr2 "Current score is greater than expected, :)";
+ pr2 "Current score is greater than expected :)";
+ pr2 (spf "(was expecting %d but got %d)" expected_good good);
pr2 "Generating new expected score file and saving old one";
Common.command2_y_or_no_exit_if_no
(spf "mv %s %s" expected_score_file (expected_score_file ^ ".save"));
(spf "mv %s %s" best_of_both_file expected_score_file);
raise (UnixExit 0);
end
-
+
end
(* ------------------------------------------------------------------------ *)
| SpatchOK -> ".spatch_ok"
| Failed -> ".failed"
-let delete_previous_result_files infile =
- [Ok;SpatchOK;Failed] +> List.iter (fun kind ->
+let delete_previous_result_files infile =
+ [Ok;SpatchOK;Failed] +> List.iter (fun kind ->
Common.command2 ("rm -f " ^ infile ^ t_to_s kind)
)
(* quite similar to compare_with_expected below *)
-let test_okfailed cocci_file cfiles =
+let test_okfailed cocci_file cfiles =
cfiles +> List.iter delete_previous_result_files;
(* final_files contain the name of an output file (a .ok or .failed
* or .spatch_ok), and also some additionnal strings to be printed in
* this output file in addition to the general error message of
* full_engine. *)
- let final_files = ref [] in
+ let final_files = ref [] in
- let newout =
- Common.new_temp_file "cocci" ".stdout"
+ let newout =
+ Common.new_temp_file "cocci" ".stdout"
in
let t = Unix.gettimeofday () in
- let time_per_file_str () =
+ let time_per_file_str () =
let t' = Unix.gettimeofday () in
let tdiff = t' -. t in
let tperfile = tdiff /. (float_of_int (List.length cfiles)) in
spf "time: %f" tperfile
in
-
- Common.redirect_stdout_stderr newout (fun () ->
+
+ Common.redirect_stdout_stderr newout (fun () ->
try (
Common.timeout_function_opt !Flag_cocci.timeout (fun () ->
Cocci.post_engine cocci_infos;
let time_str = time_per_file_str () in
-
- outfiles +> List.iter (fun (infile, outopt) ->
+
+ outfiles +> List.iter (fun (infile, outopt) ->
let (dir, base, ext) = Common.dbe_of_filename infile in
- let expected_suffix =
+ let expected_suffix =
match ext with
| "c" -> "res"
| "h" -> "h.res"
| s -> pr2 ("WEIRD: not a .c or .h :" ^ base ^ "." ^ s);
"" (* no extension, will compare to same file *)
in
- let expected_res =
+ let expected_res =
Common.filename_of_dbe (dir, base, expected_suffix) in
- let expected_res2 =
- Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix)
+ let expected_res2 =
+ Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix)
in
-
+
(* can delete more than the first delete_previous_result_files
* because here we can have more files than in cfiles, for instance
* the header files
*)
delete_previous_result_files infile;
-
+
match outopt, Common.lfile_exists expected_res with
- | None, false ->
+ | None, false ->
()
- | Some outfile, false ->
+ | Some outfile, false ->
let s =("PB: input file " ^ infile ^ " modified but no .res") in
push2 (infile^t_to_s Failed, [s;time_str]) final_files
-
- | x, true ->
- let outfile =
- match x with
- | Some outfile -> outfile
- | None -> infile
+
+ | x, true ->
+ let outfile =
+ match x with
+ | Some outfile -> outfile
+ | None -> infile
in
-
+
let diff = Compare_c.compare_default outfile expected_res in
let s1 = (Compare_c.compare_result_to_string diff) in
if fst diff =*= Compare_c.Correct
then push2 (infile ^ (t_to_s Ok), [s1;time_str]) final_files
- else
+ else
if Common.lfile_exists expected_res2
then begin
let diff = Compare_c.compare_default outfile expected_res2 in
let s2 = Compare_c.compare_result_to_string diff in
if fst diff =*= Compare_c.Correct
- then push2 (infile ^ (t_to_s SpatchOK),[s2;s1;time_str])
+ then push2 (infile ^ (t_to_s SpatchOK),[s2;s1;time_str])
final_files
- else push2 (infile ^ (t_to_s Failed), [s2;s1;time_str])
+ else push2 (infile ^ (t_to_s Failed), [s2;s1;time_str])
final_files
end
else push2 (infile ^ (t_to_s Failed), [s1;time_str]) final_files
)
);
)
- with exn ->
+ with exn ->
let clean s =
Str.global_replace (Str.regexp "\\\\n") "\n"
(Str.global_replace (Str.regexp ("\\\\\"")) "\""
(Str.global_replace (Str.regexp "\\\\t") "\t" s)) in
let s = "PROBLEM\n"^(" exn = " ^ clean(Printexc.to_string exn) ^ "\n")
in
- let time_str = time_per_file_str ()
+ let time_str = time_per_file_str ()
in
(* we may miss some file because cfiles is shorter than outfiles.
* For instance the detected local headers are not in cfiles, so
* may have less failed. But at least have some failed.
*)
- cfiles +> List.iter (fun infile ->
+ cfiles +> List.iter (fun infile ->
push2 (infile ^ (t_to_s Failed), [s;time_str]) final_files;
);
);
- !final_files +> List.iter (fun (file, additional_strs) ->
+ !final_files +> List.iter (fun (file, additional_strs) ->
Common.command2 ("cp " ^ newout ^ " " ^ file);
- with_open_outfile file (fun (pr, chan) ->
+ with_open_outfile file (fun (pr, chan) ->
additional_strs +> List.iter (fun s -> pr (s ^ "\n"))
);
-
+
)
-let test_regression_okfailed () =
+let test_regression_okfailed () =
(* it's xxx.c.ok *)
let chop_ext f = f +> Filename.chop_extension in
let newscore = Common.empty_score () in
- let oks =
- Common.cmd_to_list ("find -name \"*.ok\"")
+ let oks =
+ Common.cmd_to_list ("find -name \"*.ok\"")
++
Common.cmd_to_list ("find -name \"*.spatch_ok\"")
in
let failed = Common.cmd_to_list ("find -name \"*.failed\"") in
- if null (oks ++ failed)
+ if null (oks ++ failed)
then failwith "no ok/failed file, you certainly did a make clean"
else begin
- oks +> List.iter (fun s ->
+ oks +> List.iter (fun s ->
Hashtbl.add newscore (chop_ext s) Common.Ok
);
- failed +> List.iter (fun s ->
+ failed +> List.iter (fun s ->
Hashtbl.add newscore (chop_ext s) (Common.Pb "fail")
);
pr2 "--------------------------------";
pr2 "--------------------------------";
Common.regression_testing newscore ("score_failed.marshalled")
end
-
+
(* ------------------------------------------------------------------------ *)
(* quite similar to test_ok_failed. Maybe could factorize code *)
let compare_with_expected outfiles =
pr2 "";
- outfiles +> List.iter (fun (infile, outopt) ->
+ outfiles +> List.iter (fun (infile, outopt) ->
let (dir, base, ext) = Common.dbe_of_filename infile in
- let expected_suffix =
+ let expected_suffix =
match ext with
| "c" -> "res"
| "h" -> "h.res"
| s -> failwith ("weird C file, not a .c or .h :" ^ s)
in
- let expected_res =
+ let expected_res =
Common.filename_of_dbe (dir, base, expected_suffix) in
- let expected_res2 =
- Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix)
+ let expected_res2 =
+ Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix)
in
-
+
match outopt, Common.lfile_exists expected_res with
| None, false -> ()
- | Some outfile, false ->
+ | Some outfile, false ->
let s =("PB: input file " ^ infile ^ " modified but no .res") in
pr2 s
- | x, true ->
- let outfile =
- match x with
- | Some outfile -> outfile
- | None -> infile
+ | x, true ->
+ let outfile =
+ match x with
+ | Some outfile -> outfile
+ | None -> infile
in
let diff = Compare_c.compare_default outfile expected_res in
let s1 = (Compare_c.compare_result_to_string diff) in
if fst diff =*= Compare_c.Correct
then pr2_no_nl (infile ^ " " ^ s1)
- else
+ else
if Common.lfile_exists expected_res2
then begin
let diff = Compare_c.compare_default outfile expected_res2 in
(* Subsystem testing *)
(*****************************************************************************)
-let test_parse_cocci file =
- if not (file =~ ".*\\.cocci")
+let test_parse_cocci file =
+ if not (file =~ ".*\\.cocci")
then pr2 "warning: seems not a .cocci file";
- let (_,xs,_,_,_,_,grep_tokens,query) =
+ let (_,xs,_,_,_,_,(grep_tokens,query,_)) =
Parse_cocci.process file (Some !Config.std_iso) false in
xs +> List.iter Pretty_print_cocci.unparse;
+ Format.print_newline();
+ (* compile ocaml script code *)
+ (match Prepare_ocamlcocci.prepare file xs with
+ None -> ()
+ | Some ocaml_script_file ->
+ (* compile file *)
+ Prepare_ocamlcocci.load_file ocaml_script_file;
+ (* remove file *)
+ (if not !Common.save_tmp_files
+ then Prepare_ocamlcocci.clean_file ocaml_script_file);
+ (* Print the list of registered functions *)
+ Prepare_ocamlcocci.test ());
Printf.printf "grep tokens\n";
- List.iter (function x -> Printf.printf "%s\n" (String.concat " " x))
- grep_tokens;
- if !Flag.use_glimpse
- then match query with None -> pr "No query" | Some x -> pr x
-
-
-
-
-
+ (match grep_tokens with
+ None -> pr "No query"
+ | Some x -> pr (String.concat " || " x));
+ match !Flag.scanner with
+ Flag.NoScanner | Flag.Grep -> ()
+ | Flag.Glimpse | Flag.IdUtils | Flag.Google _ ->
+ Printf.printf "%s tokens\n"
+ (if !Flag.scanner = Flag.Glimpse then "glimpse" else "google");
+ (match query with
+ None -> pr "No query"
+ | Some x -> pr (String.concat " ||\n" x))
*)
(*
-let flows_of_ast astc =
+let flows_of_ast astc =
astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e)
-let one_flow flows =
+let one_flow flows =
List.hd flows
let one_ctl ctls = List.hd (List.hd ctls)
HCoop / bpt / coccinelle.git / blobdiff