2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
25 module CCI = Ctlcocci_integration
26 module TAC = Type_annoter_c
28 (*****************************************************************************)
29 (* This file is a kind of driver. It gathers all the important functions
30 * from coccinelle in one place. The different entities in coccinelle are:
34 * - flow (contain nodes)
35 * - ctl (contain rule_elems)
36 * This file contains functions to transform one in another.
38 (*****************************************************************************)
40 (* --------------------------------------------------------------------- *)
42 (* --------------------------------------------------------------------- *)
43 let cprogram_of_file file =
44 let (program2, _stat) = Parse_c.parse_print_error_heuristic file in
47 let cprogram_of_file_cached file =
48 let (program2, _stat) = Parse_c.parse_cache file in
49 if !Flag_cocci.ifdef_to_if
51 program2 +> Parse_c.with_program2 (fun asts ->
52 Cpp_ast_c.cpp_ifdef_statementize asts
56 let cfile_of_program program2_with_ppmethod outf =
57 Unparse_c.pp_program program2_with_ppmethod outf
59 (* for memoization, contains only one entry, the one for the SP *)
60 let _hparse = Hashtbl.create 101
61 let _hctl = Hashtbl.create 101
63 (* --------------------------------------------------------------------- *)
65 (* --------------------------------------------------------------------- *)
66 let sp_of_file2 file iso =
67 Common.memoized _hparse (file, iso) (fun () ->
68 Parse_cocci.process file iso false)
69 let sp_of_file file iso =
70 Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso)
73 (* --------------------------------------------------------------------- *)
75 (* --------------------------------------------------------------------- *)
77 Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true
80 let ast_to_flow_with_error_messages2 x =
82 try Ast_to_flow.ast_to_control_flow x
83 with Ast_to_flow.Error x ->
84 Ast_to_flow.report_error x;
87 flowopt +> do_option (fun flow ->
88 (* This time even if there is a deadcode, we still have a
89 * flow graph, so I can try the transformation and hope the
90 * deadcode will not bother us.
92 try Ast_to_flow.deadcode_detection flow
93 with Ast_to_flow.Error (Ast_to_flow.DeadCode x) ->
94 Ast_to_flow.report_error (Ast_to_flow.DeadCode x);
97 let ast_to_flow_with_error_messages a =
98 Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a)
101 (* --------------------------------------------------------------------- *)
103 (* --------------------------------------------------------------------- *)
104 let ctls_of_ast2 ast ua pos =
106 (function ast -> function (ua,pos) ->
110 else Asttoctl2.asttoctl ast ua pos)
111 (Asttomember.asttomember ast ua))
112 ast (List.combine ua pos)
114 let ctls_of_ast ast ua =
115 Common.profile_code "asttoctl2" (fun () -> ctls_of_ast2 ast ua)
117 (*****************************************************************************)
118 (* Some debugging functions *)
119 (*****************************************************************************)
123 let show_or_not_cfile2 cfile =
124 if !Flag_cocci.show_c then begin
125 Common.pr2_xxxxxxxxxxxxxxxxx ();
126 pr2 ("processing C file: " ^ cfile);
127 Common.pr2_xxxxxxxxxxxxxxxxx ();
128 Common.command2 ("cat " ^ cfile);
130 let show_or_not_cfile a =
131 Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a)
133 let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles
136 let show_or_not_cocci2 coccifile isofile =
137 if !Flag_cocci.show_cocci then begin
138 Common.pr2_xxxxxxxxxxxxxxxxx ();
139 pr2 ("processing semantic patch file: " ^ coccifile);
140 isofile +> (fun s -> pr2 ("with isos from: " ^ s));
141 Common.pr2_xxxxxxxxxxxxxxxxx ();
142 Common.command2 ("cat " ^ coccifile);
145 let show_or_not_cocci a b =
146 Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b)
151 let show_or_not_diff2 cfile outfile show_only_minus =
152 if !Flag_cocci.show_diff then begin
153 match Common.fst(Compare_c.compare_default cfile outfile) with
154 Compare_c.Correct -> () (* diff only in spacing, etc *)
156 (* may need --strip-trailing-cr under windows *)
160 match !Flag_parsing_c.diff_lines with
161 | None -> "diff -u -p " ^ cfile ^ " " ^ outfile
162 | Some n -> "diff -U "^n^" -p "^cfile^" "^outfile in
164 let res = Common.cmd_to_list line in
165 match (!Flag.patch,res) with
166 (* create something that looks like the output of patch *)
167 (Some prefix,minus_file::plus_file::rest) ->
168 let drop_prefix file =
172 (match Str.split (Str.regexp prefix) file with
173 [base_file] -> base_file
174 | _ -> failwith "prefix not found in the old file name") in
176 match List.rev(Str.split (Str.regexp " ") line) with
177 new_file::old_file::cmdrev ->
181 (List.rev ("/tmp/nothing" :: old_file :: cmdrev))
183 let old_base_file = drop_prefix old_file in
186 (("b"^old_base_file)::("a"^old_base_file)::cmdrev))
187 | _ -> failwith "bad command" in
188 let (minus_line,plus_line) =
190 then (minus_file,plus_file)
192 match (Str.split (Str.regexp "[ \t]") minus_file,
193 Str.split (Str.regexp "[ \t]") plus_file) with
194 ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
195 let old_base_file = drop_prefix old_file in
197 ("---"::("a"^old_base_file)::old_rest),
199 ("+++"::("b"^old_base_file)::new_rest))
202 (Printf.sprintf "bad diff header lines: %s %s"
203 (String.concat ":" l1) (String.concat ":" l2)) in
204 diff_line::minus_line::plus_line::rest
206 xs +> List.iter (fun s ->
207 if s =~ "^\\+" && show_only_minus
211 let show_or_not_diff a b c =
212 Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b c)
215 (* the derived input *)
217 let show_or_not_ctl_tex2 astcocci ctls =
218 if !Flag_cocci.show_ctl_tex then begin
219 Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls;
220 Common.command2 ("cd /tmp; latex __cocci_ctl.tex; " ^
221 "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
222 "gv __cocci_ctl.ps &");
224 let show_or_not_ctl_tex a b =
225 Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b)
229 let show_or_not_rule_name ast rulenb =
230 if !Flag_cocci.show_ctl_text or !Flag.show_trying or
231 !Flag.show_transinfo or !Flag_cocci.show_binding_in_out
236 Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _, _) -> nm
237 | _ -> i_to_s rulenb in
238 Common.pr_xxxxxxxxxxxxxxxxx ();
240 Common.pr_xxxxxxxxxxxxxxxxx ()
243 let show_or_not_scr_rule_name rulenb =
244 if !Flag_cocci.show_ctl_text or !Flag.show_trying or
245 !Flag.show_transinfo or !Flag_cocci.show_binding_in_out
248 let name = i_to_s rulenb in
249 Common.pr_xxxxxxxxxxxxxxxxx ();
250 pr ("script rule " ^ name ^ " = ");
251 Common.pr_xxxxxxxxxxxxxxxxx ()
254 let show_or_not_ctl_text2 ctl ast rulenb =
255 if !Flag_cocci.show_ctl_text then begin
257 adjust_pp_with_indent (fun () ->
258 Format.force_newline();
259 Pretty_print_cocci.print_plus_flag := true;
260 Pretty_print_cocci.print_minus_flag := true;
261 Pretty_print_cocci.unparse ast;
266 adjust_pp_with_indent (fun () ->
267 Format.force_newline();
268 Pretty_print_engine.pp_ctlcocci
269 !Flag_cocci.show_mcodekind_in_ctl !Flag_cocci.inline_let_ctl ctl;
273 let show_or_not_ctl_text a b c =
274 Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_text2 a b c)
278 (* running information *)
279 let get_celem celem : string =
281 Ast_c.Definition ({Ast_c.f_name = funcs;},_) -> funcs
283 (Ast_c.DeclList ([{Ast_c.v_namei = Some ((s, _),_);}, _], _)) -> s
286 let show_or_not_celem2 prelude celem =
289 | Ast_c.Definition ({Ast_c.f_name = funcs;},_) ->
290 Flag.current_element := funcs;
291 (" function: ",funcs)
293 (Ast_c.DeclList ([{Ast_c.v_namei = Some ((s, _),_);}, _], _)) ->
294 Flag.current_element := s;
297 Flag.current_element := "something_else";
298 (" ","something else");
300 if !Flag.show_trying then pr2 (prelude ^ tag ^ trying)
302 let show_or_not_celem a b =
303 Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b)
306 let show_or_not_trans_info2 trans_info =
307 if !Flag.show_transinfo then begin
308 if null trans_info then pr2 "transformation info is empty"
310 pr2 "transformation info returned:";
312 List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2)
316 trans_info +> List.iter (fun (i, subst, re) ->
317 pr2 ("transform state: " ^ (Common.i_to_s i));
319 adjust_pp_with_indent_and_header "with rule_elem: " (fun () ->
320 Pretty_print_cocci.print_plus_flag := true;
321 Pretty_print_cocci.print_minus_flag := true;
322 Pretty_print_cocci.rule_elem "" re;
324 adjust_pp_with_indent_and_header "with binding: " (fun () ->
325 Pretty_print_engine.pp_binding subst;
332 let show_or_not_trans_info a =
333 Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a)
337 let show_or_not_binding2 s binding =
338 if !Flag_cocci.show_binding_in_out then begin
339 adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () ->
340 Pretty_print_engine.pp_binding binding
343 let show_or_not_binding a b =
344 Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b)
348 (*****************************************************************************)
349 (* Some helper functions *)
350 (*****************************************************************************)
352 let worth_trying cfiles tokens =
353 (* drop the following line for a list of list by rules. since we don't
354 allow multiple minirules, all the tokens within a rule should be in
355 a single CFG entity *)
356 let tokens = Common.union_all tokens in
357 if not !Flag_cocci.windows && not (null tokens)
359 (* could also modify the code in get_constants.ml *)
360 let tokens = tokens +> List.map (fun s ->
362 | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" ->
365 | _ when s =~ "^[A-Za-z_]" ->
368 | _ when s =~ ".*[A-Za-z_]$" ->
373 let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles)
375 (match Sys.command com with
376 | 0 (* success *) -> true
379 then Printf.printf "grep failed: %s\n" com);
380 false (* no match, so not worth trying *)
384 let check_macro_in_sp_and_adjust tokens =
385 let tokens = Common.union_all tokens in
386 tokens +> List.iter (fun s ->
387 if Hashtbl.mem !Parsing_hacks._defs s
389 pr2 "warning: macro in semantic patch was in macro definitions";
390 pr2 ("disabling macro expansion for " ^ s);
391 Hashtbl.remove !Parsing_hacks._defs s
396 let contain_loop gopt =
399 g#nodes#tolist +> List.exists (fun (xi, node) ->
400 Control_flow_c.extract_is_loop node
402 | None -> true (* means nothing, if no g then will not model check *)
406 let sp_contain_typed_metavar_z toplevel_list_list =
407 let bind x y = x or y in
408 let option_default = false in
409 let mcode _ _ = option_default in
410 let donothing r k e = k e in
412 let expression r k e =
413 match Ast_cocci.unwrap e with
414 | Ast_cocci.MetaExpr (_,_,_,Some t,_,_) -> true
415 | Ast_cocci.MetaExpr (_,_,_,_,Ast_cocci.LocalID,_) -> true
420 Visitor_ast.combiner bind option_default
421 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
422 donothing donothing donothing donothing
423 donothing expression donothing donothing donothing donothing donothing
424 donothing donothing donothing donothing donothing
426 toplevel_list_list +>
428 (function (nm,_,rule) ->
429 (List.exists combiner.Visitor_ast.combiner_top_level rule))
432 let sp_contain_typed_metavar rules =
433 sp_contain_typed_metavar_z
437 Ast_cocci.CocciRule (a,b,c,d,_) -> (a,b,c)
438 | _ -> failwith "error in filter")
442 Ast_cocci.CocciRule (a,b,c,d,Ast_cocci.Normal) -> true
448 (* finding among the #include the one that we need to parse
449 * because they may contain useful type definition or because
450 * we may have to modify them
452 * For the moment we base in part our heuristic on the name of the file, e.g.
453 * serio.c is related we think to #include <linux/serio.h>
456 let (includes_to_parse:
457 (Common.filename * Parse_c.program2) list ->
458 Flag_cocci.include_options -> 'a) = fun xs choose_includes ->
459 match choose_includes with
460 Flag_cocci.I_UNSPECIFIED -> failwith "not possible"
461 | Flag_cocci.I_NO_INCLUDES -> []
463 let all_includes = x = Flag_cocci.I_ALL_INCLUDES in
464 xs +> List.map (fun (file, cs) ->
465 let dir = Common.dirname file in
467 cs +> Common.map_filter (fun (c,_info_item) ->
471 {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) ->
474 let f = Filename.concat dir (Common.join "/" xs) in
475 (* for our tests, all the files are flat in the current dir *)
476 if not (Sys.file_exists f) && !Flag_cocci.relax_include_path
478 let attempt2 = Filename.concat dir (Common.last xs) in
479 if not (Sys.file_exists f) && all_includes
480 then Some (Filename.concat !Flag_cocci.include_path
481 (Common.join "/" xs))
485 | Ast_c.NonLocal xs ->
487 Common.fileprefix (Common.last xs) = Common.fileprefix file
489 Some (Filename.concat !Flag_cocci.include_path
490 (Common.join "/" xs))
492 | Ast_c.Wierd _ -> None
498 let rec interpret_dependencies local global = function
499 Ast_cocci.Dep s -> List.mem s local
500 | Ast_cocci.AntiDep s ->
501 (if !Flag_ctl.steps != None
502 then failwith "steps and ! dependency incompatible");
503 not (List.mem s local)
504 | Ast_cocci.EverDep s -> List.mem s global
505 | Ast_cocci.NeverDep s ->
506 (if !Flag_ctl.steps != None
507 then failwith "steps and ! dependency incompatible");
508 not (List.mem s global)
509 | Ast_cocci.AndDep(s1,s2) ->
510 (interpret_dependencies local global s1) &&
511 (interpret_dependencies local global s2)
512 | Ast_cocci.OrDep(s1,s2) ->
513 (interpret_dependencies local global s1) or
514 (interpret_dependencies local global s2)
515 | Ast_cocci.NoDep -> true
517 let rec print_dependencies str local global dep =
518 if !Flag_cocci.show_dependencies
523 let rec loop = function
524 Ast_cocci.Dep s | Ast_cocci.AntiDep s ->
525 if not (List.mem s !seen)
529 then pr2 (s^" satisfied")
530 else pr2 (s^" not satisfied");
533 | Ast_cocci.EverDep s | Ast_cocci.NeverDep s ->
534 if not (List.mem s !seen)
538 then pr2 (s^" satisfied")
539 else pr2 (s^" not satisfied");
542 | Ast_cocci.AndDep(s1,s2) ->
545 | Ast_cocci.OrDep(s1,s2) ->
548 | Ast_cocci.NoDep -> () in
554 (* --------------------------------------------------------------------- *)
555 (* #include relative position in the file *)
556 (* --------------------------------------------------------------------- *)
558 (* compute the set of new prefixes
560 * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *)
564 * it would give for the first element
565 * ""; "a"; "a/b"; "a/b/x"
569 * update: if the include is inside a ifdef a put nothing. cf -test incl.
570 * this is because we dont want code added inside ifdef.
573 let compute_new_prefixes xs =
574 xs +> Common.map_withenv (fun already xs ->
575 let subdirs_prefixes = Common.inits xs in
576 let new_first = subdirs_prefixes +> List.filter (fun x ->
577 not (List.mem x already)
586 (* does via side effect on the ref in the Include in Ast_c *)
587 let rec update_include_rel_pos cs =
588 let only_include = cs +> Common.map_filter (fun c ->
590 | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_));
592 i_is_in_ifdef = inifdef}) ->
594 | Ast_c.Wierd _ -> None
603 let (locals, nonlocals) =
604 only_include +> Common.partition_either (fun (c, aref) ->
606 | Ast_c.Local x -> Left (x, aref)
607 | Ast_c.NonLocal x -> Right (x, aref)
608 | Ast_c.Wierd x -> raise Impossible
611 update_rel_pos_bis locals;
612 update_rel_pos_bis nonlocals;
614 and update_rel_pos_bis xs =
615 let xs' = List.map fst xs in
616 let the_first = compute_new_prefixes xs' in
617 let the_last = List.rev (compute_new_prefixes (List.rev xs')) in
618 let merged = Common.zip xs (Common.zip the_first the_last) in
619 merged +> List.iter (fun ((x, aref), (the_first, the_last)) ->
622 Ast_c.first_of = the_first;
623 Ast_c.last_of = the_last;
632 (*****************************************************************************)
633 (* All the information needed around the C elements and Cocci rules *)
634 (*****************************************************************************)
636 type toplevel_c_info = {
637 ast_c: Ast_c.toplevel; (* contain refs so can be modified *)
638 tokens_c: Parser_c.token list;
641 flow: Control_flow_c.cflow option; (* it's the "fixed" flow *)
644 env_typing_before: TAC.environment;
645 env_typing_after: TAC.environment;
647 was_modified: bool ref;
652 type toplevel_cocci_info_script_rule = {
653 scr_ast_rule: string * (string * (string * string)) list * string;
655 scr_dependencies: Ast_cocci.dependency;
660 type toplevel_cocci_info_cocci_rule = {
661 ctl: Lib_engine.ctlcocci * (CCI.pred list list);
662 metavars: Ast_cocci.metavar list;
663 ast_rule: Ast_cocci.rule;
664 isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *)
667 dependencies: Ast_cocci.dependency;
668 (* There are also some hardcoded rule names in parse_cocci.ml:
669 * let reserved_names = ["all";"optional_storage";"optional_qualifier"]
671 dropped_isos: string list;
672 free_vars: Ast_cocci.meta_name list;
673 negated_pos_vars: Ast_cocci.meta_name list;
674 used_after: Ast_cocci.meta_name list;
675 positions: Ast_cocci.meta_name list;
678 ruletype: Ast_cocci.ruletype;
680 was_matched: bool ref;
683 type toplevel_cocci_info =
684 ScriptRuleCocciInfo of toplevel_cocci_info_script_rule
685 | CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule
687 type kind_file = Header | Source
691 was_modified_once: bool ref;
692 asts: toplevel_c_info list;
697 let g_contain_typedmetavar = ref false
700 let last_env_toplevel_c_info xs =
701 (Common.last xs).env_typing_after
703 let concat_headers_and_c (ccs: file_info list)
704 : (toplevel_c_info * string) list =
705 (List.concat (ccs +> List.map (fun x ->
706 x.asts +> List.map (fun x' ->
709 let for_unparser xs =
710 xs +> List.map (fun x ->
711 (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr
714 let gen_pdf_graph () =
715 (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile ->
716 Printf.printf "Generation of %s%!" outfile;
717 let filename_stack = Ctl_engine.get_graph_comp_files outfile in
718 List.iter (fun filename ->
719 ignore (Unix.system ("dot " ^ filename ^ " -Tpdf -o " ^ filename ^ ".pdf;"))
721 let (head,tail) = (List.hd filename_stack, List.tl filename_stack) in
722 ignore(Unix.system ("cp " ^ head ^ ".pdf " ^ outfile ^ ".pdf;"));
723 tail +> List.iter (fun filename ->
724 ignore(Unix.system ("mv " ^ outfile ^ ".pdf /tmp/tmp.pdf;"));
725 ignore(Unix.system ("pdftk " ^ filename ^ ".pdf /tmp/tmp.pdf cat output " ^ outfile ^ ".pdf"));
727 ignore(Unix.system ("rm /tmp/tmp.pdf;"));
728 List.iter (fun filename ->
729 ignore (Unix.system ("rm " ^ filename ^ " " ^ filename ^ ".pdf;"))
731 Printf.printf " - Done\n")
734 (* --------------------------------------------------------------------- *)
735 let prepare_cocci ctls free_var_lists negated_pos_lists
736 used_after_lists positions_list metavars astcocci =
738 let gathered = Common.index_list_1
739 (zip (zip (zip (zip (zip (zip ctls metavars) astcocci) free_var_lists)
740 negated_pos_lists) used_after_lists) positions_list)
743 (fun (((((((ctl_toplevel_list,metavars),ast),free_var_list),
744 negated_pos_list),used_after_list),positions_list),rulenb) ->
746 let is_script_rule r =
747 match r with Ast_cocci.ScriptRule _ -> true | _ -> false in
749 if not (List.length ctl_toplevel_list = 1) && not (is_script_rule ast)
750 then failwith "not handling multiple minirules";
753 Ast_cocci.ScriptRule (lang,deps,mv,code) ->
756 scr_ast_rule = (lang, mv, code);
758 scr_dependencies = deps;
762 in ScriptRuleCocciInfo r
763 | Ast_cocci.CocciRule
764 (rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) ->
767 ctl = List.hd ctl_toplevel_list;
770 isexp = List.hd isexp;
772 dependencies = dependencies;
773 dropped_isos = dropped_isos;
774 free_vars = List.hd free_var_list;
775 negated_pos_vars = List.hd negated_pos_list;
776 used_after = List.hd used_after_list;
777 positions = List.hd positions_list;
780 was_matched = ref false;
785 (* --------------------------------------------------------------------- *)
787 let build_info_program cprogram env =
788 let (cs, parseinfos) = Common.unzip cprogram in
790 Common.unzip (TAC.annotate_program env (*!g_contain_typedmetavar*) cs) in
792 zip (zip cs parseinfos) envs +> List.map (fun ((c, parseinfo), (enva,envb))->
793 let (fullstr, tokens) = parseinfo in
796 ast_to_flow_with_error_messages c +> Common.map_option (fun flow ->
797 let flow = Ast_to_flow.annotate_loop_nodes flow in
799 (* remove the fake nodes for julia *)
800 let fixed_flow = CCI.fix_flow_ctl flow in
802 if !Flag_cocci.show_flow then print_flow fixed_flow;
803 if !Flag_cocci.show_before_fixed_flow then print_flow flow;
810 ast_c = c; (* contain refs so can be modified *)
812 fullstring = fullstr;
816 contain_loop = contain_loop flow;
818 env_typing_before = enva;
819 env_typing_after = envb;
821 was_modified = ref false;
827 (* Optimisation. Try not unparse/reparse the whole file when have modifs *)
828 let rebuild_info_program cs file isexp =
829 cs +> List.map (fun c ->
832 let file = Common.new_temp_file "cocci_small_output" ".c" in
834 [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal]
837 (* Common.command2 ("cat " ^ file); *)
838 let cprogram = cprogram_of_file file in
839 let xs = build_info_program cprogram c.env_typing_before in
841 (* TODO: assert env has not changed,
842 * if yes then must also reparse what follows even if not modified.
843 * Do that only if contain_typedmetavar of course, so good opti.
845 (* Common.list_init xs *) (* get rid of the FinalDef *)
851 let rebuild_info_c_and_headers ccs isexp =
852 ccs +> List.iter (fun c_or_h ->
853 if c_or_h.asts +> List.exists (fun c -> !(c.was_modified))
854 then c_or_h.was_modified_once := true;
856 ccs +> List.map (fun c_or_h ->
858 asts = rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
867 let prepare_c files choose_includes : file_info list =
868 let cprograms = List.map cprogram_of_file_cached files in
869 let includes = includes_to_parse (zip files cprograms) choose_includes in
871 (* todo?: may not be good to first have all the headers and then all the c *)
873 (includes +> List.map (fun hpath -> Right hpath))
875 ((zip files cprograms) +> List.map (fun (file, asts) -> Left (file, asts)))
878 let env = ref !TAC.initial_env in
880 let ccs = all +> Common.map_filter (fun x ->
883 if not (Common.lfile_exists hpath)
885 pr2 ("TYPE: header " ^ hpath ^ " not found");
889 let h_cs = cprogram_of_file_cached hpath in
890 let info_h_cs = build_info_program h_cs !env in
894 else last_env_toplevel_c_info info_h_cs
897 fname = Common.basename hpath;
900 was_modified_once = ref false;
904 | Left (file, cprogram) ->
905 (* todo?: don't update env ? *)
906 let cs = build_info_program cprogram !env in
907 (* we do that only for the c, not for the h *)
908 ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c)));
910 fname = Common.basename file;
913 was_modified_once = ref false;
922 (*****************************************************************************)
923 (* Processing the ctls and toplevel C elements *)
924 (*****************************************************************************)
926 (* The main algorithm =~
927 * The algorithm is roughly:
928 * for_all ctl rules in SP
929 * for_all minirule in rule (no more)
930 * for_all binding (computed during previous phase)
932 * match control flow of function vs minirule
933 * with the binding and update the set of possible
934 * bindings, and returned the possibly modified function.
935 * pretty print modified C elements and reparse it.
938 * On ne prends que les newbinding ou returned_any_state est vrai.
939 * Si ca ne donne rien, on prends ce qu'il y avait au depart.
940 * Mais au nouveau depart de quoi ?
941 * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?
942 * - ou alors si ca donne rien, apres avoir traité toutes les fonctions
943 * avec tous les bindings du round d'avant ?
945 * Julia pense qu'il faut prendre la premiere solution.
946 * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
947 * la regle ctl 1. On arrive sur la regle ctl 2.
948 * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
949 * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
952 * I have not to look at used_after_list to decide to restart from
953 * scratch. I just need to look if the binding list is empty.
954 * Indeed, let's suppose that a SP have 3 regions/rules. If we
955 * don't find a match for the first region, then if this first
956 * region does not bind metavariable used after, that is if
957 * used_after_list is empty, then mysat(), even if does not find a
958 * match, will return a Left, with an empty transformation_info,
959 * and so current_binding will grow. On the contrary if the first
960 * region must bind some metavariables used after, and that we
961 * dont find any such region, then mysat() will returns lots of
962 * Right, and current_binding will not grow, and so we will have
963 * an empty list of binding, and we will catch such a case.
965 * opti: julia says that because the binding is
966 * determined by the used_after_list, the items in the list
967 * are kind of sorted, so could optimise the insert_set operations.
971 (* r(ule), c(element in C code), e(nvironment) *)
973 let rec apply_python_rule r cache newes e rules_that_have_matched
974 rules_that_have_ever_matched =
975 show_or_not_scr_rule_name r.scr_ruleid;
976 if not(interpret_dependencies rules_that_have_matched
977 !rules_that_have_ever_matched r.scr_dependencies)
980 print_dependencies "dependencies for script not satisfied:"
981 rules_that_have_matched
982 !rules_that_have_ever_matched r.scr_dependencies;
983 show_or_not_binding "in environment" e;
984 (cache, (e, rules_that_have_matched)::newes)
988 let (_, mv, _) = r.scr_ast_rule in
989 if List.for_all (Pycocci.contains_binding e) mv
992 let relevant_bindings =
994 (function ((re,rm),_) ->
995 List.exists (function (_,(r,m)) -> r = re && m = rm) mv)
998 if List.mem relevant_bindings cache
1002 print_dependencies "dependencies for script satisfied:"
1003 rules_that_have_matched
1004 !rules_that_have_ever_matched r.scr_dependencies;
1005 show_or_not_binding "in" e;
1006 Pycocci.build_classes (List.map (function (x,y) -> x) e);
1007 Pycocci.construct_variables mv e;
1008 let _ = Pycocci.pyrun_simplestring
1009 ("import coccinelle\nfrom coccinelle "^
1010 "import *\ncocci = Cocci()\n" ^
1012 relevant_bindings :: cache
1014 if !Pycocci.inc_match
1015 then (new_cache, merge_env [(e, rules_that_have_matched)] newes)
1016 else (new_cache, newes)
1018 else (cache, merge_env [(e, rules_that_have_matched)] newes)
1021 and apply_cocci_rule r rules_that_have_ever_matched es (ccs:file_info list ref) =
1022 Common.profile_code r.rulename (fun () ->
1023 show_or_not_rule_name r.ast_rule r.ruleid;
1024 show_or_not_ctl_text r.ctl r.ast_rule r.ruleid;
1026 let reorganized_env =
1027 reassociate_positions r.free_vars r.negated_pos_vars !es in
1029 (* looping over the environments *)
1030 let (_,newes (* envs for next round/rule *)) =
1032 (function (cache,newes) ->
1033 function ((e,rules_that_have_matched),relevant_bindings) ->
1034 if not(interpret_dependencies rules_that_have_matched
1035 !rules_that_have_ever_matched r.dependencies)
1039 ("dependencies for rule "^r.rulename^" not satisfied:")
1040 rules_that_have_matched
1041 !rules_that_have_ever_matched r.dependencies;
1042 show_or_not_binding "in environment" e;
1045 [(e +> List.filter (fun (s,v) -> List.mem s r.used_after),
1046 rules_that_have_matched)]
1051 try List.assoc relevant_bindings cache
1055 ("dependencies for rule "^r.rulename^" satisfied:")
1056 rules_that_have_matched
1057 !rules_that_have_ever_matched r.dependencies;
1058 show_or_not_binding "in" e;
1059 show_or_not_binding "relevant in" relevant_bindings;
1061 (* applying the rule *)
1062 (match r.ruletype with
1064 let children_e = ref [] in
1066 (* looping over the functions and toplevel elements in
1068 concat_headers_and_c !ccs +> List.iter (fun (c,f) ->
1071 (* does also some side effects on c and r *)
1073 process_a_ctl_a_env_a_toplevel r
1074 relevant_bindings c f in
1075 match processed with
1077 | Some newbindings ->
1078 newbindings +> List.iter (fun newbinding ->
1080 Common.insert_set newbinding !children_e)
1081 ); (* end iter cs *)
1084 | Ast_cocci.Generated ->
1085 process_a_generated_a_env_a_toplevel r
1086 relevant_bindings !ccs;
1089 let old_bindings_to_keep =
1091 (e +> List.filter (fun (s,v) -> List.mem s r.used_after)) in
1093 if null new_bindings
1096 (*use the old bindings, specialized to the used_after_list*)
1097 if !Flag_ctl.partial_match
1100 "Empty list of bindings, I will restart from old env";
1101 [(old_bindings_to_keep,rules_that_have_matched)]
1104 (* combine the new bindings with the old ones, and
1105 specialize to the used_after_list *)
1106 let old_variables = List.map fst old_bindings_to_keep in
1107 (* have to explicitly discard the inherited variables
1108 because we want the inherited value of the positions
1109 variables not the extended one created by
1110 reassociate_positions. want to reassociate freshly
1111 according to the free variables of each rule. *)
1112 let new_bindings_to_add =
1118 List.mem s r.used_after &&
1119 not (List.mem s old_variables)))) in
1121 (function new_binding_to_add ->
1124 old_bindings_to_keep new_binding_to_add),
1125 r.rulename::rules_that_have_matched))
1126 new_bindings_to_add in
1127 ((relevant_bindings,new_bindings)::cache,
1128 merge_env new_e newes))
1129 ([],[]) reorganized_env in (* end iter es *)
1131 then Common.push2 r.rulename rules_that_have_ever_matched;
1135 (* apply the tagged modifs and reparse *)
1136 if not !Flag.sgrep_mode2
1137 then ccs := rebuild_info_c_and_headers !ccs r.isexp
1140 and merge_env new_e old_e =
1143 function (e,rules) as elem ->
1144 let (same,diff) = List.partition (function (e1,_) -> e = e1) old_e in
1147 | [(_,old_rules)] -> (e,Common.union_set rules old_rules) :: diff
1148 | _ -> failwith "duplicate environment entries")
1151 and bigloop2 rs (ccs: file_info list) =
1152 let es = ref [(Ast_c.emptyMetavarsBinding,[])] in
1153 let ccs = ref ccs in
1154 let rules_that_have_ever_matched = ref [] in
1156 (* looping over the rules *)
1157 rs +> List.iter (fun r ->
1159 ScriptRuleCocciInfo r ->
1160 if !Flag_cocci.show_ctl_text then begin
1161 Common.pr_xxxxxxxxxxxxxxxxx ();
1162 pr ("script: " ^ r.language);
1163 Common.pr_xxxxxxxxxxxxxxxxx ();
1165 adjust_pp_with_indent (fun () ->
1166 Format.force_newline();
1167 let (l,mv,code) = r.scr_ast_rule in
1168 let deps = r.scr_dependencies in
1169 Pretty_print_cocci.unparse
1170 (Ast_cocci.ScriptRule (l,deps,mv,code)));
1173 if !Flag.show_misc then print_endline "RESULT =";
1177 (function (cache, newes) ->
1178 function (e, rules_that_have_matched) ->
1179 match r.language with
1181 apply_python_rule r cache newes e rules_that_have_matched
1182 rules_that_have_ever_matched
1184 concat_headers_and_c !ccs +> List.iter (fun (c,_) ->
1187 Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring);
1190 Printf.printf "Unknown language: %s\n" r.language;
1196 | CocciRuleCocciInfo r ->
1197 apply_cocci_rule r rules_that_have_ever_matched es ccs);
1199 if !Flag.sgrep_mode2
1201 (* sgrep can lead to code that is not parsable, but we must
1202 * still call rebuild_info_c_and_headers to pretty print the
1203 * action (MINUS), so that later the diff will show what was
1204 * matched by sgrep. But we don't want the parsing error message
1205 * hence the following flag setting. So this code propably
1206 * will generate a NotParsedCorrectly for the matched parts
1207 * and the very final pretty print and diff will work
1209 Flag_parsing_c.verbose_parsing := false;
1210 ccs := rebuild_info_c_and_headers !ccs false
1212 !ccs (* return final C asts *)
1214 and reassociate_positions free_vars negated_pos_vars envs =
1215 (* issues: isolate the bindings that are relevant to a given rule.
1216 separate out the position variables
1217 associate all of the position variables for a given set of relevant
1218 normal variable bindings with each set of relevant normal variable
1219 bindings. Goal: if eg if@p (E) matches in two places, then both inherited
1220 occurrences of E should see both bindings of p, not just its own.
1221 Otherwise, a position constraint for something that matches in two
1222 places will never be useful, because the position can always be
1223 different from the other one. *)
1227 List.filter (function (x,_) -> List.mem x free_vars) e)
1229 let splitted_relevant =
1230 (* separate the relevant variables into the non-position ones and the
1235 (function (non_pos,pos) ->
1236 function (v,_) as x ->
1237 if List.mem v negated_pos_vars
1238 then (non_pos,x::pos)
1239 else (x::non_pos,pos))
1242 let splitted_relevant =
1244 (function (non_pos,pos) ->
1245 (List.sort compare non_pos,List.sort compare pos))
1246 splitted_relevant in
1249 (function non_pos ->
1251 if List.mem np non_pos then non_pos else np::non_pos)
1252 [] splitted_relevant in
1253 let extended_relevant =
1254 (* extend the position variables with the values found at other identical
1255 variable bindings *)
1257 (function non_pos ->
1260 (function (other_non_pos,other_pos) ->
1261 (* do we want equal? or just somehow compatible? eg non_pos
1262 binds only E, but other_non_pos binds both E and E1 *)
1263 non_pos = other_non_pos)
1264 splitted_relevant in
1268 (combine_pos negated_pos_vars
1269 (List.map (function (_,x) -> x) others)))))
1272 (List.map (function (non_pos,_) -> List.assoc non_pos extended_relevant)
1275 and combine_pos negated_pos_vars others =
1279 Ast_c.MetaPosValList
1282 (function positions ->
1283 function other_list ->
1285 match List.assoc posvar other_list with
1286 Ast_c.MetaPosValList l1 ->
1287 Common.union_set l1 positions
1288 | _ -> failwith "bad value for a position variable"
1289 with Not_found -> positions)
1294 Common.profile_code "bigloop" (fun () -> bigloop2 a b)
1300 (* does side effects on C ast and on Cocci info rule *)
1301 and process_a_ctl_a_env_a_toplevel2 r e c f =
1302 indent_do (fun () ->
1303 show_or_not_celem "trying" c.ast_c;
1304 Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c);
1305 let (trans_info, returned_any_states, inherited_bindings, newbindings) =
1306 Common.save_excursion Flag_ctl.loop_in_src_code (fun () ->
1307 Flag_ctl.loop_in_src_code := !Flag_ctl.loop_in_src_code||c.contain_loop;
1309 (***************************************)
1310 (* !Main point! The call to the engine *)
1311 (***************************************)
1312 let model_ctl = CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e
1313 in CCI.mysat model_ctl r.ctl (r.used_after, e)
1316 if not returned_any_states
1319 show_or_not_celem "found match in" c.ast_c;
1320 show_or_not_trans_info trans_info;
1321 List.iter (show_or_not_binding "out") newbindings;
1323 r.was_matched := true;
1325 if not (null trans_info)
1327 c.was_modified := true;
1329 (* les "more than one var in a decl" et "already tagged token"
1330 * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
1331 * failed. Le try limite le scope des crashes pendant la
1332 * trasformation au fichier concerne. *)
1334 (* modify ast via side effect *)
1335 ignore(Transformation_c.transform r.rulename r.dropped_isos
1336 inherited_bindings trans_info (Common.some c.flow));
1337 with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i)
1340 Some (List.map (function x -> x@inherited_bindings) newbindings)
1344 and process_a_ctl_a_env_a_toplevel a b c f=
1345 Common.profile_code "process_a_ctl_a_env_a_toplevel"
1346 (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f)
1348 and process_a_generated_a_env_a_toplevel2 r env = function
1353 (rule,_) when rule = r.rulename -> false
1354 | (_,"ARGS") -> false
1357 let env_domain = List.map (function (nm,vl) -> nm) env in
1361 let (rl,_) = Ast_cocci.get_meta_name md in
1364 if Common.include_set free_vars env_domain
1365 then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname
1366 | _ -> failwith "multiple files not supported"
1368 and process_a_generated_a_env_a_toplevel rule env ccs =
1369 Common.profile_code "process_a_ctl_a_env_a_toplevel"
1370 (fun () -> process_a_generated_a_env_a_toplevel2 rule env ccs)
1374 (*****************************************************************************)
1375 (* The main function *)
1376 (*****************************************************************************)
1378 let full_engine2 (coccifile, isofile) cfiles =
1380 show_or_not_cfiles cfiles;
1381 show_or_not_cocci coccifile isofile;
1382 Pycocci.set_coccifile coccifile;
1385 if not (Common.lfile_exists isofile)
1387 pr2 ("warning: Can't find default iso file: " ^ isofile);
1393 (* useful opti when use -dir *)
1394 let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists,
1395 positions_lists,toks,_) =
1396 sp_of_file coccifile isofile
1399 Common.memoized _hctl (coccifile, isofile) (fun () ->
1400 ctls_of_ast astcocci used_after_lists positions_lists)
1403 let contain_typedmetavar = sp_contain_typed_metavar astcocci in
1405 (* optimisation allowing to launch coccinelle on all the drivers *)
1406 if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks)
1408 pr2 ("not worth trying:" ^ Common.join " " cfiles);
1409 cfiles +> List.map (fun s -> s, None)
1413 if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
1414 if !Flag.show_misc then pr "let's go";
1415 if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
1417 g_contain_typedmetavar := contain_typedmetavar;
1419 check_macro_in_sp_and_adjust toks;
1424 prepare_cocci ctls free_var_lists negated_pos_lists
1425 used_after_lists positions_lists metavars astcocci in
1426 let choose_includes =
1427 match !Flag_cocci.include_options with
1428 Flag_cocci.I_UNSPECIFIED ->
1429 if contain_typedmetavar
1430 then Flag_cocci.I_NORMAL_INCLUDES
1431 else Flag_cocci.I_NO_INCLUDES
1433 let c_infos = prepare_c cfiles choose_includes in
1435 show_or_not_ctl_tex astcocci ctls;
1437 (* ! the big loop ! *)
1438 let c_infos' = bigloop cocci_infos c_infos in
1440 if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx ();
1441 if !Flag.show_misc then pr "Finished";
1442 if !Flag_ctl.graphical_trace then gen_pdf_graph ();
1443 if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx();
1445 c_infos' +> List.map (fun c_or_h ->
1446 if !(c_or_h.was_modified_once)
1448 let outfile = Common.new_temp_file "cocci-output" ("-" ^ c_or_h.fname)
1451 if c_or_h.fkind = Header
1452 then pr2 ("a header file was modified: " ^ c_or_h.fname);
1454 (* and now unparse everything *)
1455 cfile_of_program (for_unparser c_or_h.asts) outfile;
1457 let show_only_minus = !Flag.sgrep_mode2 in
1458 show_or_not_diff c_or_h.fpath outfile show_only_minus;
1461 if !Flag.sgrep_mode2 then None else Some outfile
1465 (c_or_h.fpath, None)
1469 let full_engine a b =
1470 Common.profile_code "full_engine" (fun () -> full_engine2 a b)
1473 (*****************************************************************************)
1474 (* check duplicate from result of full_engine *)
1475 (*****************************************************************************)
1477 let check_duplicate_modif2 xs =
1478 (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
1479 pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files");
1480 let groups = Common.group_assoc_bykey_eff xs in
1481 groups +> Common.map_filter (fun (file, xs) ->
1483 | [] -> raise Impossible
1484 | [res] -> Some (file, res)
1488 if not (List.for_all (fun res2 -> res2 = None) xs)
1490 pr2 ("different modification result for " ^ file);
1493 else Some (file, None)
1495 if not(List.for_all (fun res2 ->
1499 let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2)
1503 pr2 ("different modification result for " ^ file);
1506 else Some (file, Some res)
1510 let check_duplicate_modif a =
1511 Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a)