X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/90aeb998d88488b4402e7b211b064056d175fcbb..8f657093d128c6436330659d273c2762ac9cbf79:/cocci.ml diff --git a/cocci.ml b/cocci.ml index 6f3ee5b..5a86ffa 100644 --- a/cocci.ml +++ b/cocci.ml @@ -44,32 +44,65 @@ module Ast_to_flow = Control_flow_c_build (* --------------------------------------------------------------------- *) (* 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 + (Some saved_typedefs) (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) @@ -167,13 +200,15 @@ let fix_sgrep_diffs l = 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 @@ -185,18 +220,21 @@ let fix_sgrep_diffs l = 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)) @@ -256,24 +294,26 @@ let show_or_not_diff2 cfile outfile = 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)) | _ -> 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 " " @@ -504,7 +544,7 @@ let sp_contain_typed_metavar_z toplevel_list_list = 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 @@ -536,32 +576,60 @@ let sp_contain_typed_metavar rules = * 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 *) -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 -> [] | 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 @@ -573,29 +641,33 @@ let (includes_to_parse: (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 (List.rev x)))) (*uniq keeps last*) let rec interpret_dependencies local global = function Ast_cocci.Dep s -> List.mem s local @@ -744,15 +816,30 @@ type toplevel_c_info = { 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 = { @@ -761,21 +848,17 @@ type toplevel_cocci_info_cocci_rule = { 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 = @@ -843,14 +926,13 @@ let python_code = 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; } (* --------------------------------------------------------------------- *) @@ -866,6 +948,13 @@ let prepare_cocci ctls free_var_lists negated_pos_lists (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 _ @@ -876,55 +965,48 @@ let prepare_cocci ctls free_var_lists negated_pos_lists 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 @@ -970,6 +1052,9 @@ let build_info_program cprogram env = env_typing_after = envb; was_modified = ref false; + + all_typedefs = typedefs; + all_macros = macros; } ) @@ -986,7 +1071,7 @@ let rebuild_info_program cs file isexp = 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, @@ -1010,63 +1095,75 @@ let rebuild_info_c_and_headers ccs isexp = 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 (*****************************************************************************) (* Processing the ctls and toplevel C elements *) @@ -1140,77 +1237,137 @@ let merge_env new_e old_e = ([],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; +let contains_binding e (_,(r,m),_) = + try + let _ = List.find (function ((re, rm), _) -> r =*= re && m =$= rm) e in + true + with Not_found -> false + +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.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.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) 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; + r.scr_rule_info.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; - 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,merge_env [(new_e, rules_that_have_matched)] newes) + 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), + merge_env + [(new_e, + r.scr_rule_info.rulename :: rules_that_have_matched)] + newes) + 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)))); + let e = + e +> + List.filter + (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in (cache, merge_env [(e, rules_that_have_matched)] newes)) 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 @@ -1222,17 +1379,20 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es 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), + [(e +> + List.filter + (fun (s,v) -> List.mem s r.rule_info.used_after), rules_that_have_matched)] newes) end @@ -1242,10 +1402,11 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es 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; @@ -1282,7 +1443,9 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es 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 @@ -1312,20 +1475,20 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es (* 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; + if !(r.rule_info.was_matched) + then Common.push2 r.rule_info.rulename rules_that_have_ever_matched; es := newes; @@ -1423,7 +1586,7 @@ and process_a_generated_a_env_a_toplevel2 r env = function 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 @@ -1431,7 +1594,7 @@ and process_a_generated_a_env_a_toplevel2 r env = function 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 @@ -1454,7 +1617,7 @@ and process_a_ctl_a_env_a_toplevel2 r e c f = (* !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 CCI.mysat model_ctl r.ctl (r.rule_info.used_after, e) ) in if not returned_any_states @@ -1464,9 +1627,10 @@ and process_a_ctl_a_env_a_toplevel2 r e c f = show_or_not_trans_info trans_info; List.iter (show_or_not_binding "out") newbindings; - r.was_matched := true; + r.rule_info.was_matched := true; - if not (null trans_info) + if not (null trans_info) && + not (!Flag.sgrep_mode2 && not !Flag_cocci.show_diff) then begin c.was_modified := true; try @@ -1476,7 +1640,7 @@ and process_a_ctl_a_env_a_toplevel2 r e c f = * trasformation au fichier concerne. *) (* modify ast via side effect *) - ignore(Transformation_c.transform r.rulename r.dropped_isos + 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; @@ -1508,10 +1672,11 @@ let rec bigloop2 rs (ccs: file_info list) = 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; if !Flag.show_misc then print_endline "RESULT ="; @@ -1522,8 +1687,11 @@ let rec bigloop2 rs (ccs: file_info list) = 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 @@ -1532,11 +1700,14 @@ let rec bigloop2 rs (ccs: file_info list) = (cache, newes) | _ -> Printf.printf "Unknown language: %s\n" r.language; - (cache, newes) - ) + (cache, newes)) ([],[]) !es in - es := (if newes = [] then init_es else newes); + (if !(r.scr_rule_info.was_matched) + then + Common.push2 r.scr_rule_info.rulename rules_that_have_ever_matched); + + es := newes (*(if newes = [] then init_es else newes)*); | CocciRuleCocciInfo r -> apply_cocci_rule r rules_that_have_ever_matched es ccs); @@ -1559,27 +1730,36 @@ let rec bigloop2 rs (ccs: file_info list) = 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 _ = apply_script_rule r [] [] [] [] (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 _ = apply_script_rule r [] [] [] [] (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" @@ -1602,8 +1782,9 @@ let pre_engine2 (coccifile, isofile) = else Some isofile in (* useful opti when use -dir *) - let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists, - positions_lists,toks,_) = + 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 @@ -1629,40 +1810,52 @@ let pre_engine2 (coccifile, isofile) = | _ -> 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) @@ -1734,20 +1927,26 @@ let full_engine a b = (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)