Commit | Line | Data |
---|---|---|
0708f913 C |
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 |