X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/0708f913629519b5dbc99f68b6f3ea5ab068230c..5427db06e325c3c7c572e2e1ebe88a2fd211641c:/testing.ml diff --git a/testing.ml b/testing.ml index 31abbe3..3f5ec1e 100644 --- a/testing.ml +++ b/testing.ml @@ -1,26 +1,29 @@ (* -* 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 . -* -* 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 . + * + * The authors reserve the right to distribute this or future versions of + * Coccinelle under other licenses. + *) open Common +open Sexplib (*****************************************************************************) (* Test framework *) @@ -29,59 +32,71 @@ open Common (* 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 res = Cocci.full_engine (cocci_file, !Config.std_iso) [cfile] in - let generated = + 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 = 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 newscore = empty_score () in + 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 = if res =~ "\\(.*\\).res" then matched1 res else raise Impossible - in - let base = if x =~ "\\(.*\\)_ver[0-9]+" then matched1 x else x in + 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 cfile = "tests/" ^ x ^ ".c" in let cocci_file = "tests/" ^ base ^ ".cocci" in let expected = "tests/" ^ res in @@ -89,10 +104,15 @@ let testall () = let timeout_testall = 30 in try ( - Common.timeout_function timeout_testall (fun () -> - - let xs = Cocci.full_engine (cocci_file, !Config.std_iso) [cfile] in - let generated = + 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 = match List.assoc cfile xs with | Some generated -> generated | None -> cfile @@ -101,35 +121,38 @@ let testall () = 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 newscore res Common.Ok; - | Compare_c.Pb s -> - let s = Str.global_replace + | Compare_c.Correct -> Hashtbl.add score res Common.Ok; + | Compare_c.Pb s -> + let s = Str.global_replace (Str.regexp "\"/tmp/cocci-output.*\"") "" 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.*\"") "" 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 newscore res (Common.Pb s) - | Compare_c.PbOnlyInNotParsedCorrectly s -> - let s = + Hashtbl.add score res (Common.Pb s) + | Compare_c.PbOnlyInNotParsedCorrectly s -> + let s = "seems incorrect, but only because of code that " ^ "was not parsable" ^ s in - Hashtbl.add newscore res (Common.Pb s) + Hashtbl.add score res (Common.Pb s) ) ) ) - with exn -> + with exn -> Common.reset_pr_indent(); let s = "PROBLEM\n" ^ (" exn = " ^ Printexc.to_string exn ^ "\n") in - Hashtbl.add newscore res (Common.Pb s) + Hashtbl.add score res (Common.Pb s) ); @@ -137,11 +160,11 @@ let testall () = pr2 "statistics"; pr2 "--------------------------------"; - Common.hash_to_list newscore +> 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 ) ); @@ -150,19 +173,77 @@ let testall () = pr2 "--------------------------------"; pr2 "regression testing information"; pr2 "--------------------------------"; - Common.regression_testing newscore - (Filename.concat Config.path "tests/score_cocci_best.marshalled"); - - pr2 "--------------------------------"; - pr2 "total score"; - pr2 "--------------------------------"; - let total = Common.hash_to_list newscore +> List.length in - let good = Common.hash_to_list newscore +> List.filter - (fun (s, v) -> v = Ok) +> List.length + (* 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) = + if Sys.file_exists expected_score_file + then + let sexp = Sexp.load_sexp expected_score_file in + Sexp_common.score_of_sexp sexp + 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 - - pr2 (sprintf "good = %d/%d" good total); + + let new_bestscore = Common.regression_testing_vs score expected_score in + + + let xs = Common.hash_to_list score in + let sexp = Sexp_common.sexp_of_score_list xs in + let s_score = Sexp.to_string_hum sexp in + Common.write_file ~file:(actual_score_file) s_score; + + let xs2 = Common.hash_to_list new_bestscore in + let sexp2 = Sexp_common.sexp_of_score_list xs2 in + let s_score2 = Sexp.to_string_hum sexp2 in + Common.write_file ~file:(best_of_both_file) s_score2; + + Common.print_total_score score; + + 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 + pr2 "Current score is equal to expected score; everything is fine"; + raise (UnixExit 0); + end + else + if good < expected_good + 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." + expected_score_file actual_score_file); + raise (UnixExit 1); + end + else begin + 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")); + Common.command2_y_or_no_exit_if_no + (spf "mv %s %s" best_of_both_file expected_score_file); + raise (UnixExit 0); + end end @@ -176,144 +257,144 @@ let t_to_s = function | 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 () -> - - let outfiles = Cocci.full_engine (cocci_file, !Config.std_iso) cfiles - in + let cocci_infos = Cocci.pre_engine (cocci_file, !Config.std_iso) in + let outfiles = Cocci.full_engine cocci_infos cfiles in + 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 + 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]) + if fst diff =*= Compare_c.Correct + 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 "--------------------------------"; @@ -321,47 +402,47 @@ let test_regression_okfailed () = 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 + 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 let s2 = Compare_c.compare_result_to_string diff in - if fst diff = Compare_c.Correct + if fst diff =*= Compare_c.Correct then pr2 (infile ^ " is spatchOK " ^ s2) else pr2 (infile ^ " is failed " ^ s2) end @@ -372,23 +453,37 @@ let compare_with_expected outfiles = (* 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 "\nor on glimpse failure\n" x)) @@ -403,10 +498,10 @@ let sp_of_file file iso = Parse_cocci.process file iso false *) (* -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)