X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/f537ebc4bbd27866c9ac3e1198b6756ebab7f2ba..17ba07880e1838028b4516ba7a2db2147b3aa1c9:/cocci.ml diff --git a/cocci.ml b/cocci.ml index 5a86ffa..f469888 100644 --- a/cocci.ml +++ b/cocci.ml @@ -1,5 +1,7 @@ (* - * Copyright 2010, INRIA, 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 @@ -47,7 +49,8 @@ module Ast_to_flow = Control_flow_c_build 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 + (if !Flag_cocci.use_saved_typedefs then (Some saved_typedefs) else None) + (Some saved_macros) file in program2 let cprogram_of_file_cached file = @@ -85,12 +88,12 @@ let sp_of_file2 file iso = begin Hashtbl.add _h_ocaml_init (file,iso) (); match Prepare_ocamlcocci.prepare file xs with - None -> res - | Some ocaml_script_file -> - (* compile file *) + 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); + then Prepare_ocamlcocci.clean_file ocaml_script_file); res end in Hashtbl.add _hparse (file,iso) @@ -149,8 +152,8 @@ let ctls_of_ast2 ast (ua,fua,fuas) pos = (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 *) @@ -253,6 +256,8 @@ let normalize_path file = | 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 @@ -265,8 +270,16 @@ let show_or_not_diff2 cfile outfile = 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) -> @@ -304,7 +317,8 @@ let show_or_not_diff2 cfile outfile = else 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) = match (Str.split (Str.regexp "[ \t]") minus_file, @@ -318,14 +332,27 @@ let show_or_not_diff2 cfile outfile = ("---"::("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) @@ -335,6 +362,12 @@ let show_or_not_diff 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;" ^ @@ -380,7 +413,7 @@ let show_or_not_ctl_text2 ctl ast rulenb = ); 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 @@ -843,7 +876,7 @@ type toplevel_cocci_info_script_rule = { } 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 *) @@ -1017,6 +1050,7 @@ let build_info_program (cprogram,typedefs,macros) env = (* 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 @@ -1165,6 +1199,20 @@ let prepare_c files choose_includes : file_info list = 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 *) (*****************************************************************************) @@ -1216,26 +1264,11 @@ let prepare_c files choose_includes : file_info list = (* 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) + List.iter + (function (e,rules) -> + let _ = update_env old_e e rules in ()) new_e; + old_e let contains_binding e (_,(r,m),_) = try @@ -1243,6 +1276,8 @@ let contains_binding e (_,(r,m),_) = true with Not_found -> false +exception Exited + let python_application mv ve script_vars r = let mv = List.map @@ -1258,7 +1293,9 @@ let python_application mv ve script_vars r = 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 + if !Pycocci.exited + then raise Exited + else if !Pycocci.inc_match then Some (Pycocci.retrieve_script_variables script_vars) else None with Pycocci.Pycocciexception -> @@ -1270,7 +1307,9 @@ let ocaml_application mv ve script_vars r = let script_vals = Run_ocamlcocci.run mv ve script_vars r.scr_rule_info.rulename r.script_code in - if !Coccilib.inc_match + 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) @@ -1288,7 +1327,7 @@ let apply_script_rule r cache newes e rules_that_have_matched rules_that_have_matched !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 @@ -1321,7 +1360,7 @@ let apply_script_rule r cache newes e rules_that_have_matched 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) + (cache,update_env newes new_e rules_that_have_matched) with Not_found -> begin print_dependencies "dependencies for script satisfied:" @@ -1337,18 +1376,15 @@ let apply_script_rule r cache newes e rules_that_have_matched 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 = (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) + update_env newes new_e + (r.scr_rule_info.rulename :: rules_that_have_matched)) end) | unbound -> (if !Flag_cocci.show_dependencies @@ -1358,9 +1394,8 @@ let apply_script_rule r cache newes e rules_that_have_matched (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)) + 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 @@ -1389,12 +1424,11 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es !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.rule_info.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 = @@ -1485,12 +1519,13 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es 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 *) + 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 @@ -1607,47 +1642,58 @@ and process_a_generated_a_env_a_toplevel rule env ccs = (* 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.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 - ) + 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" @@ -1660,6 +1706,8 @@ let rec bigloop2 rs (ccs: file_info list) = 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 @@ -1679,6 +1727,7 @@ let rec bigloop2 rs (ccs: file_info list) = (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) = @@ -1701,16 +1750,20 @@ let rec bigloop2 rs (ccs: file_info list) = | _ -> Printf.printf "Unknown language: %s\n" r.language; (cache, newes)) - ([],[]) !es in + ([],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 := newes (*(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 @@ -1749,13 +1802,15 @@ let initial_final_bigloop2 ty rebuild r = "python" -> (* 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 []) python_application 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 _ = apply_script_rule r [] [] [] [] (ref []) ocaml_application in + let newes = init_env() in + let _ = apply_script_rule r [] newes [] [] (ref []) ocaml_application in () | _ -> failwith ("Unknown language for initial/final script: "^ @@ -1784,8 +1839,8 @@ let pre_engine2 (coccifile, isofile) = (* 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 + 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; @@ -1884,6 +1939,20 @@ let full_engine2 (cocci_infos,toks) cfiles = 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 ->