(*
- * 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
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 =
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)
(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 *)
| 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) ->
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,
("---"::("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
}
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 *)
(* 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
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)
+ List.iter
+ (function (e,rules) ->
+ let _ = update_env old_e e rules in ()) new_e;
+ old_e
let contains_binding e (_,(r,m),_) =
try
true
with Not_found -> false
+exception Exited
+
let python_application mv ve script_vars r =
let mv =
List.map
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 ->
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)
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
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:"
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
(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
!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 =
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
(* 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"
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
(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) =
| _ ->
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
"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: "^
(* 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;
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 ->
HCoop / bpt / coccinelle.git / blobdiff