Release coccinelle-0.1.6
[bpt/coccinelle.git] / .#cocci.ml.1.295
1 (*
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.
5 *
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.
9 *
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.
14 *
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/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
23 open Common
24
25 module CCI = Ctlcocci_integration
26 module TAC = Type_annoter_c
27
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:
31 * - files
32 * - astc
33 * - astcocci
34 * - flow (contain nodes)
35 * - ctl (contain rule_elems)
36 * This file contains functions to transform one in another.
37 *)
38 (*****************************************************************************)
39
40 (* --------------------------------------------------------------------- *)
41 (* C related *)
42 (* --------------------------------------------------------------------- *)
43 let cprogram_of_file file =
44 let (program2, _stat) = Parse_c.parse_print_error_heuristic file in
45 program2
46
47 let cprogram_of_file_cached file =
48 let (program2, _stat) = Parse_c.parse_cache file in
49 if !Flag_cocci.ifdef_to_if
50 then
51 program2 +> Parse_c.with_program2 (fun asts ->
52 Cpp_ast_c.cpp_ifdef_statementize asts
53 )
54 else program2
55
56 let cfile_of_program program2_with_ppmethod outf =
57 Unparse_c.pp_program program2_with_ppmethod outf
58
59 (* for memoization, contains only one entry, the one for the SP *)
60 let _hparse = Hashtbl.create 101
61 let _hctl = Hashtbl.create 101
62
63 (* --------------------------------------------------------------------- *)
64 (* Cocci related *)
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)
71
72
73 (* --------------------------------------------------------------------- *)
74 (* Flow related *)
75 (* --------------------------------------------------------------------- *)
76 let print_flow flow =
77 Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true
78
79
80 let ast_to_flow_with_error_messages2 x =
81 let flowopt =
82 try Ast_to_flow.ast_to_control_flow x
83 with Ast_to_flow.Error x ->
84 Ast_to_flow.report_error x;
85 None
86 in
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.
91 *)
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);
95 );
96 flowopt
97 let ast_to_flow_with_error_messages a =
98 Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a)
99
100
101 (* --------------------------------------------------------------------- *)
102 (* Ctl related *)
103 (* --------------------------------------------------------------------- *)
104 let ctls_of_ast2 ast ua pos =
105 List.map2
106 (function ast -> function (ua,pos) ->
107 List.combine
108 (if !Flag_cocci.popl
109 then Popl.popl ast
110 else Asttoctl2.asttoctl ast ua pos)
111 (Asttomember.asttomember ast ua))
112 ast (List.combine ua pos)
113
114 let ctls_of_ast ast ua =
115 Common.profile_code "asttoctl2" (fun () -> ctls_of_ast2 ast ua)
116
117 (*****************************************************************************)
118 (* Some debugging functions *)
119 (*****************************************************************************)
120
121 (* the inputs *)
122
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);
129 end
130 let show_or_not_cfile a =
131 Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a)
132
133 let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles
134
135
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);
143 pr2 "";
144 end
145 let show_or_not_cocci a b =
146 Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b)
147
148
149 (* the output *)
150
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 *)
155 | _ ->
156 (* may need --strip-trailing-cr under windows *)
157 pr2 "diff = ";
158
159 let line =
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
163 let xs =
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 =
169 if prefix = ""
170 then "/"^file
171 else
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
175 let diff_line =
176 match List.rev(Str.split (Str.regexp " ") line) with
177 new_file::old_file::cmdrev ->
178 if !Flag.sgrep_mode2
179 then
180 String.concat " "
181 (List.rev ("/tmp/nothing" :: old_file :: cmdrev))
182 else
183 let old_base_file = drop_prefix old_file in
184 String.concat " "
185 (List.rev
186 (("b"^old_base_file)::("a"^old_base_file)::cmdrev))
187 | _ -> failwith "bad command" in
188 let (minus_line,plus_line) =
189 if !Flag.sgrep_mode2
190 then (minus_file,plus_file)
191 else
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
196 (String.concat " "
197 ("---"::("a"^old_base_file)::old_rest),
198 String.concat " "
199 ("+++"::("b"^old_base_file)::new_rest))
200 | (l1,l2) ->
201 failwith
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
205 | _ -> res in
206 xs +> List.iter (fun s ->
207 if s =~ "^\\+" && show_only_minus
208 then ()
209 else pr s)
210 end
211 let show_or_not_diff a b c =
212 Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b c)
213
214
215 (* the derived input *)
216
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 &");
223 end
224 let show_or_not_ctl_tex a b =
225 Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b)
226
227
228
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
232 then
233 begin
234 let name =
235 match ast with
236 Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _, _) -> nm
237 | _ -> i_to_s rulenb in
238 Common.pr_xxxxxxxxxxxxxxxxx ();
239 pr (name ^ " = ");
240 Common.pr_xxxxxxxxxxxxxxxxx ()
241 end
242
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
246 then
247 begin
248 let name = i_to_s rulenb in
249 Common.pr_xxxxxxxxxxxxxxxxx ();
250 pr ("script rule " ^ name ^ " = ");
251 Common.pr_xxxxxxxxxxxxxxxxx ()
252 end
253
254 let show_or_not_ctl_text2 ctl ast rulenb =
255 if !Flag_cocci.show_ctl_text then begin
256
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;
262 );
263
264 pr "CTL = ";
265 let (ctl,_) = ctl in
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;
270 );
271 pr "";
272 end
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)
275
276
277
278 (* running information *)
279 let get_celem celem : string =
280 match celem with
281 Ast_c.Definition ({Ast_c.f_name = funcs;},_) -> funcs
282 | Ast_c.Declaration
283 (Ast_c.DeclList ([{Ast_c.v_namei = Some ((s, _),_);}, _], _)) -> s
284 | _ -> ""
285
286 let show_or_not_celem2 prelude celem =
287 let (tag,trying) =
288 (match celem with
289 | Ast_c.Definition ({Ast_c.f_name = funcs;},_) ->
290 Flag.current_element := funcs;
291 (" function: ",funcs)
292 | Ast_c.Declaration
293 (Ast_c.DeclList ([{Ast_c.v_namei = Some ((s, _),_);}, _], _)) ->
294 Flag.current_element := s;
295 (" variable ",s);
296 | _ ->
297 Flag.current_element := "something_else";
298 (" ","something else");
299 ) in
300 if !Flag.show_trying then pr2 (prelude ^ tag ^ trying)
301
302 let show_or_not_celem a b =
303 Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b)
304
305
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"
309 else begin
310 pr2 "transformation info returned:";
311 let trans_info =
312 List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2)
313 trans_info
314 in
315 indent_do (fun () ->
316 trans_info +> List.iter (fun (i, subst, re) ->
317 pr2 ("transform state: " ^ (Common.i_to_s i));
318 indent_do (fun () ->
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;
323 );
324 adjust_pp_with_indent_and_header "with binding: " (fun () ->
325 Pretty_print_engine.pp_binding subst;
326 );
327 )
328 );
329 )
330 end
331 end
332 let show_or_not_trans_info a =
333 Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a)
334
335
336
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
341 )
342 end
343 let show_or_not_binding a b =
344 Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b)
345
346
347
348 (*****************************************************************************)
349 (* Some helper functions *)
350 (*****************************************************************************)
351
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)
358 then
359 (* could also modify the code in get_constants.ml *)
360 let tokens = tokens +> List.map (fun s ->
361 match () with
362 | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" ->
363 "\\b" ^ s ^ "\\b"
364
365 | _ when s =~ "^[A-Za-z_]" ->
366 "\\b" ^ s
367
368 | _ when s =~ ".*[A-Za-z_]$" ->
369 s ^ "\\b"
370 | _ -> s
371
372 ) in
373 let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles)
374 in
375 (match Sys.command com with
376 | 0 (* success *) -> true
377 | _ (* failure *) ->
378 (if !Flag.show_misc
379 then Printf.printf "grep failed: %s\n" com);
380 false (* no match, so not worth trying *)
381 )
382 else true
383
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
388 then begin
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
392 end
393 )
394
395
396 let contain_loop gopt =
397 match gopt with
398 | Some g ->
399 g#nodes#tolist +> List.exists (fun (xi, node) ->
400 Control_flow_c.extract_is_loop node
401 )
402 | None -> true (* means nothing, if no g then will not model check *)
403
404
405
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
411
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
416 | _ -> k e
417 in
418
419 let combiner =
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
425 in
426 toplevel_list_list +>
427 List.exists
428 (function (nm,_,rule) ->
429 (List.exists combiner.Visitor_ast.combiner_top_level rule))
430
431
432 let sp_contain_typed_metavar rules =
433 sp_contain_typed_metavar_z
434 (List.map
435 (function x ->
436 match x with
437 Ast_cocci.CocciRule (a,b,c,d,_) -> (a,b,c)
438 | _ -> failwith "error in filter")
439 (List.filter
440 (function x ->
441 match x with
442 Ast_cocci.CocciRule (a,b,c,d,Ast_cocci.Normal) -> true
443 | _ -> false)
444 rules))
445
446
447
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
451 *
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>
454 *)
455
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 -> []
462 | x ->
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
466
467 cs +> Common.map_filter (fun (c,_info_item) ->
468 match c with
469 | Ast_c.CppTop
470 (Ast_c.Include
471 {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) ->
472 (match x with
473 | Ast_c.Local xs ->
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
477 then
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))
482 else Some attempt2
483 else Some f
484
485 | Ast_c.NonLocal xs ->
486 if all_includes ||
487 Common.fileprefix (Common.last xs) = Common.fileprefix file
488 then
489 Some (Filename.concat !Flag_cocci.include_path
490 (Common.join "/" xs))
491 else None
492 | Ast_c.Wierd _ -> None
493 )
494 | _ -> None))
495 +> List.concat
496 +> Common.uniq
497
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
516
517 let rec print_dependencies str local global dep =
518 if !Flag_cocci.show_dependencies
519 then
520 begin
521 pr2 str;
522 let seen = ref [] in
523 let rec loop = function
524 Ast_cocci.Dep s | Ast_cocci.AntiDep s ->
525 if not (List.mem s !seen)
526 then
527 begin
528 if List.mem s local
529 then pr2 (s^" satisfied")
530 else pr2 (s^" not satisfied");
531 seen := s :: !seen
532 end
533 | Ast_cocci.EverDep s | Ast_cocci.NeverDep s ->
534 if not (List.mem s !seen)
535 then
536 begin
537 if List.mem s global
538 then pr2 (s^" satisfied")
539 else pr2 (s^" not satisfied");
540 seen := s :: !seen
541 end
542 | Ast_cocci.AndDep(s1,s2) ->
543 loop s1;
544 loop s2
545 | Ast_cocci.OrDep(s1,s2) ->
546 loop s1;
547 loop s2
548 | Ast_cocci.NoDep -> () in
549 loop dep
550 end
551
552
553
554 (* --------------------------------------------------------------------- *)
555 (* #include relative position in the file *)
556 (* --------------------------------------------------------------------- *)
557
558 (* compute the set of new prefixes
559 * on
560 * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *)
561 * "a/b/c/x";
562 * "a/x";
563 * "b/x";
564 * it would give for the first element
565 * ""; "a"; "a/b"; "a/b/x"
566 * for the second
567 * "a/b/c/x"
568 *
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.
571 *)
572
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)
578 )
579 in
580 new_first,
581 new_first @ already
582 ) []
583 +> fst
584
585
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 ->
589 match c with
590 | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_));
591 i_rel_pos = aref;
592 i_is_in_ifdef = inifdef}) ->
593 (match x with
594 | Ast_c.Wierd _ -> None
595 | _ ->
596 if inifdef
597 then None
598 else Some (x, aref)
599 )
600 | _ -> None
601 )
602 in
603 let (locals, nonlocals) =
604 only_include +> Common.partition_either (fun (c, aref) ->
605 match c with
606 | Ast_c.Local x -> Left (x, aref)
607 | Ast_c.NonLocal x -> Right (x, aref)
608 | Ast_c.Wierd x -> raise Impossible
609 ) in
610
611 update_rel_pos_bis locals;
612 update_rel_pos_bis nonlocals;
613 cs
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)) ->
620 aref := Some
621 {
622 Ast_c.first_of = the_first;
623 Ast_c.last_of = the_last;
624 }
625 )
626
627
628
629
630
631
632 (*****************************************************************************)
633 (* All the information needed around the C elements and Cocci rules *)
634 (*****************************************************************************)
635
636 type toplevel_c_info = {
637 ast_c: Ast_c.toplevel; (* contain refs so can be modified *)
638 tokens_c: Parser_c.token list;
639 fullstring: string;
640
641 flow: Control_flow_c.cflow option; (* it's the "fixed" flow *)
642 contain_loop: bool;
643
644 env_typing_before: TAC.environment;
645 env_typing_after: TAC.environment;
646
647 was_modified: bool ref;
648
649 (* id: int *)
650 }
651
652 type toplevel_cocci_info_script_rule = {
653 scr_ast_rule: string * (string * (string * string)) list * string;
654 language: string;
655 scr_dependencies: Ast_cocci.dependency;
656 scr_ruleid: int;
657 script_code: string;
658 }
659
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 *)
665
666 rulename: string;
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"]
670 *)
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;
676
677 ruleid: int;
678 ruletype: Ast_cocci.ruletype;
679
680 was_matched: bool ref;
681 }
682
683 type toplevel_cocci_info =
684 ScriptRuleCocciInfo of toplevel_cocci_info_script_rule
685 | CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule
686
687 type kind_file = Header | Source
688 type file_info = {
689 fname : string;
690 full_fname : string;
691 was_modified_once: bool ref;
692 asts: toplevel_c_info list;
693 fpath : string;
694 fkind : kind_file;
695 }
696
697 let g_contain_typedmetavar = ref false
698
699
700 let last_env_toplevel_c_info xs =
701 (Common.last xs).env_typing_after
702
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' ->
707 (x', x.fname)))))
708
709 let for_unparser xs =
710 xs +> List.map (fun x ->
711 (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr
712 )
713
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;"))
720 ) filename_stack;
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"));
726 );
727 ignore(Unix.system ("rm /tmp/tmp.pdf;"));
728 List.iter (fun filename ->
729 ignore (Unix.system ("rm " ^ filename ^ " " ^ filename ^ ".pdf;"))
730 ) filename_stack;
731 Printf.printf " - Done\n")
732
733
734 (* --------------------------------------------------------------------- *)
735 let prepare_cocci ctls free_var_lists negated_pos_lists
736 used_after_lists positions_list metavars astcocci =
737
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)
741 in
742 gathered +> List.map
743 (fun (((((((ctl_toplevel_list,metavars),ast),free_var_list),
744 negated_pos_list),used_after_list),positions_list),rulenb) ->
745
746 let is_script_rule r =
747 match r with Ast_cocci.ScriptRule _ -> true | _ -> false in
748
749 if not (List.length ctl_toplevel_list = 1) && not (is_script_rule ast)
750 then failwith "not handling multiple minirules";
751
752 match ast with
753 Ast_cocci.ScriptRule (lang,deps,mv,code) ->
754 let r =
755 {
756 scr_ast_rule = (lang, mv, code);
757 language = lang;
758 scr_dependencies = deps;
759 scr_ruleid = rulenb;
760 script_code = code;
761 }
762 in ScriptRuleCocciInfo r
763 | Ast_cocci.CocciRule
764 (rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) ->
765 CocciRuleCocciInfo (
766 {
767 ctl = List.hd ctl_toplevel_list;
768 metavars = metavars;
769 ast_rule = ast;
770 isexp = List.hd isexp;
771 rulename = rulename;
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;
778 ruleid = rulenb;
779 ruletype = ruletype;
780 was_matched = ref false;
781 })
782 )
783
784
785 (* --------------------------------------------------------------------- *)
786
787 let build_info_program cprogram env =
788 let (cs, parseinfos) = Common.unzip cprogram in
789 let (cs, envs) =
790 Common.unzip (TAC.annotate_program env (*!g_contain_typedmetavar*) cs) in
791
792 zip (zip cs parseinfos) envs +> List.map (fun ((c, parseinfo), (enva,envb))->
793 let (fullstr, tokens) = parseinfo in
794
795 let flow =
796 ast_to_flow_with_error_messages c +> Common.map_option (fun flow ->
797 let flow = Ast_to_flow.annotate_loop_nodes flow in
798
799 (* remove the fake nodes for julia *)
800 let fixed_flow = CCI.fix_flow_ctl flow in
801
802 if !Flag_cocci.show_flow then print_flow fixed_flow;
803 if !Flag_cocci.show_before_fixed_flow then print_flow flow;
804
805 fixed_flow
806 )
807 in
808
809 {
810 ast_c = c; (* contain refs so can be modified *)
811 tokens_c = tokens;
812 fullstring = fullstr;
813
814 flow = flow;
815
816 contain_loop = contain_loop flow;
817
818 env_typing_before = enva;
819 env_typing_after = envb;
820
821 was_modified = ref false;
822 }
823 )
824
825
826
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 ->
830 if !(c.was_modified)
831 then
832 let file = Common.new_temp_file "cocci_small_output" ".c" in
833 cfile_of_program
834 [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal]
835 file;
836
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
840
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.
844 *)
845 (* Common.list_init xs *) (* get rid of the FinalDef *)
846 xs
847 else [c]
848 ) +> List.concat
849
850
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;
855 );
856 ccs +> List.map (fun c_or_h ->
857 { c_or_h with
858 asts = rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
859 )
860
861
862
863
864
865
866
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
870
871 (* todo?: may not be good to first have all the headers and then all the c *)
872 let all =
873 (includes +> List.map (fun hpath -> Right hpath))
874 ++
875 ((zip files cprograms) +> List.map (fun (file, asts) -> Left (file, asts)))
876 in
877
878 let env = ref !TAC.initial_env in
879
880 let ccs = all +> Common.map_filter (fun x ->
881 match x with
882 | Right hpath ->
883 if not (Common.lfile_exists hpath)
884 then begin
885 pr2 ("TYPE: header " ^ hpath ^ " not found");
886 None
887 end
888 else
889 let h_cs = cprogram_of_file_cached hpath in
890 let info_h_cs = build_info_program h_cs !env in
891 env :=
892 if null info_h_cs
893 then !env
894 else last_env_toplevel_c_info info_h_cs
895 ;
896 Some {
897 fname = Common.basename hpath;
898 full_fname = hpath;
899 asts = info_h_cs;
900 was_modified_once = ref false;
901 fpath = hpath;
902 fkind = Header;
903 }
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)));
909 Some {
910 fname = Common.basename file;
911 full_fname = file;
912 asts = cs;
913 was_modified_once = ref false;
914 fpath = file;
915 fkind = Source;
916 }
917 )
918 in
919 ccs
920
921
922 (*****************************************************************************)
923 (* Processing the ctls and toplevel C elements *)
924 (*****************************************************************************)
925
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)
931 * for_all C elements
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.
936 *
937 *
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 ?
944 *
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
950 * la regle 3.
951 *
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.
964 *
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.
968 *)
969
970
971 (* r(ule), c(element in C code), e(nvironment) *)
972
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)
978 then
979 begin
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)
985 end
986 else
987 begin
988 let (_, mv, _) = r.scr_ast_rule in
989 if List.for_all (Pycocci.contains_binding e) mv
990 then
991 begin
992 let relevant_bindings =
993 List.filter
994 (function ((re,rm),_) ->
995 List.exists (function (_,(r,m)) -> r = re && m = rm) mv)
996 e in
997 let new_cache =
998 if List.mem relevant_bindings cache
999 then cache
1000 else
1001 begin
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" ^
1011 r.script_code) in
1012 relevant_bindings :: cache
1013 end in
1014 if !Pycocci.inc_match
1015 then (new_cache, merge_env [(e, rules_that_have_matched)] newes)
1016 else (new_cache, newes)
1017 end
1018 else (cache, merge_env [(e, rules_that_have_matched)] newes)
1019 end
1020
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;
1025
1026 let reorganized_env =
1027 reassociate_positions r.free_vars r.negated_pos_vars !es in
1028
1029 (* looping over the environments *)
1030 let (_,newes (* envs for next round/rule *)) =
1031 List.fold_left
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)
1036 then
1037 begin
1038 print_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;
1043 (cache,
1044 merge_env
1045 [(e +> List.filter (fun (s,v) -> List.mem s r.used_after),
1046 rules_that_have_matched)]
1047 newes)
1048 end
1049 else
1050 let new_bindings =
1051 try List.assoc relevant_bindings cache
1052 with
1053 Not_found ->
1054 print_dependencies
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;
1060
1061 (* applying the rule *)
1062 (match r.ruletype with
1063 Ast_cocci.Normal ->
1064 let children_e = ref [] in
1065
1066 (* looping over the functions and toplevel elements in
1067 .c and .h *)
1068 concat_headers_and_c !ccs +> List.iter (fun (c,f) ->
1069 if c.flow <> None
1070 then
1071 (* does also some side effects on c and r *)
1072 let processed =
1073 process_a_ctl_a_env_a_toplevel r
1074 relevant_bindings c f in
1075 match processed with
1076 | None -> ()
1077 | Some newbindings ->
1078 newbindings +> List.iter (fun newbinding ->
1079 children_e :=
1080 Common.insert_set newbinding !children_e)
1081 ); (* end iter cs *)
1082
1083 !children_e
1084 | Ast_cocci.Generated ->
1085 process_a_generated_a_env_a_toplevel r
1086 relevant_bindings !ccs;
1087 []) in
1088
1089 let old_bindings_to_keep =
1090 Common.nub
1091 (e +> List.filter (fun (s,v) -> List.mem s r.used_after)) in
1092 let new_e =
1093 if null new_bindings
1094 then
1095 begin
1096 (*use the old bindings, specialized to the used_after_list*)
1097 if !Flag_ctl.partial_match
1098 then
1099 printf
1100 "Empty list of bindings, I will restart from old env";
1101 [(old_bindings_to_keep,rules_that_have_matched)]
1102 end
1103 else
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 =
1113 Common.nub
1114 (new_bindings +>
1115 List.map
1116 (List.filter
1117 (fun (s,v) ->
1118 List.mem s r.used_after &&
1119 not (List.mem s old_variables)))) in
1120 List.map
1121 (function new_binding_to_add ->
1122 (List.sort compare
1123 (Common.union_set
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 *)
1130 if !(r.was_matched)
1131 then Common.push2 r.rulename rules_that_have_ever_matched;
1132
1133 es := newes;
1134
1135 (* apply the tagged modifs and reparse *)
1136 if not !Flag.sgrep_mode2
1137 then ccs := rebuild_info_c_and_headers !ccs r.isexp
1138 )
1139
1140 and merge_env new_e old_e =
1141 List.fold_left
1142 (function old_e ->
1143 function (e,rules) as elem ->
1144 let (same,diff) = List.partition (function (e1,_) -> e = e1) old_e in
1145 match same with
1146 [] -> elem :: old_e
1147 | [(_,old_rules)] -> (e,Common.union_set rules old_rules) :: diff
1148 | _ -> failwith "duplicate environment entries")
1149 old_e new_e
1150
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
1155
1156 (* looping over the rules *)
1157 rs +> List.iter (fun r ->
1158 match r with
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 ();
1164
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)));
1171 end;
1172
1173 if !Flag.show_misc then print_endline "RESULT =";
1174
1175 let (_, newes) =
1176 List.fold_left
1177 (function (cache, newes) ->
1178 function (e, rules_that_have_matched) ->
1179 match r.language with
1180 "python" ->
1181 apply_python_rule r cache newes e rules_that_have_matched
1182 rules_that_have_ever_matched
1183 | "test" ->
1184 concat_headers_and_c !ccs +> List.iter (fun (c,_) ->
1185 if c.flow <> None
1186 then
1187 Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring);
1188 (cache, newes)
1189 | _ ->
1190 Printf.printf "Unknown language: %s\n" r.language;
1191 (cache, newes)
1192 )
1193 ([],[]) !es in
1194
1195 es := newes;
1196 | CocciRuleCocciInfo r ->
1197 apply_cocci_rule r rules_that_have_ever_matched es ccs);
1198
1199 if !Flag.sgrep_mode2
1200 then begin
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
1208 *)
1209 Flag_parsing_c.verbose_parsing := false;
1210 ccs := rebuild_info_c_and_headers !ccs false
1211 end;
1212 !ccs (* return final C asts *)
1213
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. *)
1224 let relevant =
1225 List.map
1226 (function (e,_) ->
1227 List.filter (function (x,_) -> List.mem x free_vars) e)
1228 envs in
1229 let splitted_relevant =
1230 (* separate the relevant variables into the non-position ones and the
1231 position ones *)
1232 List.map
1233 (function r ->
1234 List.fold_left
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))
1240 ([],[]) r)
1241 relevant in
1242 let splitted_relevant =
1243 List.map
1244 (function (non_pos,pos) ->
1245 (List.sort compare non_pos,List.sort compare pos))
1246 splitted_relevant in
1247 let non_poss =
1248 List.fold_left
1249 (function non_pos ->
1250 function (np,_) ->
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 *)
1256 List.map
1257 (function non_pos ->
1258 let others =
1259 List.filter
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
1265 (non_pos,
1266 List.sort compare
1267 (non_pos @
1268 (combine_pos negated_pos_vars
1269 (List.map (function (_,x) -> x) others)))))
1270 non_poss in
1271 List.combine envs
1272 (List.map (function (non_pos,_) -> List.assoc non_pos extended_relevant)
1273 splitted_relevant)
1274
1275 and combine_pos negated_pos_vars others =
1276 List.map
1277 (function posvar ->
1278 (posvar,
1279 Ast_c.MetaPosValList
1280 (List.sort compare
1281 (List.fold_left
1282 (function positions ->
1283 function other_list ->
1284 try
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)
1290 [] others))))
1291 negated_pos_vars
1292
1293 and bigloop a b =
1294 Common.profile_code "bigloop" (fun () -> bigloop2 a b)
1295
1296
1297
1298
1299
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;
1308
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)
1314 )
1315 in
1316 if not returned_any_states
1317 then None
1318 else begin
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;
1322
1323 r.was_matched := true;
1324
1325 if not (null trans_info)
1326 then begin
1327 c.was_modified := true;
1328 try
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. *)
1333
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)
1338 end;
1339
1340 Some (List.map (function x -> x@inherited_bindings) newbindings)
1341 end
1342 )
1343
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)
1347
1348 and process_a_generated_a_env_a_toplevel2 r env = function
1349 [cfile] ->
1350 let free_vars =
1351 List.filter
1352 (function
1353 (rule,_) when rule = r.rulename -> false
1354 | (_,"ARGS") -> false
1355 | _ -> true)
1356 r.free_vars in
1357 let env_domain = List.map (function (nm,vl) -> nm) env in
1358 let metavars =
1359 List.filter
1360 (function md ->
1361 let (rl,_) = Ast_cocci.get_meta_name md in
1362 rl = r.rulename)
1363 r.metavars 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"
1367
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)
1371
1372
1373
1374 (*****************************************************************************)
1375 (* The main function *)
1376 (*****************************************************************************)
1377
1378 let full_engine2 (coccifile, isofile) cfiles =
1379
1380 show_or_not_cfiles cfiles;
1381 show_or_not_cocci coccifile isofile;
1382 Pycocci.set_coccifile coccifile;
1383
1384 let isofile =
1385 if not (Common.lfile_exists isofile)
1386 then begin
1387 pr2 ("warning: Can't find default iso file: " ^ isofile);
1388 None
1389 end
1390 else Some isofile
1391 in
1392
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
1397 in
1398 let ctls =
1399 Common.memoized _hctl (coccifile, isofile) (fun () ->
1400 ctls_of_ast astcocci used_after_lists positions_lists)
1401 in
1402
1403 let contain_typedmetavar = sp_contain_typed_metavar astcocci in
1404
1405 (* optimisation allowing to launch coccinelle on all the drivers *)
1406 if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks)
1407 then begin
1408 pr2 ("not worth trying:" ^ Common.join " " cfiles);
1409 cfiles +> List.map (fun s -> s, None)
1410 end
1411 else begin
1412
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();
1416
1417 g_contain_typedmetavar := contain_typedmetavar;
1418
1419 check_macro_in_sp_and_adjust toks;
1420
1421
1422
1423 let cocci_infos =
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
1432 | x -> x in
1433 let c_infos = prepare_c cfiles choose_includes in
1434
1435 show_or_not_ctl_tex astcocci ctls;
1436
1437 (* ! the big loop ! *)
1438 let c_infos' = bigloop cocci_infos c_infos in
1439
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();
1444
1445 c_infos' +> List.map (fun c_or_h ->
1446 if !(c_or_h.was_modified_once)
1447 then begin
1448 let outfile = Common.new_temp_file "cocci-output" ("-" ^ c_or_h.fname)
1449 in
1450
1451 if c_or_h.fkind = Header
1452 then pr2 ("a header file was modified: " ^ c_or_h.fname);
1453
1454 (* and now unparse everything *)
1455 cfile_of_program (for_unparser c_or_h.asts) outfile;
1456
1457 let show_only_minus = !Flag.sgrep_mode2 in
1458 show_or_not_diff c_or_h.fpath outfile show_only_minus;
1459
1460 (c_or_h.fpath,
1461 if !Flag.sgrep_mode2 then None else Some outfile
1462 )
1463 end
1464 else
1465 (c_or_h.fpath, None)
1466 );
1467 end
1468
1469 let full_engine a b =
1470 Common.profile_code "full_engine" (fun () -> full_engine2 a b)
1471
1472
1473 (*****************************************************************************)
1474 (* check duplicate from result of full_engine *)
1475 (*****************************************************************************)
1476
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) ->
1482 match xs with
1483 | [] -> raise Impossible
1484 | [res] -> Some (file, res)
1485 | res::xs ->
1486 match res with
1487 | None ->
1488 if not (List.for_all (fun res2 -> res2 = None) xs)
1489 then begin
1490 pr2 ("different modification result for " ^ file);
1491 None
1492 end
1493 else Some (file, None)
1494 | Some res ->
1495 if not(List.for_all (fun res2 ->
1496 match res2 with
1497 | None -> false
1498 | Some res2 ->
1499 let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2)
1500 in
1501 null diff
1502 ) xs) then begin
1503 pr2 ("different modification result for " ^ file);
1504 None
1505 end
1506 else Some (file, Some res)
1507
1508
1509 )
1510 let check_duplicate_modif a =
1511 Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a)
1512