(*
-* Copyright 2005-2008, 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 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, 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.
+ *)
+# 0 "./main.ml"
open Common
+module FC = Flag_cocci
(*****************************************************************************)
(* Flags *)
let cocci_file = ref ""
let output_file = ref ""
-let inplace_modif = ref false (* but keeps a .cocci_orig *)
+let inplace_modif = ref false (* but keeps nothing *)
+let backup_suffix =
+ ref (None : string option) (* suffix for backup if one is desired *)
let outplace_modif = ref false (* generates a .cocci_res *)
+let preprocess = ref false (* run the C preprocessor before cocci *)
+let compat_mode = ref false
+let ignore_unknown_opt = ref false
-(* could be avoided by using Common.files_of_dir_or_files instead *)
-let dir = ref false
+(* somehow obsolete now *)
+let dir = ref false
-let include_headers = ref false
let kbuild_info = ref ""
+let macro_file = ref ""
+
(* test mode *)
let test_mode = ref false
let test_all = ref false
let test_okfailed = ref false
let test_regression_okfailed = ref false
-
+let expected_score_file = ref ""
+let allow_update_score_file = ref true
(* action mode *)
let action = ref ""
(* works with -test but also in "normal" spatch mode *)
let compare_with_expected = ref false
-
let distrib_index = ref (None : int option)
let distrib_max = ref (None : int option)
let mod_distrib = ref false
-
(*****************************************************************************)
(* Profiles *)
(*****************************************************************************)
(* 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
],
[
- (* Flag_cocci.show_diff; just leave this as it is *)
+ (* FC.show_diff; just leave this as it is *)
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_cocci.show_c;
- Flag_cocci.show_cocci;
- Flag_cocci.show_flow;
- Flag_cocci.show_before_fixed_flow;
- Flag_cocci.show_ctl_tex;
- Flag_cocci.show_ctl_text;
- Flag_cocci.show_transinfo;
- Flag_cocci.show_binding_in_out;
+ 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;
+
+
+ ])
+
+(* some information that is useful in seeing why a semantic patch doesn't
+work properly *)
+let debug_profile = (
+ [
+ Common.print_to_stderr;
+ Flag.show_misc;
+ Flag.show_transinfo;
+
+ FC.show_diff;
+ FC.show_cocci;
+ FC.show_binding_in_out;
+ FC.show_dependencies;
+
+ Flag_parsing_cocci.keep_ml_script;
+ Flag_parsing_cocci.show_iso_failures;
+
+ FC.verbose_cocci;
+
+ Flag_parsing_c.verbose_cfg;
+ Flag_parsing_c.verbose_unparsing;
+ Flag_parsing_c.verbose_visit;
+
+ Flag_matcher.verbose_matcher;
+
+ Flag_parsing_c.show_parsing_error;
+ ],
+ [
+
+ Flag.show_misc;
+
+ FC.show_c;
+ FC.show_flow;
+ FC.show_before_fixed_flow;
+ FC.show_ctl_tex;
+ FC.show_ctl_text;
+
+ Flag_parsing_cocci.show_SP;
Flag_ctl.verbose_ctl_engine;
Flag_ctl.verbose_match;
Flag_matcher.debug_engine;
let pad_profile = (
[
- Flag_cocci.show_diff;
+ FC.show_diff;
+ Common.print_to_stderr;
],
[
Flag.show_misc;
+ Flag.show_transinfo;
- Flag_cocci.show_c;
- Flag_cocci.show_cocci;
- Flag_cocci.show_flow;
- Flag_cocci.show_before_fixed_flow;
- Flag_cocci.show_ctl_tex;
- Flag_cocci.show_ctl_text;
- Flag_cocci.show_transinfo;
- Flag_cocci.show_binding_in_out;
+ 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;
Flag_parsing_cocci.show_SP;
Flag_parsing_cocci.show_iso_failures;
Flag_parsing_c.verbose_parsing;
])
+let run_profile p =
+ let (set_to_true, set_to_false) = p in
+ List.iter (fun x -> x := false) set_to_false;
+ List.iter (fun x -> x := true) set_to_true
+
(*****************************************************************************)
(* The spatch options *)
(*****************************************************************************)
-let usage_msg =
- "Usage: " ^ basename Sys.argv.(0) ^
- " -sp_file <SP> <infile> [-o <outfile>] [-iso_file <iso>] [options]" ^
+let usage_msg =
+ "Usage: " ^ basename Sys.argv.(0) ^
+ " --sp-file <SP> <infile> [-o <outfile>] [--iso-file <iso>] [options]" ^
"\n" ^ "Options are:"
(* forward reference trick *)
* the developers of coccinelle or advanced-users that know
* quite well the underlying semantics of coccinelle.
*)
-
+
(* will be printed when use only ./spatch. For the rest you have to
- * use -longhelp to see them.
+ * use -longhelp to see them.
*)
-let short_options = [
- "-sp_file", Arg.Set_string cocci_file,
+let short_options = [
+ "--sp-file", Arg.Set_string cocci_file,
" <file> the semantic patch file";
"-o", Arg.Set_string output_file,
" <file> the output file";
- "-inplace", Arg.Set inplace_modif,
+ "--in-place", Arg.Set inplace_modif,
" do the modification on the file directly";
- "-outplace", Arg.Set outplace_modif,
+ "--backup-suffix", Arg.String (function s -> backup_suffix := Some s),
+ " suffix to use when making a backup for inplace";
+ "--out-place", Arg.Set outplace_modif,
" store modifications in a .cocci_res file";
+ "--reverse", Arg.Set Flag_parsing_cocci.interpret_inverted,
+ " invert the semantic patch before applying it";
- "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
+ "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
" set number of diff context lines";
- "-partial_match", Arg.Set Flag_ctl.partial_match,
+ "--partial-match", Arg.Set Flag_ctl.partial_match,
" report partial matches of the SP on the C file";
- "-iso_file", Arg.Set_string Config.std_iso,
+ "--iso-file", Arg.Set_string Config.std_iso,
" <file> (default=" ^ !Config.std_iso ^")";
- "-macro_file", Arg.Set_string Config.std_h,
+ "--macro-file", Arg.Set_string macro_file,
+ " <file>";
+ "--macro-file-builtins", Arg.Set_string Config.std_h,
" <file> (default=" ^ !Config.std_h ^ ")";
- "-all_includes", Arg.Set Flag_cocci.all_includes,
- " causes all available include files to be used";
- "-no_includes", Arg.Set Flag_cocci.no_includes,
+ "--recursive-includes",
+ Arg.Unit (function _ -> FC.include_options := FC.I_REALLY_ALL_INCLUDES),
+ " causes all available include files, both those included in the C file(s) and those included in header files, to be used";
+ "--all-includes",
+ Arg.Unit (function _ -> FC.include_options := FC.I_ALL_INCLUDES),
+ " causes all available include files included in the C file(s) to be used";
+ "--no-includes",
+ Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES),
" causes not even local include files to be used";
- "-I", Arg.Set_string Flag_cocci.include_path,
- " <dir> containing the Linux headers (optional)";
+ "--local-includes",
+ Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES),
+ " causes local include files to be used";
+ "--ignore-unknown-options", Arg.Set ignore_unknown_opt,
+ " For integration in a toolchain (must be set before the first unknown option)";
+ "--include-headers", Arg.Set Flag.include_headers,
+ " process header files independently";
+ "-I", Arg.String (fun x -> FC.include_path:= x::!FC.include_path),
+ " <dir> containing the header files";
+ "--include", Arg.String (fun x -> FC.extra_includes:=x::!FC.extra_includes),
+ " file to consider as being included";
+ "--preprocess", Arg.Set preprocess,
+ " run the C preprocessor before applying the semantic match";
- "-dir", Arg.Set dir,
+ "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode";
+
+ "--dir", Arg.Set dir,
" <dir> process all files in directory recursively";
- "-include_headers", Arg.Set include_headers,
- " process header files independently";
- "-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";
+ "--use-idutils", Arg.Unit (function s -> Flag.scanner := Flag.IdUtils),
+ " find relevant files using id-utils";
+ "--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,
+ "--kbuild-info", Arg.Set_string kbuild_info,
" <file> improve -dir by grouping related c files";
- "-pyoutput", Arg.Set_string Flag.pyoutput,
+ "--pyoutput", Arg.Set_string Flag.pyoutput,
" Sets output routine: Standard values: <coccilib.output.Gtk|coccilib.output.Console>";
- "-version", Arg.Unit (fun () ->
- pr2 (spf "spatch version: %s" Config.version);
+ "--version", Arg.Unit (fun () ->
+ let withpython = if Pycocci.python_support then "with" else "without" in
+ let whichregexp =
+ if !Regexp.pcre_support then "with PCRE support"
+ else "with Str regexp support "
+ in
+ pr2 (spf "spatch version %s %s Python support and %s" Config.version withpython whichregexp);
exit 0;
- ),
+ ),
" guess what";
- "-date", Arg.Unit (fun () ->
- pr2 "version: $Date: 2008/11/18 20:37:55 $";
+ "--date", Arg.Unit (fun () ->
+ pr2 "version: $Date$";
raise (Common.UnixExit 0)
- ),
+ ),
" guess what";
- "-shorthelp", Arg.Unit (fun () ->
+ "--shorthelp", Arg.Unit (fun () ->
!short_usage_func();
raise (Common.UnixExit 0)
- ),
+ ),
" see short list of options";
- "-longhelp", Arg.Unit (fun () ->
+ "--longhelp", Arg.Unit (fun () ->
!long_usage_func();
raise (Common.UnixExit 0)
- ),
+ ),
" see all the available options in different categories";
- "-help", Arg.Unit (fun () ->
+ "-help", Arg.Unit (fun () ->
!long_usage_func();
raise (Common.UnixExit 0)
),
" ";
- "--help", Arg.Unit (fun () ->
+ "--help", Arg.Unit (fun () ->
!long_usage_func();
raise (Common.UnixExit 0)
),
" ";
-
]
(* the format is a list of triples:
* (title of section * (optional) explanation of sections * option list)
*)
let other_options = [
- "aliases and obsolete options",
+ "aliases and obsolete options",
"",
- [
- "-cocci_file", Arg.Set_string cocci_file,
+ [
+ "--sp", Arg.Unit (function _ -> failwith "impossible"),
+ " command line semantic patch";
+ "--iso", Arg.Set_string Config.std_iso, " short option of --iso-file";
+
+ "--cocci-file", Arg.Set_string cocci_file,
" <file> the semantic patch file";
- "-c", Arg.Set_string cocci_file, " short option of -cocci_file";
- "-iso", Arg.Set_string Config.std_iso, " short option of -iso_file";
- "-D", Arg.Set_string Config.std_h, " short option of -macro_file";
+(* "-c", Arg.Set_string cocci_file, " short option of -sp_file"; *)
];
- "most useful show options",
+ "most useful show options",
"",
[
- "-show_diff" , Arg.Set Flag_cocci.show_diff, " ";
- "-no_show_diff" , Arg.Clear Flag_cocci.show_diff, " ";
- "-show_flow" , Arg.Set Flag_cocci.show_flow, " ";
- "-no_show_ctl_text" , Arg.Clear Flag_cocci.show_ctl_text, " ";
- (* works in conjunction with -show_ctl *)
- "-ctl_inline_let", Arg.Set Flag_cocci.inline_let_ctl, " ";
- "-ctl_show_mcodekind", Arg.Set Flag_cocci.show_mcodekind_in_ctl, " ";
- "-show_binding_in_out", Arg.Set Flag_cocci.show_binding_in_out, " ";
- "-no_show_transinfo", Arg.Clear Flag_cocci.show_transinfo, " ";
- "-no_show_misc", Arg.Clear Flag.show_misc, " ";
- "-show_trying", Arg.Set Flag.show_trying,
+ "--show-diff" , Arg.Set FC.show_diff, " ";
+ "--no-show-diff" , Arg.Clear FC.show_diff, " ";
+ "--force-diff" , Arg.Set FC.force_diff,
+ "show diff even if only spacing changes";
+ "--show-flow" , Arg.Set FC.show_flow, " ";
+ (* works in conjunction with -show_ctl_text *)
+ "--ctl-inline-let",
+ Arg.Unit
+ (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " ";
+ "--ctl-show-mcodekind",
+ Arg.Unit
+ (function _ -> FC.show_ctl_text := true; FC.show_mcodekind_in_ctl := true),
+ " ";
+ "--show-bindings", Arg.Set FC.show_binding_in_out, " ";
+ "--show-transinfo", Arg.Set Flag.show_transinfo, " ";
+ "--show-misc", Arg.Set Flag.show_misc, " ";
+ "--show-trying", Arg.Set Flag.show_trying,
" show the name of each function being processed";
- "-show_dependencies",
- Arg.Unit (function _ -> Flag_cocci.show_dependencies := true;
- Flag_cocci.show_binding_in_out := true),
+ "--show-dependencies",
+ Arg.Unit (function _ -> FC.show_dependencies := true;
+ FC.show_binding_in_out := true),
" show the dependencies related to each rule";
];
- "verbose subsystems options",
+ "verbose subsystems options",
"",
[
- "-verbose_ctl_engine", Arg.Set Flag_ctl.verbose_ctl_engine, " ";
- "-verbose_match", Arg.Set Flag_ctl.verbose_match, " ";
- "-verbose_engine", Arg.Set Flag_matcher.debug_engine, " ";
- "-graphical_trace", Arg.Set Flag_ctl.graphical_trace, " generate a pdf file representing the matching process";
- "-gt_without_label", Arg.Set Flag_ctl.gt_without_label, " remove graph label (requires option -graphical_trace)";
-
- "-no_parse_error_msg", Arg.Clear Flag_parsing_c.verbose_parsing, " ";
- "-no_type_error_msg", Arg.Clear Flag_parsing_c.verbose_type, " ";
+ "--verbose-ctl-engine",
+ Arg.Unit (function _ ->
+ Flag_ctl.verbose_ctl_engine := true; FC.show_ctl_text := true) , " ";
+ "--verbose-match", Arg.Set Flag_ctl.verbose_match, " ";
+ "--verbose-engine", Arg.Set Flag_matcher.debug_engine, " ";
+ "--graphical-trace", Arg.Set Flag_ctl.graphical_trace, " generate a pdf file representing the matching process";
+ "--gt-without-label",
+ Arg.Unit (function _ ->
+ 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.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 *)
];
"other show options",
"",
[
- "-show_c" , Arg.Set Flag_cocci.show_c, " ";
- "-show_cocci" , Arg.Set Flag_cocci.show_cocci, " ";
- "-show_before_fixed_flow" , Arg.Set Flag_cocci.show_before_fixed_flow, " ";
- "-show_ctl_tex" , Arg.Set Flag_cocci.show_ctl_tex, " ";
- "-show_SP_julia" , Arg.Set Flag_parsing_cocci.show_SP, " ";
+ "--show-c" , Arg.Set FC.show_c, " ";
+ "--show-cocci" , Arg.Set FC.show_cocci, " ";
+ "--show-before-fixed-flow" , Arg.Set FC.show_before_fixed_flow, " ";
+ "--show-ctl-tex" , Arg.Set FC.show_ctl_tex, " ";
+ "--show-ctl-text" , Arg.Set FC.show_ctl_text, " ";
+ "--show-SP" , Arg.Set Flag_parsing_cocci.show_SP, " ";
];
"debug C parsing/unparsing",
"",
[
- "-debug_cpp", Arg.Set Flag_parsing_c.debug_cpp, " ";
- "-debug_lexer", Arg.Set Flag_parsing_c.debug_lexer , " ";
- "-debug_etdt", Arg.Set Flag_parsing_c.debug_etdt , " ";
- "-debug_typedef", Arg.Set Flag_parsing_c.debug_typedef, " ";
+ "--debug-cpp", Arg.Set Flag_parsing_c.debug_cpp, " ";
+ "--debug-lexer", Arg.Set Flag_parsing_c.debug_lexer , " ";
+ "--debug-etdt", Arg.Set Flag_parsing_c.debug_etdt , " ";
+ "--debug-typedef", Arg.Set Flag_parsing_c.debug_typedef, " ";
- "-filter_msg", Arg.Set Flag_parsing_c.filter_msg ,
+ "--filter-msg", Arg.Set Flag_parsing_c.filter_msg ,
" filter some cpp message when the macro is a \"known\" cpp construct";
- "-filter_define_error",Arg.Set Flag_parsing_c.filter_define_error," ";
- "-filter_passed_level", Arg.Set_int Flag_parsing_c.filter_passed_level," ";
-
- "-debug_cfg", Arg.Set Flag_parsing_c.debug_cfg , " ";
- "-debug_unparsing", Arg.Set Flag_parsing_c.debug_unparsing, " ";
+ "--filter-define-error", Arg.Set Flag_parsing_c.filter_define_error," ";
+ "--filter-msg-define-error", Arg.Set Flag_parsing_c.filter_msg_define_error,
+ " filter the error msg";
+ "--filter-passed-level", Arg.Set_int Flag_parsing_c.filter_passed_level," ";
+(* debug cfg doesn't seem to have any effect, so drop it as an option *)
+(* "--debug_cfg", Arg.Set Flag_parsing_c.debug_cfg , " "; *)
+ "--debug-unparsing", Arg.Set Flag_parsing_c.debug_unparsing, " ";
];
(* could use Flag_parsing_c.options_debug_with_title instead *)
"",
[
(* todo: other profile ? *)
- "-quiet", Arg.Unit (fun () ->
- let (set_to_true, set_to_false) = quiet_profile in
- List.iter (fun x -> x := false) set_to_false;
- List.iter (fun x -> x := true) set_to_true;
- ), " ";
-
- "-pad", Arg.Unit (fun () ->
- let (set_to_true, set_to_false) = pad_profile in
- List.iter (fun x -> x := false) set_to_false;
- List.iter (fun x -> x := true) set_to_true;
- ), " ";
+ "--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), " ";
];
"bench options",
"",
[
- "-profile", Arg.Unit (function () -> Common.profile := Common.PALL) ,
+ "--profile", Arg.Unit (function () -> Common.profile := Common.PALL) ,
" gather timing information about the main coccinelle functions";
- "-bench", Arg.Int (function x -> Flag_ctl.bench := x),
+ "--bench", Arg.Int (function x -> Flag_ctl.bench := x),
" <level> for profiling the CTL engine";
- "-timeout", Arg.Int (fun x -> Flag_cocci.timeout := Some x),
+ "--timeout", Arg.Int (fun x -> FC.timeout := Some x),
" <sec> timeout in seconds";
- "-steps", Arg.Int (fun x -> Flag_ctl.steps := Some x),
+ "--steps", Arg.Int (fun x -> Flag_ctl.steps := Some x),
" max number of model checking steps per code unit";
- "-track_iso", Arg.Set Flag.track_iso_usage,
+ "--iso-limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x),
+ " max depth of iso application";
+ "--no-iso-limit", Arg.Unit (fun _ -> Flag_parsing_cocci.iso_limit := None),
+ " disable limit on max depth of iso application";
+ "--track-iso", Arg.Set Flag.track_iso_usage,
" gather information about isomorphism usage";
- "-profile_iso",
+ "--disable-iso",
+ Arg.String
+ (fun s -> Flag_parsing_cocci.disabled_isos :=
+ s :: !Flag_parsing_cocci.disabled_isos),
+ " disable a specific isomorphism";
+ "--profile-iso",
Arg.Unit
(function () ->
- Common.profile:=PSOME ["parse cocci";"mysat";"asttoctl2";"full_engine"]),
+ Common.profile :=
+ (*post_engine not included, because it doesn't use isos*)
+ PSOME ["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
" gather information about the cost of isomorphism usage"
];
"change of algorithm options",
- "",
- [
- "-popl", Arg.Set Flag_cocci.popl,
+ "",
+ [
+(* "--popl", Arg.Set FC.popl,
" simplified SmPL, for the popl paper";
- "-popl_mark_all",
+ "--popl_mark_all",
Arg.Unit
- (function _ -> Flag_cocci.popl := true; Flag_popl.mark_all := true),
+ (function _ -> FC.popl := true; Flag_popl.mark_all := true),
" simplified SmPL, for the popl paper";
- "-popl_keep_all_wits",
+ "--popl_keep_all_wits",
Arg.Unit
- (function _ -> Flag_cocci.popl := true; Flag_popl.keep_all_wits := true),
+ (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),
+ "--hrule", Arg.String
+ (function s ->
+ Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
" semantic patch generation";
-
- "-loop", Arg.Set Flag_ctl.loop_in_src_code, " ";
-
- "-l1", Arg.Clear Flag_parsing_c.label_strategy_2, " ";
- "-ifdef_to_if", Arg.Set Flag_cocci.ifdef_to_if,
+*)
+ "--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";
+ "--no-saved-typedefs", Arg.Clear Flag_cocci.use_saved_typedefs,
+ " drop all inferred typedefs from one parse of some code to the next";
+
+ "--ocaml-regexps", Arg.Clear Regexp.pcre_support,
+ " use OCaml Str regular expressions for constraints";
+
+ "--l1", Arg.Clear Flag_parsing_c.label_strategy_2, " ";
+ "--ifdef-to-if", Arg.Set FC.ifdef_to_if,
+ " convert ifdef to if (experimental)";
+ "--no-ifdef-to-if", Arg.Clear FC.ifdef_to_if,
" convert ifdef to if (experimental)";
- "-noif0_passing", Arg.Clear Flag_parsing_c.if0_passing,
- " ";
- "-noadd_typedef_root", Arg.Clear Flag_parsing_c.add_typedef_root, " ";
+ "--disable-multi-pass", Arg.Set Flag_parsing_c.disable_multi_pass, " ";
+
+ "--noif0-passing", Arg.Clear Flag_parsing_c.if0_passing, " ";
+ "--defined", Arg.String (Flag_parsing_c.add Flag_parsing_c.defined), " ";
+ "--undefined", Arg.String
+ (Flag_parsing_c.add Flag_parsing_c.undefined), " ";
+ "--noadd-typedef-root", Arg.Clear Flag_parsing_c.add_typedef_root, " ";
(* could use Flag_parsing_c.options_algo instead *)
- "-disallow_nested_exps", Arg.Set Flag_matcher.disallow_nested_exps,
- "disallow an expresion pattern from matching a term and its subterm";
- "-disable_worth_trying_opt", Arg.Clear Flag_cocci.worth_trying_opt,
+ "--disallow-nested-exps", Arg.Set Flag_matcher.disallow_nested_exps,
+ " 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",
+ "--only-return-is-error-exit",
Arg.Set Flag_matcher.only_return_is_error_exit,
"if this flag is not set, then break and continue are also error exits";
(* the following is a hack to make it easier to add code in sgrep-like
code, essentially to compensate for the fact that we don't have
any way of printing things out *)
- "-allow_inconsistent_paths",
+ "--allow-inconsistent-paths",
Arg.Set Flag_matcher.allow_inconsistent_paths,
- "if this flag is set don't check for inconsistent paths; dangerous";
+ " if this flag is set don't check for inconsistent paths; dangerous";
+ "--no-safe-expressions",
+ Arg.Set Flag_matcher.no_safe_expressions,
+ " make an expression disjunction not prioritise the topmost disjunct";
+ "--int-bits", Arg.Int Flag_parsing_c.set_int_bits,
+ " the number of bits in an unsigned int";
+ "--long-bits", Arg.Int Flag_parsing_c.set_long_bits,
+ " the number of bits in an unsigned long";
+ "--linux-spacing", Arg.Unit Flag_parsing_c.set_linux_spacing,
+ " 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";
+ "--c++", Arg.Set Flag.c_plus_plus,
+ " make a small attempt to parse C++ files"
];
"misc options",
"",
[
- "-debugger", Arg.Set Common.debugger ,
+ "--debugger", Arg.Set Common.debugger,
" option to set if launch spatch in ocamldebug";
- "-disable_once", Arg.Set Common.disable_pr2_once,
+ "--disable-once", Arg.Set Common.disable_pr2_once,
" to print more messages";
- "-save_tmp_files", Arg.Set Common.save_tmp_files, " ";
+ "--show-trace-profile", Arg.Set Common.show_trace_profile,
+ " show trace";
+ "--save-tmp-files", Arg.Set Common.save_tmp_files, " ";
+ "--external-analysis-file", Arg.String
+ (Externalanalysis.load_external_results),
+ " import results from an external analysis";
];
"concurrency",
"",
[
- "-index", Arg.Int (function x -> distrib_index := Some x) ,
+ "--index", Arg.Int (function x -> distrib_index := Some x) ,
" the processor to use for this run of spatch";
- "-max", Arg.Int (function x -> distrib_max := Some x) ,
+ "--max", Arg.Int (function x -> distrib_max := Some x) ,
" the number of processors available";
- "-mod_distrib", Arg.Set mod_distrib,
+ "--mod-distrib", Arg.Set mod_distrib,
" use mod to distribute files among the processors";
];
"pad options",
"",
[
- "-use_cache", Arg.Set Flag_parsing_c.use_cache,
+ "--use-cache", Arg.Set Flag_parsing_c.use_cache,
" use .ast_raw pre-parsed cached C file";
+ "--cache-prefix",
+ Arg.String (function s ->
+ Flag_parsing_c.cache_prefix := Some s;
+ Flag_parsing_c.use_cache := true),
+ " directory of cached ASTs, sets -use-cache";
(* could use Flag_parsing_c.options_pad instead *)
+ "--cache-limit",
+ Arg.Int (function n ->
+ Flag_parsing_c.cache_limit := Some n),
+ " maximum number of cached ASTs, sets -use-cache";
];
"test mode and test options (works with tests/ or .ok files)",
- "The test options don't work with the -sp_file and so on.",
+ "The test options don't work with the --sp-file and so on.",
[
- "-test", Arg.Set test_mode,
+ "--test", Arg.Set test_mode,
" <file> launch spatch on tests/file.[c,cocci]";
- "-testall", Arg.Set test_all,
+ "--testall", Arg.Set test_all,
" launch spatch on all files in tests/ having a .res";
- "-test_okfailed", Arg.Set test_okfailed,
+ "--test-okfailed", Arg.Set test_okfailed,
" generates .{ok,failed,spatch_ok} files using .res files";
- "-test_regression_okfailed", Arg.Set test_regression_okfailed,
+ "--test-regression-okfailed", Arg.Set test_regression_okfailed,
" process the .{ok,failed,spatch_ok} files in current dir";
- "-compare_with_expected", Arg.Set compare_with_expected,
- " use also file.res";
- "-relax_include_path", Arg.Set Flag_cocci.relax_include_path,
+ "--compare-with-expected", Arg.Set compare_with_expected,
+ " use also file.res";
+ "--expected-score-file", Arg.Set_string expected_score_file,
+ " which score file to compare with in -testall";
+ "--no-update-score-file", Arg.Clear allow_update_score_file,
+ " do not update the score file when -testall succeeds";
+ "--relax-include-path", Arg.Set FC.relax_include_path,
" ";
-
];
"action mode",
- ("The action options don't work with the -sp_file and so on." ^ "\n" ^
+ ("The action options don't work with the --sp-file and so on." ^ "\n" ^
"It's for the other (internal) uses of the spatch program."
),
(* -token_c, -parse_c, etc *)
((Common.options_of_actions action (Test_parsing_c.actions())) ++
[
- (let s = "-parse_cocci" in s, Arg.Unit (fun () -> action := s),
+ (let s = "--parse-cocci" in s, Arg.Unit (fun () -> action := s),
" <file>");
- (let s = "-compare_c" in s, Arg.Unit (fun () -> action := s),
+ (let s = "--compare-c" in s, Arg.Unit (fun () -> action := s),
" <file1> <file2>");
]);
]
-let all_options =
+let all_options =
short_options ++ List.concat (List.map Common.thd3 other_options)
-
-
(* I don't want the -help and --help that are appended by Arg.align *)
let arg_align2 xs =
Arg.align xs +> List.rev +> Common.drop 2 +> List.rev
+(*
+ Ignore unknown option
+
+ This simplifies the integration of Coccinelle in toolchain. For
+ instance, spatch can then be used as a checker in the Linux build
+ system.
+
+*)
+let check_include_path () =
+ let opt = Array.get Sys.argv !Arg.current in
+ let is_include_re = Str.regexp "-I\\(.*\\)" in
+ if Str.string_match is_include_re opt 0 then
+ let path = Str.matched_group 1 opt in
+ FC.include_path:= path::!FC.include_path
+ else ()
+
+let rec arg_parse_no_fail l f msg =
+ try
+ check_include_path ();
+ Arg.parse_argv Sys.argv l f msg;
+ with
+ | Arg.Bad emsg ->
+ arg_parse_no_fail l f msg
+ | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
+ raise (Impossible 165) (* -help is specified in speclist *)
+
(* copy paste of Arg.parse. Don't want the default -help msg *)
-let arg_parse2 l f msg =
+let arg_parse2 l f msg argv =
(try
- Arg.parse_argv Sys.argv l f msg;
+ Arg.parse_argv argv l f msg;
with
- | Arg.Bad msg -> (* eprintf "%s" msg; exit 2; *)
- let xs = Common.lines msg in
- (* take only head, it's where the error msg is *)
- pr2 (List.hd xs);
- !short_usage_func();
- raise (Common.UnixExit (2))
+ | Arg.Bad emsg -> (* eprintf "%s" msg; exit 2; *)
+ if not !ignore_unknown_opt then
+ begin
+ let xs = Common.lines emsg in
+ (* take only head, it's where the error msg is *)
+ pr2 (List.hd xs);
+ !short_usage_func();
+ raise (Common.UnixExit (2))
+ end
+ else
+ arg_parse_no_fail l f msg;
| Arg.Help msg -> (* printf "%s" msg; exit 0; *)
- raise Impossible (* -help is specified in speclist *)
+ raise (Impossible 166) (* -help is specified in speclist *)
)
let short_usage () =
begin
- Common.short_usage usage_msg short_options;
+ Common.short_usage usage_msg short_options;
pr2 "";
pr2 "Example of use:";
- pr2 " ./spatch -sp_file foo.cocci foo.c -o /tmp/newfoo.c";
+ pr2 " ./spatch --sp-file foo.cocci foo.c -o /tmp/newfoo.c";
pr2 "";
end
-let long_usage () =
+let long_usage () =
Common.long_usage usage_msg short_options other_options
let _ = short_usage_func := short_usage
(* Helpers *)
(*****************************************************************************)
-let adjust_stdin cfile k =
- if !dir
- then k()
- else
- let newin =
- try
- let (dir, base, ext) = Common.dbe_of_filename cfile in
- let varfile = Common.filename_of_dbe (dir, base, "var") in
- if ext = "c" && Common.lfile_exists varfile
- then Some varfile
- else None
- with Invalid_argument("Filename.chop_extension") -> None
- in
- Common.redirect_stdin_opt newin k
-
-let glimpse_filter (coccifile, isofile) dir =
- let (astcocci,_free_var_lists,_negated_positions,
- _used_after_lists,_positions_lists,_,query) =
+(* for fresh identifier information *)
+let adjust_stdin cfiles k =
+ match cfiles with
+ [] -> failwith "not possible"
+ | cfile::_ ->
+ let newin =
+ try
+ let (dir, base, ext) = Common.dbe_of_filename cfile in
+ let varfile = Common.filename_of_dbe (dir, base, "var") in
+ if ext =$= "c" && Common.lfile_exists varfile
+ then Some varfile
+ else None
+ with Invalid_argument("Filename.chop_extension") -> None in
+ Common.redirect_stdin_opt newin k
+
+let glimpse_filter (coccifile, isofile) dir =
+ let (_metavars,astcocci,_free_var_lists,_negated_positions,
+ _used_after_lists,_positions_lists,(_,query,_)) =
+ Cocci.sp_of_file coccifile (Some isofile) in
+ match query with
+ None -> pr2 "no inferred glimpse keywords"; None
+ | Some queries ->
+ let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in
+ let rec loop = function
+ [] -> None (* error, eg due to pattern too big *)
+ | query::queries ->
+ Printf.fprintf stderr "%s\n" ("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
+ match stat with
+ Unix.WEXITED(0) | Unix.WEXITED(1) ->
+ Printf.fprintf stderr "got files\n"; flush stderr;
+ Some
+ (glimpse_res +>
+ List.filter
+ (fun file -> List.mem (Common.filesuffix file) suffixes))
+ | _ -> loop queries (* error, eg due to pattern too big *) in
+ loop queries
+
+let idutils_filter (coccifile, isofile) dir =
+ let (_metavars,astcocci,_free_var_lists,_negated_positions,
+ _used_after_lists,_positions_lists,(_,_,query)) =
Cocci.sp_of_file coccifile (Some isofile) in
match query with
- None -> pr2 "no glimpse keyword infered from snippet"; None
+ None -> pr2 "no inferred idutils keywords"; None
| 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
- match stat with
- Unix.WEXITED(0) | Unix.WEXITED(1) ->
- Some
- (glimpse_res +>
- List.filter
- (fun file -> List.mem (Common.filesuffix file) suffixes))
- | _ -> None (* error, eg due to pattern too big *)
-
-
-
+ let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in
+ let files = Id_utils.interpret dir query in
+ Printf.fprintf stderr "got files\n"; flush stderr;
+ Some
+ (files +>
+ List.filter (fun file -> List.mem (Common.filesuffix file) suffixes))
(*****************************************************************************)
-(* The coccinelle main entry point *)
+(* Main action *)
(*****************************************************************************)
-let main () =
- begin
- let args = ref [] in
-
- arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg;
-
- (if !dir && List.length !args > 1
- then
- begin
- let chosen = List.hd !args in
- pr2 ("ignoring all but the last specified directory: "^chosen);
- args := [chosen]
- end);
- args := List.rev !args;
-
- (if !Flag_cocci.all_includes && !Flag_cocci.no_includes
- then failwith "cannot set both all_includes and no_includes");
- if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$"))
- then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci";
-
- if !Config.std_iso <> ""
- then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso";
- if !Config.std_h <> ""
- then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h";
-
- if !Config.std_h <> ""
- then Parse_c.init_defs !Config.std_h;
-
-
- (* must be done after Arg.parse, because Common.profile is set by it *)
- Common.profile_code "Main total" (fun () ->
-
-
- let all_actions = Test_parsing_c.actions() in
-
- (match (!args) with
-
- (* --------------------------------------------------------- *)
- (* The test framework. Works with tests/ or .ok and .failed *)
- (* --------------------------------------------------------- *)
- | [x] when !test_mode ->
- Flag_cocci.include_path := "tests/include";
- Testing.testone x !compare_with_expected
-
- | [] when !test_all ->
- Flag_cocci.include_path := "tests/include";
- Testing.testall ()
-
- | [] when !test_regression_okfailed ->
- Testing.test_regression_okfailed ()
-
- | x::xs when !test_okfailed ->
- (* do its own timeout on Flag_cocci.timeout internally *)
- Flag_cocci.relax_include_path := true;
- adjust_stdin x (fun () ->
- Testing.test_okfailed !cocci_file (x::xs)
- )
-
- (* --------------------------------------------------------- *)
- (* Actions, useful to debug subpart of coccinelle *)
- (* --------------------------------------------------------- *)
-
- | xs when List.mem !action (Common.action_list all_actions) ->
- Common.do_action !action xs all_actions
-
- | [file] when !action = "-parse_cocci" ->
- Testing.test_parse_cocci file
-
- (* I think this is used by some scripts in some Makefile for our
- * big-tests. So dont remove.
- *)
- | [file1;file2] when !action = "-compare_c" ->
- Test_parsing_c.test_compare_c file1 file2 (* result = unix code *)
-
- (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
-
-
- (* --------------------------------------------------------- *)
- (* This is the main entry *)
- (* --------------------------------------------------------- *)
- | x::xs ->
- adjust_stdin x (fun () ->
- if !cocci_file = ""
- then failwith "I need a cocci file, use -sp_file <file>";
-
- if !dir && !Flag.patch = None
+let rec main_action xs =
+ let (cocci_files,xs) =
+ List.partition (function nm -> Filename.check_suffix nm ".cocci") xs in
+ (match (!cocci_file,cocci_files) with
+ "",[fl] -> cocci_file := fl
+ | _,[] -> ()
+ | _ -> failwith "only one .cocci file allowed");
+ Iteration.base_file_list := xs;
+ let rec toploop = function
+ [] -> failwith "no C files provided"
+ | x::xs ->
+ (* a more general solution would be to use
+ * Common.files_of_dir_or_files (x::xs)
+ * as some elements in xs may also be directories, or individual
+ * files.
+ *)
+ dir := (Common.is_directory x);
+
+ if !cocci_file =$= ""
+ then failwith "I need a cocci file, use --sp-file <file>";
+
+ 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"^
"directory is specified or when the -patch flag is used")
- );
-
- let infiles =
- Common.profile_code "Main.infiles computation" (fun () ->
- match !dir, !kbuild_info, !Flag.use_glimpse with
- (* glimpse *)
- | false, _, true ->
- failwith "-use_glimpse works only with -dir"
- | true, s, true when s <> "" ->
- failwith "-use_glimpse does not work with -kbuild"
- | true, "", true ->
- if not (null xs)
- then failwith "-use_glimpse can accept only one dir";
-
+ );
+ Flag.dir := x;
+
+ let infiles =
+ Common.profile_code "Main.infiles computation" (fun () ->
+ match !dir, !kbuild_info, !Flag.scanner, xs with
+ (* glimpse *)
+ | false, _, (Flag.Glimpse|Flag.IdUtils), _ -> [x::xs]
+ | true, s, (Flag.Glimpse|Flag.IdUtils), _ when s <> "" ->
+ failwith
+ "--use-glimpse or --id-utils does not work with --kbuild"
+ | true, "", Flag.Glimpse, [] ->
+ (*if not (null xs)
+ then failwith "--use-glimpse can accept only one dir"*)
+
let files =
match glimpse_filter (!cocci_file, !Config.std_iso) x with
- None ->
- Common.cmd_to_list (* same as "true, "", _" case *)
- (if !include_headers
- then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
- else ("find "^(join " " (x::xs))^" -name \"*.c\""))
+ None -> Test_parsing_c.get_files x
+ | Some files -> files in
+ files +> List.map (fun x -> [x])
+ | true, "", Flag.IdUtils, [] ->
+ (*if not (null xs)
+ then failwith "--id-utils can accept only one dir"*)
+
+ let files =
+ match idutils_filter (!cocci_file, !Config.std_iso) x with
+ None -> Test_parsing_c.get_files x
| Some files -> files in
files +> List.map (fun x -> [x])
- (* normal *)
- | false, _, _ -> [x::xs]
- | true, "", _ ->
- Common.cmd_to_list
- (if !include_headers
- then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
- else ("find "^(join " " (x::xs))^" -name \"*.c\""))
- +> List.map (fun x -> [x])
-
- (* kbuild *)
- | true, kbuild_info_file,_ ->
- let dirs =
- Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d")
+ (* normal *)
+ | false, _, _, _ -> [x::xs]
+ | true, "", _, _ ->
+ Test_parsing_c.get_files (join " " (x::xs)) +> List.map (fun x -> [x])
+
+ (* kbuild *)
+ | true, kbuild_info_file,_,_ ->
+ let dirs =
+ Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d")
in
let info = Kbuild.parse_kbuild_info kbuild_info_file in
let groups = Kbuild.files_in_dirs dirs info in
groups +> List.map (function Kbuild.Group xs -> xs)
- )
+ )
in
+ (* make cache unique in parallel case *)
+ (match (!distrib_index,!Flag_parsing_c.cache_prefix) with
+ (Some index,Some str) ->
+ Flag_parsing_c.cache_prefix :=
+ Some (Printf.sprintf "%s/d%d" str index)
+ | _ -> ());
+
let infiles =
match (!distrib_index,!distrib_max) with
(None,None) -> infiles
let rec loop ct = function
[] -> []
| x::xs ->
- if (ct mod max) = index
+ if (ct mod max) =|= index
then x::(loop (ct+1) xs)
else loop (ct+1) xs in
loop 0 infiles
loop 0 infiles
end
| _ -> failwith "inconsistent distribution information" in
-
- let outfiles =
- Common.profile_code "Main.outfiles computation" (fun () ->
- infiles +> List.map (fun cfiles ->
- pr2 ("HANDLING: " ^ (join " " cfiles));
- Common.timeout_function_opt !Flag_cocci.timeout (fun () ->
- Common.report_if_take_time 10 (join " " cfiles) (fun () ->
- (* Unix.sleep 1; *)
- try
- (* this is the main call *)
- Cocci.full_engine (!cocci_file, !Config.std_iso) cfiles
- with
- | Common.UnixExit x -> raise (Common.UnixExit x)
- | e ->
- if !dir
- then begin
- pr2 ("EXN:" ^ Printexc.to_string e);
- [] (* *)
- end
- else raise e)))
- ) +> List.concat
- in
+
+ let (cocci_infos,outfiles) =
+ Common.profile_code "Main.outfiles computation" (fun () ->
+ let cocci_infos =
+ Cocci.pre_engine (!cocci_file, !Config.std_iso) in
+ let res =
+ infiles +> List.map (fun cfiles ->
+ pr2 ("HANDLING: " ^ (join " " cfiles));
+ (*pr2 (List.hd(Common.cmd_to_list "free -m | grep Mem"));*)
+ flush stderr;
+
+ Common.timeout_function_opt !FC.timeout (fun () ->
+ Common.report_if_take_time 10 (join " " cfiles) (fun () ->
+ try
+ let optfile =
+ if !output_file <> "" && !compat_mode then
+ Some !output_file
+ else
+ None
+ in
+ adjust_stdin cfiles (fun () ->
+ Common.redirect_stdout_opt optfile (fun () ->
+ (* this is the main call *)
+ Cocci.full_engine cocci_infos cfiles
+ ))
+ with
+ | Common.UnixExit x -> raise (Common.UnixExit x)
+ | Pycocci.Pycocciexception ->
+ raise Pycocci.Pycocciexception
+ | e ->
+ if !dir
+ then begin
+ pr2 ("EXN:" ^ Printexc.to_string e);
+ [] (* *)
+ end
+ else raise e))) in
+ (cocci_infos,res)) in
+ let outfiles = List.concat outfiles in
+ (match Iteration.get_pending_instance() with
+ None ->
+ (x,xs,cocci_infos,outfiles)
+ | Some (files,virt_rules,virt_ids) ->
+ if outfiles = [] or outfiles = [] or not !FC.show_diff
+ or !inplace_modif
+ then
+ begin
+ (if !inplace_modif then generate_outfiles outfiles x xs);
+ Flag.defined_virtual_rules := virt_rules;
+ Flag.defined_virtual_env := virt_ids;
+ Common.erase_temp_files();
+ Common.clear_pr2_once();
+ distrib_index := None;
+ distrib_max := None;
+ toploop files
+ end
+ else
+ begin
+ Common.pr2
+ "Out of place transformation not compatible with iteration. Aborting.\n consider using -no_show_diff or -in_place";
+ (x,xs,cocci_infos,outfiles)
+ end) in
+ let (x,xs,cocci_infos,outfiles) = toploop xs in
+
+ Cocci.post_engine cocci_infos;
+ Common.profile_code "Main.result analysis" (fun () ->
+ Ctlcocci_integration.print_bench();
+ generate_outfiles outfiles x xs;
+ if !compare_with_expected
+ then Testing.compare_with_expected outfiles)
+
+and generate_outfiles outfiles x (* front file *) xs (* other files *) =
+ let outfiles = Cocci.check_duplicate_modif outfiles in
+ outfiles +> List.iter (fun (infile, outopt) ->
+ outopt +> Common.do_option (fun outfile ->
+ if !inplace_modif
+ then begin
+ (match !backup_suffix with
+ Some backup_suffix ->
+ Common.command2 ("cp "^infile^" "^infile^backup_suffix)
+ | None -> ());
+ Common.command2 ("cp "^outfile^" "^infile);
+ end;
+
+ if !outplace_modif
+ then Common.command2 ("cp "^outfile^" "^infile^".cocci_res")
+
+ (* potential source of security pb if the /tmp/ file is
+ * a symlink, so simpler to not produce any regular file
+ * (files created by Common.new_temp_file are still ok)
+ * anymore in /tmp.
+ *)
+ (*
+ if !output_file =$= ""
+ then begin
+ let tmpfile = "/tmp/"^Common.basename infile in
+ pr2 (spf "One file modified. Result is here: %s" tmpfile);
+ Common.command2 ("cp "^outfile^" "^tmpfile);
+ end
+ *)
+ ));
+ if !output_file <> "" && not !compat_mode then
+ (match outfiles with
+ | [infile, Some outfile] when infile =$= x && null xs ->
+ Common.command2 ("cp " ^outfile^ " " ^ !output_file)
+ | [infile, None] when infile =$= x && null xs ->
+ Common.command2 ("cp " ^infile^ " " ^ !output_file)
+ | _ ->
+ failwith
+ ("-o can not be applied because there are multiple " ^
+ "modified files"))
+
+let fix_chars s =
+ if (String.length s) > 2 && String.get s 0 = '-'
+ && not (String.get s 1 = '-')
+ then "-"^(String.concat "-" (Str.split (Str.regexp_string "_") s))
+ else s
- Common.profile_code "Main.result analysis" (fun () ->
-
- Ctlcocci_integration.print_bench();
-
- let outfiles = Cocci.check_duplicate_modif outfiles in
-
- outfiles +> List.iter (fun (infile, outopt) ->
- outopt +> Common.do_option (fun outfile ->
- if !inplace_modif
- then begin
- Common.command2 ("cp "^infile^" "^infile^".cocci_orig");
- Common.command2 ("cp "^outfile^" "^infile);
- end;
-
- if !outplace_modif
- then Common.command2 ("cp "^outfile^" "^infile^".cocci_res");
-
- if !output_file = ""
- then begin
- let tmpfile = "/tmp/"^Common.basename infile in
- pr2 (spf "One file modified. Result is here: %s" tmpfile);
- Common.command2 ("cp "^outfile^" "^tmpfile);
+(*****************************************************************************)
+(* The coccinelle main entry point *)
+(*****************************************************************************)
+let main () =
+ begin
+ let arglist = Array.to_list Sys.argv in
+ let arglist = Command_line.command_line arglist in
+ let arglist = List.map fix_chars arglist in
+
+ let contains_cocci =
+ (* rather a hack... don't want to think about all possible options *)
+ List.exists
+ (function x -> Filename.check_suffix x ".cocci")
+ arglist &&
+ not (List.mem "--parse-cocci" arglist) in
+ if not (null (Common.inter_set arglist
+ ["--cocci-file";"--sp-file";"--sp";"--test";"--testall";
+ "--test-okfailed";"--test-regression-okfailed"]))
+ or contains_cocci
+ then run_profile quiet_profile;
+
+ let args = ref [] in
+
+ (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*)
+
+ (* this call can set up many global flag variables via the cmd line *)
+ arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg
+ (Array.of_list arglist);
+ args :=
+ List.filter
+ (function arg ->
+ if Filename.check_suffix arg ".cocci"
+ then
+ begin
+ (if !cocci_file = ""
+ then cocci_file := arg
+ else failwith "only one .cocci file allowed");
+ false
+ end
+ else true)
+ !args;
+ (match (!Flag_parsing_c.cache_prefix,!distrib_index) with
+ (Some cp,Some n) ->
+ Flag_parsing_c.cache_prefix :=
+ Some (Printf.sprintf "%s_%d" cp n)
+ | _ -> ());
+
+ (* julia hack so that one can override directories specified on
+ * the command line. *)
+ (if !dir
+ then
+ let chosen_dir =
+ if List.length !args > 1
+ then
+ begin
+ let chosen = List.hd !args in
+ Flag.dir := chosen;
+ pr2 ("ignoring all but the last specified directory: "^chosen);
+ args := [chosen];
+ chosen
+ end
+ else List.hd !args in
+ if !FC.include_path =*= []
+ then FC.include_path := [Filename.concat chosen_dir "include"]);
+
+ args := List.rev !args;
+
+ if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$"))
+ then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci";
+
+ if !Config.std_iso <> ""
+ then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso";
+ if !Config.std_h <> ""
+ then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h";
+
+ if !Config.std_h <> ""
+ then Parse_c.init_defs_builtins !Config.std_h;
+
+ if !macro_file <> ""
+ then Parse_c.init_defs_macros !macro_file;
+
+
+ (* must be done after Arg.parse, because Common.profile is set by it *)
+ Common.profile_code "Main total" (fun () ->
+
+
+ let all_actions = Test_parsing_c.actions() in
+
+ (match (!args) with
+
+ (* --------------------------------------------------------- *)
+ (* The test framework. Works with tests/ or .ok and .failed *)
+ (* --------------------------------------------------------- *)
+ | [x] when !test_mode ->
+ begin
+ let prefix = "tests/" in
+ let testfile = x ^ ".cocci" in
+ if Sys.file_exists (prefix ^ testfile) then
+ begin
+ (if !FC.include_path = []
+ then FC.include_path := [prefix^"include"]);
+ Testing.testone prefix x !compare_with_expected
+ end
+ else
+ if Sys.file_exists testfile then
+ begin
+ (if !FC.include_path = []
+ then FC.include_path := ["include"]);
+ Testing.testone "" x !compare_with_expected
end
- ));
- if !output_file <> "" then
- (match outfiles with
- | [infile, Some outfile] when infile = x && null xs ->
- Common.command2 ("cp " ^outfile^ " " ^ !output_file);
- | [infile, None] when infile = x && null xs ->
- Common.command2 ("cp " ^infile^ " " ^ !output_file);
- | _ ->
- failwith
- ("-o can not be applied because there is multiple " ^
- "modified files");
- );
-
- if !compare_with_expected
- then Testing.compare_with_expected outfiles))
-
+ else
+ Printf.fprintf stderr
+ "ERROR: File %s does not exist\n" testfile
+ end
+
+ | [] when !test_all ->
+ (if !FC.include_path = []
+ then FC.include_path := ["tests/include"]);
+ let score_file = if !expected_score_file <> ""
+ then !expected_score_file
+ else "tests/SCORE_expected.sexp" in
+ Testing.testall score_file !allow_update_score_file
+
+ | [] when !test_regression_okfailed ->
+ Testing.test_regression_okfailed ()
+
+ | ((x::xs) as cfiles) when !test_okfailed ->
+ (* do its own timeout on FC.timeout internally *)
+ FC.relax_include_path := true;
+ adjust_stdin cfiles (fun () ->
+ Testing.test_okfailed !cocci_file cfiles
+ )
+
+ (* --------------------------------------------------------- *)
+ (* Actions, useful to debug subpart of coccinelle *)
+ (* --------------------------------------------------------- *)
+
+ | xs when List.mem !action (Common.action_list all_actions) ->
+ Common.do_action !action xs all_actions
+
+ | [] when !action =$= "--parse-cocci" ->
+ Testing.test_parse_cocci !cocci_file
+
+ (* I think this is used by some scripts in some Makefile for our
+ * big-tests. So dont remove.
+ *)
+ | [file1;file2] when !action =$= "--compare-c" ->
+ Test_parsing_c.test_compare_c file1 file2 (* result = unix code *)
+
+ (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
+
+
+ (* --------------------------------------------------------- *)
+ (* This is the main entry *)
+ (* --------------------------------------------------------- *)
+ | x::xs -> main_action (x::xs)
+
(* --------------------------------------------------------- *)
(* empty entry *)
(* --------------------------------------------------------- *)
| [] -> short_usage()
-
));
if !Pycocci.initialised && (Pycocci.py_isinitialized ()) != 0 then begin
ignore(Pycocci.pyrun_simplestring "cocci.finalise()");
- if !Flag.show_misc
+ if !Flag.show_misc
then Common.pr2 "Finalizing python\n";
Pycocci.py_finalize ();
end
end
+
+let main_with_better_error_report () =
+ if !Common.debugger then main ()
+ else
+ try
+ main ()
+ with
+ | Unix.Unix_error (e, "stat", filename) ->
+ Printf.fprintf stderr "ERROR: File %s does not exist: %s\n"
+ filename (Unix.error_message e);
+ raise (UnixExit (-1))
+ | Parse_cocci.Bad_virt s ->
+ Printf.fprintf stderr "virtual rule %s not supported\n" s;
+ raise (UnixExit (-1))
+
(*****************************************************************************)
-let _ =
- Common.main_boilerplate (fun () ->
- main ();
+let start =
+ Common.main_boilerplate (fun () ->
+ main_with_better_error_report ();
Ctlcocci_integration.print_bench();
)
HCoop / bpt / coccinelle.git / blobdiff