(*
-* 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 <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
+(*
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
open Common
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)),
"-macro_file_builtins", Arg.Set_string Config.std_h,
" <file> (default=" ^ !Config.std_h ^ ")";
+ "-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";
+ " 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",
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,
"-dir", Arg.Set dir,
" <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)),
(" <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,
"-version", Arg.Unit (fun () ->
- pr2 (spf "spatch version: %s" Config.version);
+ let withpython = if Pycocci.python_support then "with" else "without" in
+ pr2 (spf "spatch version %s %s Python support" Config.version withpython);
exit 0;
),
" guess what";
"-date", Arg.Unit (fun () ->
- pr2 "version: $Date: 2009/08/27 08:54:57 $";
+ pr2 "version: $Date: 2010/11/13 21:06:27 $";
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), " ";
" disable limit on max depth of iso application";
"-track_iso", Arg.Set Flag.track_iso_usage,
" gather information about isomorphism usage";
+ "-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 () ->
"change of algorithm options",
- "",
- [
-(* no popl in official version
+ "",
+ [
"-popl", Arg.Set FC.popl,
" simplified SmPL, for the popl paper";
Arg.Unit
(function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
" simplified SmPL, for the popl paper";
-*)
"-hrule", Arg.String
(function s ->
Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
" semantic patch generation";
+ "-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";
"-l1", Arg.Clear Flag_parsing_c.label_strategy_2, " ";
"-ifdef_to_if", Arg.Set FC.ifdef_to_if,
"-disallow_nested_exps", Arg.Set Flag_matcher.disallow_nested_exps,
- "disallow an expresion pattern from matching a term and its subterm";
+ " 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",
" 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";
];
"misc options",
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 *)
)
let glimpse_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 inferred glimpse keywords"; None
+ | Some queries ->
+ let suffixes = if !include_headers then ["c";"h"] else ["c"] in
+ let rec loop = function
+ [] -> None (* error, eg due to pattern too big *)
+ | query::queries ->
+ Printf.fprintf stderr "%s\n" ("glimpse request = " ^ query);
+ let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in
+ let (glimpse_res,stat) = Common.cmd_to_list_and_status command in
+ match stat with
+ Unix.WEXITED(0) | Unix.WEXITED(1) ->
+ Printf.fprintf stderr "got files\n"; flush stderr;
+ Some
+ (glimpse_res +>
+ List.filter
+ (fun file -> List.mem (Common.filesuffix file) suffixes))
+ | _ -> loop queries (* error, eg due to pattern too big *) in
+ loop queries
+
+let idutils_filter (coccifile, isofile) dir =
+ let (_metavars,astcocci,_free_var_lists,_negated_positions,
+ _used_after_lists,_positions_lists,(_,_,query)) =
Cocci.sp_of_file coccifile (Some isofile) in
match query with
- None -> pr2 "no glimpse keyword 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 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 *)
if !dir && !Flag.patch =*= None
then
(match xs with
- | [] -> Flag.patch := Some x
+ | [] -> Flag.patch := Some (Cocci.normalize_path x)
| _ ->
pr2
("warning: patch output can only be created when only one\n"^
"directory is specified or when the -patch flag is used")
);
+ Flag.dir := x;
let infiles =
Common.profile_code "Main.infiles computation" (fun () ->
- match !dir, !kbuild_info, !Flag.use_glimpse with
+ match !dir, !kbuild_info, !Flag.scanner with
(* glimpse *)
- | false, _, true ->
- failwith "-use_glimpse works only with -dir"
- | true, s, true when s <> "" ->
- failwith "-use_glimpse does not work with -kbuild"
- | true, "", true ->
- if not (null xs)
- then failwith "-use_glimpse can accept only one dir";
-
- Flag.dir := x;
+ | false, _, (Flag.Glimpse|Flag.IdUtils) ->
+ failwith "-use_glimpse or -id_utils works only with -dir"
+ | true, s, (Flag.Glimpse|Flag.IdUtils) when s <> "" ->
+ failwith "-use_glimpse or -id_utils does not work with -kbuild"
+ | true, "", Flag.Glimpse ->
+ (if not (null xs)
+ then failwith "-use_glimpse can accept only one dir");
+
let files =
match glimpse_filter (!cocci_file, !Config.std_iso) x with
None ->
else ("find "^ x ^" -name \"*.c\""))
| Some files -> files in
files +> List.map (fun x -> [x])
+ | true, "", Flag.IdUtils ->
+ (if not (null xs)
+ then failwith "-id_utils can accept only one dir");
+
+ let files =
+ match idutils_filter (!cocci_file, !Config.std_iso) x with
+ None ->
+ Common.cmd_to_list (* same as "true, "", _" case *)
+ (if !include_headers
+ (* FIXME : Could we remove xs ?
+ -use_glimpse requires a singleton.
+ This is checked some lines before.
+ then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
+ else ("find "^(join " " (x::xs))^" -name \"*.c\""))
+ *)
+ then ("find "^ x ^" -name \"*.[ch]\"")
+ else ("find "^ x ^" -name \"*.c\""))
+ | Some files -> files in
+ files +> List.map (fun x -> [x])
(* normal *)
| false, _, _ -> [x::xs]
| true, "", _ ->
)
with
| Common.UnixExit x -> raise (Common.UnixExit x)
+ | Pycocci.Pycocciexception ->
+ raise Pycocci.Pycocciexception
| e ->
(*pr2 "previous";
pr2 s;
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;
then
begin
let chosen = List.hd !args in
- pr2 ("ignoring all but the last specified directory: "^chosen);
- args := [chosen];
- chosen
+ 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 =*= 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))
+ | Parse_cocci.Bad_virt s ->
+ Common.pr2 (Printf.sprintf "virtual rule %s not supported" s);
raise (UnixExit (-1))
(*****************************************************************************)
HCoop / bpt / coccinelle.git / blobdiff