(*
-* 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 2005-2010, 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
(*****************************************************************************)
(* pair of (list of flags to set true, list of flags to set false *)
+let very_quiet_profile = (
+ [
+ ],
+ [
+ (* FC.show_diff; just leave this as it is *)
+
+ Common.print_to_stderr;
+ Flag.show_misc;
+ Flag.show_trying;
+ Flag.show_transinfo;
+
+ FC.show_c;
+ FC.show_cocci;
+ FC.show_flow;
+ FC.show_before_fixed_flow;
+ FC.show_ctl_tex;
+ FC.show_ctl_text;
+ FC.show_binding_in_out;
+
+ FC.verbose_cocci;
+
+ Flag_parsing_c.show_parsing_error;
+
+ Flag_parsing_c.verbose_lexing;
+ Flag_parsing_c.verbose_parsing;
+ Flag_parsing_c.verbose_type;
+ Flag_parsing_c.verbose_cfg;
+ Flag_parsing_c.verbose_unparsing;
+ Flag_parsing_c.verbose_visit;
+ Flag_parsing_c.verbose_cpp_ast;
+
+ Flag_matcher.verbose_matcher;
+ Flag_matcher.debug_engine;
+
+ Flag_parsing_c.debug_unparsing;
+
+ Flag_parsing_cocci.show_SP;
+ Flag_parsing_cocci.show_iso_failures;
+
+ Flag_ctl.verbose_ctl_engine;
+ Flag_ctl.verbose_match;
+
+
+ ])
+
let quiet_profile = (
[
+ Common.print_to_stderr
],
[
(* FC.show_diff; just leave this as it is *)
work properly *)
let debug_profile = (
[
+ Common.print_to_stderr;
Flag.show_misc;
Flag.show_transinfo;
let pad_profile = (
[
FC.show_diff;
+ Common.print_to_stderr;
],
[
" causes local include files to be used";
"-include_headers", Arg.Set include_headers,
" process header files independently";
- "-I", Arg.String (function x -> FC.include_path := Some x),
+ "-I", Arg.String (fun x ->
+ FC.include_path:= x::!FC.include_path
+ ),
" <dir> containing the header files (optional)";
"-preprocess", Arg.Set preprocess,
"-dir", Arg.Set dir,
" <dir> process all files in directory recursively";
- "-use_glimpse", Arg.Set Flag.use_glimpse,
+ "-use_glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse),
" works with -dir, use info generated by glimpseindex";
- "-patch", Arg.String (function s -> Flag.patch := Some s),
+ "-use_google", Arg.String (function s -> Flag.scanner := Flag.Google s),
+ " find relevant files using google code search";
+ "-patch",
+ Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)),
(" <dir> path name with respect to which a patch should be created\n"^
" \"\" for a file in the current directory");
"-kbuild_info", Arg.Set_string kbuild_info,
"-version", Arg.Unit (fun () ->
- pr2 (spf "spatch version: %s" Config.version);
+ let withpython = if Pycocci.python_support then "with" else "without" in
+ pr2 (spf "spatch version %s %s Python support" Config.version withpython);
exit 0;
),
" guess what";
"-date", Arg.Unit (fun () ->
- pr2 "version: $Date: 2009/07/21 08:21:29 $";
+ pr2 "version: $Date: 2010/03/05 21:12:11 $";
raise (Common.UnixExit 0)
),
" guess what";
Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true),
" remove graph label (requires option -graphical_trace)";
- "-parse_error_msg", Arg.Set Flag_parsing_c.verbose_parsing, " ";
+ "-parse_error_msg", Arg.Set Flag_parsing_c.show_parsing_error, " ";
+ "-verbose_parsing",
+ Arg.Unit (fun _ -> Flag_parsing_c.verbose_parsing := true;
+ Flag_parsing_c.show_parsing_error := true), " ";
"-type_error_msg", Arg.Set Flag_parsing_c.verbose_type, " ";
(* could also use Flag_parsing_c.options_verbose *)
];
[
(* todo: other profile ? *)
"-quiet", Arg.Unit (fun () -> run_profile quiet_profile), " ";
+ "-very_quiet", Arg.Unit (fun () -> run_profile very_quiet_profile), " ";
"-debug", Arg.Unit (fun () -> run_profile debug_profile), " ";
"-pad", Arg.Unit (fun () -> run_profile pad_profile), " ";
"change of algorithm options",
- "",
- [
-(* no popl in official version
+ "",
+ [
"-popl", Arg.Set FC.popl,
" simplified SmPL, for the popl paper";
Arg.Unit
(function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
" simplified SmPL, for the popl paper";
-*)
"-hrule", Arg.String
(function s ->
Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
" semantic patch generation";
+ "-keep_comments", Arg.Set Flag_parsing_c.keep_comments,
+ " keep comments around removed code";
+
"-loop", Arg.Set Flag_ctl.loop_in_src_code, " ";
"-no_loops", Arg.Set Flag_parsing_c.no_loops,
" drop all back edges derived from looping constructs - unsafe";
+ "-no_gotos", Arg.Set Flag_parsing_c.no_gotos,
+ " drop all jumps derived from gotos - unsafe";
"-l1", Arg.Clear Flag_parsing_c.label_strategy_2, " ";
"-ifdef_to_if", Arg.Set FC.ifdef_to_if,
"-disallow_nested_exps", Arg.Set Flag_matcher.disallow_nested_exps,
- "disallow an expresion pattern from matching a term and its subterm";
+ " disallow an expresion pattern from matching a term and its subterm";
"-disable_worth_trying_opt", Arg.Clear FC.worth_trying_opt,
" ";
"-only_return_is_error_exit",
" spacing of + code follows the conventions of Linux";
"-smpl_spacing", Arg.Unit Flag_parsing_c.set_smpl_spacing,
" spacing of + code follows the semantic patch";
+ "-D", Arg.String Flag.set_defined_virtual_rules,
+ " indicate that a virtual rule should be considered to be matched";
];
"misc options",
Cocci.sp_of_file coccifile (Some isofile) in
match query with
None -> pr2 "no glimpse keyword inferred from snippet"; None
- | Some query ->
- let suffixes = if !include_headers then ["c";"h"] else ["c"] in
+ | Some [query] ->
+ (let suffixes = if !include_headers then ["c";"h"] else ["c"] in
pr2 ("glimpse request = " ^ query);
let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in
let (glimpse_res,stat) = Common.cmd_to_list_and_status command in
(glimpse_res +>
List.filter
(fun file -> List.mem (Common.filesuffix file) suffixes))
- | _ -> None (* error, eg due to pattern too big *)
-
+ | _ -> None (* error, eg due to pattern too big *))
+ | _ -> failwith "not possible"
(*****************************************************************************)
(* Main action *)
if !dir && !Flag.patch =*= None
then
(match xs with
- | [] -> Flag.patch := Some x
+ | [] -> Flag.patch := Some (Cocci.normalize_path x)
| _ ->
pr2
("warning: patch output can only be created when only one\n"^
let infiles =
Common.profile_code "Main.infiles computation" (fun () ->
- match !dir, !kbuild_info, !Flag.use_glimpse with
+ match !dir, !kbuild_info, !Flag.scanner = Flag.Glimpse with
(* glimpse *)
| false, _, true ->
failwith "-use_glimpse works only with -dir"
pr2 ("HANDLING: " ^ (join " " cfiles));
Common.timeout_function_opt !FC.timeout (fun () ->
Common.report_if_take_time 10 (join " " cfiles) (fun () ->
+ (*let s = profile_diagnostic() in*)
(* Unix.sleep 1; *)
try
let optfile =
with
| Common.UnixExit x -> raise (Common.UnixExit x)
| e ->
+ (*pr2 "previous";
+ pr2 s;
+ pr2 "new";
+ pr2(profile_diagnostic());*)
if !dir
then begin
pr2 ("EXN:" ^ Printexc.to_string e);
let arglist = Array.to_list Sys.argv in
if not (null (Common.inter_set arglist
- ["-cocci_file";"-sp_file";"-test";"-testall";
+ ["-cocci_file";"-sp_file";"-sp";"-test";"-testall";
"-test_okfailed";"-test_regression_okfailed"]))
then run_profile quiet_profile;
chosen
end
else List.hd !args in
- if !FC.include_path =*= None
- then FC.include_path := Some (Filename.concat chosen_dir "include"));
+ if !FC.include_path =*= []
+ then FC.include_path := [Filename.concat chosen_dir "include"]);
args := List.rev !args;
(* The test framework. Works with tests/ or .ok and .failed *)
(* --------------------------------------------------------- *)
| [x] when !test_mode ->
- FC.include_path := Some "tests/include";
- Testing.testone x !compare_with_expected
+ begin
+ try
+ let prefix = "tests/" in
+ FC.include_path := [prefix^"include"];
+ Testing.testone prefix x !compare_with_expected
+ with _ ->
+ FC.include_path := ["include"];
+ Testing.testone "" x !compare_with_expected
+ end
| [] when !test_all ->
- FC.include_path := Some "tests/include";
+ FC.include_path := ["tests/include"];
if !expected_score_file <> ""
then Testing.testall ~expected_score_file:!expected_score_file ()
else Testing.testall ()
(* --------------------------------------------------------- *)
(* This is the main entry *)
(* --------------------------------------------------------- *)
- | x::xs ->
- main_action (x::xs)
+ | x::xs -> main_action (x::xs)
(* --------------------------------------------------------- *)
(* empty entry *)
HCoop / bpt / coccinelle.git / blobdiff