X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/190f1acf3b0fa9403bea541654465a6a00bf3693..1b9ae60616d2f065ce16fe26385b684e13b40284:/main.ml diff --git a/main.ml b/main.ml index 81cacc7..e64fe96 100644 --- a/main.ml +++ b/main.ml @@ -1,5 +1,7 @@ (* - * 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 @@ -22,6 +24,7 @@ *) +# 0 "./main.ml" open Common module FC = Flag_cocci @@ -48,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 "" @@ -59,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 "" @@ -71,7 +73,6 @@ let distrib_index = ref (None : int option) let distrib_max = ref (None : int option) let mod_distrib = ref false - (*****************************************************************************) (* Profiles *) (*****************************************************************************) @@ -180,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; @@ -250,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 *) @@ -268,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: 2011/03/14 21:16:17 $"; + "--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) ), @@ -379,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"; *) ]; @@ -390,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"; @@ -415,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 *) @@ -472,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 := @@ -515,141 +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, + "--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), " "); ]); ] @@ -686,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 @@ -705,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 *) ) @@ -714,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,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 -> @@ -775,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 @@ -786,28 +818,16 @@ let idutils_filter (coccifile, isofile) dir = (* Main action *) (*****************************************************************************) -let get_files path = - let ch = - 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 "^ path ^" -name \"*.[ch]\"") - else ("find "^ path ^" -name \"*.c\"")) in - let cpp = - if !Flag.c_plus_plus - then Common.cmd_to_list ("find "^ path ^" -name \"*.cpp\"") - else [] in - cpp @ ch - -let main_action 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 - [] -> raise Impossible + [] -> failwith "no C files provided" | x::xs -> (* a more general solution would be to use * Common.files_of_dir_or_files (x::xs) @@ -817,7 +837,7 @@ let main_action xs = dir := (Common.is_directory x); if !cocci_file =$= "" - then failwith "I need a cocci file, use -sp_file "; + then failwith "I need a cocci file, use --sp-file "; if !dir && !Flag.patch =*= None then @@ -832,37 +852,37 @@ let main_action xs = let infiles = Common.profile_code "Main.infiles computation" (fun () -> - match !dir, !kbuild_info, !Flag.scanner with + match !dir, !kbuild_info, !Flag.scanner, xs with (* glimpse *) - | false, _, (Flag.Glimpse|Flag.IdUtils) -> [x::xs] - | true, s, (Flag.Glimpse|Flag.IdUtils) when s <> "" -> + | 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"); + "--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 -> get_files x + 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"); + | 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 -> get_files x + None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) (* normal *) - | false, _, _ -> [x::xs] - | true, "", _ -> - get_files (join " " (x::xs)) +> 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,_ -> + | true, kbuild_info_file,_,_ -> let dirs = Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d") in @@ -872,7 +892,14 @@ let main_action xs = 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 @@ -912,6 +939,9 @@ let main_action xs = 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 @@ -940,21 +970,26 @@ let main_action xs = (cocci_infos,res)) in let outfiles = List.concat outfiles in (match Iteration.get_pending_instance() with - None -> (x,xs,cocci_infos,outfiles) + 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 - "Transformation not compatible with iteration. Aborting."; + "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 @@ -962,21 +997,26 @@ let main_action xs = Cocci.post_engine cocci_infos; 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"); - + 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) @@ -991,31 +1031,42 @@ let main_action xs = 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"); - ); - if !compare_with_expected - then Testing.compare_with_expected outfiles) - - + 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 *) (*****************************************************************************) 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 @@ -1023,7 +1074,26 @@ let main () = (* 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. *) @@ -1089,15 +1159,17 @@ let main () = 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 -> (if !FC.include_path = [] then FC.include_path := ["tests/include"]); - if !expected_score_file <> "" - then Testing.testall ~expected_score_file:!expected_score_file () - else Testing.testall () + 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 () @@ -1116,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 *) @@ -1154,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)) (*****************************************************************************)