(*
- * Copyright 2005-2010, 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 2005-2010, Ecole des Mines de Nantes, 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
* This file is part of Coccinelle.
*
*)
+# 0 "./cocci.ml"
open Common
module CCI = Ctlcocci_integration
(* --------------------------------------------------------------------- *)
(* C related *)
(* --------------------------------------------------------------------- *)
-let cprogram_of_file file =
- let (program2, _stat) = Parse_c.parse_c_and_cpp file in
+let cprogram_of_file saved_typedefs saved_macros file =
+ let (program2, _stat) =
+ Parse_c.parse_c_and_cpp_keep_typedefs
+ (if !Flag_cocci.use_saved_typedefs then (Some saved_typedefs) else None)
+ (Some saved_macros) file in
program2
let cprogram_of_file_cached file =
- let (program2, _stat) = Parse_c.parse_cache file in
+ let ((program2,typedefs,macros), _stat) = Parse_c.parse_cache file in
if !Flag_cocci.ifdef_to_if
then
- program2 +> Parse_c.with_program2 (fun asts ->
- Cpp_ast_c.cpp_ifdef_statementize asts
- )
- else program2
+ let p2 =
+ program2 +> Parse_c.with_program2 (fun asts ->
+ Cpp_ast_c.cpp_ifdef_statementize asts
+ ) in
+ (p2,typedefs,macros)
+ else (program2,typedefs,macros)
let cfile_of_program program2_with_ppmethod outf =
Unparse_c.pp_program program2_with_ppmethod outf
(* for memoization, contains only one entry, the one for the SP *)
let _hparse = Hashtbl.create 101
+let _h_ocaml_init = Hashtbl.create 101
let _hctl = Hashtbl.create 101
(* --------------------------------------------------------------------- *)
(* Cocci related *)
(* --------------------------------------------------------------------- *)
-let sp_of_file2 file iso =
- Common.memoized _hparse (file, iso) (fun () ->
- Parse_cocci.process file iso false)
+(* for a given pair (file,iso), only keep an instance for the most recent
+virtual rules and virtual_env *)
+
+let sp_of_file2 file iso =
+ let redo _ =
+ let new_code =
+ let (_,xs,_,_,_,_,_) as res = Parse_cocci.process file iso false in
+ (* if there is already a compiled ML code, do nothing and use that *)
+ try let _ = Hashtbl.find _h_ocaml_init (file,iso) in res
+ with Not_found ->
+ begin
+ Hashtbl.add _h_ocaml_init (file,iso) ();
+ match Prepare_ocamlcocci.prepare file xs with
+ None -> res
+ | Some ocaml_script_file ->
+ (* compile file *)
+ Prepare_ocamlcocci.load_file ocaml_script_file;
+ (if not !Common.save_tmp_files
+ then Prepare_ocamlcocci.clean_file ocaml_script_file);
+ res
+ end in
+ Hashtbl.add _hparse (file,iso)
+ (!Flag.defined_virtual_rules,!Flag.defined_virtual_env,new_code);
+ new_code in
+ try
+ let (rules,env,code) = Hashtbl.find _hparse (file,iso) in
+ if rules = !Flag.defined_virtual_rules && env = !Flag.defined_virtual_env
+ then code
+ else (Hashtbl.remove _hparse (file,iso); redo())
+ with Not_found -> redo()
+
let sp_of_file file iso =
Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso)
(Asttomember.asttomember ast ua))
ast (List.combine ua (List.combine fua (List.combine fuas pos)))
-let ctls_of_ast ast ua =
- Common.profile_code "asttoctl2" (fun () -> ctls_of_ast2 ast ua)
+let ctls_of_ast ast ua pl =
+ Common.profile_code "asttoctl2" (fun () -> ctls_of_ast2 ast ua pl)
(*****************************************************************************)
(* Some debugging functions *)
then
(match Str.split (Str.regexp " ") s with
bef::min::pl::aft ->
- (match Str.split (Str.regexp ",") pl with
- [n1;n2] ->
- let n2 = int_of_string n2 in
- (Printf.sprintf "%s %s %s,%d %s" bef min n1 (n2-n)
- (String.concat " " aft))
- :: loop1 0 ss
- | _ -> failwith "bad + line information")
+ let (n1,n2) =
+ match Str.split (Str.regexp ",") pl with
+ [n1;n2] -> (n1,n2)
+ | [n1] -> (n1,"1")
+ | _ -> failwith "bad + line information" in
+ let n2 = int_of_string n2 in
+ (Printf.sprintf "%s %s %s,%d %s" bef min n1 (n2-n)
+ (String.concat " " aft))
+ :: loop1 0 ss
| _ -> failwith "bad @@ information")
else s :: loop1 n ss in
let rec loop2 n = function
then
(match Str.split (Str.regexp " ") s with
bef::min::pl::aft ->
- (match (Str.split (Str.regexp ",") min,
- Str.split (Str.regexp ",") pl) with
- ([_;m2],[n1;n2]) ->
- let n1 =
- int_of_string
- (String.sub n1 1 ((String.length n1)-1)) in
- let m2 = int_of_string m2 in
- let n2 = int_of_string n2 in
- (Printf.sprintf "%s %s +%d,%d %s" bef min (n1-n) n2
- (String.concat " " aft))
- :: loop2 (n+(m2-n2)) ss
- | _ -> failwith "bad -/+ line information")
+ let (m2,n1,n2) =
+ match (Str.split (Str.regexp ",") min,
+ Str.split (Str.regexp ",") pl) with
+ ([_;m2],[n1;n2]) -> (m2,n1,n2)
+ | ([_],[n1;n2]) -> ("1",n1,n2)
+ | ([_;m2],[n1]) -> (m2,n1,"1")
+ | ([_],[n1]) -> ("1",n1,"1")
+ | _ -> failwith "bad -/+ line information" in
+ let n1 =
+ int_of_string (String.sub n1 1 ((String.length n1)-1)) in
+ let m2 = int_of_string m2 in
+ let n2 = int_of_string n2 in
+ (Printf.sprintf "%s %s +%d,%d %s" bef min (n1-n) n2
+ (String.concat " " aft))
+ :: loop2 (n+(m2-n2)) ss
| _ -> failwith "bad @@ information")
else s :: loop2 n ss in
loop2 0 (List.rev (loop1 0 l))
| x::rest -> loop (x::prev) rest in
loop [] elements
+let generated_patches = Hashtbl.create(100)
+
let show_or_not_diff2 cfile outfile =
if !Flag_cocci.show_diff then begin
match Common.fst(Compare_c.compare_to_original cfile outfile) with
match !Flag_parsing_c.diff_lines with
| None -> "diff -u -p " ^ cfile ^ " " ^ outfile
| Some n -> "diff -U "^n^" -p "^cfile^" "^outfile in
+ let res = Common.cmd_to_list line in
+ let res =
+ List.map
+ (function l ->
+ match Str.split (Str.regexp "[ \t]+") l with
+ "---"::file::date -> "--- "^file
+ | "+++"::file::date -> "+++ "^file
+ | _ -> l)
+ res in
let xs =
- let res = Common.cmd_to_list line in
match (!Flag.patch,res) with
(* create something that looks like the output of patch *)
(Some prefix,minus_file::plus_file::rest) ->
let diff_line =
match List.rev(Str.split (Str.regexp " ") line) with
new_file::old_file::cmdrev ->
+ let old_base_file = drop_prefix old_file in
if !Flag.sgrep_mode2
then
String.concat " "
- (List.rev ("/tmp/nothing" :: old_file :: cmdrev))
+ (List.rev
+ (("/tmp/nothing"^old_base_file)
+ :: old_file :: cmdrev))
else
- let old_base_file = drop_prefix old_file in
String.concat " "
(List.rev
- (("b"^old_base_file)::("a"^old_base_file)::cmdrev))
+ (("b"^old_base_file)::("a"^old_base_file)::
+ cmdrev))
| _ -> failwith "bad command" in
let (minus_line,plus_line) =
- if !Flag.sgrep_mode2
- then (minus_file,"+++ /tmp/nothing")
- else
- match (Str.split (Str.regexp "[ \t]") minus_file,
- Str.split (Str.regexp "[ \t]") plus_file) with
- ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
- let old_base_file = drop_prefix old_file in
+ match (Str.split (Str.regexp "[ \t]") minus_file,
+ Str.split (Str.regexp "[ \t]") plus_file) with
+ ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
+ let old_base_file = drop_prefix old_file in
+ if !Flag.sgrep_mode2
+ then (minus_file,"+++ /tmp/nothing"^old_base_file)
+ else
(String.concat " "
("---"::("a"^old_base_file)::old_rest),
String.concat " "
("+++"::("b"^old_base_file)::new_rest))
- | (l1,l2) ->
- failwith
- (Printf.sprintf "bad diff header lines: %s %s"
- (String.concat ":" l1) (String.concat ":" l2)) in
+ | (l1,l2) ->
+ failwith
+ (Printf.sprintf "bad diff header lines: %s %s"
+ (String.concat ":" l1) (String.concat ":" l2)) in
diff_line::minus_line::plus_line::rest
| _ -> res in
let xs = if !Flag.sgrep_mode2 then fix_sgrep_diffs xs else xs in
- xs +> List.iter pr
+ let cfile = normalize_path cfile in
+ let patches =
+ try Hashtbl.find generated_patches cfile
+ with Not_found ->
+ let cell = ref [] in
+ Hashtbl.add generated_patches cfile cell;
+ cell in
+ if List.mem xs !patches
+ then ()
+ else
+ begin
+ patches := xs :: !patches;
+ xs +> List.iter pr
+ end
end
let show_or_not_diff a b =
Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b)
let show_or_not_ctl_tex2 astcocci ctls =
if !Flag_cocci.show_ctl_tex then begin
+ let ctls =
+ List.map
+ (List.map
+ (function ((Asttoctl2.NONDECL ctl | Asttoctl2.CODE ctl),x) ->
+ (ctl,x)))
+ ctls in
Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls;
Common.command2 ("cd /tmp; latex __cocci_ctl.tex; " ^
"dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
);
pr "CTL = ";
- let (ctl,_) = ctl in
+ let ((Asttoctl2.CODE ctl | Asttoctl2.NONDECL ctl),_) = ctl in
adjust_pp_with_indent (fun () ->
Format.force_newline();
Pretty_print_engine.pp_ctlcocci
(* drop the following line for a list of list by rules. since we don't
allow multiple minirules, all the tokens within a rule should be in
a single CFG entity *)
- let tokens = Common.union_all tokens in
- if not !Flag_cocci.windows && not (null tokens)
- then
+ match (!Flag_cocci.windows,tokens) with
+ (true,_) | (_,None) -> true
+ | (_,Some tokens) ->
(* could also modify the code in get_constants.ml *)
- let tokens = tokens +> List.map (fun s ->
- match () with
- | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" ->
- "\\b" ^ s ^ "\\b"
+ let tokens = tokens +> List.map (fun s ->
+ match () with
+ | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" ->
+ "\\b" ^ s ^ "\\b"
- | _ when s =~ "^[A-Za-z_]" ->
- "\\b" ^ s
+ | _ when s =~ "^[A-Za-z_]" ->
+ "\\b" ^ s
- | _ when s =~ ".*[A-Za-z_]$" ->
- s ^ "\\b"
- | _ -> s
+ | _ when s =~ ".*[A-Za-z_]$" ->
+ s ^ "\\b"
+ | _ -> s
- ) in
- let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles)
- in
- (match Sys.command com with
- | 0 (* success *) -> true
- | _ (* failure *) ->
- (if !Flag.show_misc
- then Printf.printf "grep failed: %s\n" com);
- false (* no match, so not worth trying *)
- )
- else true
-
-let check_macro_in_sp_and_adjust tokens =
- let tokens = Common.union_all tokens in
- tokens +> List.iter (fun s ->
- if Hashtbl.mem !Parse_c._defs s
- then begin
- if !Flag_cocci.verbose_cocci then begin
- pr2 "warning: macro in semantic patch was in macro definitions";
- pr2 ("disabling macro expansion for " ^ s);
- end;
- Hashtbl.remove !Parse_c._defs s
- end
- )
+ ) in
+ let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles)
+ in
+ (match Sys.command com with
+ | 0 (* success *) -> true
+ | _ (* failure *) ->
+ (if !Flag.show_misc
+ then Printf.printf "grep failed: %s\n" com);
+ false (* no match, so not worth trying *))
+
+let check_macro_in_sp_and_adjust = function
+ None -> ()
+ | Some tokens ->
+ tokens +> List.iter (fun s ->
+ if Hashtbl.mem !Parse_c._defs s
+ then begin
+ if !Flag_cocci.verbose_cocci then begin
+ pr2 "warning: macro in semantic patch was in macro definitions";
+ pr2 ("disabling macro expansion for " ^ s);
+ end;
+ Hashtbl.remove !Parse_c._defs s
+ end)
let contain_loop gopt =
let combiner =
Visitor_ast.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing
+ donothing donothing donothing donothing donothing
donothing expression donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing
in
* For the moment we base in part our heuristic on the name of the file, e.g.
* serio.c is related we think to #include <linux/serio.h>
*)
-let rec search_include_path searchlist relpath =
- match searchlist with
- [] -> Some relpath
- | hd::tail ->
- let file = Filename.concat hd relpath in
- if Sys.file_exists file then
- Some file
- else
- search_include_path tail relpath
+let include_table = Hashtbl.create(100)
let interpret_include_path relpath =
+ let maxdepth = List.length relpath in
+ let unique_file_exists dir f =
+ let cmd =
+ Printf.sprintf "find %s -maxdepth %d -mindepth %d -path \"*/%s\""
+ dir maxdepth maxdepth f in
+ match Common.cmd_to_list cmd with
+ [x] -> Some x
+ | _ -> None in
+ let native_file_exists dir f =
+ let f = Filename.concat dir f in
+ if Sys.file_exists f
+ then Some f
+ else None in
+ let rec search_include_path exists searchlist relpath =
+ match searchlist with
+ [] -> None
+ | hd::tail ->
+ (match exists hd relpath with
+ Some x -> Some x
+ | None -> search_include_path exists tail relpath) in
+ let rec search_path exists searchlist = function
+ [] ->
+ let res = Common.concat "/" relpath in
+ Hashtbl.add include_table (searchlist,relpath) res;
+ Some res
+ | (hd::tail) as relpath1 ->
+ let relpath1 = Common.concat "/" relpath1 in
+ (match search_include_path exists searchlist relpath1 with
+ None -> search_path unique_file_exists searchlist tail
+ | Some f ->
+ Hashtbl.add include_table (searchlist,relpath) f;
+ Some f) in
let searchlist =
match !Flag_cocci.include_path with
- [] -> ["include"]
- | x -> List.rev x
- in
- search_include_path searchlist relpath
+ [] -> ["include"]
+ | x -> List.rev x in
+ try Some(Hashtbl.find include_table (searchlist,relpath))
+ with Not_found ->
+ search_path native_file_exists searchlist relpath
let (includes_to_parse:
- (Common.filename * Parse_c.program2) list ->
+ (Common.filename * Parse_c.extended_program2) list ->
Flag_cocci.include_options -> 'a) = fun xs choose_includes ->
match choose_includes with
Flag_cocci.I_UNSPECIFIED -> failwith "not possible"
- | Flag_cocci.I_NO_INCLUDES -> []
+ | Flag_cocci.I_NO_INCLUDES -> !Flag_cocci.extra_includes
| x ->
- let all_includes = x =*= Flag_cocci.I_ALL_INCLUDES in
+ let all_includes =
+ List.mem x
+ [Flag_cocci.I_ALL_INCLUDES; Flag_cocci.I_REALLY_ALL_INCLUDES] in
+ let xs = List.map (function (file,(cs,_,_)) -> (file,cs)) xs in
xs +> List.map (fun (file, cs) ->
let dir = Common.dirname file in
(match x with
| Ast_c.Local xs ->
let relpath = Common.join "/" xs in
- let f = Filename.concat dir (relpath) in
+ let f = Filename.concat dir relpath in
+ if (Sys.file_exists f) then
+ Some f
+ else
+ if !Flag_cocci.relax_include_path
(* for our tests, all the files are flat in the current dir *)
- if not (Sys.file_exists f) && !Flag_cocci.relax_include_path
- then
- let attempt2 = Filename.concat dir (Common.last xs) in
- if not (Sys.file_exists f) && all_includes
then
- interpret_include_path relpath
- else Some attempt2
- else Some f
+ let attempt2 = Filename.concat dir (Common.last xs) in
+ if not (Sys.file_exists attempt2) && all_includes
+ then
+ interpret_include_path xs
+ else Some attempt2
+ else
+ if all_includes then interpret_include_path xs
+ else None
| Ast_c.NonLocal xs ->
- let relpath = Common.join "/" xs in
if all_includes ||
Common.fileprefix (Common.last xs) =$= Common.fileprefix file
then
- interpret_include_path relpath
+ interpret_include_path xs
else None
| Ast_c.Weird _ -> None
)
| _ -> None))
+> List.concat
- +> Common.uniq
+ +> (fun x ->
+ (List.rev
+ (Common.uniq
+ (!Flag_cocci.extra_includes@(List.rev x)))))(*uniq keeps last*)
let rec interpret_dependencies local global = function
Ast_cocci.Dep s -> List.mem s local
match c with
| Ast_c.Local x -> Left (x, aref)
| Ast_c.NonLocal x -> Right (x, aref)
- | Ast_c.Weird x -> raise Impossible
+ | Ast_c.Weird x -> raise (Impossible 161)
) in
update_rel_pos_bis locals;
was_modified: bool ref;
+ all_typedefs: (string, Lexer_parser.identkind) Common.scoped_h_env;
+ all_macros: (string, Cpp_token_c.define_def) Hashtbl.t;
+
(* id: int *)
}
+type rule_info = {
+ rulename: string;
+ dependencies: Ast_cocci.dependency;
+ used_after: Ast_cocci.meta_name list;
+ ruleid: int;
+ was_matched: bool ref;
+}
+
type toplevel_cocci_info_script_rule = {
- scr_ast_rule: string * (string * Ast_cocci.meta_name) list * string;
+ scr_ast_rule:
+ string *
+ (Ast_cocci.script_meta_name * Ast_cocci.meta_name *
+ Ast_cocci.metavar) list *
+ Ast_cocci.meta_name list (*fresh vars*) *
+ string;
language: string;
- scr_dependencies: Ast_cocci.dependency;
- scr_ruleid: int;
script_code: string;
+ scr_rule_info: rule_info;
}
type toplevel_cocci_info_cocci_rule = {
- ctl: Lib_engine.ctlcocci * (CCI.pred list list);
+ ctl: Asttoctl2.top_formula * (CCI.pred list list);
metavars: Ast_cocci.metavar list;
ast_rule: Ast_cocci.rule;
isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *)
- rulename: string;
- dependencies: Ast_cocci.dependency;
(* There are also some hardcoded rule names in parse_cocci.ml:
* let reserved_names = ["all";"optional_storage";"optional_qualifier"]
*)
dropped_isos: string list;
free_vars: Ast_cocci.meta_name list;
negated_pos_vars: Ast_cocci.meta_name list;
- used_after: Ast_cocci.meta_name list;
positions: Ast_cocci.meta_name list;
- ruleid: int;
ruletype: Ast_cocci.ruletype;
- was_matched: bool ref;
+ rule_info: rule_info;
}
type toplevel_cocci_info =
| FinalScriptRuleCocciInfo of toplevel_cocci_info_script_rule
| CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule
-type cocci_info = toplevel_cocci_info list * string list list (* tokens *)
+type cocci_info = toplevel_cocci_info list * string list option (* tokens *)
type kind_file = Header | Source
type file_info = {
local_python_code ^
"cocci = Cocci()\n"
-let make_init rulenb lang deps code =
+let make_init lang code rule_info =
let mv = [] in
{
- scr_ast_rule = (lang, mv, code);
+ scr_ast_rule = (lang, mv, [], code);
language = lang;
- scr_dependencies = deps;
- scr_ruleid = rulenb;
- script_code = (if lang = "python" then python_code else "") ^code
+ script_code = (if lang = "python" then python_code else "") ^code;
+ scr_rule_info = rule_info;
}
(* --------------------------------------------------------------------- *)
(fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list),
negated_pos_list),ua),fua),fuas),positions_list),rulenb) ->
+ let build_rule_info rulename deps =
+ {rulename = rulename;
+ dependencies = deps;
+ used_after = (List.hd ua) @ (List.hd fua);
+ ruleid = rulenb;
+ was_matched = ref false;} in
+
let is_script_rule r =
match r with
Ast_cocci.ScriptRule _
then failwith "not handling multiple minirules";
match ast with
- Ast_cocci.ScriptRule (lang,deps,mv,code) ->
+ Ast_cocci.ScriptRule (name,lang,deps,mv,script_vars,code) ->
let r =
- {
- scr_ast_rule = (lang, mv, code);
- language = lang;
- scr_dependencies = deps;
- scr_ruleid = rulenb;
- script_code = code;
- }
+ {
+ scr_ast_rule = (lang, mv, script_vars, code);
+ language = lang;
+ script_code = code;
+ scr_rule_info = build_rule_info name deps;
+ }
in ScriptRuleCocciInfo r
- | Ast_cocci.InitialScriptRule (lang,deps,code) ->
- let r = make_init rulenb lang deps code in
+ | Ast_cocci.InitialScriptRule (name,lang,deps,code) ->
+ let r = make_init lang code (build_rule_info name deps) in
InitialScriptRuleCocciInfo r
- | Ast_cocci.FinalScriptRule (lang,deps,code) ->
+ | Ast_cocci.FinalScriptRule (name,lang,deps,code) ->
let mv = [] in
let r =
- {
- scr_ast_rule = (lang, mv, code);
- language = lang;
- scr_dependencies = deps;
- scr_ruleid = rulenb;
- script_code = code;
- }
+ {
+ scr_ast_rule = (lang, mv, [], code);
+ language = lang;
+ script_code = code;
+ scr_rule_info = build_rule_info name deps;
+ }
in FinalScriptRuleCocciInfo r
| Ast_cocci.CocciRule
(rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) ->
- CocciRuleCocciInfo (
- {
- ctl = List.hd ctl_toplevel_list;
- metavars = metavars;
- ast_rule = ast;
- isexp = List.hd isexp;
- rulename = rulename;
- dependencies = dependencies;
- dropped_isos = dropped_isos;
- free_vars = List.hd free_var_list;
- negated_pos_vars = List.hd negated_pos_list;
- used_after = (List.hd ua) @ (List.hd fua);
- positions = List.hd positions_list;
- ruleid = rulenb;
- ruletype = ruletype;
- was_matched = ref false;
- })
+ CocciRuleCocciInfo (
+ {
+ ctl = List.hd ctl_toplevel_list;
+ metavars = metavars;
+ ast_rule = ast;
+ isexp = List.hd isexp;
+ dropped_isos = dropped_isos;
+ free_vars = List.hd free_var_list;
+ negated_pos_vars = List.hd negated_pos_list;
+ positions = List.hd positions_list;
+ ruletype = ruletype;
+ rule_info = build_rule_info rulename dependencies;
+ })
)
-
(* --------------------------------------------------------------------- *)
-let build_info_program cprogram env =
+let build_info_program (cprogram,typedefs,macros) env =
let (cs, parseinfos) =
Common.unzip cprogram in
(* I use cs' but really annotate_xxx work by doing side effects on cs *)
let cs' =
Comment_annotater_c.annotate_program alltoks cs in
+
let cs_with_envs =
Type_annoter_c.annotate_program env (*!g_contain_typedmetavar*) cs'
in
fixed_flow
)
in
-
{
ast_c = c; (* contain refs so can be modified *)
- tokens_c = tokens;
+ tokens_c = tokens;
fullstring = fullstr;
flow = flow;
env_typing_after = envb;
was_modified = ref false;
- }
- )
+
+ all_typedefs = typedefs;
+ all_macros = macros;
+ })
file;
(* Common.command2 ("cat " ^ file); *)
- let cprogram = cprogram_of_file file in
+ let cprogram = cprogram_of_file c.all_typedefs c.all_macros file in
let xs = build_info_program cprogram c.env_typing_before in
(* TODO: assert env has not changed,
rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
)
-
+let rec prepare_h seen env hpath choose_includes : file_info list =
+ if not (Common.lfile_exists hpath)
+ then
+ begin
+ pr2_once ("TYPE: header " ^ hpath ^ " not found");
+ []
+ end
+ else
+ begin
+ let h_cs = cprogram_of_file_cached hpath in
+ let local_includes =
+ if choose_includes =*= Flag_cocci.I_REALLY_ALL_INCLUDES
+ then
+ List.filter
+ (function x -> not (List.mem x !seen))
+ (includes_to_parse [(hpath,h_cs)] choose_includes)
+ else [] in
+ seen := local_includes @ !seen;
+ let others =
+ List.concat
+ (List.map (function x -> prepare_h seen env x choose_includes)
+ local_includes) in
+ let info_h_cs = build_info_program h_cs !env in
+ env :=
+ if null info_h_cs
+ then !env
+ else last_env_toplevel_c_info info_h_cs;
+ others@
+ [{
+ fname = Common.basename hpath;
+ full_fname = hpath;
+ asts = info_h_cs;
+ was_modified_once = ref false;
+ fpath = hpath;
+ fkind = Header;
+ }]
+ end
let prepare_c files choose_includes : file_info list =
let cprograms = List.map cprogram_of_file_cached files in
let includes = includes_to_parse (zip files cprograms) choose_includes in
+ let seen = ref includes in
(* todo?: may not be good to first have all the headers and then all the c *)
- let all =
- (includes +> List.map (fun hpath -> Right hpath))
- ++
- ((zip files cprograms) +>
- List.map (fun (file, asts) -> Left (file, asts)))
- in
-
let env = ref !TAC.initial_env in
- let ccs = all +> Common.map_filter (fun x ->
- match x with
- | Right hpath ->
- if not (Common.lfile_exists hpath)
- then begin
- pr2 ("TYPE: header " ^ hpath ^ " not found");
- None
- end
- else
- let h_cs = cprogram_of_file_cached hpath in
- let info_h_cs = build_info_program h_cs !env in
- env :=
- if null info_h_cs
- then !env
- else last_env_toplevel_c_info info_h_cs
- ;
- Some {
- fname = Common.basename hpath;
- full_fname = hpath;
- asts = info_h_cs;
- was_modified_once = ref false;
- fpath = hpath;
- fkind = Header;
- }
- | Left (file, cprogram) ->
- (* todo?: don't update env ? *)
+ let includes =
+ includes +>
+ List.map (function hpath -> prepare_h seen env hpath choose_includes) +>
+ List.concat in
+
+ let cfiles =
+ (zip files cprograms) +>
+ List.map
+ (function (file, cprogram) ->
+ (* todo?: don't update env ? *)
let cs = build_info_program cprogram !env in
(* we do that only for the c, not for the h *)
ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c)));
- Some {
- fname = Common.basename file;
- full_fname = file;
- asts = cs;
- was_modified_once = ref false;
- fpath = file;
- fkind = Source;
- }
- )
- in
- ccs
+ {
+ fname = Common.basename file;
+ full_fname = file;
+ asts = cs;
+ was_modified_once = ref false;
+ fpath = file;
+ fkind = Source
+ }) in
+
+ includes @ cfiles
+
+(*****************************************************************************)
+(* Manage environments as they are being built up *)
+(*****************************************************************************)
+
+let init_env _ = Hashtbl.create 101
+
+let update_env env v i = Hashtbl.replace env v i; env
+
+(* know that there are no conflicts *)
+let safe_update_env env v i = Hashtbl.add env v i; env
+let end_env env =
+ List.sort compare (Hashtbl.fold (fun k v rest -> (k,v) :: rest) env [])
(*****************************************************************************)
(* Processing the ctls and toplevel C elements *)
(* r(ule), c(element in C code), e(nvironment) *)
-let findk f l =
- let rec loop k = function
- [] -> None
- | x::xs ->
- if f x
- then Some (x, function n -> k (n :: xs))
- else loop (function vs -> k (x :: vs)) xs in
- loop (function x -> x) l
-
let merge_env new_e old_e =
- let (ext,old_e) =
- List.fold_left
- (function (ext,old_e) ->
- function (e,rules) as elem ->
- match findk (function (e1,_) -> e =*= e1) old_e with
- None -> (elem :: ext,old_e)
- | Some((_,old_rules),k) ->
- (ext,k (e,Common.union_set rules old_rules)))
- ([],old_e) new_e in
- old_e @ (List.rev ext)
-
-let apply_python_rule r cache newes e rules_that_have_matched
- rules_that_have_ever_matched =
- Common.profile_code "python" (fun () ->
- show_or_not_scr_rule_name r.scr_ruleid;
+ List.iter
+ (function (e,rules) ->
+ let _ = update_env old_e e rules in ()) new_e;
+ old_e
+
+let contains_binding e (_,(r,m),_) =
+ try
+ let _ = List.find (function ((re, rm), _) -> r =*= re && m =$= rm) e in
+ true
+ with Not_found -> false
+
+exception Exited
+
+let python_application mv ve script_vars r =
+ let mv =
+ List.map
+ (function
+ ((Some x,None),y,z) -> (x,y,z)
+ | _ ->
+ failwith
+ (Printf.sprintf "unexpected ast metavar in rule %s"
+ r.scr_rule_info.rulename))
+ mv in
+ try
+ Pycocci.build_classes (List.map (function (x,y) -> x) ve);
+ Pycocci.construct_variables mv ve;
+ Pycocci.construct_script_variables script_vars;
+ let _ = Pycocci.pyrun_simplestring (local_python_code ^r.script_code) in
+ if !Pycocci.exited
+ then raise Exited
+ else if !Pycocci.inc_match
+ then Some (Pycocci.retrieve_script_variables script_vars)
+ else None
+ with Pycocci.Pycocciexception ->
+ (pr2 ("Failure in " ^ r.scr_rule_info.rulename);
+ raise Pycocci.Pycocciexception)
+
+let ocaml_application mv ve script_vars r =
+ try
+ let script_vals =
+ Run_ocamlcocci.run mv ve script_vars
+ r.scr_rule_info.rulename r.script_code in
+ if !Coccilib.exited
+ then raise Exited
+ else if !Coccilib.inc_match
+ then Some script_vals
+ else None
+ with e -> (pr2 ("Failure in " ^ r.scr_rule_info.rulename); raise e)
+
+(* returns Left in case of dependency failure, Right otherwise *)
+let apply_script_rule r cache newes e rules_that_have_matched
+ rules_that_have_ever_matched script_application =
+ Common.profile_code r.language (fun () ->
+ show_or_not_scr_rule_name r.scr_rule_info.ruleid;
if not(interpret_dependencies rules_that_have_matched
- !rules_that_have_ever_matched r.scr_dependencies)
+ !rules_that_have_ever_matched r.scr_rule_info.dependencies)
then
begin
print_dependencies "dependencies for script not satisfied:"
rules_that_have_matched
- !rules_that_have_ever_matched r.scr_dependencies;
+ !rules_that_have_ever_matched r.scr_rule_info.dependencies;
show_or_not_binding "in environment" e;
- (cache, (e, rules_that_have_matched)::newes)
+ (cache, safe_update_env newes e rules_that_have_matched)
end
else
begin
- let (_, mv, _) = r.scr_ast_rule in
+ let (_, mv, script_vars, _) = r.scr_ast_rule in
let ve =
(List.map (function (n,v) -> (("virtual",n),Ast_c.MetaIdVal (v,[])))
!Flag.defined_virtual_env) @ e in
- let not_bound x = not (Pycocci.contains_binding ve x) in
+ let not_bound x = not (contains_binding ve x) in
(match List.filter not_bound mv with
[] ->
let relevant_bindings =
List.filter
(function ((re,rm),_) ->
- List.exists (function (_,(r,m)) -> r =*= re && m =$= rm) mv)
+ List.exists (function (_,(r,m),_) -> r =*= re && m =$= rm) mv)
e in
- let new_cache =
- if List.mem relevant_bindings cache
- then
- begin
+ (try
+ match List.assoc relevant_bindings cache with
+ None -> (cache,newes)
+ | Some script_vals ->
print_dependencies
"dependencies for script satisfied, but cached:"
rules_that_have_matched
!rules_that_have_ever_matched
- r.scr_dependencies;
- show_or_not_binding "in" e;
- cache
- end
- else
- begin
- print_dependencies "dependencies for script satisfied:"
- rules_that_have_matched
- !rules_that_have_ever_matched
- r.scr_dependencies;
+ r.scr_rule_info.dependencies;
show_or_not_binding "in" e;
- Pycocci.build_classes (List.map (function (x,y) -> x) ve);
- Pycocci.construct_variables mv ve;
- let _ =
- Pycocci.pyrun_simplestring
- (local_python_code ^r.script_code) in
- relevant_bindings :: cache
- end in
- if !Pycocci.inc_match
- then (new_cache, merge_env [(e, rules_that_have_matched)] newes)
- else (new_cache, newes)
+ (* env might be bigger than what was cached against, so have to
+ merge with newes anyway *)
+ let new_e = (List.combine script_vars script_vals) @ e in
+ let new_e =
+ new_e +>
+ List.filter
+ (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
+ (cache,update_env newes new_e rules_that_have_matched)
+ with Not_found ->
+ begin
+ print_dependencies "dependencies for script satisfied:"
+ rules_that_have_matched
+ !rules_that_have_ever_matched
+ r.scr_rule_info.dependencies;
+ show_or_not_binding "in" e;
+ match script_application mv ve script_vars r with
+ None ->
+ (* failure means we should drop e, no new bindings *)
+ (((relevant_bindings,None) :: cache), newes)
+ | Some script_vals ->
+ let script_vals =
+ List.map (function x -> Ast_c.MetaIdVal(x,[]))
+ script_vals in
+ let new_e = (List.combine script_vars script_vals) @ e in
+ let new_e =
+ new_e +>
+ List.filter
+ (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
+ r.scr_rule_info.was_matched := true;
+ (((relevant_bindings,Some script_vals) :: cache),
+ update_env newes new_e
+ (r.scr_rule_info.rulename :: rules_that_have_matched))
+ end)
| unbound ->
(if !Flag_cocci.show_dependencies
then
- let m2c (_,(r,x)) = r^"."^x in
+ let m2c (_,(r,x),_) = r^"."^x in
pr2 (Printf.sprintf "script not applied: %s not bound"
(String.concat ", " (List.map m2c unbound))));
- (cache, merge_env [(e, rules_that_have_matched)] newes))
+ let e =
+ e +>
+ List.filter (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
+ (cache, update_env newes e rules_that_have_matched))
end)
let rec apply_cocci_rule r rules_that_have_ever_matched es
(ccs:file_info list ref) =
- Common.profile_code r.rulename (fun () ->
- show_or_not_rule_name r.ast_rule r.ruleid;
- show_or_not_ctl_text r.ctl r.ast_rule r.ruleid;
+ Common.profile_code r.rule_info.rulename (fun () ->
+ show_or_not_rule_name r.ast_rule r.rule_info.ruleid;
+ show_or_not_ctl_text r.ctl r.ast_rule r.rule_info.ruleid;
let reorganized_env =
reassociate_positions r.free_vars r.negated_pos_vars !es in
function ((e,rules_that_have_matched),relevant_bindings) ->
if not(interpret_dependencies rules_that_have_matched
!rules_that_have_ever_matched
- r.dependencies)
+ r.rule_info.dependencies)
then
begin
print_dependencies
- ("dependencies for rule "^r.rulename^" not satisfied:")
+ ("dependencies for rule "^r.rule_info.rulename^
+ " not satisfied:")
rules_that_have_matched
- !rules_that_have_ever_matched r.dependencies;
+ !rules_that_have_ever_matched r.rule_info.dependencies;
show_or_not_binding "in environment" e;
(cache,
- merge_env
- [(e +> List.filter (fun (s,v) -> List.mem s r.used_after),
- rules_that_have_matched)]
- newes)
+ update_env newes
+ (e +>
+ List.filter
+ (fun (s,v) -> List.mem s r.rule_info.used_after))
+ rules_that_have_matched)
end
else
let new_bindings =
with
Not_found ->
print_dependencies
- ("dependencies for rule "^r.rulename^" satisfied:")
+ ("dependencies for rule "^r.rule_info.rulename^
+ " satisfied:")
rules_that_have_matched
!rules_that_have_ever_matched
- r.dependencies;
+ r.rule_info.dependencies;
show_or_not_binding "in" e;
show_or_not_binding "relevant in" relevant_bindings;
let old_bindings_to_keep =
Common.nub
- (e +> List.filter (fun (s,v) -> List.mem s r.used_after)) in
+ (e +>
+ List.filter
+ (fun (s,v) -> List.mem s r.rule_info.used_after)) in
let new_e =
if null new_bindings
then
(* see comment before combine_pos *)
(s,Ast_c.MetaPosValList []) -> false
| (s,v) ->
- List.mem s r.used_after &&
+ List.mem s r.rule_info.used_after &&
not (List.mem s old_variables)))) in
List.map
(function new_binding_to_add ->
(List.sort compare
(Common.union_set
old_bindings_to_keep new_binding_to_add),
- r.rulename::rules_that_have_matched))
+ r.rule_info.rulename::rules_that_have_matched))
new_bindings_to_add in
((relevant_bindings,new_bindings)::cache,
- merge_env new_e newes))
- ([],[]) reorganized_env in (* end iter es *)
- if !(r.was_matched)
- then Common.push2 r.rulename rules_that_have_ever_matched;
+ Common.profile_code "merge_env" (function _ ->
+ merge_env new_e newes)))
+ ([],init_env()) reorganized_env in (* end iter es *)
+ if !(r.rule_info.was_matched)
+ then Common.push2 r.rule_info.rulename rules_that_have_ever_matched;
- es := newes;
+ es := end_env newes;
(* apply the tagged modifs and reparse *)
if not !Flag.sgrep_mode2
let free_vars =
List.filter
(function
- (rule,_) when rule =$= r.rulename -> false
+ (rule,_) when rule =$= r.rule_info.rulename -> false
| (_,"ARGS") -> false
| _ -> true)
r.free_vars in
let metavars =
List.filter
(function md ->
- let (rl,_) = Ast_cocci.get_meta_name md in rl =$= r.rulename)
+ let (rl,_) = Ast_cocci.get_meta_name md in rl =$= r.rule_info.rulename)
r.metavars in
if Common.include_set free_vars env_domain
then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname
(* does side effects on C ast and on Cocci info rule *)
and process_a_ctl_a_env_a_toplevel2 r e c f =
indent_do (fun () ->
- show_or_not_celem "trying" c.ast_c;
- Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c);
- let (trans_info, returned_any_states, inherited_bindings, newbindings) =
- Common.save_excursion Flag_ctl.loop_in_src_code (fun () ->
- Flag_ctl.loop_in_src_code := !Flag_ctl.loop_in_src_code||c.contain_loop;
+ show_or_not_celem "trying" c.ast_c;
+ Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c);
+ match (r.ctl,c.ast_c) with
+ ((Asttoctl2.NONDECL ctl,t),Ast_c.Declaration _) -> None
+ | ((Asttoctl2.NONDECL ctl,t), _)
+ | ((Asttoctl2.CODE ctl,t), _) ->
+ let ctl = (ctl,t) in (* ctl and other info *)
+ let (trans_info, returned_any_states, inherited_bindings, newbindings) =
+ Common.save_excursion Flag_ctl.loop_in_src_code (fun () ->
+ Flag_ctl.loop_in_src_code :=
+ !Flag_ctl.loop_in_src_code||c.contain_loop;
(***************************************)
(* !Main point! The call to the engine *)
(***************************************)
- let model_ctl = CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e
- in CCI.mysat model_ctl r.ctl (r.used_after, e)
- )
- in
- if not returned_any_states
- then None
- else begin
- show_or_not_celem "found match in" c.ast_c;
- show_or_not_trans_info trans_info;
- List.iter (show_or_not_binding "out") newbindings;
-
- r.was_matched := true;
-
- if not (null trans_info)
- then begin
- c.was_modified := true;
- try
- (* les "more than one var in a decl" et "already tagged token"
- * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
- * failed. Le try limite le scope des crashes pendant la
- * trasformation au fichier concerne. *)
-
- (* modify ast via side effect *)
- ignore(Transformation_c.transform r.rulename r.dropped_isos
- inherited_bindings trans_info (Common.some c.flow));
- with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i)
- end;
-
- Some (List.map (function x -> x@inherited_bindings) newbindings)
- end
- )
+ let model_ctl =
+ CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e
+ in CCI.mysat model_ctl ctl
+ (r.rule_info.rulename, r.rule_info.used_after, e))
+ in
+ if not returned_any_states
+ then None
+ else
+ begin
+ show_or_not_celem "found match in" c.ast_c;
+ show_or_not_trans_info trans_info;
+ List.iter (show_or_not_binding "out") newbindings;
+
+ r.rule_info.was_matched := true;
+
+ if not (null trans_info) &&
+ not (!Flag.sgrep_mode2 && not !Flag_cocci.show_diff)
+ then
+ begin
+ c.was_modified := true;
+ try
+ (* les "more than one var in a decl" et "already tagged token"
+ * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
+ * failed. Le try limite le scope des crashes pendant la
+ * trasformation au fichier concerne. *)
+
+ (* modify ast via side effect *)
+ ignore
+ (Transformation_c.transform r.rule_info.rulename
+ r.dropped_isos
+ inherited_bindings trans_info (Common.some c.flow));
+ with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i)
+ end;
+
+ Some (List.map (function x -> x@inherited_bindings) newbindings)
+ end
+ )
and process_a_ctl_a_env_a_toplevel a b c f=
Common.profile_code "process_a_ctl_a_env_a_toplevel"
let ccs = ref ccs in
let rules_that_have_ever_matched = ref [] in
+ (try
+
(* looping over the rules *)
rs +> List.iter (fun r ->
match r with
adjust_pp_with_indent (fun () ->
Format.force_newline();
- let (l,mv,code) = r.scr_ast_rule in
- let deps = r.scr_dependencies in
+ let (l,mv,script_vars,code) = r.scr_ast_rule in
+ let nm = r.scr_rule_info.rulename in
+ let deps = r.scr_rule_info.dependencies in
Pretty_print_cocci.unparse
- (Ast_cocci.ScriptRule (l,deps,mv,code)));
+ (Ast_cocci.ScriptRule (nm,l,deps,mv,script_vars,code)));
end;
+ (*pr2 (List.hd(cmd_to_list "free -m | grep Mem"));*)
if !Flag.show_misc then print_endline "RESULT =";
let (_, newes) =
function (e, rules_that_have_matched) ->
match r.language with
"python" ->
- apply_python_rule r cache newes e rules_that_have_matched
- rules_that_have_ever_matched
+ apply_script_rule r cache newes e rules_that_have_matched
+ rules_that_have_ever_matched python_application
+ | "ocaml" ->
+ apply_script_rule r cache newes e rules_that_have_matched
+ rules_that_have_ever_matched ocaml_application
| "test" ->
concat_headers_and_c !ccs +> List.iter (fun (c,_) ->
if c.flow <> None
(cache, newes)
| _ ->
Printf.printf "Unknown language: %s\n" r.language;
- (cache, newes)
- )
- ([],[]) !es in
+ (cache, newes))
+ ([],init_env()) !es in
+
+ (if !(r.scr_rule_info.was_matched)
+ then
+ Common.push2 r.scr_rule_info.rulename rules_that_have_ever_matched);
- es := (if newes = [] then init_es else newes);
+ (* just newes can't work, because if one does include_match false
+ on everything that binds a variable, then nothing is left *)
+ es := (*newes*)
+ (if Hashtbl.length newes = 0 then init_es else end_env newes)
| CocciRuleCocciInfo r ->
apply_cocci_rule r rules_that_have_ever_matched
- es ccs);
+ es ccs)
+ with Exited -> ());
if !Flag.sgrep_mode2
then begin
let bigloop a b =
Common.profile_code "bigloop" (fun () -> bigloop2 a b)
+type init_final = Initial | Final
+
let initial_final_bigloop2 ty rebuild r =
if !Flag_cocci.show_ctl_text then
begin
Common.pr_xxxxxxxxxxxxxxxxx ();
- pr (ty ^ ": " ^ r.language);
+ pr ((match ty with Initial -> "initial" | Final -> "final") ^ ": " ^
+ r.language);
Common.pr_xxxxxxxxxxxxxxxxx ();
adjust_pp_with_indent (fun () ->
Format.force_newline();
- Pretty_print_cocci.unparse(rebuild r.scr_ast_rule r.scr_dependencies));
+ Pretty_print_cocci.unparse(rebuild r.scr_ast_rule r.scr_rule_info.dependencies));
end;
match r.language with
"python" ->
(* include_match makes no sense in an initial or final rule, although
we have no way to prevent it *)
- let _ = apply_python_rule r [] [] [] [] (ref []) in
+ let newes = init_env() in
+ let _ = apply_script_rule r [] newes [] [] (ref []) python_application in
+ ()
+ | "ocaml" when ty = Initial -> () (* nothing to do *)
+ | "ocaml" ->
+ (* include_match makes no sense in an initial or final rule, although
+ we have no way to prevent it *)
+ let newes = init_env() in
+ let _ = apply_script_rule r [] newes [] [] (ref []) ocaml_application in
()
| _ ->
- Printf.printf "Unknown language for initial/final script: %s\n"
- r.language
+ failwith ("Unknown language for initial/final script: "^
+ r.language)
let initial_final_bigloop a b c =
Common.profile_code "initial_final_bigloop"
else Some isofile in
(* useful opti when use -dir *)
- let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists,
- positions_lists,toks,_) =
- sp_of_file coccifile isofile in
+ let (metavars,astcocci,
+ free_var_lists,negated_pos_lists,used_after_lists,
+ positions_lists,(toks,_,_)) = sp_of_file coccifile isofile in
+
let ctls = ctls_of_ast astcocci used_after_lists positions_lists in
g_contain_typedmetavar := sp_contain_typed_metavar astcocci;
| _ -> languages)
[] cocci_infos in
+ let runrule r =
+ let rlang = r.language in
+ let rname = r.scr_rule_info.rulename in
+ try
+ let _ = List.assoc (rlang,rname) !Iteration.initialization_stack in
+ ()
+ with Not_found ->
+ begin
+ Iteration.initialization_stack :=
+ ((rlang,rname),!Flag.defined_virtual_rules) ::
+ !Iteration.initialization_stack;
+ initial_final_bigloop Initial
+ (fun (x,_,_,y) -> fun deps ->
+ Ast_cocci.InitialScriptRule(rname,x,deps,y))
+ r
+ end in
+
let initialized_languages =
List.fold_left
(function languages ->
- function
- InitialScriptRuleCocciInfo(r) ->
- (if List.mem r.language languages
- then
- failwith
- ("double initializer found for "^r.language));
- if interpret_dependencies [] [] r.scr_dependencies
- then
- begin
- initial_final_bigloop "initial"
- (fun (x,_,y) -> fun deps ->
- Ast_cocci.InitialScriptRule(x,deps,y))
- r;
- r.language::languages
- end
- else languages
- | _ -> languages)
+ function
+ InitialScriptRuleCocciInfo(r) ->
+ let rlang = r.language in
+ (if List.mem rlang languages
+ then failwith ("double initializer found for "^rlang));
+ if interpret_dependencies [] [] r.scr_rule_info.dependencies
+ then begin runrule r; rlang::languages end
+ else languages
+ | _ -> languages)
[] cocci_infos in
let uninitialized_languages =
List.filter
(fun used -> not (List.mem used initialized_languages))
- used_languages
- in
- List.iter (fun lgg ->
- initial_final_bigloop "initial"
- (fun (x,_,y) -> fun deps ->
- Ast_cocci.InitialScriptRule(x,deps,y))
- (make_init (-1) lgg Ast_cocci.NoDep "");
- )
- uninitialized_languages;
+ used_languages in
+
+ List.iter
+ (fun lgg ->
+ let rule_info =
+ {rulename = "";
+ dependencies = Ast_cocci.NoDep;
+ used_after = [];
+ ruleid = (-1);
+ was_matched = ref false;} in
+ runrule (make_init lgg "" rule_info))
+ uninitialized_languages;
(cocci_infos,toks)
if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks)
then
begin
- pr2 ("No matches found for " ^ (Common.join " " (Common.union_all toks))
- ^ "\nSkipping:" ^ (Common.join " " cfiles));
+ (match toks with
+ None -> ()
+ | Some toks ->
+ pr2 ("No matches found for " ^ (Common.join " " toks)
+ ^ "\nSkipping:" ^ (Common.join " " cfiles)));
cfiles +> List.map (fun s -> s, None)
end
else
if !Flag.show_misc then pr "let's go";
if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
+ if !Flag_cocci.show_binding_in_out
+ then
+ begin
+ (match !Flag.defined_virtual_rules with
+ [] -> ()
+ | l -> pr (Printf.sprintf "Defined virtual rules: %s"
+ (String.concat " " l)));
+ List.iter
+ (function (v,vl) ->
+ pr (Printf.sprintf "%s = %s" v vl))
+ !Flag.defined_virtual_env;
+ Common.pr_xxxxxxxxxxxxxxxxx()
+ end;
+
let choose_includes =
match !Flag_cocci.include_options with
Flag_cocci.I_UNSPECIFIED ->
(fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res)
let post_engine2 (cocci_infos,_) =
- let _ =
- List.fold_left
- (function languages ->
- function
- FinalScriptRuleCocciInfo(r) ->
- (if List.mem r.language languages
- then failwith ("double finalizer found for "^r.language));
- initial_final_bigloop "final"
- (fun (x,_,y) -> fun deps -> Ast_cocci.FinalScriptRule(x,deps,y))
- r;
- r.language::languages
- | _ -> languages)
- [] cocci_infos in
- ()
+ List.iter
+ (function ((language,_),virt_rules) ->
+ Flag.defined_virtual_rules := virt_rules;
+ let _ =
+ List.fold_left
+ (function languages ->
+ function
+ FinalScriptRuleCocciInfo(r) ->
+ (if r.language = language && List.mem r.language languages
+ then failwith ("double finalizer found for "^r.language));
+ initial_final_bigloop Final
+ (fun (x,_,_,y) -> fun deps ->
+ Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename,
+ x,deps,y))
+ r;
+ r.language::languages
+ | _ -> languages)
+ [] cocci_infos in
+ ())
+ !Iteration.initialization_stack
let post_engine a =
Common.profile_code "post_engine" (fun () -> post_engine2 a)
let groups = Common.group_assoc_bykey_eff xs in
groups +> Common.map_filter (fun (file, xs) ->
match xs with
- | [] -> raise Impossible
+ | [] -> raise (Impossible 162)
| [res] -> Some (file, res)
| res::xs ->
match res with
HCoop / bpt / coccinelle.git / blobdiff