Commit | Line | Data |
---|---|---|
9f8e26f4 | 1 | (* |
ae4735db | 2 | * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen |
9f8e26f4 C |
3 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix |
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 | ||
34e49164 C |
23 | open Common |
24 | ||
25 | module CCI = Ctlcocci_integration | |
26 | module TAC = Type_annoter_c | |
27 | ||
708f4980 C |
28 | module Ast_to_flow = Control_flow_c_build |
29 | ||
34e49164 | 30 | (*****************************************************************************) |
ae4735db | 31 | (* This file is a kind of driver. It gathers all the important functions |
34e49164 C |
32 | * from coccinelle in one place. The different entities in coccinelle are: |
33 | * - files | |
34 | * - astc | |
35 | * - astcocci | |
36 | * - flow (contain nodes) | |
37 | * - ctl (contain rule_elems) | |
38 | * This file contains functions to transform one in another. | |
39 | *) | |
40 | (*****************************************************************************) | |
41 | ||
42 | (* --------------------------------------------------------------------- *) | |
43 | (* C related *) | |
44 | (* --------------------------------------------------------------------- *) | |
ae4735db | 45 | let cprogram_of_file file = |
978fd7e5 | 46 | let (program2, _stat) = Parse_c.parse_c_and_cpp file in |
ae4735db | 47 | program2 |
34e49164 | 48 | |
ae4735db | 49 | let cprogram_of_file_cached file = |
34e49164 | 50 | let (program2, _stat) = Parse_c.parse_cache file in |
485bce71 | 51 | if !Flag_cocci.ifdef_to_if |
ae4735db C |
52 | then |
53 | program2 +> Parse_c.with_program2 (fun asts -> | |
485bce71 C |
54 | Cpp_ast_c.cpp_ifdef_statementize asts |
55 | ) | |
56 | else program2 | |
34e49164 | 57 | |
ae4735db | 58 | let cfile_of_program program2_with_ppmethod outf = |
485bce71 | 59 | Unparse_c.pp_program program2_with_ppmethod outf |
34e49164 C |
60 | |
61 | (* for memoization, contains only one entry, the one for the SP *) | |
62 | let _hparse = Hashtbl.create 101 | |
63 | let _hctl = Hashtbl.create 101 | |
64 | ||
65 | (* --------------------------------------------------------------------- *) | |
66 | (* Cocci related *) | |
67 | (* --------------------------------------------------------------------- *) | |
68 | let sp_of_file2 file iso = | |
69 | Common.memoized _hparse (file, iso) (fun () -> | |
70 | Parse_cocci.process file iso false) | |
ae4735db | 71 | let sp_of_file file iso = |
34e49164 C |
72 | Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso) |
73 | ||
74 | ||
75 | (* --------------------------------------------------------------------- *) | |
76 | (* Flow related *) | |
77 | (* --------------------------------------------------------------------- *) | |
ae4735db | 78 | let print_flow flow = |
34e49164 C |
79 | Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true |
80 | ||
81 | ||
82 | let ast_to_flow_with_error_messages2 x = | |
ae4735db | 83 | let flowopt = |
34e49164 | 84 | try Ast_to_flow.ast_to_control_flow x |
ae4735db | 85 | with Ast_to_flow.Error x -> |
34e49164 C |
86 | Ast_to_flow.report_error x; |
87 | None | |
88 | in | |
ae4735db | 89 | flowopt +> do_option (fun flow -> |
34e49164 C |
90 | (* This time even if there is a deadcode, we still have a |
91 | * flow graph, so I can try the transformation and hope the | |
ae4735db | 92 | * deadcode will not bother us. |
34e49164 C |
93 | *) |
94 | try Ast_to_flow.deadcode_detection flow | |
ae4735db | 95 | with Ast_to_flow.Error (Ast_to_flow.DeadCode x) -> |
34e49164 C |
96 | Ast_to_flow.report_error (Ast_to_flow.DeadCode x); |
97 | ); | |
98 | flowopt | |
ae4735db | 99 | let ast_to_flow_with_error_messages a = |
34e49164 C |
100 | Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a) |
101 | ||
102 | ||
103 | (* --------------------------------------------------------------------- *) | |
104 | (* Ctl related *) | |
105 | (* --------------------------------------------------------------------- *) | |
b1b2de81 | 106 | |
978fd7e5 | 107 | let ctls_of_ast2 ast (ua,fua,fuas) pos = |
34e49164 | 108 | List.map2 |
978fd7e5 | 109 | (function ast -> function (ua,(fua,(fuas,pos))) -> |
34e49164 C |
110 | List.combine |
111 | (if !Flag_cocci.popl | |
951c7801 | 112 | then Popl.popl ast |
978fd7e5 | 113 | else Asttoctl2.asttoctl ast (ua,fua,fuas) pos) |
34e49164 | 114 | (Asttomember.asttomember ast ua)) |
978fd7e5 | 115 | ast (List.combine ua (List.combine fua (List.combine fuas pos))) |
34e49164 C |
116 | |
117 | let ctls_of_ast ast ua = | |
118 | Common.profile_code "asttoctl2" (fun () -> ctls_of_ast2 ast ua) | |
119 | ||
120 | (*****************************************************************************) | |
121 | (* Some debugging functions *) | |
122 | (*****************************************************************************) | |
123 | ||
124 | (* the inputs *) | |
125 | ||
126 | let show_or_not_cfile2 cfile = | |
127 | if !Flag_cocci.show_c then begin | |
128 | Common.pr2_xxxxxxxxxxxxxxxxx (); | |
129 | pr2 ("processing C file: " ^ cfile); | |
130 | Common.pr2_xxxxxxxxxxxxxxxxx (); | |
131 | Common.command2 ("cat " ^ cfile); | |
132 | end | |
ae4735db | 133 | let show_or_not_cfile a = |
34e49164 C |
134 | Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a) |
135 | ||
136 | let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles | |
137 | ||
138 | ||
ae4735db | 139 | let show_or_not_cocci2 coccifile isofile = |
34e49164 C |
140 | if !Flag_cocci.show_cocci then begin |
141 | Common.pr2_xxxxxxxxxxxxxxxxx (); | |
142 | pr2 ("processing semantic patch file: " ^ coccifile); | |
143 | isofile +> (fun s -> pr2 ("with isos from: " ^ s)); | |
144 | Common.pr2_xxxxxxxxxxxxxxxxx (); | |
145 | Common.command2 ("cat " ^ coccifile); | |
146 | pr2 ""; | |
147 | end | |
ae4735db | 148 | let show_or_not_cocci a b = |
34e49164 C |
149 | Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b) |
150 | ||
c3e37e97 | 151 | (* ---------------------------------------------------------------------- *) |
34e49164 C |
152 | (* the output *) |
153 | ||
c3e37e97 C |
154 | let fix_sgrep_diffs l = |
155 | let l = | |
156 | List.filter (function s -> (s =~ "^\\+\\+\\+") || not (s =~ "^\\+")) l in | |
157 | let l = List.rev l in | |
158 | (* adjust second number for + code *) | |
159 | let rec loop1 n = function | |
160 | [] -> [] | |
161 | | s::ss -> | |
162 | if s =~ "^-" && not(s =~ "^---") | |
163 | then s :: loop1 (n+1) ss | |
164 | else if s =~ "^@@" | |
165 | then | |
166 | (match Str.split (Str.regexp " ") s with | |
167 | bef::min::pl::aft -> | |
168 | (match Str.split (Str.regexp ",") pl with | |
169 | [n1;n2] -> | |
170 | let n2 = int_of_string n2 in | |
171 | (Printf.sprintf "%s %s %s,%d %s" bef min n1 (n2-n) | |
172 | (String.concat " " aft)) | |
173 | :: loop1 0 ss | |
174 | | _ -> failwith "bad + line information") | |
175 | | _ -> failwith "bad @@ information") | |
176 | else s :: loop1 n ss in | |
177 | let rec loop2 n = function | |
178 | [] -> [] | |
179 | | s::ss -> | |
180 | if s =~ "^---" | |
181 | then s :: loop2 0 ss | |
182 | else if s =~ "^@@" | |
183 | then | |
184 | (match Str.split (Str.regexp " ") s with | |
185 | bef::min::pl::aft -> | |
186 | (match (Str.split (Str.regexp ",") min, | |
187 | Str.split (Str.regexp ",") pl) with | |
188 | ([_;m2],[n1;n2]) -> | |
189 | let n1 = | |
190 | int_of_string | |
191 | (String.sub n1 1 ((String.length n1)-1)) in | |
192 | let m2 = int_of_string m2 in | |
193 | let n2 = int_of_string n2 in | |
194 | (Printf.sprintf "%s %s +%d,%d %s" bef min (n1-n) n2 | |
195 | (String.concat " " aft)) | |
196 | :: loop2 (n+(m2-n2)) ss | |
197 | | _ -> failwith "bad -/+ line information") | |
198 | | _ -> failwith "bad @@ information") | |
199 | else s :: loop2 n ss in | |
200 | loop2 0 (List.rev (loop1 0 l)) | |
201 | ||
202 | let normalize_path file = | |
203 | let fullpath = | |
204 | if String.get file 0 = '/' then file else (Sys.getcwd()) ^ "/" ^ file in | |
205 | let elements = Str.split_delim (Str.regexp "/") fullpath in | |
206 | let rec loop prev = function | |
207 | [] -> String.concat "/" (List.rev prev) | |
208 | | "." :: rest -> loop prev rest | |
209 | | ".." :: rest -> | |
210 | (match prev with | |
211 | x::xs -> loop xs rest | |
212 | | _ -> failwith "bad path") | |
213 | | x::rest -> loop (x::prev) rest in | |
214 | loop [] elements | |
215 | ||
216 | let show_or_not_diff2 cfile outfile = | |
34e49164 | 217 | if !Flag_cocci.show_diff then begin |
951c7801 | 218 | match Common.fst(Compare_c.compare_to_original cfile outfile) with |
34e49164 C |
219 | Compare_c.Correct -> () (* diff only in spacing, etc *) |
220 | | _ -> | |
221 | (* may need --strip-trailing-cr under windows *) | |
222 | pr2 "diff = "; | |
223 | ||
224 | let line = | |
225 | match !Flag_parsing_c.diff_lines with | |
226 | | None -> "diff -u -p " ^ cfile ^ " " ^ outfile | |
227 | | Some n -> "diff -U "^n^" -p "^cfile^" "^outfile in | |
228 | let xs = | |
229 | let res = Common.cmd_to_list line in | |
230 | match (!Flag.patch,res) with | |
231 | (* create something that looks like the output of patch *) | |
232 | (Some prefix,minus_file::plus_file::rest) -> | |
c3e37e97 C |
233 | let prefix = |
234 | let lp = String.length prefix in | |
235 | if String.get prefix (lp-1) = '/' | |
236 | then String.sub prefix 0 (lp-1) | |
237 | else prefix in | |
34e49164 | 238 | let drop_prefix file = |
c3e37e97 C |
239 | let file = normalize_path file in |
240 | if Str.string_match (Str.regexp prefix) file 0 | |
241 | then | |
b1b2de81 | 242 | let lp = String.length prefix in |
c3e37e97 C |
243 | let lf = String.length file in |
244 | if lp < lf | |
245 | then String.sub file lp (lf - lp) | |
246 | else | |
247 | failwith | |
248 | (Printf.sprintf "prefix %s doesn't match file %s" | |
249 | prefix file) | |
250 | else | |
251 | failwith | |
252 | (Printf.sprintf "prefix %s doesn't match file %s" | |
253 | prefix file) in | |
34e49164 C |
254 | let diff_line = |
255 | match List.rev(Str.split (Str.regexp " ") line) with | |
256 | new_file::old_file::cmdrev -> | |
257 | if !Flag.sgrep_mode2 | |
258 | then | |
259 | String.concat " " | |
260 | (List.rev ("/tmp/nothing" :: old_file :: cmdrev)) | |
261 | else | |
262 | let old_base_file = drop_prefix old_file in | |
263 | String.concat " " | |
264 | (List.rev | |
265 | (("b"^old_base_file)::("a"^old_base_file)::cmdrev)) | |
266 | | _ -> failwith "bad command" in | |
267 | let (minus_line,plus_line) = | |
268 | if !Flag.sgrep_mode2 | |
c3e37e97 | 269 | then (minus_file,"+++ /tmp/nothing") |
34e49164 C |
270 | else |
271 | match (Str.split (Str.regexp "[ \t]") minus_file, | |
272 | Str.split (Str.regexp "[ \t]") plus_file) with | |
273 | ("---"::old_file::old_rest,"+++"::new_file::new_rest) -> | |
274 | let old_base_file = drop_prefix old_file in | |
275 | (String.concat " " | |
276 | ("---"::("a"^old_base_file)::old_rest), | |
277 | String.concat " " | |
278 | ("+++"::("b"^old_base_file)::new_rest)) | |
279 | | (l1,l2) -> | |
280 | failwith | |
281 | (Printf.sprintf "bad diff header lines: %s %s" | |
282 | (String.concat ":" l1) (String.concat ":" l2)) in | |
283 | diff_line::minus_line::plus_line::rest | |
b1b2de81 | 284 | | _ -> res in |
c3e37e97 C |
285 | let xs = if !Flag.sgrep_mode2 then fix_sgrep_diffs xs else xs in |
286 | xs +> List.iter pr | |
34e49164 | 287 | end |
c3e37e97 C |
288 | let show_or_not_diff a b = |
289 | Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b) | |
ae4735db C |
290 | |
291 | ||
34e49164 | 292 | (* the derived input *) |
ae4735db | 293 | |
34e49164 C |
294 | let show_or_not_ctl_tex2 astcocci ctls = |
295 | if !Flag_cocci.show_ctl_tex then begin | |
296 | Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls; | |
297 | Common.command2 ("cd /tmp; latex __cocci_ctl.tex; " ^ | |
298 | "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^ | |
299 | "gv __cocci_ctl.ps &"); | |
300 | end | |
ae4735db | 301 | let show_or_not_ctl_tex a b = |
34e49164 | 302 | Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b) |
ae4735db C |
303 | |
304 | ||
34e49164 C |
305 | let show_or_not_rule_name ast rulenb = |
306 | if !Flag_cocci.show_ctl_text or !Flag.show_trying or | |
faf9a90c | 307 | !Flag.show_transinfo or !Flag_cocci.show_binding_in_out |
34e49164 C |
308 | then |
309 | begin | |
310 | let name = | |
311 | match ast with | |
faf9a90c | 312 | Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _, _) -> nm |
34e49164 C |
313 | | _ -> i_to_s rulenb in |
314 | Common.pr_xxxxxxxxxxxxxxxxx (); | |
315 | pr (name ^ " = "); | |
316 | Common.pr_xxxxxxxxxxxxxxxxx () | |
317 | end | |
318 | ||
319 | let show_or_not_scr_rule_name rulenb = | |
320 | if !Flag_cocci.show_ctl_text or !Flag.show_trying or | |
faf9a90c | 321 | !Flag.show_transinfo or !Flag_cocci.show_binding_in_out |
34e49164 C |
322 | then |
323 | begin | |
324 | let name = i_to_s rulenb in | |
325 | Common.pr_xxxxxxxxxxxxxxxxx (); | |
326 | pr ("script rule " ^ name ^ " = "); | |
327 | Common.pr_xxxxxxxxxxxxxxxxx () | |
328 | end | |
329 | ||
330 | let show_or_not_ctl_text2 ctl ast rulenb = | |
331 | if !Flag_cocci.show_ctl_text then begin | |
ae4735db C |
332 | |
333 | adjust_pp_with_indent (fun () -> | |
34e49164 C |
334 | Format.force_newline(); |
335 | Pretty_print_cocci.print_plus_flag := true; | |
336 | Pretty_print_cocci.print_minus_flag := true; | |
337 | Pretty_print_cocci.unparse ast; | |
338 | ); | |
ae4735db | 339 | |
34e49164 C |
340 | pr "CTL = "; |
341 | let (ctl,_) = ctl in | |
ae4735db | 342 | adjust_pp_with_indent (fun () -> |
34e49164 | 343 | Format.force_newline(); |
ae4735db | 344 | Pretty_print_engine.pp_ctlcocci |
34e49164 C |
345 | !Flag_cocci.show_mcodekind_in_ctl !Flag_cocci.inline_let_ctl ctl; |
346 | ); | |
347 | pr ""; | |
348 | end | |
349 | let show_or_not_ctl_text a b c = | |
350 | Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_text2 a b c) | |
351 | ||
352 | ||
353 | ||
354 | (* running information *) | |
ae4735db C |
355 | let get_celem celem : string = |
356 | match celem with | |
357 | Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) -> | |
b1b2de81 | 358 | Ast_c.str_of_name namefuncs |
485bce71 | 359 | | Ast_c.Declaration |
ae4735db | 360 | (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) -> |
b1b2de81 | 361 | Ast_c.str_of_name name |
485bce71 | 362 | | _ -> "" |
34e49164 | 363 | |
ae4735db | 364 | let show_or_not_celem2 prelude celem = |
485bce71 | 365 | let (tag,trying) = |
ae4735db C |
366 | (match celem with |
367 | | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) -> | |
b1b2de81 | 368 | let funcs = Ast_c.str_of_name namefuncs in |
485bce71 C |
369 | Flag.current_element := funcs; |
370 | (" function: ",funcs) | |
34e49164 | 371 | | Ast_c.Declaration |
b1b2de81 C |
372 | (Ast_c.DeclList ([{Ast_c.v_namei = Some (name,_)}, _], _)) -> |
373 | let s = Ast_c.str_of_name name in | |
485bce71 C |
374 | Flag.current_element := s; |
375 | (" variable ",s); | |
376 | | _ -> | |
377 | Flag.current_element := "something_else"; | |
378 | (" ","something else"); | |
379 | ) in | |
380 | if !Flag.show_trying then pr2 (prelude ^ tag ^ trying) | |
ae4735db C |
381 | |
382 | let show_or_not_celem a b = | |
34e49164 C |
383 | Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b) |
384 | ||
385 | ||
ae4735db | 386 | let show_or_not_trans_info2 trans_info = |
708f4980 C |
387 | (* drop witness tree indices for printing *) |
388 | let trans_info = | |
389 | List.map (function (index,trans_info) -> trans_info) trans_info in | |
faf9a90c | 390 | if !Flag.show_transinfo then begin |
34e49164 C |
391 | if null trans_info then pr2 "transformation info is empty" |
392 | else begin | |
393 | pr2 "transformation info returned:"; | |
394 | let trans_info = | |
395 | List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2) | |
ae4735db | 396 | trans_info |
34e49164 | 397 | in |
ae4735db C |
398 | indent_do (fun () -> |
399 | trans_info +> List.iter (fun (i, subst, re) -> | |
34e49164 | 400 | pr2 ("transform state: " ^ (Common.i_to_s i)); |
ae4735db C |
401 | indent_do (fun () -> |
402 | adjust_pp_with_indent_and_header "with rule_elem: " (fun () -> | |
34e49164 C |
403 | Pretty_print_cocci.print_plus_flag := true; |
404 | Pretty_print_cocci.print_minus_flag := true; | |
405 | Pretty_print_cocci.rule_elem "" re; | |
406 | ); | |
ae4735db | 407 | adjust_pp_with_indent_and_header "with binding: " (fun () -> |
34e49164 C |
408 | Pretty_print_engine.pp_binding subst; |
409 | ); | |
410 | ) | |
411 | ); | |
412 | ) | |
413 | end | |
414 | end | |
ae4735db | 415 | let show_or_not_trans_info a = |
34e49164 C |
416 | Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a) |
417 | ||
418 | ||
419 | ||
420 | let show_or_not_binding2 s binding = | |
421 | if !Flag_cocci.show_binding_in_out then begin | |
ae4735db | 422 | adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () -> |
34e49164 C |
423 | Pretty_print_engine.pp_binding binding |
424 | ) | |
425 | end | |
ae4735db | 426 | let show_or_not_binding a b = |
34e49164 C |
427 | Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b) |
428 | ||
429 | ||
430 | ||
431 | (*****************************************************************************) | |
432 | (* Some helper functions *) | |
433 | (*****************************************************************************) | |
434 | ||
ae4735db | 435 | let worth_trying cfiles tokens = |
34e49164 C |
436 | (* drop the following line for a list of list by rules. since we don't |
437 | allow multiple minirules, all the tokens within a rule should be in | |
438 | a single CFG entity *) | |
439 | let tokens = Common.union_all tokens in | |
440 | if not !Flag_cocci.windows && not (null tokens) | |
441 | then | |
442 | (* could also modify the code in get_constants.ml *) | |
ae4735db C |
443 | let tokens = tokens +> List.map (fun s -> |
444 | match () with | |
445 | | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" -> | |
34e49164 C |
446 | "\\b" ^ s ^ "\\b" |
447 | ||
ae4735db | 448 | | _ when s =~ "^[A-Za-z_]" -> |
34e49164 C |
449 | "\\b" ^ s |
450 | ||
ae4735db | 451 | | _ when s =~ ".*[A-Za-z_]$" -> |
34e49164 C |
452 | s ^ "\\b" |
453 | | _ -> s | |
454 | ||
455 | ) in | |
456 | let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles) | |
457 | in | |
458 | (match Sys.command com with | |
459 | | 0 (* success *) -> true | |
460 | | _ (* failure *) -> | |
461 | (if !Flag.show_misc | |
462 | then Printf.printf "grep failed: %s\n" com); | |
463 | false (* no match, so not worth trying *) | |
464 | ) | |
465 | else true | |
466 | ||
ae4735db | 467 | let check_macro_in_sp_and_adjust tokens = |
34e49164 | 468 | let tokens = Common.union_all tokens in |
ae4735db | 469 | tokens +> List.iter (fun s -> |
708f4980 | 470 | if Hashtbl.mem !Parse_c._defs s |
34e49164 | 471 | then begin |
708f4980 C |
472 | if !Flag_cocci.verbose_cocci then begin |
473 | pr2 "warning: macro in semantic patch was in macro definitions"; | |
474 | pr2 ("disabling macro expansion for " ^ s); | |
475 | end; | |
476 | Hashtbl.remove !Parse_c._defs s | |
34e49164 C |
477 | end |
478 | ) | |
479 | ||
480 | ||
ae4735db | 481 | let contain_loop gopt = |
34e49164 | 482 | match gopt with |
ae4735db C |
483 | | Some g -> |
484 | g#nodes#tolist +> List.exists (fun (xi, node) -> | |
34e49164 C |
485 | Control_flow_c.extract_is_loop node |
486 | ) | |
487 | | None -> true (* means nothing, if no g then will not model check *) | |
488 | ||
489 | ||
490 | ||
ae4735db | 491 | let sp_contain_typed_metavar_z toplevel_list_list = |
34e49164 C |
492 | let bind x y = x or y in |
493 | let option_default = false in | |
494 | let mcode _ _ = option_default in | |
495 | let donothing r k e = k e in | |
496 | ||
497 | let expression r k e = | |
498 | match Ast_cocci.unwrap e with | |
499 | | Ast_cocci.MetaExpr (_,_,_,Some t,_,_) -> true | |
500 | | Ast_cocci.MetaExpr (_,_,_,_,Ast_cocci.LocalID,_) -> true | |
ae4735db | 501 | | _ -> k e |
34e49164 C |
502 | in |
503 | ||
ae4735db | 504 | let combiner = |
34e49164 C |
505 | Visitor_ast.combiner bind option_default |
506 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
34e49164 C |
507 | donothing donothing donothing donothing |
508 | donothing expression donothing donothing donothing donothing donothing | |
ae4735db | 509 | donothing donothing donothing donothing donothing |
34e49164 | 510 | in |
ae4735db | 511 | toplevel_list_list +> |
34e49164 C |
512 | List.exists |
513 | (function (nm,_,rule) -> | |
514 | (List.exists combiner.Visitor_ast.combiner_top_level rule)) | |
34e49164 C |
515 | |
516 | let sp_contain_typed_metavar rules = | |
ae4735db | 517 | sp_contain_typed_metavar_z |
34e49164 C |
518 | (List.map |
519 | (function x -> | |
520 | match x with | |
faf9a90c | 521 | Ast_cocci.CocciRule (a,b,c,d,_) -> (a,b,c) |
34e49164 C |
522 | | _ -> failwith "error in filter") |
523 | (List.filter | |
524 | (function x -> | |
faf9a90c C |
525 | match x with |
526 | Ast_cocci.CocciRule (a,b,c,d,Ast_cocci.Normal) -> true | |
527 | | _ -> false) | |
34e49164 C |
528 | rules)) |
529 | ||
530 | ||
531 | ||
532 | (* finding among the #include the one that we need to parse | |
533 | * because they may contain useful type definition or because | |
534 | * we may have to modify them | |
ae4735db | 535 | * |
34e49164 | 536 | * For the moment we base in part our heuristic on the name of the file, e.g. |
ae4735db | 537 | * serio.c is related we think to #include <linux/serio.h> |
34e49164 | 538 | *) |
c3e37e97 C |
539 | let rec search_include_path searchlist relpath = |
540 | match searchlist with | |
541 | [] -> Some relpath | |
542 | | hd::tail -> | |
543 | let file = Filename.concat hd relpath in | |
544 | if Sys.file_exists file then | |
545 | Some file | |
546 | else | |
547 | search_include_path tail relpath | |
548 | ||
549 | let interpret_include_path relpath = | |
550 | let searchlist = | |
551 | match !Flag_cocci.include_path with | |
552 | [] -> ["include"] | |
553 | | x -> List.rev x | |
554 | in | |
555 | search_include_path searchlist relpath | |
b1b2de81 | 556 | |
faf9a90c C |
557 | let (includes_to_parse: |
558 | (Common.filename * Parse_c.program2) list -> | |
559 | Flag_cocci.include_options -> 'a) = fun xs choose_includes -> | |
560 | match choose_includes with | |
561 | Flag_cocci.I_UNSPECIFIED -> failwith "not possible" | |
562 | | Flag_cocci.I_NO_INCLUDES -> [] | |
563 | | x -> | |
b1b2de81 | 564 | let all_includes = x =*= Flag_cocci.I_ALL_INCLUDES in |
ae4735db | 565 | xs +> List.map (fun (file, cs) -> |
faf9a90c | 566 | let dir = Common.dirname file in |
ae4735db C |
567 | |
568 | cs +> Common.map_filter (fun (c,_info_item) -> | |
faf9a90c C |
569 | match c with |
570 | | Ast_c.CppTop | |
571 | (Ast_c.Include | |
ae4735db | 572 | {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) -> |
faf9a90c | 573 | (match x with |
ae4735db | 574 | | Ast_c.Local xs -> |
c3e37e97 C |
575 | let relpath = Common.join "/" xs in |
576 | let f = Filename.concat dir (relpath) in | |
34e49164 C |
577 | (* for our tests, all the files are flat in the current dir *) |
578 | if not (Sys.file_exists f) && !Flag_cocci.relax_include_path | |
579 | then | |
580 | let attempt2 = Filename.concat dir (Common.last xs) in | |
faf9a90c | 581 | if not (Sys.file_exists f) && all_includes |
c3e37e97 C |
582 | then |
583 | interpret_include_path relpath | |
34e49164 C |
584 | else Some attempt2 |
585 | else Some f | |
faf9a90c | 586 | |
ae4735db | 587 | | Ast_c.NonLocal xs -> |
c3e37e97 | 588 | let relpath = Common.join "/" xs in |
faf9a90c | 589 | if all_includes || |
b1b2de81 | 590 | Common.fileprefix (Common.last xs) =$= Common.fileprefix file |
ae4735db | 591 | then |
c3e37e97 | 592 | interpret_include_path relpath |
34e49164 | 593 | else None |
0708f913 | 594 | | Ast_c.Weird _ -> None |
34e49164 | 595 | ) |
faf9a90c C |
596 | | _ -> None)) |
597 | +> List.concat | |
598 | +> Common.uniq | |
ae4735db | 599 | |
7f004419 C |
600 | let rec interpret_dependencies local global = function |
601 | Ast_cocci.Dep s -> List.mem s local | |
34e49164 C |
602 | | Ast_cocci.AntiDep s -> |
603 | (if !Flag_ctl.steps != None | |
604 | then failwith "steps and ! dependency incompatible"); | |
7f004419 C |
605 | not (List.mem s local) |
606 | | Ast_cocci.EverDep s -> List.mem s global | |
34e49164 C |
607 | | Ast_cocci.NeverDep s -> |
608 | (if !Flag_ctl.steps != None | |
609 | then failwith "steps and ! dependency incompatible"); | |
7f004419 | 610 | not (List.mem s global) |
34e49164 | 611 | | Ast_cocci.AndDep(s1,s2) -> |
7f004419 C |
612 | (interpret_dependencies local global s1) && |
613 | (interpret_dependencies local global s2) | |
34e49164 | 614 | | Ast_cocci.OrDep(s1,s2) -> |
7f004419 C |
615 | (interpret_dependencies local global s1) or |
616 | (interpret_dependencies local global s2) | |
34e49164 | 617 | | Ast_cocci.NoDep -> true |
7f004419 | 618 | | Ast_cocci.FailDep -> false |
ae4735db | 619 | |
7f004419 | 620 | let rec print_dependencies str local global dep = |
1be43e12 C |
621 | if !Flag_cocci.show_dependencies |
622 | then | |
623 | begin | |
624 | pr2 str; | |
625 | let seen = ref [] in | |
626 | let rec loop = function | |
627 | Ast_cocci.Dep s | Ast_cocci.AntiDep s -> | |
951c7801 C |
628 | if not (List.mem s !seen) |
629 | then | |
630 | begin | |
7f004419 | 631 | if List.mem s local |
951c7801 C |
632 | then pr2 (s^" satisfied") |
633 | else pr2 (s^" not satisfied"); | |
634 | seen := s :: !seen | |
635 | end | |
1be43e12 | 636 | | Ast_cocci.EverDep s | Ast_cocci.NeverDep s -> |
951c7801 C |
637 | if not (List.mem s !seen) |
638 | then | |
639 | begin | |
7f004419 | 640 | if List.mem s global |
951c7801 C |
641 | then pr2 (s^" satisfied") |
642 | else pr2 (s^" not satisfied"); | |
643 | seen := s :: !seen | |
644 | end | |
1be43e12 C |
645 | | Ast_cocci.AndDep(s1,s2) -> |
646 | loop s1; | |
647 | loop s2 | |
648 | | Ast_cocci.OrDep(s1,s2) -> | |
649 | loop s1; | |
650 | loop s2 | |
7f004419 C |
651 | | Ast_cocci.NoDep -> () |
652 | | Ast_cocci.FailDep -> pr2 "False not satisfied" in | |
1be43e12 C |
653 | loop dep |
654 | end | |
951c7801 | 655 | |
34e49164 C |
656 | (* --------------------------------------------------------------------- *) |
657 | (* #include relative position in the file *) | |
658 | (* --------------------------------------------------------------------- *) | |
ae4735db | 659 | |
34e49164 | 660 | (* compute the set of new prefixes |
ae4735db | 661 | * on |
34e49164 C |
662 | * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *) |
663 | * "a/b/c/x"; | |
664 | * "a/x"; | |
665 | * "b/x"; | |
ae4735db | 666 | * it would give for the first element |
34e49164 C |
667 | * ""; "a"; "a/b"; "a/b/x" |
668 | * for the second | |
669 | * "a/b/c/x" | |
ae4735db | 670 | * |
34e49164 C |
671 | * update: if the include is inside a ifdef a put nothing. cf -test incl. |
672 | * this is because we dont want code added inside ifdef. | |
673 | *) | |
674 | ||
ae4735db C |
675 | let compute_new_prefixes xs = |
676 | xs +> Common.map_withenv (fun already xs -> | |
34e49164 | 677 | let subdirs_prefixes = Common.inits xs in |
ae4735db | 678 | let new_first = subdirs_prefixes +> List.filter (fun x -> |
34e49164 C |
679 | not (List.mem x already) |
680 | ) | |
681 | in | |
ae4735db | 682 | new_first, |
34e49164 C |
683 | new_first @ already |
684 | ) [] | |
685 | +> fst | |
686 | ||
687 | ||
688 | (* does via side effect on the ref in the Include in Ast_c *) | |
689 | let rec update_include_rel_pos cs = | |
ae4735db C |
690 | let only_include = cs +> Common.map_filter (fun c -> |
691 | match c with | |
485bce71 C |
692 | | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_)); |
693 | i_rel_pos = aref; | |
694 | i_is_in_ifdef = inifdef}) -> | |
34e49164 | 695 | (match x with |
0708f913 | 696 | | Ast_c.Weird _ -> None |
ae4735db C |
697 | | _ -> |
698 | if inifdef | |
34e49164 C |
699 | then None |
700 | else Some (x, aref) | |
701 | ) | |
702 | | _ -> None | |
703 | ) | |
704 | in | |
ae4735db C |
705 | let (locals, nonlocals) = |
706 | only_include +> Common.partition_either (fun (c, aref) -> | |
34e49164 C |
707 | match c with |
708 | | Ast_c.Local x -> Left (x, aref) | |
709 | | Ast_c.NonLocal x -> Right (x, aref) | |
0708f913 | 710 | | Ast_c.Weird x -> raise Impossible |
34e49164 C |
711 | ) in |
712 | ||
713 | update_rel_pos_bis locals; | |
714 | update_rel_pos_bis nonlocals; | |
715 | cs | |
ae4735db | 716 | and update_rel_pos_bis xs = |
34e49164 C |
717 | let xs' = List.map fst xs in |
718 | let the_first = compute_new_prefixes xs' in | |
719 | let the_last = List.rev (compute_new_prefixes (List.rev xs')) in | |
720 | let merged = Common.zip xs (Common.zip the_first the_last) in | |
ae4735db C |
721 | merged +> List.iter (fun ((x, aref), (the_first, the_last)) -> |
722 | aref := Some | |
723 | { | |
34e49164 C |
724 | Ast_c.first_of = the_first; |
725 | Ast_c.last_of = the_last; | |
726 | } | |
727 | ) | |
34e49164 C |
728 | |
729 | ||
730 | (*****************************************************************************) | |
731 | (* All the information needed around the C elements and Cocci rules *) | |
732 | (*****************************************************************************) | |
733 | ||
ae4735db | 734 | type toplevel_c_info = { |
34e49164 C |
735 | ast_c: Ast_c.toplevel; (* contain refs so can be modified *) |
736 | tokens_c: Parser_c.token list; | |
737 | fullstring: string; | |
738 | ||
739 | flow: Control_flow_c.cflow option; (* it's the "fixed" flow *) | |
740 | contain_loop: bool; | |
ae4735db | 741 | |
34e49164 C |
742 | env_typing_before: TAC.environment; |
743 | env_typing_after: TAC.environment; | |
744 | ||
745 | was_modified: bool ref; | |
746 | ||
747 | (* id: int *) | |
748 | } | |
749 | ||
750 | type toplevel_cocci_info_script_rule = { | |
ae4735db | 751 | scr_ast_rule: string * (string * Ast_cocci.meta_name) list * string; |
34e49164 C |
752 | language: string; |
753 | scr_dependencies: Ast_cocci.dependency; | |
754 | scr_ruleid: int; | |
755 | script_code: string; | |
756 | } | |
757 | ||
758 | type toplevel_cocci_info_cocci_rule = { | |
759 | ctl: Lib_engine.ctlcocci * (CCI.pred list list); | |
faf9a90c | 760 | metavars: Ast_cocci.metavar list; |
34e49164 C |
761 | ast_rule: Ast_cocci.rule; |
762 | isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *) | |
763 | ||
764 | rulename: string; | |
765 | dependencies: Ast_cocci.dependency; | |
766 | (* There are also some hardcoded rule names in parse_cocci.ml: | |
ae4735db | 767 | * let reserved_names = ["all";"optional_storage";"optional_qualifier"] |
34e49164 C |
768 | *) |
769 | dropped_isos: string list; | |
770 | free_vars: Ast_cocci.meta_name list; | |
771 | negated_pos_vars: Ast_cocci.meta_name list; | |
772 | used_after: Ast_cocci.meta_name list; | |
773 | positions: Ast_cocci.meta_name list; | |
774 | ||
775 | ruleid: int; | |
faf9a90c | 776 | ruletype: Ast_cocci.ruletype; |
34e49164 C |
777 | |
778 | was_matched: bool ref; | |
779 | } | |
780 | ||
ae4735db | 781 | type toplevel_cocci_info = |
34e49164 | 782 | ScriptRuleCocciInfo of toplevel_cocci_info_script_rule |
b1b2de81 C |
783 | | InitialScriptRuleCocciInfo of toplevel_cocci_info_script_rule |
784 | | FinalScriptRuleCocciInfo of toplevel_cocci_info_script_rule | |
34e49164 C |
785 | | CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule |
786 | ||
7f004419 | 787 | type cocci_info = toplevel_cocci_info list * string list list (* tokens *) |
b1b2de81 | 788 | |
ae4735db C |
789 | type kind_file = Header | Source |
790 | type file_info = { | |
34e49164 C |
791 | fname : string; |
792 | full_fname : string; | |
793 | was_modified_once: bool ref; | |
794 | asts: toplevel_c_info list; | |
795 | fpath : string; | |
796 | fkind : kind_file; | |
797 | } | |
798 | ||
ae4735db | 799 | let g_contain_typedmetavar = ref false |
34e49164 C |
800 | |
801 | ||
802 | let last_env_toplevel_c_info xs = | |
803 | (Common.last xs).env_typing_after | |
804 | ||
ae4735db C |
805 | let concat_headers_and_c (ccs: file_info list) |
806 | : (toplevel_c_info * string) list = | |
807 | (List.concat (ccs +> List.map (fun x -> | |
485bce71 C |
808 | x.asts +> List.map (fun x' -> |
809 | (x', x.fname))))) | |
34e49164 | 810 | |
ae4735db C |
811 | let for_unparser xs = |
812 | xs +> List.map (fun x -> | |
485bce71 | 813 | (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr |
34e49164 C |
814 | ) |
815 | ||
485bce71 | 816 | let gen_pdf_graph () = |
ae4735db | 817 | (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile -> |
485bce71 C |
818 | Printf.printf "Generation of %s%!" outfile; |
819 | let filename_stack = Ctl_engine.get_graph_comp_files outfile in | |
820 | List.iter (fun filename -> | |
821 | ignore (Unix.system ("dot " ^ filename ^ " -Tpdf -o " ^ filename ^ ".pdf;")) | |
822 | ) filename_stack; | |
823 | let (head,tail) = (List.hd filename_stack, List.tl filename_stack) in | |
824 | ignore(Unix.system ("cp " ^ head ^ ".pdf " ^ outfile ^ ".pdf;")); | |
825 | tail +> List.iter (fun filename -> | |
826 | ignore(Unix.system ("mv " ^ outfile ^ ".pdf /tmp/tmp.pdf;")); | |
827 | ignore(Unix.system ("pdftk " ^ filename ^ ".pdf /tmp/tmp.pdf cat output " ^ outfile ^ ".pdf")); | |
828 | ); | |
829 | ignore(Unix.system ("rm /tmp/tmp.pdf;")); | |
830 | List.iter (fun filename -> | |
831 | ignore (Unix.system ("rm " ^ filename ^ " " ^ filename ^ ".pdf;")) | |
832 | ) filename_stack; | |
833 | Printf.printf " - Done\n") | |
834 | ||
ae4735db C |
835 | let local_python_code = |
836 | "from coccinelle import *\n" | |
837 | ||
838 | let python_code = | |
839 | "import coccinelle\n"^ | |
840 | "import coccilib\n"^ | |
841 | "import coccilib.org\n"^ | |
842 | "import coccilib.report\n" ^ | |
843 | local_python_code ^ | |
844 | "cocci = Cocci()\n" | |
845 | ||
c3e37e97 | 846 | let make_init rulenb lang deps code = |
ae4735db | 847 | let mv = [] in |
c3e37e97 C |
848 | { |
849 | scr_ast_rule = (lang, mv, code); | |
850 | language = lang; | |
851 | scr_dependencies = deps; | |
852 | scr_ruleid = rulenb; | |
853 | script_code = (if lang = "python" then python_code else "") ^code | |
854 | } | |
485bce71 | 855 | |
34e49164 C |
856 | (* --------------------------------------------------------------------- *) |
857 | let prepare_cocci ctls free_var_lists negated_pos_lists | |
951c7801 | 858 | (ua,fua,fuas) positions_list metavars astcocci = |
34e49164 C |
859 | |
860 | let gathered = Common.index_list_1 | |
978fd7e5 C |
861 | (zip (zip (zip (zip (zip (zip (zip (zip ctls metavars) astcocci) |
862 | free_var_lists) | |
863 | negated_pos_lists) ua) fua) fuas) positions_list) | |
34e49164 | 864 | in |
ae4735db | 865 | gathered +> List.map |
978fd7e5 | 866 | (fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list), |
ae4735db C |
867 | negated_pos_list),ua),fua),fuas),positions_list),rulenb) -> |
868 | ||
34e49164 | 869 | let is_script_rule r = |
b1b2de81 C |
870 | match r with |
871 | Ast_cocci.ScriptRule _ | |
872 | | Ast_cocci.InitialScriptRule _ | Ast_cocci.FinalScriptRule _ -> true | |
873 | | _ -> false in | |
34e49164 | 874 | |
b1b2de81 | 875 | if not (List.length ctl_toplevel_list =|= 1) && not (is_script_rule ast) |
34e49164 C |
876 | then failwith "not handling multiple minirules"; |
877 | ||
878 | match ast with | |
879 | Ast_cocci.ScriptRule (lang,deps,mv,code) -> | |
ae4735db | 880 | let r = |
34e49164 C |
881 | { |
882 | scr_ast_rule = (lang, mv, code); | |
883 | language = lang; | |
884 | scr_dependencies = deps; | |
885 | scr_ruleid = rulenb; | |
886 | script_code = code; | |
887 | } | |
888 | in ScriptRuleCocciInfo r | |
c3e37e97 C |
889 | | Ast_cocci.InitialScriptRule (lang,deps,code) -> |
890 | let r = make_init rulenb lang deps code in | |
ae4735db | 891 | InitialScriptRuleCocciInfo r |
c3e37e97 | 892 | | Ast_cocci.FinalScriptRule (lang,deps,code) -> |
b1b2de81 | 893 | let mv = [] in |
b1b2de81 C |
894 | let r = |
895 | { | |
896 | scr_ast_rule = (lang, mv, code); | |
897 | language = lang; | |
898 | scr_dependencies = deps; | |
899 | scr_ruleid = rulenb; | |
900 | script_code = code; | |
901 | } | |
902 | in FinalScriptRuleCocciInfo r | |
34e49164 | 903 | | Ast_cocci.CocciRule |
faf9a90c | 904 | (rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) -> |
34e49164 C |
905 | CocciRuleCocciInfo ( |
906 | { | |
907 | ctl = List.hd ctl_toplevel_list; | |
faf9a90c | 908 | metavars = metavars; |
34e49164 C |
909 | ast_rule = ast; |
910 | isexp = List.hd isexp; | |
911 | rulename = rulename; | |
912 | dependencies = dependencies; | |
913 | dropped_isos = dropped_isos; | |
914 | free_vars = List.hd free_var_list; | |
915 | negated_pos_vars = List.hd negated_pos_list; | |
978fd7e5 | 916 | used_after = (List.hd ua) @ (List.hd fua); |
34e49164 C |
917 | positions = List.hd positions_list; |
918 | ruleid = rulenb; | |
faf9a90c | 919 | ruletype = ruletype; |
34e49164 C |
920 | was_matched = ref false; |
921 | }) | |
922 | ) | |
923 | ||
924 | ||
925 | (* --------------------------------------------------------------------- *) | |
926 | ||
ae4735db C |
927 | let build_info_program cprogram env = |
928 | ||
929 | let (cs, parseinfos) = | |
0708f913 C |
930 | Common.unzip cprogram in |
931 | ||
ae4735db | 932 | let alltoks = |
0708f913 | 933 | parseinfos +> List.map (fun (s,toks) -> toks) +> List.flatten in |
34e49164 | 934 | |
0708f913 | 935 | (* I use cs' but really annotate_xxx work by doing side effects on cs *) |
ae4735db | 936 | let cs' = |
0708f913 | 937 | Comment_annotater_c.annotate_program alltoks cs in |
ae4735db | 938 | let cs_with_envs = |
0708f913 C |
939 | Type_annoter_c.annotate_program env (*!g_contain_typedmetavar*) cs' |
940 | in | |
ae4735db | 941 | |
0708f913 | 942 | zip cs_with_envs parseinfos +> List.map (fun ((c, (enva,envb)), parseinfo)-> |
34e49164 C |
943 | let (fullstr, tokens) = parseinfo in |
944 | ||
ae4735db | 945 | let flow = |
951c7801 | 946 | ast_to_flow_with_error_messages c +> |
ae4735db | 947 | Common.map_option (fun flow -> |
34e49164 C |
948 | let flow = Ast_to_flow.annotate_loop_nodes flow in |
949 | ||
950 | (* remove the fake nodes for julia *) | |
951 | let fixed_flow = CCI.fix_flow_ctl flow in | |
952 | ||
953 | if !Flag_cocci.show_flow then print_flow fixed_flow; | |
954 | if !Flag_cocci.show_before_fixed_flow then print_flow flow; | |
955 | ||
956 | fixed_flow | |
957 | ) | |
958 | in | |
959 | ||
960 | { | |
961 | ast_c = c; (* contain refs so can be modified *) | |
962 | tokens_c = tokens; | |
963 | fullstring = fullstr; | |
964 | ||
965 | flow = flow; | |
966 | ||
967 | contain_loop = contain_loop flow; | |
ae4735db | 968 | |
34e49164 C |
969 | env_typing_before = enva; |
970 | env_typing_after = envb; | |
971 | ||
972 | was_modified = ref false; | |
973 | } | |
974 | ) | |
975 | ||
976 | ||
977 | ||
978 | (* Optimisation. Try not unparse/reparse the whole file when have modifs *) | |
ae4735db | 979 | let rebuild_info_program cs file isexp = |
34e49164 C |
980 | cs +> List.map (fun c -> |
981 | if !(c.was_modified) | |
982 | then | |
faf9a90c | 983 | let file = Common.new_temp_file "cocci_small_output" ".c" in |
ae4735db C |
984 | cfile_of_program |
985 | [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal] | |
faf9a90c | 986 | file; |
ae4735db | 987 | |
faf9a90c C |
988 | (* Common.command2 ("cat " ^ file); *) |
989 | let cprogram = cprogram_of_file file in | |
990 | let xs = build_info_program cprogram c.env_typing_before in | |
ae4735db | 991 | |
faf9a90c C |
992 | (* TODO: assert env has not changed, |
993 | * if yes then must also reparse what follows even if not modified. | |
994 | * Do that only if contain_typedmetavar of course, so good opti. | |
995 | *) | |
996 | (* Common.list_init xs *) (* get rid of the FinalDef *) | |
997 | xs | |
34e49164 C |
998 | else [c] |
999 | ) +> List.concat | |
1000 | ||
1001 | ||
1002 | let rebuild_info_c_and_headers ccs isexp = | |
ae4735db | 1003 | ccs +> List.iter (fun c_or_h -> |
34e49164 C |
1004 | if c_or_h.asts +> List.exists (fun c -> !(c.was_modified)) |
1005 | then c_or_h.was_modified_once := true; | |
1006 | ); | |
ae4735db | 1007 | ccs +> List.map (fun c_or_h -> |
34e49164 | 1008 | { c_or_h with |
951c7801 C |
1009 | asts = |
1010 | rebuild_info_program c_or_h.asts c_or_h.full_fname isexp } | |
34e49164 C |
1011 | ) |
1012 | ||
1013 | ||
1014 | ||
ae4735db | 1015 | let prepare_c files choose_includes : file_info list = |
34e49164 | 1016 | let cprograms = List.map cprogram_of_file_cached files in |
faf9a90c | 1017 | let includes = includes_to_parse (zip files cprograms) choose_includes in |
34e49164 C |
1018 | |
1019 | (* todo?: may not be good to first have all the headers and then all the c *) | |
ae4735db | 1020 | let all = |
34e49164 C |
1021 | (includes +> List.map (fun hpath -> Right hpath)) |
1022 | ++ | |
c3e37e97 C |
1023 | ((zip files cprograms) +> |
1024 | List.map (fun (file, asts) -> Left (file, asts))) | |
34e49164 C |
1025 | in |
1026 | ||
91eba41f | 1027 | let env = ref !TAC.initial_env in |
34e49164 | 1028 | |
ae4735db C |
1029 | let ccs = all +> Common.map_filter (fun x -> |
1030 | match x with | |
1031 | | Right hpath -> | |
1032 | if not (Common.lfile_exists hpath) | |
1033 | then begin | |
1034 | pr2 ("TYPE: header " ^ hpath ^ " not found"); | |
1035 | None | |
34e49164 | 1036 | end |
ae4735db | 1037 | else |
34e49164 C |
1038 | let h_cs = cprogram_of_file_cached hpath in |
1039 | let info_h_cs = build_info_program h_cs !env in | |
ae4735db | 1040 | env := |
34e49164 C |
1041 | if null info_h_cs |
1042 | then !env | |
1043 | else last_env_toplevel_c_info info_h_cs | |
1044 | ; | |
ae4735db | 1045 | Some { |
34e49164 C |
1046 | fname = Common.basename hpath; |
1047 | full_fname = hpath; | |
1048 | asts = info_h_cs; | |
1049 | was_modified_once = ref false; | |
1050 | fpath = hpath; | |
1051 | fkind = Header; | |
1052 | } | |
ae4735db | 1053 | | Left (file, cprogram) -> |
34e49164 C |
1054 | (* todo?: don't update env ? *) |
1055 | let cs = build_info_program cprogram !env in | |
1056 | (* we do that only for the c, not for the h *) | |
1057 | ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c))); | |
ae4735db | 1058 | Some { |
34e49164 C |
1059 | fname = Common.basename file; |
1060 | full_fname = file; | |
1061 | asts = cs; | |
1062 | was_modified_once = ref false; | |
1063 | fpath = file; | |
1064 | fkind = Source; | |
1065 | } | |
ae4735db | 1066 | ) |
34e49164 | 1067 | in |
ae4735db | 1068 | ccs |
34e49164 C |
1069 | |
1070 | ||
1071 | (*****************************************************************************) | |
1072 | (* Processing the ctls and toplevel C elements *) | |
1073 | (*****************************************************************************) | |
1074 | ||
1075 | (* The main algorithm =~ | |
ae4735db | 1076 | * The algorithm is roughly: |
34e49164 C |
1077 | * for_all ctl rules in SP |
1078 | * for_all minirule in rule (no more) | |
1079 | * for_all binding (computed during previous phase) | |
1080 | * for_all C elements | |
ae4735db C |
1081 | * match control flow of function vs minirule |
1082 | * with the binding and update the set of possible | |
34e49164 C |
1083 | * bindings, and returned the possibly modified function. |
1084 | * pretty print modified C elements and reparse it. | |
1085 | * | |
ae4735db | 1086 | * |
34e49164 C |
1087 | * On ne prends que les newbinding ou returned_any_state est vrai. |
1088 | * Si ca ne donne rien, on prends ce qu'il y avait au depart. | |
ae4735db | 1089 | * Mais au nouveau depart de quoi ? |
34e49164 | 1090 | * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ? |
ae4735db | 1091 | * - ou alors si ca donne rien, apres avoir traité toutes les fonctions |
34e49164 | 1092 | * avec tous les bindings du round d'avant ? |
ae4735db | 1093 | * |
34e49164 C |
1094 | * Julia pense qu'il faut prendre la premiere solution. |
1095 | * Example: on a deux environnements candidats, E1 et E2 apres avoir traité | |
1096 | * la regle ctl 1. On arrive sur la regle ctl 2. | |
1097 | * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3. | |
1098 | * E2 donne un match a un endroit et rend E2' alors on utilise ca pour | |
1099 | * la regle 3. | |
ae4735db | 1100 | * |
34e49164 C |
1101 | * I have not to look at used_after_list to decide to restart from |
1102 | * scratch. I just need to look if the binding list is empty. | |
1103 | * Indeed, let's suppose that a SP have 3 regions/rules. If we | |
1104 | * don't find a match for the first region, then if this first | |
1105 | * region does not bind metavariable used after, that is if | |
1106 | * used_after_list is empty, then mysat(), even if does not find a | |
1107 | * match, will return a Left, with an empty transformation_info, | |
1108 | * and so current_binding will grow. On the contrary if the first | |
1109 | * region must bind some metavariables used after, and that we | |
1110 | * dont find any such region, then mysat() will returns lots of | |
1111 | * Right, and current_binding will not grow, and so we will have | |
ae4735db | 1112 | * an empty list of binding, and we will catch such a case. |
34e49164 C |
1113 | * |
1114 | * opti: julia says that because the binding is | |
1115 | * determined by the used_after_list, the items in the list | |
1116 | * are kind of sorted, so could optimise the insert_set operations. | |
1117 | *) | |
1118 | ||
1119 | ||
1120 | (* r(ule), c(element in C code), e(nvironment) *) | |
1121 | ||
708f4980 C |
1122 | let findk f l = |
1123 | let rec loop k = function | |
1124 | [] -> None | |
1125 | | x::xs -> | |
1126 | if f x | |
1127 | then Some (x, function n -> k (n :: xs)) | |
1128 | else loop (function vs -> k (x :: vs)) xs in | |
1129 | loop (function x -> x) l | |
1130 | ||
b1b2de81 | 1131 | let merge_env new_e old_e = |
708f4980 C |
1132 | let (ext,old_e) = |
1133 | List.fold_left | |
1134 | (function (ext,old_e) -> | |
1135 | function (e,rules) as elem -> | |
1136 | match findk (function (e1,_) -> e =*= e1) old_e with | |
1137 | None -> (elem :: ext,old_e) | |
1138 | | Some((_,old_rules),k) -> | |
1139 | (ext,k (e,Common.union_set rules old_rules))) | |
1140 | ([],old_e) new_e in | |
1141 | old_e @ (List.rev ext) | |
b1b2de81 C |
1142 | |
1143 | let apply_python_rule r cache newes e rules_that_have_matched | |
7f004419 | 1144 | rules_that_have_ever_matched = |
951c7801 | 1145 | Common.profile_code "python" (fun () -> |
34e49164 C |
1146 | show_or_not_scr_rule_name r.scr_ruleid; |
1147 | if not(interpret_dependencies rules_that_have_matched | |
7f004419 | 1148 | !rules_that_have_ever_matched r.scr_dependencies) |
34e49164 C |
1149 | then |
1150 | begin | |
1be43e12 C |
1151 | print_dependencies "dependencies for script not satisfied:" |
1152 | rules_that_have_matched | |
7f004419 | 1153 | !rules_that_have_ever_matched r.scr_dependencies; |
1be43e12 | 1154 | show_or_not_binding "in environment" e; |
34e49164 C |
1155 | (cache, (e, rules_that_have_matched)::newes) |
1156 | end | |
1157 | else | |
1158 | begin | |
1159 | let (_, mv, _) = r.scr_ast_rule in | |
ae4735db C |
1160 | let ve = |
1161 | (List.map (function (n,v) -> (("virtual",n),Ast_c.MetaIdVal v)) | |
1162 | !Flag.defined_virtual_env) @ e in | |
1163 | let not_bound x = not (Pycocci.contains_binding ve x) in | |
978fd7e5 C |
1164 | (match List.filter not_bound mv with |
1165 | [] -> | |
34e49164 C |
1166 | let relevant_bindings = |
1167 | List.filter | |
1168 | (function ((re,rm),_) -> | |
ae4735db | 1169 | List.exists (function (_,(r,m)) -> r =*= re && m =$= rm) mv) |
34e49164 C |
1170 | e in |
1171 | let new_cache = | |
1172 | if List.mem relevant_bindings cache | |
951c7801 C |
1173 | then |
1174 | begin | |
1175 | print_dependencies | |
1176 | "dependencies for script satisfied, but cached:" | |
1177 | rules_that_have_matched | |
7f004419 | 1178 | !rules_that_have_ever_matched |
951c7801 C |
1179 | r.scr_dependencies; |
1180 | show_or_not_binding "in" e; | |
1181 | cache | |
1182 | end | |
34e49164 C |
1183 | else |
1184 | begin | |
1be43e12 C |
1185 | print_dependencies "dependencies for script satisfied:" |
1186 | rules_that_have_matched | |
7f004419 | 1187 | !rules_that_have_ever_matched |
951c7801 | 1188 | r.scr_dependencies; |
1be43e12 | 1189 | show_or_not_binding "in" e; |
ae4735db C |
1190 | Pycocci.build_classes (List.map (function (x,y) -> x) ve); |
1191 | Pycocci.construct_variables mv ve; | |
c3e37e97 C |
1192 | let _ = |
1193 | Pycocci.pyrun_simplestring | |
1194 | (local_python_code ^r.script_code) in | |
34e49164 C |
1195 | relevant_bindings :: cache |
1196 | end in | |
1197 | if !Pycocci.inc_match | |
1be43e12 | 1198 | then (new_cache, merge_env [(e, rules_that_have_matched)] newes) |
34e49164 | 1199 | else (new_cache, newes) |
978fd7e5 C |
1200 | | unbound -> |
1201 | (if !Flag_cocci.show_dependencies | |
1202 | then | |
1203 | let m2c (_,(r,x)) = r^"."^x in | |
1204 | pr2 (Printf.sprintf "script not applied: %s not bound" | |
1205 | (String.concat ", " (List.map m2c unbound)))); | |
1206 | (cache, merge_env [(e, rules_that_have_matched)] newes)) | |
fc1ad971 | 1207 | end) |
34e49164 | 1208 | |
7f004419 | 1209 | let rec apply_cocci_rule r rules_that_have_ever_matched es |
b1b2de81 | 1210 | (ccs:file_info list ref) = |
ae4735db | 1211 | Common.profile_code r.rulename (fun () -> |
34e49164 C |
1212 | show_or_not_rule_name r.ast_rule r.ruleid; |
1213 | show_or_not_ctl_text r.ctl r.ast_rule r.ruleid; | |
1214 | ||
1215 | let reorganized_env = | |
1216 | reassociate_positions r.free_vars r.negated_pos_vars !es in | |
1217 | ||
1218 | (* looping over the environments *) | |
1219 | let (_,newes (* envs for next round/rule *)) = | |
1220 | List.fold_left | |
1221 | (function (cache,newes) -> | |
1222 | function ((e,rules_that_have_matched),relevant_bindings) -> | |
1223 | if not(interpret_dependencies rules_that_have_matched | |
7f004419 | 1224 | !rules_that_have_ever_matched |
951c7801 | 1225 | r.dependencies) |
34e49164 C |
1226 | then |
1227 | begin | |
1be43e12 C |
1228 | print_dependencies |
1229 | ("dependencies for rule "^r.rulename^" not satisfied:") | |
1230 | rules_that_have_matched | |
7f004419 | 1231 | !rules_that_have_ever_matched r.dependencies; |
1be43e12 | 1232 | show_or_not_binding "in environment" e; |
34e49164 | 1233 | (cache, |
1be43e12 | 1234 | merge_env |
34e49164 | 1235 | [(e +> List.filter (fun (s,v) -> List.mem s r.used_after), |
1be43e12 C |
1236 | rules_that_have_matched)] |
1237 | newes) | |
34e49164 C |
1238 | end |
1239 | else | |
1240 | let new_bindings = | |
1241 | try List.assoc relevant_bindings cache | |
1242 | with | |
1243 | Not_found -> | |
1be43e12 C |
1244 | print_dependencies |
1245 | ("dependencies for rule "^r.rulename^" satisfied:") | |
1246 | rules_that_have_matched | |
7f004419 | 1247 | !rules_that_have_ever_matched |
951c7801 | 1248 | r.dependencies; |
1be43e12 C |
1249 | show_or_not_binding "in" e; |
1250 | show_or_not_binding "relevant in" relevant_bindings; | |
34e49164 | 1251 | |
faf9a90c C |
1252 | (* applying the rule *) |
1253 | (match r.ruletype with | |
1254 | Ast_cocci.Normal -> | |
34e49164 C |
1255 | (* looping over the functions and toplevel elements in |
1256 | .c and .h *) | |
708f4980 C |
1257 | List.rev |
1258 | (concat_headers_and_c !ccs +> | |
ae4735db C |
1259 | List.fold_left (fun children_e (c,f) -> |
1260 | if c.flow <> None | |
708f4980 C |
1261 | then |
1262 | (* does also some side effects on c and r *) | |
1263 | let processed = | |
1264 | process_a_ctl_a_env_a_toplevel r | |
1265 | relevant_bindings c f in | |
1266 | match processed with | |
1267 | | None -> children_e | |
ae4735db | 1268 | | Some newbindings -> |
708f4980 C |
1269 | newbindings +> |
1270 | List.fold_left | |
ae4735db | 1271 | (fun children_e newbinding -> |
708f4980 C |
1272 | if List.mem newbinding children_e |
1273 | then children_e | |
1274 | else newbinding :: children_e) | |
1275 | children_e | |
1276 | else children_e) | |
1277 | []) | |
faf9a90c C |
1278 | | Ast_cocci.Generated -> |
1279 | process_a_generated_a_env_a_toplevel r | |
1280 | relevant_bindings !ccs; | |
1281 | []) in | |
1282 | ||
34e49164 C |
1283 | let old_bindings_to_keep = |
1284 | Common.nub | |
1285 | (e +> List.filter (fun (s,v) -> List.mem s r.used_after)) in | |
1286 | let new_e = | |
1287 | if null new_bindings | |
1288 | then | |
1289 | begin | |
1290 | (*use the old bindings, specialized to the used_after_list*) | |
1291 | if !Flag_ctl.partial_match | |
1292 | then | |
1293 | printf | |
7f004419 | 1294 | "Empty list of bindings, I will restart from old env\n"; |
34e49164 C |
1295 | [(old_bindings_to_keep,rules_that_have_matched)] |
1296 | end | |
1297 | else | |
1298 | (* combine the new bindings with the old ones, and | |
1299 | specialize to the used_after_list *) | |
1300 | let old_variables = List.map fst old_bindings_to_keep in | |
1301 | (* have to explicitly discard the inherited variables | |
1302 | because we want the inherited value of the positions | |
1303 | variables not the extended one created by | |
1304 | reassociate_positions. want to reassociate freshly | |
1305 | according to the free variables of each rule. *) | |
1306 | let new_bindings_to_add = | |
1307 | Common.nub | |
1308 | (new_bindings +> | |
1309 | List.map | |
1310 | (List.filter | |
1311 | (fun (s,v) -> | |
1312 | List.mem s r.used_after && | |
1313 | not (List.mem s old_variables)))) in | |
1314 | List.map | |
1315 | (function new_binding_to_add -> | |
1be43e12 C |
1316 | (List.sort compare |
1317 | (Common.union_set | |
1318 | old_bindings_to_keep new_binding_to_add), | |
34e49164 C |
1319 | r.rulename::rules_that_have_matched)) |
1320 | new_bindings_to_add in | |
1321 | ((relevant_bindings,new_bindings)::cache, | |
1be43e12 | 1322 | merge_env new_e newes)) |
34e49164 C |
1323 | ([],[]) reorganized_env in (* end iter es *) |
1324 | if !(r.was_matched) | |
1325 | then Common.push2 r.rulename rules_that_have_ever_matched; | |
1326 | ||
1327 | es := newes; | |
1328 | ||
1329 | (* apply the tagged modifs and reparse *) | |
1330 | if not !Flag.sgrep_mode2 | |
b1b2de81 | 1331 | then ccs := rebuild_info_c_and_headers !ccs r.isexp) |
34e49164 C |
1332 | |
1333 | and reassociate_positions free_vars negated_pos_vars envs = | |
1334 | (* issues: isolate the bindings that are relevant to a given rule. | |
1335 | separate out the position variables | |
1336 | associate all of the position variables for a given set of relevant | |
1337 | normal variable bindings with each set of relevant normal variable | |
1338 | bindings. Goal: if eg if@p (E) matches in two places, then both inherited | |
1339 | occurrences of E should see both bindings of p, not just its own. | |
1340 | Otherwise, a position constraint for something that matches in two | |
1341 | places will never be useful, because the position can always be | |
1342 | different from the other one. *) | |
1343 | let relevant = | |
1344 | List.map | |
1345 | (function (e,_) -> | |
1346 | List.filter (function (x,_) -> List.mem x free_vars) e) | |
1347 | envs in | |
1348 | let splitted_relevant = | |
1349 | (* separate the relevant variables into the non-position ones and the | |
1350 | position ones *) | |
1351 | List.map | |
1352 | (function r -> | |
1353 | List.fold_left | |
1354 | (function (non_pos,pos) -> | |
1355 | function (v,_) as x -> | |
1356 | if List.mem v negated_pos_vars | |
1357 | then (non_pos,x::pos) | |
1358 | else (x::non_pos,pos)) | |
1359 | ([],[]) r) | |
1360 | relevant in | |
1361 | let splitted_relevant = | |
1362 | List.map | |
1363 | (function (non_pos,pos) -> | |
1364 | (List.sort compare non_pos,List.sort compare pos)) | |
1365 | splitted_relevant in | |
1366 | let non_poss = | |
1367 | List.fold_left | |
1368 | (function non_pos -> | |
1369 | function (np,_) -> | |
1370 | if List.mem np non_pos then non_pos else np::non_pos) | |
1371 | [] splitted_relevant in | |
1372 | let extended_relevant = | |
1373 | (* extend the position variables with the values found at other identical | |
1374 | variable bindings *) | |
1375 | List.map | |
1376 | (function non_pos -> | |
1377 | let others = | |
1378 | List.filter | |
1379 | (function (other_non_pos,other_pos) -> | |
1380 | (* do we want equal? or just somehow compatible? eg non_pos | |
1381 | binds only E, but other_non_pos binds both E and E1 *) | |
b1b2de81 | 1382 | non_pos =*= other_non_pos) |
34e49164 C |
1383 | splitted_relevant in |
1384 | (non_pos, | |
1385 | List.sort compare | |
1386 | (non_pos @ | |
1387 | (combine_pos negated_pos_vars | |
1388 | (List.map (function (_,x) -> x) others))))) | |
1389 | non_poss in | |
1390 | List.combine envs | |
1391 | (List.map (function (non_pos,_) -> List.assoc non_pos extended_relevant) | |
1392 | splitted_relevant) | |
1393 | ||
1394 | and combine_pos negated_pos_vars others = | |
1395 | List.map | |
1396 | (function posvar -> | |
1397 | (posvar, | |
1398 | Ast_c.MetaPosValList | |
1399 | (List.sort compare | |
1400 | (List.fold_left | |
1401 | (function positions -> | |
1402 | function other_list -> | |
1403 | try | |
1404 | match List.assoc posvar other_list with | |
1405 | Ast_c.MetaPosValList l1 -> | |
1406 | Common.union_set l1 positions | |
1407 | | _ -> failwith "bad value for a position variable" | |
1408 | with Not_found -> positions) | |
1409 | [] others)))) | |
1410 | negated_pos_vars | |
1411 | ||
b1b2de81 C |
1412 | and process_a_generated_a_env_a_toplevel2 r env = function |
1413 | [cfile] -> | |
1414 | let free_vars = | |
1415 | List.filter | |
1416 | (function | |
1417 | (rule,_) when rule =$= r.rulename -> false | |
1418 | | (_,"ARGS") -> false | |
1419 | | _ -> true) | |
1420 | r.free_vars in | |
1421 | let env_domain = List.map (function (nm,vl) -> nm) env in | |
1422 | let metavars = | |
1423 | List.filter | |
1424 | (function md -> | |
ae4735db | 1425 | let (rl,_) = Ast_cocci.get_meta_name md in rl =$= r.rulename) |
b1b2de81 C |
1426 | r.metavars in |
1427 | if Common.include_set free_vars env_domain | |
1428 | then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname | |
1429 | | _ -> failwith "multiple files not supported" | |
34e49164 | 1430 | |
ae4735db C |
1431 | and process_a_generated_a_env_a_toplevel rule env ccs = |
1432 | Common.profile_code "process_a_ctl_a_env_a_toplevel" | |
b1b2de81 | 1433 | (fun () -> process_a_generated_a_env_a_toplevel2 rule env ccs) |
34e49164 C |
1434 | |
1435 | (* does side effects on C ast and on Cocci info rule *) | |
ae4735db C |
1436 | and process_a_ctl_a_env_a_toplevel2 r e c f = |
1437 | indent_do (fun () -> | |
34e49164 | 1438 | show_or_not_celem "trying" c.ast_c; |
485bce71 | 1439 | Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c); |
ae4735db C |
1440 | let (trans_info, returned_any_states, inherited_bindings, newbindings) = |
1441 | Common.save_excursion Flag_ctl.loop_in_src_code (fun () -> | |
34e49164 | 1442 | Flag_ctl.loop_in_src_code := !Flag_ctl.loop_in_src_code||c.contain_loop; |
ae4735db | 1443 | |
34e49164 C |
1444 | (***************************************) |
1445 | (* !Main point! The call to the engine *) | |
1446 | (***************************************) | |
1447 | let model_ctl = CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e | |
1448 | in CCI.mysat model_ctl r.ctl (r.used_after, e) | |
ae4735db | 1449 | ) |
34e49164 | 1450 | in |
ae4735db | 1451 | if not returned_any_states |
34e49164 C |
1452 | then None |
1453 | else begin | |
1454 | show_or_not_celem "found match in" c.ast_c; | |
1455 | show_or_not_trans_info trans_info; | |
ae4735db | 1456 | List.iter (show_or_not_binding "out") newbindings; |
34e49164 C |
1457 | |
1458 | r.was_matched := true; | |
1459 | ||
1460 | if not (null trans_info) | |
1461 | then begin | |
1462 | c.was_modified := true; | |
ae4735db | 1463 | try |
34e49164 C |
1464 | (* les "more than one var in a decl" et "already tagged token" |
1465 | * font crasher coccinelle. Si on a 5 fichiers, donc on a 5 | |
1466 | * failed. Le try limite le scope des crashes pendant la | |
1467 | * trasformation au fichier concerne. *) | |
1468 | ||
1469 | (* modify ast via side effect *) | |
485bce71 | 1470 | ignore(Transformation_c.transform r.rulename r.dropped_isos |
1be43e12 | 1471 | inherited_bindings trans_info (Common.some c.flow)); |
34e49164 C |
1472 | with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i) |
1473 | end; | |
1474 | ||
1be43e12 | 1475 | Some (List.map (function x -> x@inherited_bindings) newbindings) |
34e49164 C |
1476 | end |
1477 | ) | |
ae4735db C |
1478 | |
1479 | and process_a_ctl_a_env_a_toplevel a b c f= | |
1480 | Common.profile_code "process_a_ctl_a_env_a_toplevel" | |
485bce71 | 1481 | (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f) |
faf9a90c | 1482 | |
34e49164 | 1483 | |
7f004419 C |
1484 | let rec bigloop2 rs (ccs: file_info list) = |
1485 | let init_es = [(Ast_c.emptyMetavarsBinding,[])] in | |
1486 | let es = ref init_es in | |
b1b2de81 C |
1487 | let ccs = ref ccs in |
1488 | let rules_that_have_ever_matched = ref [] in | |
1489 | ||
1490 | (* looping over the rules *) | |
ae4735db | 1491 | rs +> List.iter (fun r -> |
b1b2de81 C |
1492 | match r with |
1493 | InitialScriptRuleCocciInfo r | FinalScriptRuleCocciInfo r -> () | |
ae4735db | 1494 | | ScriptRuleCocciInfo r -> |
b1b2de81 C |
1495 | if !Flag_cocci.show_ctl_text then begin |
1496 | Common.pr_xxxxxxxxxxxxxxxxx (); | |
1497 | pr ("script: " ^ r.language); | |
1498 | Common.pr_xxxxxxxxxxxxxxxxx (); | |
ae4735db C |
1499 | |
1500 | adjust_pp_with_indent (fun () -> | |
b1b2de81 C |
1501 | Format.force_newline(); |
1502 | let (l,mv,code) = r.scr_ast_rule in | |
1503 | let deps = r.scr_dependencies in | |
1504 | Pretty_print_cocci.unparse | |
1505 | (Ast_cocci.ScriptRule (l,deps,mv,code))); | |
1506 | end; | |
1507 | ||
1508 | if !Flag.show_misc then print_endline "RESULT ="; | |
1509 | ||
1510 | let (_, newes) = | |
1511 | List.fold_left | |
1512 | (function (cache, newes) -> | |
1513 | function (e, rules_that_have_matched) -> | |
1514 | match r.language with | |
1515 | "python" -> | |
1516 | apply_python_rule r cache newes e rules_that_have_matched | |
7f004419 | 1517 | rules_that_have_ever_matched |
b1b2de81 | 1518 | | "test" -> |
ae4735db C |
1519 | concat_headers_and_c !ccs +> List.iter (fun (c,_) -> |
1520 | if c.flow <> None | |
b1b2de81 C |
1521 | then |
1522 | Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring); | |
1523 | (cache, newes) | |
1524 | | _ -> | |
1525 | Printf.printf "Unknown language: %s\n" r.language; | |
1526 | (cache, newes) | |
1527 | ) | |
1528 | ([],[]) !es in | |
1529 | ||
7f004419 | 1530 | es := (if newes = [] then init_es else newes); |
b1b2de81 | 1531 | | CocciRuleCocciInfo r -> |
7f004419 | 1532 | apply_cocci_rule r rules_that_have_ever_matched |
951c7801 | 1533 | es ccs); |
b1b2de81 C |
1534 | |
1535 | if !Flag.sgrep_mode2 | |
1536 | then begin | |
1537 | (* sgrep can lead to code that is not parsable, but we must | |
ae4735db | 1538 | * still call rebuild_info_c_and_headers to pretty print the |
b1b2de81 C |
1539 | * action (MINUS), so that later the diff will show what was |
1540 | * matched by sgrep. But we don't want the parsing error message | |
1541 | * hence the following flag setting. So this code propably | |
1542 | * will generate a NotParsedCorrectly for the matched parts | |
1543 | * and the very final pretty print and diff will work | |
1544 | *) | |
1545 | Flag_parsing_c.verbose_parsing := false; | |
1546 | ccs := rebuild_info_c_and_headers !ccs false | |
1547 | end; | |
1548 | !ccs (* return final C asts *) | |
1549 | ||
ae4735db | 1550 | let bigloop a b = |
b1b2de81 C |
1551 | Common.profile_code "bigloop" (fun () -> bigloop2 a b) |
1552 | ||
ae4735db | 1553 | let initial_final_bigloop2 ty rebuild r = |
b1b2de81 C |
1554 | if !Flag_cocci.show_ctl_text then |
1555 | begin | |
1556 | Common.pr_xxxxxxxxxxxxxxxxx (); | |
1557 | pr (ty ^ ": " ^ r.language); | |
1558 | Common.pr_xxxxxxxxxxxxxxxxx (); | |
1559 | ||
ae4735db | 1560 | adjust_pp_with_indent (fun () -> |
b1b2de81 | 1561 | Format.force_newline(); |
c3e37e97 | 1562 | Pretty_print_cocci.unparse(rebuild r.scr_ast_rule r.scr_dependencies)); |
b1b2de81 C |
1563 | end; |
1564 | ||
1565 | match r.language with | |
1566 | "python" -> | |
1567 | (* include_match makes no sense in an initial or final rule, although | |
c3e37e97 | 1568 | we have no way to prevent it *) |
7f004419 | 1569 | let _ = apply_python_rule r [] [] [] [] (ref []) in |
951c7801 | 1570 | () |
b1b2de81 C |
1571 | | _ -> |
1572 | Printf.printf "Unknown language for initial/final script: %s\n" | |
1573 | r.language | |
1574 | ||
ae4735db | 1575 | let initial_final_bigloop a b c = |
b1b2de81 C |
1576 | Common.profile_code "initial_final_bigloop" |
1577 | (fun () -> initial_final_bigloop2 a b c) | |
34e49164 C |
1578 | |
1579 | (*****************************************************************************) | |
b1b2de81 | 1580 | (* The main functions *) |
34e49164 C |
1581 | (*****************************************************************************) |
1582 | ||
b1b2de81 C |
1583 | let pre_engine2 (coccifile, isofile) = |
1584 | show_or_not_cocci coccifile isofile; | |
34e49164 C |
1585 | Pycocci.set_coccifile coccifile; |
1586 | ||
ae4735db | 1587 | let isofile = |
34e49164 | 1588 | if not (Common.lfile_exists isofile) |
ae4735db | 1589 | then begin |
34e49164 C |
1590 | pr2 ("warning: Can't find default iso file: " ^ isofile); |
1591 | None | |
1592 | end | |
b1b2de81 | 1593 | else Some isofile in |
34e49164 C |
1594 | |
1595 | (* useful opti when use -dir *) | |
faf9a90c | 1596 | let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists, |
ae4735db | 1597 | positions_lists,toks,_) = |
b1b2de81 C |
1598 | sp_of_file coccifile isofile in |
1599 | let ctls = ctls_of_ast astcocci used_after_lists positions_lists in | |
34e49164 | 1600 | |
b1b2de81 | 1601 | g_contain_typedmetavar := sp_contain_typed_metavar astcocci; |
34e49164 | 1602 | |
b1b2de81 | 1603 | check_macro_in_sp_and_adjust toks; |
34e49164 | 1604 | |
b1b2de81 | 1605 | show_or_not_ctl_tex astcocci ctls; |
34e49164 | 1606 | |
b1b2de81 C |
1607 | let cocci_infos = |
1608 | prepare_cocci ctls free_var_lists negated_pos_lists | |
1609 | used_after_lists positions_lists metavars astcocci in | |
34e49164 | 1610 | |
ae4735db | 1611 | let used_languages = |
b1b2de81 C |
1612 | List.fold_left |
1613 | (function languages -> | |
ae4735db C |
1614 | function |
1615 | ScriptRuleCocciInfo(r) -> | |
1616 | if List.mem r.language languages then | |
1617 | languages | |
1618 | else | |
1619 | r.language::languages | |
1620 | | _ -> languages) | |
b1b2de81 | 1621 | [] cocci_infos in |
951c7801 | 1622 | |
ae4735db C |
1623 | let initialized_languages = |
1624 | List.fold_left | |
1625 | (function languages -> | |
1626 | function | |
1627 | InitialScriptRuleCocciInfo(r) -> | |
1628 | (if List.mem r.language languages | |
1629 | then failwith ("double initializer found for "^r.language)); | |
c3e37e97 C |
1630 | if interpret_dependencies [] [] r.scr_dependencies |
1631 | then | |
1632 | begin | |
1633 | initial_final_bigloop "initial" | |
1634 | (fun (x,_,y) -> fun deps -> | |
1635 | Ast_cocci.InitialScriptRule(x,deps,y)) | |
1636 | r; | |
1637 | r.language::languages | |
1638 | end | |
1639 | else languages | |
ae4735db C |
1640 | | _ -> languages) |
1641 | [] cocci_infos in | |
1642 | ||
1643 | let uninitialized_languages = | |
1644 | List.filter | |
1645 | (fun used -> not (List.mem used initialized_languages)) | |
1646 | used_languages | |
1647 | in | |
1648 | List.iter (fun lgg -> | |
1649 | initial_final_bigloop "initial" | |
c3e37e97 C |
1650 | (fun (x,_,y) -> fun deps -> |
1651 | Ast_cocci.InitialScriptRule(x,deps,y)) | |
1652 | (make_init (-1) lgg Ast_cocci.NoDep ""); | |
ae4735db C |
1653 | ) |
1654 | uninitialized_languages; | |
1655 | ||
7f004419 | 1656 | (cocci_infos,toks) |
34e49164 | 1657 | |
ae4735db | 1658 | let pre_engine a = |
b1b2de81 | 1659 | Common.profile_code "pre_engine" (fun () -> pre_engine2 a) |
faf9a90c | 1660 | |
ae4735db | 1661 | let full_engine2 (cocci_infos,toks) cfiles = |
b1b2de81 C |
1662 | |
1663 | show_or_not_cfiles cfiles; | |
1664 | ||
1665 | (* optimisation allowing to launch coccinelle on all the drivers *) | |
1666 | if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks) | |
1667 | then | |
ae4735db | 1668 | begin |
7f004419 C |
1669 | pr2 ("No matches found for " ^ (Common.join " " (Common.union_all toks)) |
1670 | ^ "\nSkipping:" ^ (Common.join " " cfiles)); | |
b1b2de81 C |
1671 | cfiles +> List.map (fun s -> s, None) |
1672 | end | |
1673 | else | |
1674 | begin | |
1675 | ||
1676 | if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx(); | |
1677 | if !Flag.show_misc then pr "let's go"; | |
1678 | if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx(); | |
1679 | ||
1680 | let choose_includes = | |
1681 | match !Flag_cocci.include_options with | |
1682 | Flag_cocci.I_UNSPECIFIED -> | |
1683 | if !g_contain_typedmetavar | |
1684 | then Flag_cocci.I_NORMAL_INCLUDES | |
1685 | else Flag_cocci.I_NO_INCLUDES | |
1686 | | x -> x in | |
1687 | let c_infos = prepare_c cfiles choose_includes in | |
1688 | ||
1689 | (* ! the big loop ! *) | |
7f004419 | 1690 | let c_infos' = bigloop cocci_infos c_infos in |
b1b2de81 C |
1691 | |
1692 | if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx (); | |
1693 | if !Flag.show_misc then pr "Finished"; | |
1694 | if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx (); | |
1695 | if !Flag_ctl.graphical_trace then gen_pdf_graph (); | |
1696 | ||
ae4735db | 1697 | c_infos' +> List.map (fun c_or_h -> |
b1b2de81 C |
1698 | if !(c_or_h.was_modified_once) |
1699 | then | |
1700 | begin | |
1701 | let outfile = | |
1702 | Common.new_temp_file "cocci-output" ("-" ^ c_or_h.fname) in | |
1703 | ||
1704 | if c_or_h.fkind =*= Header | |
1705 | then pr2 ("a header file was modified: " ^ c_or_h.fname); | |
1706 | ||
1707 | (* and now unparse everything *) | |
1708 | cfile_of_program (for_unparser c_or_h.asts) outfile; | |
1709 | ||
c3e37e97 | 1710 | show_or_not_diff c_or_h.fpath outfile; |
b1b2de81 C |
1711 | |
1712 | (c_or_h.fpath, | |
1713 | if !Flag.sgrep_mode2 then None else Some outfile) | |
1714 | end | |
1715 | else (c_or_h.fpath, None)) | |
1716 | end | |
34e49164 | 1717 | |
ae4735db | 1718 | let full_engine a b = |
fc1ad971 C |
1719 | Common.profile_code "full_engine" |
1720 | (fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res) | |
34e49164 | 1721 | |
7f004419 | 1722 | let post_engine2 (cocci_infos,_) = |
b1b2de81 C |
1723 | let _ = |
1724 | List.fold_left | |
1725 | (function languages -> | |
1726 | function | |
1727 | FinalScriptRuleCocciInfo(r) -> | |
1728 | (if List.mem r.language languages | |
1729 | then failwith ("double finalizer found for "^r.language)); | |
1730 | initial_final_bigloop "final" | |
c3e37e97 | 1731 | (fun (x,_,y) -> fun deps -> Ast_cocci.FinalScriptRule(x,deps,y)) |
b1b2de81 C |
1732 | r; |
1733 | r.language::languages | |
1734 | | _ -> languages) | |
1735 | [] cocci_infos in | |
1736 | () | |
1737 | ||
ae4735db | 1738 | let post_engine a = |
b1b2de81 | 1739 | Common.profile_code "post_engine" (fun () -> post_engine2 a) |
34e49164 C |
1740 | |
1741 | (*****************************************************************************) | |
1742 | (* check duplicate from result of full_engine *) | |
1743 | (*****************************************************************************) | |
1744 | ||
ae4735db | 1745 | let check_duplicate_modif2 xs = |
34e49164 | 1746 | (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *) |
708f4980 C |
1747 | if !Flag_cocci.verbose_cocci |
1748 | then pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files"); | |
1749 | ||
34e49164 | 1750 | let groups = Common.group_assoc_bykey_eff xs in |
ae4735db | 1751 | groups +> Common.map_filter (fun (file, xs) -> |
34e49164 C |
1752 | match xs with |
1753 | | [] -> raise Impossible | |
1754 | | [res] -> Some (file, res) | |
ae4735db C |
1755 | | res::xs -> |
1756 | match res with | |
1757 | | None -> | |
b1b2de81 | 1758 | if not (List.for_all (fun res2 -> res2 =*= None) xs) |
34e49164 C |
1759 | then begin |
1760 | pr2 ("different modification result for " ^ file); | |
1761 | None | |
1762 | end | |
1763 | else Some (file, None) | |
ae4735db C |
1764 | | Some res -> |
1765 | if not(List.for_all (fun res2 -> | |
34e49164 C |
1766 | match res2 with |
1767 | | None -> false | |
ae4735db | 1768 | | Some res2 -> |
34e49164 C |
1769 | let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2) |
1770 | in | |
1771 | null diff | |
1772 | ) xs) then begin | |
1773 | pr2 ("different modification result for " ^ file); | |
1774 | None | |
1775 | end | |
1776 | else Some (file, Some res) | |
34e49164 | 1777 | ) |
ae4735db | 1778 | let check_duplicate_modif a = |
34e49164 C |
1779 | Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a) |
1780 |