(*
+ * 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.
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
(* somehow obsolete now *)
let dir = ref false
(*****************************************************************************)
(* pair of (list of flags to set true, list of flags to set false *)
+let very_quiet_profile = (
+ [
+ ],
+ [
+ (* FC.show_diff; just leave this as it is *)
+
+ Common.print_to_stderr;
+ Flag.show_misc;
+ Flag.show_trying;
+ Flag.show_transinfo;
+
+ FC.show_c;
+ FC.show_cocci;
+ FC.show_flow;
+ FC.show_before_fixed_flow;
+ FC.show_ctl_tex;
+ FC.show_ctl_text;
+ FC.show_binding_in_out;
+
+ FC.verbose_cocci;
+
+ Flag_parsing_c.show_parsing_error;
+
+ Flag_parsing_c.verbose_lexing;
+ Flag_parsing_c.verbose_parsing;
+ Flag_parsing_c.verbose_type;
+ Flag_parsing_c.verbose_cfg;
+ Flag_parsing_c.verbose_unparsing;
+ Flag_parsing_c.verbose_visit;
+ Flag_parsing_c.verbose_cpp_ast;
+
+ Flag_matcher.verbose_matcher;
+ Flag_matcher.debug_engine;
+
+ Flag_parsing_c.debug_unparsing;
+
+ Flag_parsing_cocci.show_SP;
+ Flag_parsing_cocci.show_iso_failures;
+
+ Flag_ctl.verbose_ctl_engine;
+ Flag_ctl.verbose_match;
+
+
+ ])
+
let quiet_profile = (
[
+ Common.print_to_stderr
],
[
(* FC.show_diff; just leave this as it is *)
work properly *)
let debug_profile = (
[
+ Common.print_to_stderr;
Flag.show_misc;
Flag.show_transinfo;
let pad_profile = (
[
FC.show_diff;
+ Common.print_to_stderr;
],
[
"-o", Arg.Set_string output_file,
" <file> the output file";
- "-inplace", Arg.Set inplace_modif,
+ "-in_place", Arg.Set inplace_modif,
" do the modification on the file directly";
- "-outplace", Arg.Set outplace_modif,
+ "-backup_suffix", Arg.String (function s -> backup_suffix := Some s),
+ " suffix to use when making a backup for inplace";
+ "-out_place", Arg.Set outplace_modif,
" store modifications in a .cocci_res file";
"-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
"-local_includes",
Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES),
" causes local include files to be used";
+ "-ignore_unknown_options", Arg.Set ignore_unknown_opt,
+ " For integration in a toolchain (must be set before the first unknown option)";
"-include_headers", Arg.Set include_headers,
" process header files independently";
- "-I", Arg.String (function x -> FC.include_path := Some x),
+ "-I", Arg.String (fun x ->
+ FC.include_path:= x::!FC.include_path
+ ),
" <dir> containing the header files (optional)";
"-preprocess", Arg.Set preprocess,
" works with -dir, use info generated by glimpseindex";
"-use_google", Arg.String (function s -> Flag.scanner := Flag.Google s),
" find relevant files using google code search";
- "-patch", Arg.String (function s -> Flag.patch := Some s),
+ "-patch",
+ Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)),
(" <dir> path name with respect to which a patch should be created\n"^
" \"\" for a file in the current directory");
"-kbuild_info", Arg.Set_string kbuild_info,
" guess what";
"-date", Arg.Unit (fun () ->
- pr2 "version: $Date: 2010/01/04 11:16:30 $";
+ pr2 "version: $Date: 2010/06/07 09:53:34 $";
raise (Common.UnixExit 0)
),
" guess what";
Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true),
" remove graph label (requires option -graphical_trace)";
- "-parse_error_msg", Arg.Set Flag_parsing_c.verbose_parsing, " ";
+ "-parse_error_msg", Arg.Set Flag_parsing_c.show_parsing_error, " ";
+ "-verbose_parsing",
+ Arg.Unit (fun _ -> Flag_parsing_c.verbose_parsing := true;
+ Flag_parsing_c.show_parsing_error := true), " ";
"-type_error_msg", Arg.Set Flag_parsing_c.verbose_type, " ";
(* could also use Flag_parsing_c.options_verbose *)
];
[
(* todo: other profile ? *)
"-quiet", Arg.Unit (fun () -> run_profile quiet_profile), " ";
+ "-very_quiet", Arg.Unit (fun () -> run_profile very_quiet_profile), " ";
"-debug", Arg.Unit (fun () -> run_profile debug_profile), " ";
"-pad", Arg.Unit (fun () -> run_profile pad_profile), " ";
" 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_parsing_cocci.set_defined_virtual_rules,
+ "-D", Arg.String Flag.set_defined_virtual_rules,
" indicate that a virtual rule should be considered to be matched";
];
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 (* -help is specified in speclist *)
+
(* copy paste of Arg.parse. Don't want the default -help msg *)
let arg_parse2 l f msg =
(try
Arg.parse_argv Sys.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 *)
)
None -> pr2 "no glimpse keyword inferred from snippet"; None
| Some [query] ->
(let suffixes = if !include_headers then ["c";"h"] else ["c"] in
- pr2 ("glimpse request = " ^ query);
+ 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
if !dir && !Flag.patch =*= None
then
(match xs with
- | [] -> Flag.patch := Some x
+ | [] -> Flag.patch := Some (Cocci.normalize_path x)
| _ ->
pr2
("warning: patch output can only be created when only one\n"^
outopt +> Common.do_option (fun outfile ->
if !inplace_modif
then begin
- Common.command2 ("cp "^infile^" "^infile^".cocci_orig");
+ (match !backup_suffix with
+ Some backup_suffix ->
+ Common.command2 ("cp "^infile^" "^infile^backup_suffix)
+ | None -> ());
Common.command2 ("cp "^outfile^" "^infile);
end;
chosen
end
else List.hd !args in
- if !FC.include_path =*= None
- then FC.include_path := Some (Filename.concat chosen_dir "include"));
+ if !FC.include_path =*= []
+ then FC.include_path := [Filename.concat chosen_dir "include"]);
args := List.rev !args;
(* The test framework. Works with tests/ or .ok and .failed *)
(* --------------------------------------------------------- *)
| [x] when !test_mode ->
- FC.include_path := Some "tests/include";
- Testing.testone x !compare_with_expected
+ begin
+ let prefix = "tests/" in
+ let testfile = x ^ ".cocci" in
+ if Sys.file_exists (prefix ^ testfile) then
+ begin
+ 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"];
+ Testing.testone "" x !compare_with_expected
+ end
+ else
+ pr2 (spf "ERROR: File %s does not exist" testfile)
+ end
| [] when !test_all ->
- FC.include_path := Some "tests/include";
+ FC.include_path := ["tests/include"];
if !expected_score_file <> ""
then Testing.testall ~expected_score_file:!expected_score_file ()
else Testing.testall ()
try
main ()
with
- | Unix.Unix_error (_, "stat", filename) ->
- pr2 (spf "ERROR: File %s does not exist" filename);
+ | Unix.Unix_error (e, "stat", filename) ->
+ pr2
+ (spf "ERROR: File %s does not exist: %s"
+ filename (Unix.error_message e));
raise (UnixExit (-1))
(*****************************************************************************)
HCoop / bpt / coccinelle.git / blobdiff