X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/113803cf8147c1b5332cc7d9ac43febcc197e4f0..1b9ae60616d2f065ce16fe26385b684e13b40284:/main.ml diff --git a/main.ml b/main.ml index 992b6ae..e64fe96 100644 --- a/main.ml +++ b/main.ml @@ -1,25 +1,30 @@ (* -* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen -* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller -* This file is part of Coccinelle. -* -* Coccinelle is free software: you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation, according to version 2 of the License. -* -* Coccinelle is distributed in the hope that it will be useful, -* but WITHOUT ANY WARRANTY; without even the implied warranty of -* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with Coccinelle. If not, see . -* -* The authors reserve the right to distribute this or future versions of -* Coccinelle under other licenses. -*) + * Copyright 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 . + * + * 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 @@ -35,21 +40,28 @@ module FC = Flag_cocci 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 "" @@ -57,23 +69,22 @@ 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 quiet_profile = ( +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; @@ -86,27 +97,102 @@ let quiet_profile = ( FC.show_ctl_text; FC.show_binding_in_out; + FC.verbose_cocci; + + Flag_parsing_c.show_parsing_error; + + Flag_parsing_c.verbose_lexing; + Flag_parsing_c.verbose_parsing; + Flag_parsing_c.verbose_type; + Flag_parsing_c.verbose_cfg; + Flag_parsing_c.verbose_unparsing; + Flag_parsing_c.verbose_visit; + Flag_parsing_c.verbose_cpp_ast; + + Flag_matcher.verbose_matcher; + Flag_matcher.debug_engine; + + Flag_parsing_c.debug_unparsing; + Flag_parsing_cocci.show_SP; Flag_parsing_cocci.show_iso_failures; + Flag_ctl.verbose_ctl_engine; Flag_ctl.verbose_match; + + + ]) + +let quiet_profile = ( + [ + Common.print_to_stderr + ], + [ + (* FC.show_diff; just leave this as it is *) + + 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_c.verbose_type; - Flag_parsing_c.verbose_parsing; + + 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.show_transinfo; + + 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; ], [ @@ -130,6 +216,7 @@ let debug_profile = ( let pad_profile = ( [ FC.show_diff; + Common.print_to_stderr; ], [ @@ -163,9 +250,9 @@ let run_profile p = (* The spatch options *) (*****************************************************************************) -let usage_msg = - "Usage: " ^ basename Sys.argv.(0) ^ - " -sp_file [-o ] [-iso_file ] [options]" ^ +let usage_msg = + "Usage: " ^ basename Sys.argv.(0) ^ + " --sp-file [-o ] [--iso-file ] [options]" ^ "\n" ^ "Options are:" (* forward reference trick *) @@ -177,181 +264,216 @@ let long_usage_func = ref (fun () -> ()) * 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, " the semantic patch file"; "-o", Arg.Set_string output_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, " (default=" ^ !Config.std_iso ^")"; - "-macro_file", Arg.Set_string Config.std_h, + "--macro-file", Arg.Set_string macro_file, + " "; + "--macro-file-builtins", Arg.Set_string Config.std_h, " (default=" ^ !Config.std_h ^ ")"; - "-all_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 to be used"; - "-no_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"; - "-local_includes", + "--local-includes", Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES), " causes local include files to be used"; - "-include_headers", Arg.Set include_headers, + "--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.Set_string FC.include_path, - " containing the Linux headers (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, + " 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, " process all files in directory recursively"; - "-use_glimpse", Arg.Set Flag.use_glimpse, + "--use-glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse), " works with -dir, use info generated by glimpseindex"; - "-patch", Arg.String (function s -> Flag.patch := Some s), + "--use-google", Arg.String (function s -> Flag.scanner := Flag.Google s), + " find relevant files using google code search"; + "--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)), (" 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 () -> - 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: 2009/02/03 17:17:04 $"; + "--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, " 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 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"; ]; - "verbose subsystems 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.verbose_parsing, " "; - "-type_error_msg", Arg.Set Flag_parsing_c.verbose_type, " "; + "--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 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_passed_level", Arg.Set_int Flag_parsing_c.filter_passed_level," "; + "--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, " "; +(* "--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 *) @@ -361,184 +483,275 @@ let other_options = [ "", [ (* todo: other profile ? *) - "-quiet", Arg.Unit (fun () -> run_profile 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"; - "-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 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), + (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), + (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"; - - "-loop", Arg.Set Flag_ctl.loop_in_src_code, " "; - - "-l1", Arg.Clear Flag_parsing_c.label_strategy_2, " "; - "-ifdef_to_if", Arg.Set FC.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 FC.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, " 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 FC.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), " "); - (let s = "-compare_c" in s, Arg.Unit (fun () -> action := s), + (let s = "--compare-c" in s, Arg.Unit (fun () -> action := s), " "); ]); ] -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 @@ -548,83 +761,377 @@ 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 - -let glimpse_filter (coccifile, isofile) dir = +(* 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) = + _used_after_lists,_positions_lists,(_,_,query)) = Cocci.sp_of_file coccifile (Some isofile) in match query with - None -> pr2 "no glimpse keyword inferred 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)) + +(*****************************************************************************) +(* Main action *) +(*****************************************************************************) + +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 "; + + 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), _ -> [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, "", _, _ -> + 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 + | (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 + 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 + | 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 (*****************************************************************************) (* The coccinelle main entry point *) (*****************************************************************************) -let main () = +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";"-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; - - (if !dir && List.length !args > 1 + 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 - begin - let chosen = List.hd !args in - pr2 ("ignoring all but the last specified directory: "^chosen); - args := [chosen] - end); + 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 <> "" + if !Config.std_iso <> "" then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso"; - if !Config.std_h <> "" + 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; + 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 () -> + Common.profile_code "Main total" (fun () -> let all_actions = Test_parsing_c.actions() in @@ -634,22 +1141,44 @@ let main () = (* --------------------------------------------------------- *) (* The test framework. Works with tests/ or .ok and .failed *) (* --------------------------------------------------------- *) - | [x] when !test_mode -> - FC.include_path := "tests/include"; - Testing.testone x !compare_with_expected - - | [] when !test_all -> - FC.include_path := "tests/include"; - Testing.testall () - - | [] when !test_regression_okfailed -> + | [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 + 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 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 ) (* --------------------------------------------------------- *) @@ -659,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 *) @@ -674,174 +1203,39 @@ let main () = (* --------------------------------------------------------- *) (* This is the main entry *) (* --------------------------------------------------------- *) - | x::xs -> - - 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 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"; - - 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\"")) - | 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") - 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 + | x::xs -> main_action (x::xs) - 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 - 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 outfiles = - Common.profile_code "Main.outfiles computation" (fun () -> - 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 () -> - (* 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 - - 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); - 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)) - (* --------------------------------------------------------- *) (* 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(); )