(*
-* Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
open Common
module CCI = Ctlcocci_integration
module TAC = Type_annoter_c
+module Ast_to_flow = Control_flow_c_build
+
(*****************************************************************************)
(* This file is a kind of driver. It gathers all the important functions
* from coccinelle in one place. The different entities in coccinelle are:
(* C related *)
(* --------------------------------------------------------------------- *)
let cprogram_of_file file =
- let (program2, _stat) = Parse_c.parse_print_error_heuristic file in
+ let (program2, _stat) = Parse_c.parse_c_and_cpp file in
program2
let cprogram_of_file_cached file =
let (program2, _stat) = Parse_c.parse_cache file in
- program2
-
+ if !Flag_cocci.ifdef_to_if
+ then
+ program2 +> Parse_c.with_program2 (fun asts ->
+ Cpp_ast_c.cpp_ifdef_statementize asts
+ )
+ else program2
let cfile_of_program program2_with_ppmethod outf =
- Unparse_c2.pp_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
(* --------------------------------------------------------------------- *)
(* Ctl related *)
(* --------------------------------------------------------------------- *)
-let ctls_of_ast2 ast ua pos =
+
+let ctls_of_ast2 ast (ua,fua,fuas) pos =
List.map2
- (function ast -> function (ua,pos) ->
+ (function ast -> function (ua,(fua,(fuas,pos))) ->
List.combine
(if !Flag_cocci.popl
then Popl.popl ast
- else Asttoctl2.asttoctl ast ua pos)
+ else Asttoctl2.asttoctl ast (ua,fua,fuas) pos)
(Asttomember.asttomember ast ua))
- ast (List.combine ua pos)
+ 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 show_or_not_cocci a b =
Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b)
-
(* the output *)
let show_or_not_diff2 cfile outfile show_only_minus =
if !Flag_cocci.show_diff then begin
- match Common.fst(Compare_c.compare_default cfile outfile) with
+ match Common.fst(Compare_c.compare_to_original cfile outfile) with
Compare_c.Correct -> () (* diff only in spacing, etc *)
| _ ->
(* may need --strip-trailing-cr under windows *)
(* create something that looks like the output of patch *)
(Some prefix,minus_file::plus_file::rest) ->
let drop_prefix file =
- if prefix = ""
+ if prefix =$= ""
then "/"^file
else
- (match Str.split (Str.regexp prefix) file with
- [base_file] -> base_file
- | _ -> failwith "prefix not found in the old file name") in
+ let lp = String.length prefix in
+ String.sub file lp ((String.length file) - lp) in
let diff_line =
match List.rev(Str.split (Str.regexp " ") line) with
new_file::old_file::cmdrev ->
(Printf.sprintf "bad diff header lines: %s %s"
(String.concat ":" l1) (String.concat ":" l2)) in
diff_line::minus_line::plus_line::rest
- | _ -> res in
+ | _ -> res in
xs +> List.iter (fun s ->
if s =~ "^\\+" && show_only_minus
then ()
let show_or_not_rule_name ast rulenb =
if !Flag_cocci.show_ctl_text or !Flag.show_trying or
- !Flag_cocci.show_transinfo or !Flag_cocci.show_binding_in_out
+ !Flag.show_transinfo or !Flag_cocci.show_binding_in_out
then
begin
let name =
match ast with
- Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _) -> nm
+ Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _, _) -> nm
| _ -> i_to_s rulenb in
Common.pr_xxxxxxxxxxxxxxxxx ();
pr (name ^ " = ");
let show_or_not_scr_rule_name rulenb =
if !Flag_cocci.show_ctl_text or !Flag.show_trying or
- !Flag_cocci.show_transinfo or !Flag_cocci.show_binding_in_out
+ !Flag.show_transinfo or !Flag_cocci.show_binding_in_out
then
begin
let name = i_to_s rulenb in
(* running information *)
+let get_celem celem : string =
+ match celem with
+ Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) ->
+ Ast_c.str_of_name namefuncs
+ | Ast_c.Declaration
+ (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) ->
+ Ast_c.str_of_name name
+ | _ -> ""
let show_or_not_celem2 prelude celem =
- if !Flag.show_trying then
+ let (tag,trying) =
(match celem with
- | Ast_c.Definition ((funcs,_,_,_c),_) ->
- pr2 (prelude ^ " function: " ^ funcs);
+ | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) ->
+ let funcs = Ast_c.str_of_name namefuncs in
+ Flag.current_element := funcs;
+ (" function: ",funcs)
| Ast_c.Declaration
- (Ast_c.DeclList ([(Some ((s, _),_), typ, sto, _local), _], _)) ->
- pr2 (prelude ^ " variable " ^ s);
- | _ ->
- pr2 (prelude ^ " something else");
- )
+ (Ast_c.DeclList ([{Ast_c.v_namei = Some (name,_)}, _], _)) ->
+ let s = Ast_c.str_of_name name in
+ Flag.current_element := s;
+ (" variable ",s);
+ | _ ->
+ Flag.current_element := "something_else";
+ (" ","something else");
+ ) in
+ if !Flag.show_trying then pr2 (prelude ^ tag ^ trying)
+
let show_or_not_celem a b =
Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b)
let show_or_not_trans_info2 trans_info =
- if !Flag_cocci.show_transinfo then begin
+ (* drop witness tree indices for printing *)
+ let trans_info =
+ List.map (function (index,trans_info) -> trans_info) trans_info in
+ if !Flag.show_transinfo then begin
if null trans_info then pr2 "transformation info is empty"
else begin
pr2 "transformation info returned:";
let check_macro_in_sp_and_adjust tokens =
let tokens = Common.union_all tokens in
tokens +> List.iter (fun s ->
- if Hashtbl.mem !Parsing_hacks._defs s
+ if Hashtbl.mem !Parse_c._defs s
then begin
- pr2 "warning: macro in semantic patch was in macro definitions";
- pr2 ("disabling macro expansion for " ^ s);
- Hashtbl.remove !Parsing_hacks._defs s
+ 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 combiner =
Visitor_ast.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
donothing donothing donothing donothing
donothing expression donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing
(List.map
(function x ->
match x with
- Ast_cocci.CocciRule (a,b,c,d) -> (a,b,c)
+ Ast_cocci.CocciRule (a,b,c,d,_) -> (a,b,c)
| _ -> failwith "error in filter")
(List.filter
(function x ->
- match x with Ast_cocci.CocciRule _ -> true | _ -> false)
+ match x with
+ Ast_cocci.CocciRule (a,b,c,d,Ast_cocci.Normal) -> true
+ | _ -> false)
rules))
* serio.c is related we think to #include <linux/serio.h>
*)
-let includes_to_parse xs =
- if !Flag_cocci.no_includes
- then []
- else
- xs +> List.map (fun (file, cs) ->
- let dir = Common.dirname file in
-
- cs +> Common.map_filter (fun (c,_info_item) ->
- match c with
- | Ast_c.Include ((x,ii),info_h_pos) ->
- (match x with
+let interpret_include_path _ =
+ match !Flag_cocci.include_path with
+ None -> "include"
+ | Some x -> x
+
+let (includes_to_parse:
+ (Common.filename * Parse_c.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
+ xs +> List.map (fun (file, cs) ->
+ let dir = Common.dirname file in
+
+ cs +> Common.map_filter (fun (c,_info_item) ->
+ match c with
+ | Ast_c.CppTop
+ (Ast_c.Include
+ {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) ->
+ (match x with
| Ast_c.Local xs ->
let f = Filename.concat dir (Common.join "/" xs) in
(* 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) && !Flag_cocci.all_includes
- then Some (Filename.concat !Flag_cocci.include_path
+ if not (Sys.file_exists f) && all_includes
+ then Some (Filename.concat (interpret_include_path())
(Common.join "/" xs))
else Some attempt2
else Some f
-
+
| Ast_c.NonLocal xs ->
- if !Flag_cocci.all_includes ||
- Common.fileprefix (Common.last xs) = Common.fileprefix file
+ if all_includes ||
+ Common.fileprefix (Common.last xs) =$= Common.fileprefix file
then
- Some (Filename.concat !Flag_cocci.include_path
+ Some (Filename.concat (interpret_include_path())
(Common.join "/" xs))
else None
- | Ast_c.Wierd _ -> None
+ | Ast_c.Weird _ -> None
)
- | _ -> None
- )
- )
- +> List.concat
- +> Common.uniq
+ | _ -> None))
+ +> List.concat
+ +> Common.uniq
let rec interpret_dependencies local global = function
Ast_cocci.Dep s -> List.mem s local
(interpret_dependencies local global s1) or
(interpret_dependencies local global s2)
| Ast_cocci.NoDep -> true
+ | Ast_cocci.FailDep -> false
let rec print_dependencies str local global dep =
if !Flag_cocci.show_dependencies
let seen = ref [] in
let rec loop = function
Ast_cocci.Dep s | Ast_cocci.AntiDep s ->
- if not (List.mem s !seen)
- then
- begin
- if List.mem s local
- then pr2 (s^" satisfied")
- else pr2 (s^" not satisfied");
- seen := s :: !seen
- end
+ if not (List.mem s !seen)
+ then
+ begin
+ if List.mem s local
+ then pr2 (s^" satisfied")
+ else pr2 (s^" not satisfied");
+ seen := s :: !seen
+ end
| Ast_cocci.EverDep s | Ast_cocci.NeverDep s ->
- if not (List.mem s !seen)
- then
- begin
- if List.mem s global
- then pr2 (s^" satisfied")
- else pr2 (s^" not satisfied");
- seen := s :: !seen
- end
+ if not (List.mem s !seen)
+ then
+ begin
+ if List.mem s global
+ then pr2 (s^" satisfied")
+ else pr2 (s^" not satisfied");
+ seen := s :: !seen
+ end
| Ast_cocci.AndDep(s1,s2) ->
loop s1;
loop s2
| Ast_cocci.OrDep(s1,s2) ->
loop s1;
loop s2
- | Ast_cocci.NoDep -> () in
+ | Ast_cocci.NoDep -> ()
+ | Ast_cocci.FailDep -> pr2 "False not satisfied" in
loop dep
end
-
-
-
+
(* --------------------------------------------------------------------- *)
(* #include relative position in the file *)
(* --------------------------------------------------------------------- *)
let rec update_include_rel_pos cs =
let only_include = cs +> Common.map_filter (fun c ->
match c with
- | Ast_c.Include ((x,_),(aref, inifdef)) ->
+ | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_));
+ i_rel_pos = aref;
+ i_is_in_ifdef = inifdef}) ->
(match x with
- | Ast_c.Wierd _ -> None
+ | Ast_c.Weird _ -> None
| _ ->
if inifdef
then None
match c with
| Ast_c.Local x -> Left (x, aref)
| Ast_c.NonLocal x -> Right (x, aref)
- | Ast_c.Wierd x -> raise Impossible
+ | Ast_c.Weird x -> raise Impossible
) in
update_rel_pos_bis locals;
type toplevel_cocci_info_cocci_rule = {
ctl: Lib_engine.ctlcocci * (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 *)
positions: Ast_cocci.meta_name list;
ruleid: int;
+ ruletype: Ast_cocci.ruletype;
was_matched: bool ref;
}
type toplevel_cocci_info =
ScriptRuleCocciInfo of toplevel_cocci_info_script_rule
+ | InitialScriptRuleCocciInfo of toplevel_cocci_info_script_rule
+ | 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 kind_file = Header | Source
type file_info = {
fname : string;
let last_env_toplevel_c_info xs =
(Common.last xs).env_typing_after
-let concat_headers_and_c ccs =
- (List.concat (ccs +> List.map (fun x -> x.asts)))
+let concat_headers_and_c (ccs: file_info list)
+ : (toplevel_c_info * string) list =
+ (List.concat (ccs +> List.map (fun x ->
+ x.asts +> List.map (fun x' ->
+ (x', x.fname)))))
let for_unparser xs =
xs +> List.map (fun x ->
- (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c2.PPviastr
+ (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr
)
+let gen_pdf_graph () =
+ (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile ->
+ Printf.printf "Generation of %s%!" outfile;
+ let filename_stack = Ctl_engine.get_graph_comp_files outfile in
+ List.iter (fun filename ->
+ ignore (Unix.system ("dot " ^ filename ^ " -Tpdf -o " ^ filename ^ ".pdf;"))
+ ) filename_stack;
+ let (head,tail) = (List.hd filename_stack, List.tl filename_stack) in
+ ignore(Unix.system ("cp " ^ head ^ ".pdf " ^ outfile ^ ".pdf;"));
+ tail +> List.iter (fun filename ->
+ ignore(Unix.system ("mv " ^ outfile ^ ".pdf /tmp/tmp.pdf;"));
+ ignore(Unix.system ("pdftk " ^ filename ^ ".pdf /tmp/tmp.pdf cat output " ^ outfile ^ ".pdf"));
+ );
+ ignore(Unix.system ("rm /tmp/tmp.pdf;"));
+ List.iter (fun filename ->
+ ignore (Unix.system ("rm " ^ filename ^ " " ^ filename ^ ".pdf;"))
+ ) filename_stack;
+ Printf.printf " - Done\n")
+
+
(* --------------------------------------------------------------------- *)
let prepare_cocci ctls free_var_lists negated_pos_lists
- used_after_lists positions_list astcocci =
+ (ua,fua,fuas) positions_list metavars astcocci =
let gathered = Common.index_list_1
- (zip (zip (zip (zip (zip ctls astcocci) free_var_lists)
- negated_pos_lists) used_after_lists) positions_list)
+ (zip (zip (zip (zip (zip (zip (zip (zip ctls metavars) astcocci)
+ free_var_lists)
+ negated_pos_lists) ua) fua) fuas) positions_list)
in
gathered +> List.map
- (fun ((((((ctl_toplevel_list,ast),free_var_list),negated_pos_list),
- used_after_list),
- positions_list),rulenb) ->
+ (fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list),
+ negated_pos_list),ua),fua),fuas),positions_list),rulenb) ->
let is_script_rule r =
- match r with Ast_cocci.ScriptRule _ -> true | _ -> false in
+ match r with
+ Ast_cocci.ScriptRule _
+ | Ast_cocci.InitialScriptRule _ | Ast_cocci.FinalScriptRule _ -> true
+ | _ -> false in
- if not (List.length ctl_toplevel_list = 1) && not (is_script_rule ast)
+ if not (List.length ctl_toplevel_list =|= 1) && not (is_script_rule ast)
then failwith "not handling multiple minirules";
match ast with
script_code = code;
}
in ScriptRuleCocciInfo r
+ | Ast_cocci.InitialScriptRule (lang,code) ->
+ let mv = [] in
+ let deps = Ast_cocci.NoDep in
+ let r =
+ {
+ scr_ast_rule = (lang, mv, code);
+ language = lang;
+ scr_dependencies = deps;
+ scr_ruleid = rulenb;
+ script_code = code;
+ }
+ in InitialScriptRuleCocciInfo r
+ | Ast_cocci.FinalScriptRule (lang,code) ->
+ let mv = [] in
+ let deps = Ast_cocci.NoDep in
+ let r =
+ {
+ scr_ast_rule = (lang, mv, code);
+ language = lang;
+ scr_dependencies = deps;
+ scr_ruleid = rulenb;
+ script_code = code;
+ }
+ in FinalScriptRuleCocciInfo r
| Ast_cocci.CocciRule
- (rulename,(dependencies,dropped_isos,z),restast,isexp) ->
+ (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;
dropped_isos = dropped_isos;
free_vars = List.hd free_var_list;
negated_pos_vars = List.hd negated_pos_list;
- used_after = List.hd used_after_list;
+ used_after = (List.hd ua) @ (List.hd fua);
positions = List.hd positions_list;
ruleid = rulenb;
+ ruletype = ruletype;
was_matched = ref false;
})
)
(* --------------------------------------------------------------------- *)
let build_info_program cprogram env =
- let (cs, parseinfos) = Common.unzip cprogram in
- let (cs, envs) =
- Common.unzip (TAC.annotate_program env !g_contain_typedmetavar cs) in
+
+ let (cs, parseinfos) =
+ Common.unzip cprogram in
+
+ let alltoks =
+ parseinfos +> List.map (fun (s,toks) -> toks) +> List.flatten in
- zip (zip cs parseinfos) envs +> List.map (fun ((c, parseinfo), (enva,envb))->
+ (* 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
+
+ zip cs_with_envs parseinfos +> List.map (fun ((c, (enva,envb)), parseinfo)->
let (fullstr, tokens) = parseinfo in
let flow =
- ast_to_flow_with_error_messages c +> Common.map_option (fun flow ->
+ ast_to_flow_with_error_messages c +>
+ Common.map_option (fun flow ->
let flow = Ast_to_flow.annotate_loop_nodes flow in
(* remove the fake nodes for julia *)
cs +> List.map (fun c ->
if !(c.was_modified)
then
- (match !Flag.make_hrule with
- Some dir ->
- Unparse_hrule.pp_program (c.ast_c, (c.fullstring, c.tokens_c))
- dir file isexp;
- []
- | None ->
- let file = Common.new_temp_file "cocci_small_output" ".c" in
- cfile_of_program
- [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c2.PPnormal]
- file;
+ let file = Common.new_temp_file "cocci_small_output" ".c" in
+ cfile_of_program
+ [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal]
+ file;
- (* Common.command2 ("cat " ^ file); *)
- let cprogram = cprogram_of_file file in
- let xs = build_info_program cprogram c.env_typing_before in
+ (* Common.command2 ("cat " ^ file); *)
+ let cprogram = cprogram_of_file file in
+ let xs = build_info_program cprogram c.env_typing_before in
- (* TODO: assert env has not changed,
- * if yes then must also reparse what follows even if not modified.
- * Do that only if contain_typedmetavar of course, so good opti.
- *)
- (* Common.list_init xs *) (* get rid of the FinalDef *)
- xs)
+ (* TODO: assert env has not changed,
+ * if yes then must also reparse what follows even if not modified.
+ * Do that only if contain_typedmetavar of course, so good opti.
+ *)
+ (* Common.list_init xs *) (* get rid of the FinalDef *)
+ xs
else [c]
) +> List.concat
);
ccs +> List.map (fun c_or_h ->
{ c_or_h with
- asts = rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
+ asts =
+ rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
)
-let prepare_c files =
+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) in
+ let includes = includes_to_parse (zip files cprograms) choose_includes in
(* todo?: may not be good to first have all the headers and then all the c *)
let all =
((zip files cprograms) +> List.map (fun (file, asts) -> Left (file, asts)))
in
- let env = ref TAC.initial_env in
+ let env = ref !TAC.initial_env in
let ccs = all +> Common.map_filter (fun x ->
match x with
(* r(ule), c(element in C code), e(nvironment) *)
-let rec apply_python_rule r cache newes e rules_that_have_matched
+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;
if not(interpret_dependencies rules_that_have_matched
!rules_that_have_ever_matched r.scr_dependencies)
else
begin
let (_, mv, _) = r.scr_ast_rule in
- if List.for_all (Pycocci.contains_binding e) mv
- then
- begin
+ let not_bound x = not (Pycocci.contains_binding e 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 cache
+ then
+ begin
+ 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;
+ !rules_that_have_ever_matched
+ r.scr_dependencies;
show_or_not_binding "in" e;
Pycocci.build_classes (List.map (function (x,y) -> x) e);
Pycocci.construct_variables mv e;
if !Pycocci.inc_match
then (new_cache, merge_env [(e, rules_that_have_matched)] newes)
else (new_cache, newes)
- end
- else (cache, merge_env [(e, rules_that_have_matched)] newes)
- end
-
-and apply_cocci_rule r rules_that_have_ever_matched es ccs =
+ | unbound ->
+ (if !Flag_cocci.show_dependencies
+ then
+ 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))
+ 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;
(function (cache,newes) ->
function ((e,rules_that_have_matched),relevant_bindings) ->
if not(interpret_dependencies rules_that_have_matched
- !rules_that_have_ever_matched r.dependencies)
+ !rules_that_have_ever_matched
+ r.dependencies)
then
begin
print_dependencies
print_dependencies
("dependencies for rule "^r.rulename^" satisfied:")
rules_that_have_matched
- !rules_that_have_ever_matched r.dependencies;
+ !rules_that_have_ever_matched
+ r.dependencies;
show_or_not_binding "in" e;
show_or_not_binding "relevant in" relevant_bindings;
- let children_e = ref [] in
-
+ (* applying the rule *)
+ (match r.ruletype with
+ Ast_cocci.Normal ->
(* looping over the functions and toplevel elements in
.c and .h *)
- concat_headers_and_c !ccs +> List.iter (fun c ->
- if c.flow <> None
- then
- (* does also some side effects on c and r *)
- let processed =
- process_a_ctl_a_env_a_toplevel r relevant_bindings
- c in
- match processed with
- | None -> ()
- | Some newbindings ->
- newbindings +> List.iter (fun newbinding ->
- children_e :=
- Common.insert_set newbinding !children_e)
- ); (* end iter cs *)
-
- !children_e in
+ List.rev
+ (concat_headers_and_c !ccs +>
+ List.fold_left (fun children_e (c,f) ->
+ if c.flow <> None
+ then
+ (* does also some side effects on c and r *)
+ let processed =
+ process_a_ctl_a_env_a_toplevel r
+ relevant_bindings c f in
+ match processed with
+ | None -> children_e
+ | Some newbindings ->
+ newbindings +>
+ List.fold_left
+ (fun children_e newbinding ->
+ if List.mem newbinding children_e
+ then children_e
+ else newbinding :: children_e)
+ children_e
+ else children_e)
+ [])
+ | Ast_cocci.Generated ->
+ process_a_generated_a_env_a_toplevel r
+ relevant_bindings !ccs;
+ []) in
+
let old_bindings_to_keep =
Common.nub
(e +> List.filter (fun (s,v) -> List.mem s r.used_after)) in
if !Flag_ctl.partial_match
then
printf
- "Empty list of bindings, I will restart from old env";
+ "Empty list of bindings, I will restart from old env\n";
[(old_bindings_to_keep,rules_that_have_matched)]
end
else
(* apply the tagged modifs and reparse *)
if not !Flag.sgrep_mode2
- then ccs := rebuild_info_c_and_headers !ccs r.isexp
- )
-
-and merge_env new_e old_e =
- List.fold_left
- (function old_e ->
- function (e,rules) as elem ->
- let (same,diff) = List.partition (function (e1,_) -> e = e1) old_e in
- match same with
- [] -> elem :: old_e
- | [(_,old_rules)] -> (e,Common.union_set rules old_rules) :: diff
- | _ -> failwith "duplicate environment entries")
- old_e new_e
-
-and bigloop2 rs ccs =
- let es = ref [(Ast_c.emptyMetavarsBinding,[])] in
- let ccs = ref ccs in
- let rules_that_have_ever_matched = ref [] in
-
- (* looping over the rules *)
- rs +> List.iter (fun r ->
- match r with
- ScriptRuleCocciInfo r ->
- if !Flag_cocci.show_ctl_text then begin
- Common.pr_xxxxxxxxxxxxxxxxx ();
- pr ("script: " ^ r.language);
- Common.pr_xxxxxxxxxxxxxxxxx ();
-
- adjust_pp_with_indent (fun () ->
- Format.force_newline();
- let (l,mv,code) = r.scr_ast_rule in
- let deps = r.scr_dependencies in
- Pretty_print_cocci.unparse
- (Ast_cocci.ScriptRule (l,deps,mv,code)));
- end;
-
- if !Flag.show_misc then print_endline "RESULT =";
-
- let (_, newes) =
- List.fold_left
- (function (cache, 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
- | "test" ->
- concat_headers_and_c !ccs +> List.iter (fun c ->
- if c.flow <> None
- then
- Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring);
- (cache, newes)
- | _ ->
- Printf.printf "Unknown language: %s\n" r.language;
- (cache, newes)
- )
- ([],[]) !es in
-
- es := newes;
- | CocciRuleCocciInfo r ->
- apply_cocci_rule r rules_that_have_ever_matched es ccs);
-
- if !Flag.sgrep_mode2
- then begin
- (* sgrep can lead to code that is not parsable, but we must
- * still call rebuild_info_c_and_headers to pretty print the
- * action (MINUS), so that later the diff will show what was
- * matched by sgrep. But we don't want the parsing error message
- * hence the following flag setting. So this code propably
- * will generate a NotParsedCorrectly for the matched parts
- * and the very final pretty print and diff will work
- *)
- Flag_parsing_c.verbose_parsing := false;
- ccs := rebuild_info_c_and_headers !ccs false
- end;
- !ccs (* return final C asts *)
+ then ccs := rebuild_info_c_and_headers !ccs r.isexp)
and reassociate_positions free_vars negated_pos_vars envs =
(* issues: isolate the bindings that are relevant to a given rule.
(function (other_non_pos,other_pos) ->
(* do we want equal? or just somehow compatible? eg non_pos
binds only E, but other_non_pos binds both E and E1 *)
- non_pos = other_non_pos)
+ non_pos =*= other_non_pos)
splitted_relevant in
(non_pos,
List.sort compare
[] others))))
negated_pos_vars
-and bigloop a b =
- Common.profile_code "bigloop" (fun () -> bigloop2 a b)
-
-
-
-
+and process_a_generated_a_env_a_toplevel2 r env = function
+ [cfile] ->
+ let free_vars =
+ List.filter
+ (function
+ (rule,_) when rule =$= r.rulename -> false
+ | (_,"ARGS") -> false
+ | _ -> true)
+ r.free_vars in
+ let env_domain = List.map (function (nm,vl) -> nm) env in
+ let metavars =
+ List.filter
+ (function md ->
+ let (rl,_) = Ast_cocci.get_meta_name md in
+ rl =$= r.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
+ | _ -> failwith "multiple files not supported"
+
+and process_a_generated_a_env_a_toplevel rule env ccs =
+ Common.profile_code "process_a_ctl_a_env_a_toplevel"
+ (fun () -> process_a_generated_a_env_a_toplevel2 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 =
+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;
* trasformation au fichier concerne. *)
(* modify ast via side effect *)
- ignore(Transformation3.transform r.rulename r.dropped_isos
+ 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;
end
)
-and process_a_ctl_a_env_a_toplevel a b c =
+and process_a_ctl_a_env_a_toplevel a b c f=
Common.profile_code "process_a_ctl_a_env_a_toplevel"
- (fun () -> process_a_ctl_a_env_a_toplevel2 a b c)
-
+ (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f)
+
+
+let rec bigloop2 rs (ccs: file_info list) =
+ let init_es = [(Ast_c.emptyMetavarsBinding,[])] in
+ let es = ref init_es in
+ let ccs = ref ccs in
+ let rules_that_have_ever_matched = ref [] in
+
+ (* looping over the rules *)
+ rs +> List.iter (fun r ->
+ match r with
+ InitialScriptRuleCocciInfo r | FinalScriptRuleCocciInfo r -> ()
+ | ScriptRuleCocciInfo r ->
+ if !Flag_cocci.show_ctl_text then begin
+ Common.pr_xxxxxxxxxxxxxxxxx ();
+ pr ("script: " ^ r.language);
+ Common.pr_xxxxxxxxxxxxxxxxx ();
+
+ adjust_pp_with_indent (fun () ->
+ Format.force_newline();
+ let (l,mv,code) = r.scr_ast_rule in
+ let deps = r.scr_dependencies in
+ Pretty_print_cocci.unparse
+ (Ast_cocci.ScriptRule (l,deps,mv,code)));
+ end;
+ if !Flag.show_misc then print_endline "RESULT =";
+
+ let (_, newes) =
+ List.fold_left
+ (function (cache, 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
+ | "test" ->
+ concat_headers_and_c !ccs +> List.iter (fun (c,_) ->
+ if c.flow <> None
+ then
+ Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring);
+ (cache, newes)
+ | _ ->
+ Printf.printf "Unknown language: %s\n" r.language;
+ (cache, newes)
+ )
+ ([],[]) !es in
+
+ es := (if newes = [] then init_es else newes);
+ | CocciRuleCocciInfo r ->
+ apply_cocci_rule r rules_that_have_ever_matched
+ es ccs);
+
+ if !Flag.sgrep_mode2
+ then begin
+ (* sgrep can lead to code that is not parsable, but we must
+ * still call rebuild_info_c_and_headers to pretty print the
+ * action (MINUS), so that later the diff will show what was
+ * matched by sgrep. But we don't want the parsing error message
+ * hence the following flag setting. So this code propably
+ * will generate a NotParsedCorrectly for the matched parts
+ * and the very final pretty print and diff will work
+ *)
+ Flag_parsing_c.verbose_parsing := false;
+ ccs := rebuild_info_c_and_headers !ccs false
+ end;
+ !ccs (* return final C asts *)
+
+let bigloop a b =
+ Common.profile_code "bigloop" (fun () -> bigloop2 a b)
+
+let initial_final_bigloop2 ty rebuild r =
+ if !Flag_cocci.show_ctl_text then
+ begin
+ Common.pr_xxxxxxxxxxxxxxxxx ();
+ pr (ty ^ ": " ^ r.language);
+ Common.pr_xxxxxxxxxxxxxxxxx ();
+
+ adjust_pp_with_indent (fun () ->
+ Format.force_newline();
+ Pretty_print_cocci.unparse(rebuild r.scr_ast_rule));
+ end;
+
+ match r.language with
+ "python" ->
+ (* include_match makes no sense in an initial or final rule, although
+ er have no way to prevent it *)
+ let _ = apply_python_rule r [] [] [] [] (ref []) in
+ ()
+ | _ ->
+ Printf.printf "Unknown language for initial/final script: %s\n"
+ r.language
+
+let initial_final_bigloop a b c =
+ Common.profile_code "initial_final_bigloop"
+ (fun () -> initial_final_bigloop2 a b c)
(*****************************************************************************)
-(* The main function *)
+(* The main functions *)
(*****************************************************************************)
-let full_engine2 (coccifile, isofile) cfiles =
-
- show_or_not_cfiles cfiles;
- show_or_not_cocci coccifile isofile;
+let pre_engine2 (coccifile, isofile) =
+ show_or_not_cocci coccifile isofile;
Pycocci.set_coccifile coccifile;
let isofile =
pr2 ("warning: Can't find default iso file: " ^ isofile);
None
end
- else Some isofile
- in
+ else Some isofile in
(* useful opti when use -dir *)
- let (astcocci,free_var_lists,negated_pos_lists,used_after_lists,
+ let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists,
positions_lists,toks,_) =
- sp_of_file coccifile isofile
- in
- let ctls =
- Common.memoized _hctl (coccifile, isofile) (fun () ->
- ctls_of_ast astcocci used_after_lists positions_lists)
- in
-
- let contain_typedmetavar = sp_contain_typed_metavar astcocci in
-
- (* optimisation allowing to launch coccinelle on all the drivers *)
- if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks)
- then begin
- pr2 ("not worth trying:" ^ Common.join " " cfiles);
- cfiles +> List.map (fun s -> s, None)
- end
- else begin
+ sp_of_file coccifile isofile in
+ let ctls = ctls_of_ast astcocci used_after_lists positions_lists in
- if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
- if !Flag.show_misc then pr "let's go";
- if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
+ g_contain_typedmetavar := sp_contain_typed_metavar astcocci;
- g_contain_typedmetavar := contain_typedmetavar;
+ check_macro_in_sp_and_adjust toks;
- check_macro_in_sp_and_adjust toks;
+ show_or_not_ctl_tex astcocci ctls;
- let cocci_infos =
- prepare_cocci ctls free_var_lists negated_pos_lists
- used_after_lists positions_lists astcocci in
- let c_infos = prepare_c cfiles in
+ let cocci_infos =
+ prepare_cocci ctls free_var_lists negated_pos_lists
+ used_after_lists positions_lists metavars astcocci in
- show_or_not_ctl_tex astcocci ctls;
+ let _ =
+ List.fold_left
+ (function languages ->
+ function
+ InitialScriptRuleCocciInfo(r) ->
+ (if List.mem r.language languages
+ then failwith ("double initializer found for "^r.language));
+ initial_final_bigloop "initial"
+ (function(x,_,y) -> Ast_cocci.InitialScriptRule(x,y))
+ r;
+ r.language::languages
+ | _ -> languages)
+ [] cocci_infos in
- (* ! the big loop ! *)
- let c_infos' = bigloop cocci_infos c_infos in
+ (cocci_infos,toks)
- if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx ();
- if !Flag.show_misc then pr "Finished";
- if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
+let pre_engine a =
+ Common.profile_code "pre_engine" (fun () -> pre_engine2 a)
- c_infos' +> List.map (fun c_or_h ->
- if !(c_or_h.was_modified_once)
- then begin
- let outfile = Common.new_temp_file "cocci-output" ("-" ^ c_or_h.fname)
- in
+let full_engine2 (cocci_infos,toks) cfiles =
- if c_or_h.fkind = Header
- then pr2 ("a header file was modified: " ^ c_or_h.fname);
-
- (* and now unparse everything *)
- cfile_of_program (for_unparser c_or_h.asts) outfile;
+ show_or_not_cfiles cfiles;
- let show_only_minus = !Flag.sgrep_mode2 in
- show_or_not_diff c_or_h.fpath outfile show_only_minus;
+ (* optimisation allowing to launch coccinelle on all the drivers *)
+ 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));
+ cfiles +> List.map (fun s -> s, None)
+ end
+ else
+ begin
- (c_or_h.fpath,
- if !Flag.sgrep_mode2 then None else Some outfile
- )
- end
- else
- (c_or_h.fpath, None)
- );
- end
+ if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
+ if !Flag.show_misc then pr "let's go";
+ if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
+
+ let choose_includes =
+ match !Flag_cocci.include_options with
+ Flag_cocci.I_UNSPECIFIED ->
+ if !g_contain_typedmetavar
+ then Flag_cocci.I_NORMAL_INCLUDES
+ else Flag_cocci.I_NO_INCLUDES
+ | x -> x in
+ let c_infos = prepare_c cfiles choose_includes in
+
+ (* ! the big loop ! *)
+ let c_infos' = bigloop cocci_infos c_infos in
+
+ if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx ();
+ if !Flag.show_misc then pr "Finished";
+ if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx ();
+ if !Flag_ctl.graphical_trace then gen_pdf_graph ();
+
+ c_infos' +> List.map (fun c_or_h ->
+ if !(c_or_h.was_modified_once)
+ then
+ begin
+ let outfile =
+ Common.new_temp_file "cocci-output" ("-" ^ c_or_h.fname) in
+
+ if c_or_h.fkind =*= Header
+ then pr2 ("a header file was modified: " ^ c_or_h.fname);
+
+ (* and now unparse everything *)
+ cfile_of_program (for_unparser c_or_h.asts) outfile;
+
+ let show_only_minus = !Flag.sgrep_mode2 in
+ show_or_not_diff c_or_h.fpath outfile show_only_minus;
+
+ (c_or_h.fpath,
+ if !Flag.sgrep_mode2 then None else Some outfile)
+ end
+ else (c_or_h.fpath, None))
+ end
let full_engine a b =
- Common.profile_code "full_engine" (fun () -> full_engine2 a b)
-
+ Common.profile_code "full_engine"
+ (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"
+ (function(x,_,y) -> Ast_cocci.FinalScriptRule(x,y))
+ r;
+ r.language::languages
+ | _ -> languages)
+ [] cocci_infos in
+ ()
+
+let post_engine a =
+ Common.profile_code "post_engine" (fun () -> post_engine2 a)
(*****************************************************************************)
(* check duplicate from result of full_engine *)
let check_duplicate_modif2 xs =
(* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
- pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files");
+ if !Flag_cocci.verbose_cocci
+ then pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files");
+
let groups = Common.group_assoc_bykey_eff xs in
groups +> Common.map_filter (fun (file, xs) ->
match xs with
| res::xs ->
match res with
| None ->
- if not (List.for_all (fun res2 -> res2 = None) xs)
+ if not (List.for_all (fun res2 -> res2 =*= None) xs)
then begin
pr2 ("different modification result for " ^ file);
None
HCoop / bpt / coccinelle.git / blobdiff