X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/9bc82bae75129fec4d981ebf245f2f7d7ca73a41..HEAD:/main.ml diff --git a/main.ml b/main.ml index 431238a..e64fe96 100644 --- a/main.ml +++ b/main.ml @@ -1,29 +1,7 @@ (* - * 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. - *) - - -(* - * Copyright 2010, INRIA, University of Copenhagen + * 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 @@ -46,6 +24,7 @@ *) +# 0 "./main.ml" open Common module FC = Flag_cocci @@ -72,7 +51,6 @@ let ignore_unknown_opt = ref false (* somehow obsolete now *) let dir = ref false -let include_headers = ref false let kbuild_info = ref "" let macro_file = ref "" @@ -83,7 +61,7 @@ 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 "" @@ -95,7 +73,6 @@ let distrib_index = ref (None : int option) let distrib_max = ref (None : int option) let mod_distrib = ref false - (*****************************************************************************) (* Profiles *) (*****************************************************************************) @@ -204,6 +181,7 @@ let debug_profile = ( FC.show_binding_in_out; FC.show_dependencies; + Flag_parsing_cocci.keep_ml_script; Flag_parsing_cocci.show_iso_failures; FC.verbose_cocci; @@ -274,7 +252,7 @@ let run_profile p = let usage_msg = "Usage: " ^ basename Sys.argv.(0) ^ - " -sp_file [-o ] [-iso_file ] [options]" ^ + " --sp-file [-o ] [--iso-file ] [options]" ^ "\n" ^ "Options are:" (* forward reference trick *) @@ -292,94 +270,100 @@ let long_usage_func = ref (fun () -> ()) * use -longhelp to see them. *) let short_options = [ - "-sp_file", Arg.Set_string cocci_file, + "--sp-file", Arg.Set_string cocci_file, " the semantic patch file"; "-o", Arg.Set_string output_file, " the output file"; - "-in_place", Arg.Set inplace_modif, + "--in-place", Arg.Set inplace_modif, " do the modification on the file directly"; - "-backup_suffix", Arg.String (function s -> backup_suffix := Some s), + "--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, + "--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)), " 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, " (default=" ^ !Config.std_iso ^")"; - "-macro_file", Arg.Set_string macro_file, + "--macro-file", Arg.Set_string macro_file, " "; - "-macro_file_builtins", Arg.Set_string Config.std_h, + "--macro-file-builtins", Arg.Set_string Config.std_h, " (default=" ^ !Config.std_h ^ ")"; - "-recursive_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", + "--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", + "--no-includes", Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES), " causes not even local include files to be used"; - "-local_includes", + "--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, + "--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 include_headers, + "--include-headers", Arg.Set Flag.include_headers, " process header files independently"; - "-I", Arg.String (fun x -> - FC.include_path:= x::!FC.include_path - ), - " containing the header files (optional)"; + "-I", Arg.String (fun x -> FC.include_path:= x::!FC.include_path), + " 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, + "--preprocess", Arg.Set preprocess, " run the C preprocessor before applying the semantic match"; "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode"; - "-dir", Arg.Set dir, + "--dir", Arg.Set dir, " process all files in directory recursively"; - "-use_glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse), + "--use-glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse), " works with -dir, use info generated by glimpseindex"; - "-use_google", Arg.String (function s -> Flag.scanner := Flag.Google 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), + "--use-idutils", Arg.Unit (function s -> Flag.scanner := Flag.IdUtils), " find relevant files using id-utils"; - "-patch", + "--patch", Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)), (" 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, " improve -dir by grouping related c files"; - "-pyoutput", Arg.Set_string Flag.pyoutput, + "--pyoutput", Arg.Set_string Flag.pyoutput, " Sets output routine: Standard values: "; - "-version", Arg.Unit (fun () -> + "--version", Arg.Unit (fun () -> let withpython = if Pycocci.python_support then "with" else "without" in - pr2 (spf "spatch version %s %s Python support" Config.version withpython); + 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: 2010/11/13 21:06:27 $"; + "--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) ), @@ -403,10 +387,11 @@ let other_options = [ "aliases and obsolete options", "", [ - "-sp", Arg.Set_string cocci_file, " short option of -sp_file"; - "-iso", Arg.Set_string Config.std_iso, " short option of -iso_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, + "--cocci-file", Arg.Set_string cocci_file, " the semantic patch file"; (* "-c", Arg.Set_string cocci_file, " short option of -sp_file"; *) ]; @@ -414,23 +399,25 @@ let other_options = [ "most useful show options", "", [ - "-show_diff" , Arg.Set FC.show_diff, " "; - "-no_show_diff" , Arg.Clear FC.show_diff, " "; - "-show_flow" , Arg.Set FC.show_flow, " "; + "--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", + "--ctl-inline-let", Arg.Unit (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " "; - "-ctl_show_mcodekind", + "--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-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", + "--show-dependencies", Arg.Unit (function _ -> FC.show_dependencies := true; FC.show_binding_in_out := true), " show the dependencies related to each rule"; @@ -439,54 +426,54 @@ let other_options = [ "verbose subsystems options", "", [ - "-verbose_ctl_engine", + "--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", + "--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)"; + " remove graph label (requires option -graphical-trace)"; - "-parse_error_msg", Arg.Set Flag_parsing_c.show_parsing_error, " "; - "-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, " "; + "--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 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, " "; + "--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_msg_define_error", Arg.Set Flag_parsing_c.filter_msg_define_error, + "--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," "; + "--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, " "; +(* "--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 *) @@ -496,36 +483,36 @@ let other_options = [ "", [ (* 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), " "; + "--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), " for profiling the CTL engine"; - "-timeout", Arg.Int (fun x -> FC.timeout := Some x), + "--timeout", Arg.Int (fun x -> FC.timeout := Some x), " 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"; - "-iso_limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x), + "--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), + "--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, + "--track-iso", Arg.Set Flag.track_iso_usage, " gather information about isomorphism usage"; - "-disable_iso", + "--disable-iso", Arg.String (fun s -> Flag_parsing_cocci.disabled_isos := s :: !Flag_parsing_cocci.disabled_isos), " disable a specific isomorphism"; - "-profile_iso", + "--profile-iso", Arg.Unit (function () -> Common.profile := @@ -539,139 +526,162 @@ let other_options = [ "change of algorithm options", "", [ - "-popl", Arg.Set FC.popl, +(* "--popl", Arg.Set FC.popl, " simplified SmPL, for the popl paper"; - "-popl_mark_all", + "--popl_mark_all", Arg.Unit (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 _ -> FC.popl := true; Flag_popl.keep_all_wits := true), " simplified SmPL, for the popl paper"; - "-hrule", Arg.String + "--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", 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, + "--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, + "--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, + "--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, + "--no-ifdef-to-if", Arg.Clear FC.ifdef_to_if, " convert ifdef to if (experimental)"; - "-disable_multi_pass", Arg.Set Flag_parsing_c.disable_multi_pass, " "; + "--disable-multi-pass", Arg.Set Flag_parsing_c.disable_multi_pass, " "; - "-noif0_passing", Arg.Clear Flag_parsing_c.if0_passing, - " "; - "-noadd_typedef_root", Arg.Clear Flag_parsing_c.add_typedef_root, " "; + "--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-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, + "--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"; - "-no_safe_expressions", + "--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, + "--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, + "--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, + "--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, + "--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"; - "-show_trace_profile", Arg.Set Common.show_trace_profile, + "--show-trace-profile", Arg.Set Common.show_trace_profile, " show trace"; - "-save_tmp_files", Arg.Set Common.save_tmp_files, " "; + "--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, " 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, + "--compare-with-expected", Arg.Set compare_with_expected, " use also file.res"; - "-expected_score_file", Arg.Set_string expected_score_file, + "--expected-score-file", Arg.Set_string expected_score_file, " which score file to compare with in -testall"; - "-relax_include_path", Arg.Set FC.relax_include_path, + "--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), " "); - (let s = "-compare_c" in s, Arg.Unit (fun () -> action := s), + (let s = "--compare-c" in s, Arg.Unit (fun () -> action := s), " "); ]); ] @@ -708,12 +718,12 @@ let rec arg_parse_no_fail l f msg = | Arg.Bad emsg -> arg_parse_no_fail l f msg | Arg.Help msg -> (* printf "%s" msg; exit 0; *) - raise Impossible (* -help is specified in speclist *) + 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 emsg -> (* eprintf "%s" msg; exit 2; *) if not !ignore_unknown_opt then @@ -727,7 +737,7 @@ let arg_parse2 l f msg = 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 *) ) @@ -736,7 +746,7 @@ let short_usage () = 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 @@ -751,20 +761,20 @@ let _ = long_usage_func := long_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 +(* 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, @@ -773,7 +783,7 @@ let glimpse_filter (coccifile, isofile) dir = match query with None -> pr2 "no inferred glimpse keywords"; None | Some queries -> - let suffixes = if !include_headers then ["c";"h"] else ["c"] in + 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 -> @@ -797,7 +807,7 @@ let idutils_filter (coccifile, isofile) dir = match query with None -> pr2 "no inferred idutils keywords"; None | Some query -> - let suffixes = if !include_headers then ["c";"h"] else ["c"] in + 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 @@ -808,221 +818,235 @@ let idutils_filter (coccifile, isofile) dir = (* Main action *) (*****************************************************************************) -let main_action xs = - match xs with - | x::xs -> - +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. *) - if Common.is_directory x - then dir := true; - - adjust_stdin x (fun () -> - if !cocci_file =$= "" - then failwith "I need a cocci file, use -sp_file "; - - if !dir && !Flag.patch =*= None - then - (match xs with - | [] -> 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") - ); - Flag.dir := x; - - let infiles = - Common.profile_code "Main.infiles computation" (fun () -> - match !dir, !kbuild_info, !Flag.scanner with + dir := (Common.is_directory x); + + if !cocci_file =$= "" + then failwith "I need a cocci file, use --sp-file "; + + if !dir && !Flag.patch =*= None + then + (match xs with + | [] -> 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") + ); + 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) -> - failwith "-use_glimpse or -id_utils works only with -dir" - | 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 - (* FIXME : Could we remove xs ? - -use_glimpse requires a singleton. - This is checked some lines before. - then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"") - else ("find "^(join " " (x::xs))^" -name \"*.c\"")) - *) - then ("find "^ x ^" -name \"*.[ch]\"") - else ("find "^ x ^" -name \"*.c\"")) - | 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 -> - Common.cmd_to_list (* same as "true, "", _" case *) - (if !include_headers - (* FIXME : Could we remove xs ? - -use_glimpse requires a singleton. - This is checked some lines before. - then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"") - else ("find "^(join " " (x::xs))^" -name \"*.c\"")) - *) - then ("find "^ x ^" -name \"*.[ch]\"") - else ("find "^ x ^" -name \"*.c\"")) - | Some files -> files in - files +> List.map (fun x -> [x]) + | 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 -> 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]) - + | 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 - - let infiles = - match (!distrib_index,!distrib_max) with - (None,None) -> infiles - | (Some index,Some max) -> - (if index >= max - then - failwith "index starts at 0, and so must be less than max"); - if !mod_distrib - then - let rec loop ct = function - [] -> [] - | x::xs -> - if (ct mod max) =|= index - then x::(loop (ct+1) xs) - else loop (ct+1) xs in - loop 0 infiles - else - begin - let all_files = List.length infiles in - let regions = (all_files + (max - 1)) / max in - let this_min = index * regions in - let this_max = (index+1) * regions in + | 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 + | (Some index,Some max) -> + (if index >= max + then + failwith "index starts at 0, and so must be less than max"); + if !mod_distrib + then let rec loop ct = function - [] -> [] + [] -> [] | x::xs -> - if this_min <= ct && ct < this_max + if (ct mod max) =|= index then x::(loop (ct+1) xs) else loop (ct+1) xs in loop 0 infiles - end - | _ -> failwith "inconsistent distribution information" in - - let 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)); - 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 = - if !output_file <> "" && !compat_mode then - Some !output_file - else - None - in - Common.redirect_stdout_opt optfile (fun () -> + else + begin + let all_files = List.length infiles in + let regions = (all_files + (max - 1)) / max in + let this_min = index * regions in + let this_max = (index+1) * regions in + let rec loop ct = function + [] -> [] + | x::xs -> + if this_min <= ct && ct < this_max + then x::(loop (ct+1) xs) + else loop (ct+1) xs in + loop 0 infiles + end + | _ -> failwith "inconsistent distribution information" 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 + Cocci.full_engine cocci_infos cfiles + )) + with | Common.UnixExit x -> raise (Common.UnixExit x) | Pycocci.Pycocciexception -> raise Pycocci.Pycocciexception | e -> - (*pr2 "previous"; - pr2 s; - pr2 "new"; - pr2(profile_diagnostic());*) if !dir then begin pr2 ("EXN:" ^ Printexc.to_string e); [] (* *) end else raise e))) in - Cocci.post_engine cocci_infos; - res - ) +> List.concat - in - - 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 - (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"); - + (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. - *) + * 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); + 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 is multiple " ^ - "modified files"); - ); - if !compare_with_expected - then Testing.compare_with_expected outfiles)) - - | [] -> raise Impossible - + 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 (*****************************************************************************) (* The coccinelle main entry point *) @@ -1030,34 +1054,62 @@ let main_action xs = 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"])) + ["--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; - + 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. *) + * 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 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"]); @@ -1095,33 +1147,38 @@ let main () = let testfile = x ^ ".cocci" in if Sys.file_exists (prefix ^ testfile) then begin - FC.include_path := [prefix^"include"]; + (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 - FC.include_path := ["include"]; + (if !FC.include_path = [] + then FC.include_path := ["include"]); Testing.testone "" x !compare_with_expected end else - pr2 (spf "ERROR: File %s does not exist" testfile) + Printf.fprintf stderr + "ERROR: File %s does not exist\n" testfile end | [] when !test_all -> - FC.include_path := ["tests/include"]; - if !expected_score_file <> "" - then Testing.testall ~expected_score_file:!expected_score_file () - else Testing.testall () + (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 when !test_okfailed -> + | ((x::xs) as cfiles) when !test_okfailed -> (* do its own timeout on FC.timeout internally *) FC.relax_include_path := true; - adjust_stdin x (fun () -> - Testing.test_okfailed !cocci_file (x::xs) + adjust_stdin cfiles (fun () -> + Testing.test_okfailed !cocci_file cfiles ) (* --------------------------------------------------------- *) @@ -1131,13 +1188,13 @@ let main () = | 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 + | [] 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" -> + | [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 *) @@ -1169,12 +1226,11 @@ let main_with_better_error_report () = main () with | Unix.Unix_error (e, "stat", filename) -> - pr2 - (spf "ERROR: File %s does not exist: %s" - filename (Unix.error_message e)); + Printf.fprintf stderr "ERROR: File %s does not exist: %s\n" + filename (Unix.error_message e); raise (UnixExit (-1)) | Parse_cocci.Bad_virt s -> - Common.pr2 (Printf.sprintf "virtual rule %s not supported" s); + Printf.fprintf stderr "virtual rule %s not supported\n" s; raise (UnixExit (-1)) (*****************************************************************************)