2 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
24 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
25 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
26 * This file is part of Coccinelle.
28 * Coccinelle is free software: you can redistribute it and/or modify
29 * it under the terms of the GNU General Public License as published by
30 * the Free Software Foundation, according to version 2 of the License.
32 * Coccinelle is distributed in the hope that it will be useful,
33 * but WITHOUT ANY WARRANTY; without even the implied warranty of
34 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
35 * GNU General Public License for more details.
37 * You should have received a copy of the GNU General Public License
38 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
40 * The authors reserve the right to distribute this or future versions of
41 * Coccinelle under other licenses.
47 module CCI
= Ctlcocci_integration
48 module TAC
= Type_annoter_c
50 module Ast_to_flow
= Control_flow_c_build
52 (*****************************************************************************)
53 (* This file is a kind of driver. It gathers all the important functions
54 * from coccinelle in one place. The different entities in coccinelle are:
58 * - flow (contain nodes)
59 * - ctl (contain rule_elems)
60 * This file contains functions to transform one in another.
62 (*****************************************************************************)
64 (* --------------------------------------------------------------------- *)
66 (* --------------------------------------------------------------------- *)
67 let cprogram_of_file file
=
68 let (program2
, _stat
) = Parse_c.parse_c_and_cpp file
in
71 let cprogram_of_file_cached file
=
72 let (program2
, _stat
) = Parse_c.parse_cache file
in
73 if !Flag_cocci.ifdef_to_if
75 program2
+> Parse_c.with_program2
(fun asts
->
76 Cpp_ast_c.cpp_ifdef_statementize asts
80 let cfile_of_program program2_with_ppmethod outf
=
81 Unparse_c.pp_program program2_with_ppmethod outf
83 (* for memoization, contains only one entry, the one for the SP *)
84 let _hparse = Hashtbl.create
101
85 let _hctl = Hashtbl.create
101
87 (* --------------------------------------------------------------------- *)
89 (* --------------------------------------------------------------------- *)
90 let sp_of_file2 file iso
=
91 Common.memoized
_hparse (file
, iso
) (fun () ->
92 Parse_cocci.process file iso
false)
93 let sp_of_file file iso
=
94 Common.profile_code
"parse cocci" (fun () -> sp_of_file2 file iso
)
97 (* --------------------------------------------------------------------- *)
99 (* --------------------------------------------------------------------- *)
100 let print_flow flow
=
101 Ograph_extended.print_ograph_mutable flow
"/tmp/test.dot" true
104 let ast_to_flow_with_error_messages2 x
=
106 try Ast_to_flow.ast_to_control_flow x
107 with Ast_to_flow.Error x
->
108 Ast_to_flow.report_error x
;
111 flowopt +> do_option
(fun flow
->
112 (* This time even if there is a deadcode, we still have a
113 * flow graph, so I can try the transformation and hope the
114 * deadcode will not bother us.
116 try Ast_to_flow.deadcode_detection flow
117 with Ast_to_flow.Error
(Ast_to_flow.DeadCode x
) ->
118 Ast_to_flow.report_error
(Ast_to_flow.DeadCode x
);
121 let ast_to_flow_with_error_messages a
=
122 Common.profile_code
"flow" (fun () -> ast_to_flow_with_error_messages2 a
)
125 (* --------------------------------------------------------------------- *)
127 (* --------------------------------------------------------------------- *)
129 let ctls_of_ast2 ast
(ua
,fua
,fuas
) pos
=
131 (function ast
-> function (ua
,(fua
,(fuas
,pos
))) ->
135 else Asttoctl2.asttoctl ast
(ua
,fua
,fuas
) pos
)
136 (Asttomember.asttomember ast ua
))
137 ast
(List.combine ua
(List.combine fua
(List.combine fuas pos
)))
139 let ctls_of_ast ast ua
=
140 Common.profile_code
"asttoctl2" (fun () -> ctls_of_ast2 ast ua
)
142 (*****************************************************************************)
143 (* Some debugging functions *)
144 (*****************************************************************************)
148 let show_or_not_cfile2 cfile
=
149 if !Flag_cocci.show_c
then begin
150 Common.pr2_xxxxxxxxxxxxxxxxx
();
151 pr2
("processing C file: " ^ cfile
);
152 Common.pr2_xxxxxxxxxxxxxxxxx
();
153 Common.command2
("cat " ^ cfile
);
155 let show_or_not_cfile a
=
156 Common.profile_code
"show_xxx" (fun () -> show_or_not_cfile2 a
)
158 let show_or_not_cfiles cfiles
= List.iter
show_or_not_cfile cfiles
161 let show_or_not_cocci2 coccifile isofile
=
162 if !Flag_cocci.show_cocci
then begin
163 Common.pr2_xxxxxxxxxxxxxxxxx
();
164 pr2
("processing semantic patch file: " ^ coccifile
);
165 isofile
+> (fun s
-> pr2
("with isos from: " ^ s
));
166 Common.pr2_xxxxxxxxxxxxxxxxx
();
167 Common.command2
("cat " ^ coccifile
);
170 let show_or_not_cocci a b
=
171 Common.profile_code
"show_xxx" (fun () -> show_or_not_cocci2 a b
)
173 (* ---------------------------------------------------------------------- *)
176 let fix_sgrep_diffs l
=
178 List.filter
(function s
-> (s
=~
"^\\+\\+\\+") || not
(s
=~
"^\\+")) l in
179 let l = List.rev
l in
180 (* adjust second number for + code *)
181 let rec loop1 n
= function
184 if s
=~
"^-" && not
(s
=~
"^---")
185 then s
:: loop1 (n
+1) ss
188 (match Str.split
(Str.regexp
" ") s
with
190 (match Str.split
(Str.regexp
",") pl
with
192 let n2 = int_of_string
n2 in
193 (Printf.sprintf
"%s %s %s,%d %s" bef min n1
(n2-n
)
194 (String.concat
" " aft
))
196 | _
-> failwith
"bad + line information")
197 | _
-> failwith
"bad @@ information")
198 else s
:: loop1 n ss
in
199 let rec loop2 n
= function
206 (match Str.split
(Str.regexp
" ") s
with
208 (match (Str.split
(Str.regexp
",") min
,
209 Str.split
(Str.regexp
",") pl
) with
213 (String.sub
n1 1 ((String.length
n1)-1)) in
214 let m2 = int_of_string
m2 in
215 let n2 = int_of_string
n2 in
216 (Printf.sprintf
"%s %s +%d,%d %s" bef min
(n1-n
) n2
217 (String.concat
" " aft
))
218 :: loop2 (n
+(m2-n2)) ss
219 | _
-> failwith
"bad -/+ line information")
220 | _
-> failwith
"bad @@ information")
221 else s
:: loop2 n ss
in
222 loop2 0 (List.rev
(loop1 0 l))
224 let normalize_path file
=
226 if String.get file
0 = '
/'
then file
else (Sys.getcwd
()) ^
"/" ^ file
in
227 let elements = Str.split_delim
(Str.regexp
"/") fullpath in
228 let rec loop prev
= function
229 [] -> String.concat
"/" (List.rev prev
)
230 | "." :: rest
-> loop prev rest
233 x
::xs
-> loop xs rest
234 | _
-> failwith
"bad path")
235 | x
::rest
-> loop (x
::prev
) rest
in
238 let show_or_not_diff2 cfile outfile
=
239 if !Flag_cocci.show_diff
then begin
240 match Common.fst
(Compare_c.compare_to_original cfile outfile
) with
241 Compare_c.Correct
-> () (* diff only in spacing, etc *)
243 (* may need --strip-trailing-cr under windows *)
247 match !Flag_parsing_c.diff_lines
with
248 | None
-> "diff -u -p " ^ cfile ^
" " ^ outfile
249 | Some n
-> "diff -U "^n^
" -p "^cfile^
" "^outfile
in
251 let res = Common.cmd_to_list
line in
252 match (!Flag.patch
,res) with
253 (* create something that looks like the output of patch *)
254 (Some prefix
,minus_file
::plus_file
::rest
) ->
256 let lp = String.length
prefix in
257 if String.get
prefix (lp-1) = '
/'
258 then String.sub
prefix 0 (lp-1)
260 let drop_prefix file
=
261 let file = normalize_path file in
262 if Str.string_match
(Str.regexp
prefix) file 0
264 let lp = String.length
prefix in
265 let lf = String.length
file in
267 then String.sub
file lp (lf - lp)
270 (Printf.sprintf
"prefix %s doesn't match file %s"
274 (Printf.sprintf
"prefix %s doesn't match file %s"
277 match List.rev
(Str.split
(Str.regexp
" ") line) with
278 new_file
::old_file
::cmdrev
->
282 (List.rev
("/tmp/nothing" :: old_file
:: cmdrev
))
284 let old_base_file = drop_prefix old_file
in
287 (("b"^
old_base_file)::("a"^
old_base_file)::cmdrev
))
288 | _
-> failwith
"bad command" in
289 let (minus_line
,plus_line
) =
291 then (minus_file
,"+++ /tmp/nothing")
293 match (Str.split
(Str.regexp
"[ \t]") minus_file
,
294 Str.split
(Str.regexp
"[ \t]") plus_file
) with
295 ("---"::old_file
::old_rest
,"+++"::new_file
::new_rest
) ->
296 let old_base_file = drop_prefix old_file
in
298 ("---"::("a"^
old_base_file)::old_rest
),
300 ("+++"::("b"^
old_base_file)::new_rest
))
303 (Printf.sprintf
"bad diff header lines: %s %s"
304 (String.concat
":" l1
) (String.concat
":" l2
)) in
305 diff_line::minus_line
::plus_line
::rest
307 let xs = if !Flag.sgrep_mode2
then fix_sgrep_diffs xs else xs in
310 let show_or_not_diff a b
=
311 Common.profile_code
"show_xxx" (fun () -> show_or_not_diff2 a b
)
314 (* the derived input *)
316 let show_or_not_ctl_tex2 astcocci ctls
=
317 if !Flag_cocci.show_ctl_tex
then begin
318 Ctltotex.totex
("/tmp/__cocci_ctl.tex") astcocci ctls
;
319 Common.command2
("cd /tmp; latex __cocci_ctl.tex; " ^
320 "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
321 "gv __cocci_ctl.ps &");
323 let show_or_not_ctl_tex a b
=
324 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_tex2 a b
)
327 let show_or_not_rule_name ast rulenb
=
328 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
329 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
334 Ast_cocci.CocciRule
(nm
, (deps
, drops
, exists
), x
, _
, _
) -> nm
335 | _
-> i_to_s rulenb
in
336 Common.pr_xxxxxxxxxxxxxxxxx
();
338 Common.pr_xxxxxxxxxxxxxxxxx
()
341 let show_or_not_scr_rule_name rulenb
=
342 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
343 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
346 let name = i_to_s rulenb
in
347 Common.pr_xxxxxxxxxxxxxxxxx
();
348 pr
("script rule " ^
name ^
" = ");
349 Common.pr_xxxxxxxxxxxxxxxxx
()
352 let show_or_not_ctl_text2 ctl ast rulenb
=
353 if !Flag_cocci.show_ctl_text
then begin
355 adjust_pp_with_indent
(fun () ->
356 Format.force_newline
();
357 Pretty_print_cocci.print_plus_flag
:= true;
358 Pretty_print_cocci.print_minus_flag
:= true;
359 Pretty_print_cocci.unparse ast
;
364 adjust_pp_with_indent
(fun () ->
365 Format.force_newline
();
366 Pretty_print_engine.pp_ctlcocci
367 !Flag_cocci.show_mcodekind_in_ctl
!Flag_cocci.inline_let_ctl ctl
;
371 let show_or_not_ctl_text a b c
=
372 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_text2 a b c
)
376 (* running information *)
377 let get_celem celem
: string =
379 Ast_c.Definition
({Ast_c.f_name
= namefuncs
;},_
) ->
380 Ast_c.str_of_name namefuncs
382 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name, _
);}, _
], _
)) ->
383 Ast_c.str_of_name
name
386 let show_or_not_celem2 prelude celem
=
389 | Ast_c.Definition
({Ast_c.f_name
= namefuncs
},_
) ->
390 let funcs = Ast_c.str_of_name namefuncs
in
391 Flag.current_element
:= funcs;
392 (" function: ",funcs)
394 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name,_
)}, _
], _
)) ->
395 let s = Ast_c.str_of_name
name in
396 Flag.current_element
:= s;
399 Flag.current_element
:= "something_else";
400 (" ","something else");
402 if !Flag.show_trying
then pr2
(prelude ^ tag ^ trying
)
404 let show_or_not_celem a b
=
405 Common.profile_code
"show_xxx" (fun () -> show_or_not_celem2 a b
)
408 let show_or_not_trans_info2 trans_info
=
409 (* drop witness tree indices for printing *)
411 List.map
(function (index
,trans_info) -> trans_info) trans_info in
412 if !Flag.show_transinfo
then begin
413 if null
trans_info then pr2
"transformation info is empty"
415 pr2
"transformation info returned:";
417 List.sort
(function (i1
,_
,_
) -> function (i2
,_
,_
) -> compare i1 i2
)
421 trans_info +> List.iter
(fun (i
, subst
, re
) ->
422 pr2
("transform state: " ^
(Common.i_to_s i
));
424 adjust_pp_with_indent_and_header
"with rule_elem: " (fun () ->
425 Pretty_print_cocci.print_plus_flag
:= true;
426 Pretty_print_cocci.print_minus_flag
:= true;
427 Pretty_print_cocci.rule_elem
"" re
;
429 adjust_pp_with_indent_and_header
"with binding: " (fun () ->
430 Pretty_print_engine.pp_binding subst
;
437 let show_or_not_trans_info a
=
438 Common.profile_code
"show_xxx" (fun () -> show_or_not_trans_info2 a
)
442 let show_or_not_binding2 s binding
=
443 if !Flag_cocci.show_binding_in_out
then begin
444 adjust_pp_with_indent_and_header
("binding " ^
s ^
" = ") (fun () ->
445 Pretty_print_engine.pp_binding binding
448 let show_or_not_binding a b
=
449 Common.profile_code
"show_xxx" (fun () -> show_or_not_binding2 a b
)
453 (*****************************************************************************)
454 (* Some helper functions *)
455 (*****************************************************************************)
457 let worth_trying cfiles tokens
=
458 (* drop the following line for a list of list by rules. since we don't
459 allow multiple minirules, all the tokens within a rule should be in
460 a single CFG entity *)
461 let tokens = Common.union_all
tokens in
462 if not
!Flag_cocci.windows
&& not
(null
tokens)
464 (* could also modify the code in get_constants.ml *)
465 let tokens = tokens +> List.map
(fun s ->
467 | _
when s =~
"^[A-Za-z_][A-Za-z_0-9]*$" ->
470 | _
when s =~
"^[A-Za-z_]" ->
473 | _
when s =~
".*[A-Za-z_]$" ->
478 let com = sprintf
"egrep -q '(%s)' %s" (join
"|" tokens) (join
" " cfiles
)
480 (match Sys.command
com with
481 | 0 (* success *) -> true
484 then Printf.printf
"grep failed: %s\n" com);
485 false (* no match, so not worth trying *)
489 let check_macro_in_sp_and_adjust tokens =
490 let tokens = Common.union_all
tokens in
491 tokens +> List.iter
(fun s ->
492 if Hashtbl.mem
!Parse_c._defs
s
494 if !Flag_cocci.verbose_cocci
then begin
495 pr2
"warning: macro in semantic patch was in macro definitions";
496 pr2
("disabling macro expansion for " ^
s);
498 Hashtbl.remove
!Parse_c._defs
s
503 let contain_loop gopt
=
506 g#nodes#tolist
+> List.exists
(fun (xi
, node
) ->
507 Control_flow_c.extract_is_loop node
509 | None
-> true (* means nothing, if no g then will not model check *)
513 let sp_contain_typed_metavar_z toplevel_list_list
=
514 let bind x y
= x
or y
in
515 let option_default = false in
516 let mcode _ _
= option_default in
517 let donothing r k e
= k e
in
519 let expression r k e
=
520 match Ast_cocci.unwrap e
with
521 | Ast_cocci.MetaExpr
(_
,_
,_
,Some t
,_
,_
) -> true
522 | Ast_cocci.MetaExpr
(_
,_
,_
,_
,Ast_cocci.LocalID
,_
) -> true
527 Visitor_ast.combiner bind option_default
528 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
529 donothing donothing donothing donothing
530 donothing expression donothing donothing donothing donothing donothing
531 donothing donothing donothing donothing donothing
533 toplevel_list_list
+>
535 (function (nm
,_
,rule
) ->
536 (List.exists
combiner.Visitor_ast.combiner_top_level rule
))
538 let sp_contain_typed_metavar rules
=
539 sp_contain_typed_metavar_z
543 Ast_cocci.CocciRule
(a
,b
,c
,d
,_
) -> (a
,b
,c
)
544 | _
-> failwith
"error in filter")
548 Ast_cocci.CocciRule
(a
,b
,c
,d
,Ast_cocci.Normal
) -> true
554 (* finding among the #include the one that we need to parse
555 * because they may contain useful type definition or because
556 * we may have to modify them
558 * For the moment we base in part our heuristic on the name of the file, e.g.
559 * serio.c is related we think to #include <linux/serio.h>
561 let rec search_include_path searchlist relpath
=
562 match searchlist
with
565 let file = Filename.concat hd relpath
in
566 if Sys.file_exists
file then
569 search_include_path tail relpath
571 let interpret_include_path relpath
=
573 match !Flag_cocci.include_path
with
577 search_include_path searchlist relpath
579 let (includes_to_parse
:
580 (Common.filename
* Parse_c.program2
) list
->
581 Flag_cocci.include_options
-> 'a
) = fun xs choose_includes
->
582 match choose_includes
with
583 Flag_cocci.I_UNSPECIFIED
-> failwith
"not possible"
584 | Flag_cocci.I_NO_INCLUDES
-> []
586 let all_includes = x
=*= Flag_cocci.I_ALL_INCLUDES
in
587 xs +> List.map
(fun (file, cs
) ->
588 let dir = Common.dirname
file in
590 cs
+> Common.map_filter
(fun (c
,_info_item
) ->
594 {Ast_c.i_include
= ((x
,ii
)); i_rel_pos
= info_h_pos
;}) ->
597 let relpath = Common.join
"/" xs in
598 let f = Filename.concat
dir (relpath) in
599 (* for our tests, all the files are flat in the current dir *)
600 if not
(Sys.file_exists
f) && !Flag_cocci.relax_include_path
602 let attempt2 = Filename.concat
dir (Common.last
xs) in
603 if not
(Sys.file_exists
f) && all_includes
605 interpret_include_path relpath
609 | Ast_c.NonLocal
xs ->
610 let relpath = Common.join
"/" xs in
612 Common.fileprefix
(Common.last
xs) =$
= Common.fileprefix
file
614 interpret_include_path relpath
616 | Ast_c.Weird _
-> None
622 let rec interpret_dependencies local global
= function
623 Ast_cocci.Dep
s -> List.mem
s local
624 | Ast_cocci.AntiDep
s ->
625 (if !Flag_ctl.steps
!= None
626 then failwith
"steps and ! dependency incompatible");
627 not
(List.mem
s local
)
628 | Ast_cocci.EverDep
s -> List.mem
s global
629 | Ast_cocci.NeverDep
s ->
630 (if !Flag_ctl.steps
!= None
631 then failwith
"steps and ! dependency incompatible");
632 not
(List.mem
s global
)
633 | Ast_cocci.AndDep
(s1
,s2
) ->
634 (interpret_dependencies local global s1
) &&
635 (interpret_dependencies local global s2
)
636 | Ast_cocci.OrDep
(s1
,s2
) ->
637 (interpret_dependencies local global s1
) or
638 (interpret_dependencies local global s2
)
639 | Ast_cocci.NoDep
-> true
640 | Ast_cocci.FailDep
-> false
642 let rec print_dependencies str local global dep
=
643 if !Flag_cocci.show_dependencies
648 let rec loop = function
649 Ast_cocci.Dep
s | Ast_cocci.AntiDep
s ->
650 if not
(List.mem
s !seen)
654 then pr2
(s^
" satisfied")
655 else pr2
(s^
" not satisfied");
658 | Ast_cocci.EverDep
s | Ast_cocci.NeverDep
s ->
659 if not
(List.mem
s !seen)
663 then pr2
(s^
" satisfied")
664 else pr2
(s^
" not satisfied");
667 | Ast_cocci.AndDep
(s1
,s2
) ->
670 | Ast_cocci.OrDep
(s1
,s2
) ->
673 | Ast_cocci.NoDep
-> ()
674 | Ast_cocci.FailDep
-> pr2
"False not satisfied" in
678 (* --------------------------------------------------------------------- *)
679 (* #include relative position in the file *)
680 (* --------------------------------------------------------------------- *)
682 (* compute the set of new prefixes
684 * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *)
688 * it would give
for the first element
689 * ""; "a"; "a/b"; "a/b/x"
693 * update
: if the
include is inside a ifdef a put nothing
. cf
-test incl
.
694 * this is because we dont want code added inside ifdef
.
697 let compute_new_prefixes xs =
698 xs +> Common.map_withenv
(fun already
xs ->
699 let subdirs_prefixes = Common.inits
xs in
700 let new_first = subdirs_prefixes +> List.filter
(fun x
->
701 not
(List.mem x already
)
710 (* does via side effect on the ref in the Include in Ast_c *)
711 let rec update_include_rel_pos cs
=
712 let only_include = cs
+> Common.map_filter
(fun c
->
714 | Ast_c.CppTop
(Ast_c.Include
{Ast_c.i_include
= ((x
,_
));
716 i_is_in_ifdef
= inifdef
}) ->
718 | Ast_c.Weird _
-> None
727 let (locals
, nonlocals
) =
728 only_include +> Common.partition_either
(fun (c
, aref
) ->
730 | Ast_c.Local x
-> Left
(x
, aref
)
731 | Ast_c.NonLocal x
-> Right
(x
, aref
)
732 | Ast_c.Weird x
-> raise Impossible
735 update_rel_pos_bis locals
;
736 update_rel_pos_bis nonlocals
;
738 and update_rel_pos_bis
xs =
739 let xs'
= List.map fst
xs in
740 let the_first = compute_new_prefixes xs'
in
741 let the_last = List.rev
(compute_new_prefixes (List.rev
xs'
)) in
742 let merged = Common.zip
xs (Common.zip
the_first the_last) in
743 merged +> List.iter
(fun ((x
, aref
), (the_first, the_last)) ->
746 Ast_c.first_of
= the_first;
747 Ast_c.last_of
= the_last;
752 (*****************************************************************************)
753 (* All the information needed around the C elements and Cocci rules *)
754 (*****************************************************************************)
756 type toplevel_c_info
= {
757 ast_c
: Ast_c.toplevel
; (* contain refs so can be modified *)
758 tokens_c
: Parser_c.token list
;
761 flow
: Control_flow_c.cflow
option; (* it's the "fixed" flow *)
764 env_typing_before
: TAC.environment
;
765 env_typing_after
: TAC.environment
;
767 was_modified
: bool ref;
772 type toplevel_cocci_info_script_rule
= {
773 scr_ast_rule
: string * (string * Ast_cocci.meta_name
) list
* string;
775 scr_dependencies
: Ast_cocci.dependency
;
780 type toplevel_cocci_info_cocci_rule
= {
781 ctl
: Lib_engine.ctlcocci
* (CCI.pred list list
);
782 metavars
: Ast_cocci.metavar list
;
783 ast_rule
: Ast_cocci.rule
;
784 isexp
: bool; (* true if + code is an exp, only for Flag.make_hrule *)
787 dependencies
: Ast_cocci.dependency
;
788 (* There are also some hardcoded rule names in parse_cocci.ml:
789 * let reserved_names = ["all";"optional_storage";"optional_qualifier"]
791 dropped_isos
: string list
;
792 free_vars
: Ast_cocci.meta_name list
;
793 negated_pos_vars
: Ast_cocci.meta_name list
;
794 used_after
: Ast_cocci.meta_name list
;
795 positions
: Ast_cocci.meta_name list
;
798 ruletype
: Ast_cocci.ruletype
;
800 was_matched
: bool ref;
803 type toplevel_cocci_info
=
804 ScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
805 | InitialScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
806 | FinalScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
807 | CocciRuleCocciInfo
of toplevel_cocci_info_cocci_rule
809 type cocci_info
= toplevel_cocci_info list
* string list list
(* tokens *)
811 type kind_file
= Header
| Source
815 was_modified_once
: bool ref;
816 asts
: toplevel_c_info list
;
821 let g_contain_typedmetavar = ref false
824 let last_env_toplevel_c_info xs =
825 (Common.last
xs).env_typing_after
827 let concat_headers_and_c (ccs
: file_info list
)
828 : (toplevel_c_info
* string) list
=
829 (List.concat
(ccs
+> List.map
(fun x
->
830 x
.asts
+> List.map
(fun x'
->
833 let for_unparser xs =
834 xs +> List.map
(fun x
->
835 (x
.ast_c
, (x
.fullstring
, x
.tokens_c
)), Unparse_c.PPviastr
838 let gen_pdf_graph () =
839 (Ctl_engine.get_graph_files
()) +> List.iter
(fun outfile
->
840 Printf.printf
"Generation of %s%!" outfile
;
841 let filename_stack = Ctl_engine.get_graph_comp_files outfile
in
842 List.iter
(fun filename
->
843 ignore
(Unix.system
("dot " ^ filename ^
" -Tpdf -o " ^ filename ^
".pdf;"))
845 let (head
,tail
) = (List.hd
filename_stack, List.tl
filename_stack) in
846 ignore
(Unix.system
("cp " ^ head ^
".pdf " ^ outfile ^
".pdf;"));
847 tail
+> List.iter
(fun filename
->
848 ignore
(Unix.system
("mv " ^ outfile ^
".pdf /tmp/tmp.pdf;"));
849 ignore
(Unix.system
("pdftk " ^ filename ^
".pdf /tmp/tmp.pdf cat output " ^ outfile ^
".pdf"));
851 ignore
(Unix.system
("rm /tmp/tmp.pdf;"));
852 List.iter
(fun filename
->
853 ignore
(Unix.system
("rm " ^ filename ^
" " ^ filename ^
".pdf;"))
855 Printf.printf
" - Done\n")
857 let local_python_code =
858 "from coccinelle import *\n"
861 "import coccinelle\n"^
863 "import coccilib.org\n"^
864 "import coccilib.report\n" ^
868 let make_init rulenb lang deps code
=
871 scr_ast_rule
= (lang
, mv, code
);
873 scr_dependencies
= deps
;
875 script_code
= (if lang
= "python" then python_code else "") ^code
878 (* --------------------------------------------------------------------- *)
879 let prepare_cocci ctls free_var_lists negated_pos_lists
880 (ua
,fua
,fuas
) positions_list metavars astcocci
=
882 let gathered = Common.index_list_1
883 (zip
(zip
(zip
(zip
(zip
(zip
(zip
(zip ctls metavars
) astcocci
)
885 negated_pos_lists
) ua
) fua
) fuas
) positions_list
)
888 (fun (((((((((ctl_toplevel_list
,metavars
),ast
),free_var_list
),
889 negated_pos_list
),ua
),fua
),fuas
),positions_list
),rulenb
) ->
891 let is_script_rule r
=
893 Ast_cocci.ScriptRule _
894 | Ast_cocci.InitialScriptRule _
| Ast_cocci.FinalScriptRule _
-> true
897 if not
(List.length ctl_toplevel_list
=|= 1) && not
(is_script_rule ast
)
898 then failwith
"not handling multiple minirules";
901 Ast_cocci.ScriptRule
(lang
,deps
,mv,code
) ->
904 scr_ast_rule
= (lang
, mv, code
);
906 scr_dependencies
= deps
;
910 in ScriptRuleCocciInfo
r
911 | Ast_cocci.InitialScriptRule
(lang
,deps
,code
) ->
912 let r = make_init rulenb lang deps code
in
913 InitialScriptRuleCocciInfo
r
914 | Ast_cocci.FinalScriptRule
(lang
,deps
,code
) ->
918 scr_ast_rule
= (lang
, mv, code
);
920 scr_dependencies
= deps
;
924 in FinalScriptRuleCocciInfo
r
925 | Ast_cocci.CocciRule
926 (rulename
,(dependencies
,dropped_isos
,z
),restast
,isexp
,ruletype
) ->
929 ctl
= List.hd ctl_toplevel_list
;
932 isexp
= List.hd isexp
;
934 dependencies
= dependencies
;
935 dropped_isos
= dropped_isos
;
936 free_vars
= List.hd free_var_list
;
937 negated_pos_vars
= List.hd negated_pos_list
;
938 used_after
= (List.hd ua
) @ (List.hd fua
);
939 positions
= List.hd positions_list
;
942 was_matched
= ref false;
947 (* --------------------------------------------------------------------- *)
949 let build_info_program cprogram env
=
951 let (cs
, parseinfos
) =
952 Common.unzip cprogram
in
955 parseinfos
+> List.map
(fun (s,toks
) -> toks
) +> List.flatten
in
957 (* I use cs' but really annotate_xxx work by doing side effects on cs *)
959 Comment_annotater_c.annotate_program
alltoks cs in
961 Type_annoter_c.annotate_program env
(*!g_contain_typedmetavar*) cs'
964 zip
cs_with_envs parseinfos
+> List.map
(fun ((c
, (enva
,envb
)), parseinfo
)->
965 let (fullstr
, tokens) = parseinfo
in
968 ast_to_flow_with_error_messages c
+>
969 Common.map_option
(fun flow ->
970 let flow = Ast_to_flow.annotate_loop_nodes
flow in
972 (* remove the fake nodes for julia *)
973 let fixed_flow = CCI.fix_flow_ctl
flow in
975 if !Flag_cocci.show_flow
then print_flow fixed_flow;
976 if !Flag_cocci.show_before_fixed_flow
then print_flow flow;
983 ast_c
= c
; (* contain refs so can be modified *)
985 fullstring
= fullstr
;
989 contain_loop = contain_loop flow;
991 env_typing_before
= enva
;
992 env_typing_after
= envb
;
994 was_modified
= ref false;
1000 (* Optimisation. Try not unparse/reparse the whole file when have modifs *)
1001 let rebuild_info_program cs file isexp
=
1002 cs +> List.map
(fun c
->
1003 if !(c
.was_modified
)
1005 let file = Common.new_temp_file
"cocci_small_output" ".c" in
1007 [(c
.ast_c
, (c
.fullstring
, c
.tokens_c
)), Unparse_c.PPnormal
]
1010 (* Common.command2 ("cat " ^ file); *)
1011 let cprogram = cprogram_of_file file in
1012 let xs = build_info_program cprogram c
.env_typing_before
in
1014 (* TODO: assert env has not changed,
1015 * if yes then must also reparse what follows even if not modified.
1016 * Do that only if contain_typedmetavar of course, so good opti.
1018 (* Common.list_init xs *) (* get rid of the FinalDef *)
1024 let rebuild_info_c_and_headers ccs isexp
=
1025 ccs
+> List.iter
(fun c_or_h
->
1026 if c_or_h
.asts
+> List.exists
(fun c
-> !(c
.was_modified
))
1027 then c_or_h
.was_modified_once
:= true;
1029 ccs
+> List.map
(fun c_or_h
->
1032 rebuild_info_program c_or_h
.asts c_or_h
.full_fname isexp
}
1037 let prepare_c files choose_includes
: file_info list
=
1038 let cprograms = List.map
cprogram_of_file_cached files
in
1039 let includes = includes_to_parse
(zip files
cprograms) choose_includes
in
1041 (* todo?: may not be good to first have all the headers and then all the c *)
1043 (includes +> List.map
(fun hpath
-> Right hpath
))
1045 ((zip files
cprograms) +>
1046 List.map
(fun (file, asts
) -> Left
(file, asts
)))
1049 let env = ref !TAC.initial_env
in
1051 let ccs = all +> Common.map_filter
(fun x
->
1054 if not
(Common.lfile_exists hpath
)
1056 pr2
("TYPE: header " ^ hpath ^
" not found");
1060 let h_cs = cprogram_of_file_cached hpath
in
1061 let info_h_cs = build_info_program h_cs !env in
1065 else last_env_toplevel_c_info info_h_cs
1068 fname
= Common.basename hpath
;
1071 was_modified_once
= ref false;
1075 | Left
(file, cprogram) ->
1076 (* todo?: don't update env ? *)
1077 let cs = build_info_program cprogram !env in
1078 (* we do that only for the c, not for the h *)
1079 ignore
(update_include_rel_pos (cs +> List.map
(fun x
-> x
.ast_c
)));
1081 fname
= Common.basename
file;
1084 was_modified_once
= ref false;
1093 (*****************************************************************************)
1094 (* Processing the ctls and toplevel C elements *)
1095 (*****************************************************************************)
1097 (* The main algorithm =~
1098 * The algorithm is roughly:
1099 * for_all ctl rules in SP
1100 * for_all minirule in rule (no more)
1101 * for_all binding (computed during previous phase)
1102 * for_all C elements
1103 * match control flow of function vs minirule
1104 * with the binding and update the set of possible
1105 * bindings, and returned the possibly modified function.
1106 * pretty print modified C elements and reparse it.
1109 * On ne prends que les newbinding ou returned_any_state est vrai.
1110 * Si ca ne donne rien, on prends ce qu'il y avait au depart.
1111 * Mais au nouveau depart de quoi ?
1112 * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?
1113 * - ou alors si ca donne rien, apres avoir traité toutes les fonctions
1114 * avec tous les bindings du round d'avant ?
1116 * Julia pense qu'il faut prendre la premiere solution.
1117 * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
1118 * la regle ctl 1. On arrive sur la regle ctl 2.
1119 * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
1120 * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
1123 * I have not to look at used_after_list to decide to restart from
1124 * scratch. I just need to look if the binding list is empty.
1125 * Indeed, let's suppose that a SP have 3 regions/rules. If we
1126 * don't find a match for the first region, then if this first
1127 * region does not bind metavariable used after, that is if
1128 * used_after_list is empty, then mysat(), even if does not find a
1129 * match, will return a Left, with an empty transformation_info,
1130 * and so current_binding will grow. On the contrary if the first
1131 * region must bind some metavariables used after, and that we
1132 * dont find any such region, then mysat() will returns lots of
1133 * Right, and current_binding will not grow, and so we will have
1134 * an empty list of binding, and we will catch such a case.
1136 * opti: julia says that because the binding is
1137 * determined by the used_after_list, the items in the list
1138 * are kind of sorted, so could optimise the insert_set operations.
1142 (* r(ule), c(element in C code), e(nvironment) *)
1145 let rec loop k
= function
1149 then Some
(x
, function n
-> k
(n
:: xs))
1150 else loop (function vs
-> k
(x
:: vs
)) xs in
1151 loop (function x
-> x
) l
1153 let merge_env new_e old_e
=
1156 (function (ext
,old_e
) ->
1157 function (e
,rules
) as elem
->
1158 match findk (function (e1
,_
) -> e
=*= e1
) old_e
with
1159 None
-> (elem
:: ext
,old_e
)
1160 | Some
((_
,old_rules
),k
) ->
1161 (ext
,k
(e
,Common.union_set rules old_rules
)))
1163 old_e
@ (List.rev ext
)
1165 let apply_python_rule r cache newes e rules_that_have_matched
1166 rules_that_have_ever_matched
=
1167 Common.profile_code
"python" (fun () ->
1168 show_or_not_scr_rule_name r.scr_ruleid
;
1169 if not
(interpret_dependencies rules_that_have_matched
1170 !rules_that_have_ever_matched
r.scr_dependencies
)
1173 print_dependencies "dependencies for script not satisfied:"
1174 rules_that_have_matched
1175 !rules_that_have_ever_matched
r.scr_dependencies
;
1176 show_or_not_binding "in environment" e
;
1177 (cache
, (e
, rules_that_have_matched
)::newes
)
1181 let (_
, mv, _
) = r.scr_ast_rule
in
1183 (List.map
(function (n
,v
) -> (("virtual",n
),Ast_c.MetaIdVal
(v
,[])))
1184 !Flag.defined_virtual_env
) @ e
in
1185 let not_bound x
= not
(Pycocci.contains_binding
ve x
) in
1186 (match List.filter
not_bound mv with
1188 let relevant_bindings =
1190 (function ((re
,rm
),_
) ->
1191 List.exists
(function (_
,(r,m
)) -> r =*= re
&& m
=$
= rm
) mv)
1194 if List.mem
relevant_bindings cache
1198 "dependencies for script satisfied, but cached:"
1199 rules_that_have_matched
1200 !rules_that_have_ever_matched
1202 show_or_not_binding "in" e
;
1207 print_dependencies "dependencies for script satisfied:"
1208 rules_that_have_matched
1209 !rules_that_have_ever_matched
1211 show_or_not_binding "in" e
;
1212 Pycocci.build_classes
(List.map
(function (x
,y
) -> x
) ve);
1213 Pycocci.construct_variables
mv ve;
1215 Pycocci.pyrun_simplestring
1216 (local_python_code ^
r.script_code
) in
1217 relevant_bindings :: cache
1219 if !Pycocci.inc_match
1220 then (new_cache, merge_env [(e
, rules_that_have_matched
)] newes
)
1221 else (new_cache, newes
)
1223 (if !Flag_cocci.show_dependencies
1225 let m2c (_,(r,x
)) = r^
"."^x
in
1226 pr2
(Printf.sprintf
"script not applied: %s not bound"
1227 (String.concat
", " (List.map
m2c unbound
))));
1228 (cache
, merge_env [(e
, rules_that_have_matched
)] newes
))
1231 let rec apply_cocci_rule r rules_that_have_ever_matched es
1232 (ccs:file_info list
ref) =
1233 Common.profile_code
r.rulename
(fun () ->
1234 show_or_not_rule_name r.ast_rule
r.ruleid
;
1235 show_or_not_ctl_text r.ctl
r.ast_rule
r.ruleid
;
1237 let reorganized_env =
1238 reassociate_positions
r.free_vars
r.negated_pos_vars
!es
in
1240 (* looping over the environments *)
1241 let (_,newes
(* envs for next round/rule *)) =
1243 (function (cache
,newes
) ->
1244 function ((e
,rules_that_have_matched
),relevant_bindings) ->
1245 if not
(interpret_dependencies rules_that_have_matched
1246 !rules_that_have_ever_matched
1251 ("dependencies for rule "^
r.rulename^
" not satisfied:")
1252 rules_that_have_matched
1253 !rules_that_have_ever_matched
r.dependencies
;
1254 show_or_not_binding "in environment" e
;
1257 [(e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
),
1258 rules_that_have_matched
)]
1263 try List.assoc
relevant_bindings cache
1267 ("dependencies for rule "^
r.rulename^
" satisfied:")
1268 rules_that_have_matched
1269 !rules_that_have_ever_matched
1271 show_or_not_binding "in" e
;
1272 show_or_not_binding "relevant in" relevant_bindings;
1274 (* applying the rule *)
1275 (match r.ruletype
with
1277 (* looping over the functions and toplevel elements in
1280 (concat_headers_and_c !ccs +>
1281 List.fold_left
(fun children_e
(c
,f) ->
1284 (* does also some side effects on c and r *)
1286 process_a_ctl_a_env_a_toplevel
r
1287 relevant_bindings c
f in
1288 match processed with
1289 | None
-> children_e
1290 | Some newbindings
->
1293 (fun children_e newbinding
->
1294 if List.mem newbinding children_e
1296 else newbinding
:: children_e
)
1300 | Ast_cocci.Generated
->
1301 process_a_generated_a_env_a_toplevel
r
1302 relevant_bindings !ccs;
1305 let old_bindings_to_keep =
1307 (e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
)) in
1309 if null
new_bindings
1312 (*use the old bindings, specialized to the used_after_list*)
1313 if !Flag_ctl.partial_match
1316 "Empty list of bindings, I will restart from old env\n";
1317 [(old_bindings_to_keep,rules_that_have_matched
)]
1320 (* combine the new bindings with the old ones, and
1321 specialize to the used_after_list *)
1322 let old_variables = List.map fst
old_bindings_to_keep in
1323 (* have to explicitly discard the inherited variables
1324 because we want the inherited value of the positions
1325 variables not the extended one created by
1326 reassociate_positions. want to reassociate freshly
1327 according to the free variables of each rule. *)
1328 let new_bindings_to_add =
1334 (* see comment before combine_pos *)
1335 (s,Ast_c.MetaPosValList
[]) -> false
1337 List.mem
s r.used_after
&&
1338 not
(List.mem
s old_variables)))) in
1340 (function new_binding_to_add
->
1343 old_bindings_to_keep new_binding_to_add
),
1344 r.rulename
::rules_that_have_matched
))
1345 new_bindings_to_add in
1346 ((relevant_bindings,new_bindings)::cache
,
1347 merge_env new_e newes
))
1348 ([],[]) reorganized_env in (* end iter es *)
1350 then Common.push2
r.rulename rules_that_have_ever_matched
;
1354 (* apply the tagged modifs and reparse *)
1355 if not
!Flag.sgrep_mode2
1356 then ccs := rebuild_info_c_and_headers !ccs r.isexp
)
1358 and reassociate_positions free_vars negated_pos_vars envs
=
1359 (* issues: isolate the bindings that are relevant to a given rule.
1360 separate out the position variables
1361 associate all of the position variables for a given set of relevant
1362 normal variable bindings with each set of relevant normal variable
1363 bindings. Goal: if eg if@p (E) matches in two places, then both inherited
1364 occurrences of E should see both bindings of p, not just its own.
1365 Otherwise, a position constraint for something that matches in two
1366 places will never be useful, because the position can always be
1367 different from the other one. *)
1371 List.filter
(function (x
,_) -> List.mem x free_vars
) e
)
1373 let splitted_relevant =
1374 (* separate the relevant variables into the non-position ones and the
1379 (function (non_pos
,pos
) ->
1380 function (v
,_) as x
->
1381 if List.mem v negated_pos_vars
1382 then (non_pos
,x
::pos
)
1383 else (x
::non_pos
,pos
))
1386 let splitted_relevant =
1388 (function (non_pos
,pos
) ->
1389 (List.sort compare non_pos
,List.sort compare pos
))
1390 splitted_relevant in
1393 (function non_pos
->
1395 if List.mem np non_pos
then non_pos
else np
::non_pos
)
1396 [] splitted_relevant in
1397 let extended_relevant =
1398 (* extend the position variables with the values found at other identical
1399 variable bindings *)
1401 (function non_pos
->
1404 (function (other_non_pos
,other_pos
) ->
1405 (* do we want equal? or just somehow compatible? eg non_pos
1406 binds only E, but other_non_pos binds both E and E1 *)
1407 non_pos
=*= other_non_pos
)
1408 splitted_relevant in
1412 (combine_pos negated_pos_vars
1413 (List.map
(function (_,x
) -> x
) others)))))
1416 (List.map
(function (non_pos
,_) -> List.assoc non_pos
extended_relevant)
1419 (* If the negated posvar is not bound at all, this function will
1420 nevertheless bind it to []. If we get rid of these bindings, then the
1421 matching of the term the position variable with the constraints will fail
1422 because some variables are unbound. So we let the binding be [] and then
1423 we will have to clean these up afterwards. This should be the only way
1424 that a position variable can have an empty binding. *)
1425 and combine_pos negated_pos_vars
others =
1431 (function positions ->
1432 function other_list
->
1434 match List.assoc posvar other_list
with
1435 Ast_c.MetaPosValList l1
->
1436 Common.union_set l1
positions
1437 | _ -> failwith
"bad value for a position variable"
1438 with Not_found
-> positions)
1440 (posvar
,Ast_c.MetaPosValList
positions))
1443 and process_a_generated_a_env_a_toplevel2
r env = function
1448 (rule
,_) when rule
=$
= r.rulename
-> false
1449 | (_,"ARGS") -> false
1452 let env_domain = List.map
(function (nm
,vl
) -> nm
) env in
1456 let (rl
,_) = Ast_cocci.get_meta_name md
in rl
=$
= r.rulename
)
1458 if Common.include_set
free_vars env_domain
1459 then Unparse_hrule.pp_rule
metavars r.ast_rule
env cfile
.full_fname
1460 | _ -> failwith
"multiple files not supported"
1462 and process_a_generated_a_env_a_toplevel rule
env ccs =
1463 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1464 (fun () -> process_a_generated_a_env_a_toplevel2 rule
env ccs)
1466 (* does side effects on C ast and on Cocci info rule *)
1467 and process_a_ctl_a_env_a_toplevel2
r e c
f =
1468 indent_do
(fun () ->
1469 show_or_not_celem "trying" c
.ast_c
;
1470 Flag.currentfile
:= Some
(f ^
":" ^
get_celem c
.ast_c
);
1471 let (trans_info, returned_any_states
, inherited_bindings
, newbindings
) =
1472 Common.save_excursion
Flag_ctl.loop_in_src_code
(fun () ->
1473 Flag_ctl.loop_in_src_code
:= !Flag_ctl.loop_in_src_code
||c
.contain_loop;
1475 (***************************************)
1476 (* !Main point! The call to the engine *)
1477 (***************************************)
1478 let model_ctl = CCI.model_for_ctl
r.dropped_isos
(Common.some c
.flow) e
1479 in CCI.mysat
model_ctl r.ctl
(r.used_after
, e
)
1482 if not returned_any_states
1485 show_or_not_celem "found match in" c
.ast_c
;
1486 show_or_not_trans_info trans_info;
1487 List.iter
(show_or_not_binding "out") newbindings
;
1489 r.was_matched
:= true;
1491 if not
(null
trans_info)
1493 c
.was_modified
:= true;
1495 (* les "more than one var in a decl" et "already tagged token"
1496 * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
1497 * failed. Le try limite le scope des crashes pendant la
1498 * trasformation au fichier concerne. *)
1500 (* modify ast via side effect *)
1501 ignore
(Transformation_c.transform
r.rulename
r.dropped_isos
1502 inherited_bindings
trans_info (Common.some c
.flow));
1503 with Timeout
-> raise Timeout
| UnixExit i
-> raise
(UnixExit i
)
1506 Some
(List.map
(function x
-> x
@inherited_bindings
) newbindings
)
1510 and process_a_ctl_a_env_a_toplevel a b c
f=
1511 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1512 (fun () -> process_a_ctl_a_env_a_toplevel2 a b c
f)
1515 let rec bigloop2 rs
(ccs: file_info list
) =
1516 let init_es = [(Ast_c.emptyMetavarsBinding
,[])] in
1517 let es = ref init_es in
1518 let ccs = ref ccs in
1519 let rules_that_have_ever_matched = ref [] in
1521 (* looping over the rules *)
1522 rs
+> List.iter
(fun r ->
1524 InitialScriptRuleCocciInfo
r | FinalScriptRuleCocciInfo
r -> ()
1525 | ScriptRuleCocciInfo
r ->
1526 if !Flag_cocci.show_ctl_text
then begin
1527 Common.pr_xxxxxxxxxxxxxxxxx
();
1528 pr
("script: " ^
r.language
);
1529 Common.pr_xxxxxxxxxxxxxxxxx
();
1531 adjust_pp_with_indent
(fun () ->
1532 Format.force_newline
();
1533 let (l,mv,code
) = r.scr_ast_rule
in
1534 let deps = r.scr_dependencies
in
1535 Pretty_print_cocci.unparse
1536 (Ast_cocci.ScriptRule
(l,deps,mv,code
)));
1539 if !Flag.show_misc
then print_endline
"RESULT =";
1543 (function (cache
, newes
) ->
1544 function (e
, rules_that_have_matched
) ->
1545 match r.language
with
1547 apply_python_rule r cache newes e rules_that_have_matched
1548 rules_that_have_ever_matched
1550 concat_headers_and_c !ccs +> List.iter
(fun (c
,_) ->
1553 Printf.printf
"Flow: %s\r\nFlow!\r\n%!" c
.fullstring
);
1556 Printf.printf
"Unknown language: %s\n" r.language
;
1561 es := (if newes
= [] then init_es else newes
);
1562 | CocciRuleCocciInfo
r ->
1563 apply_cocci_rule r rules_that_have_ever_matched
1566 if !Flag.sgrep_mode2
1568 (* sgrep can lead to code that is not parsable, but we must
1569 * still call rebuild_info_c_and_headers to pretty print the
1570 * action (MINUS), so that later the diff will show what was
1571 * matched by sgrep. But we don't want the parsing error message
1572 * hence the following flag setting. So this code propably
1573 * will generate a NotParsedCorrectly for the matched parts
1574 * and the very final pretty print and diff will work
1576 Flag_parsing_c.verbose_parsing
:= false;
1577 ccs := rebuild_info_c_and_headers !ccs false
1579 !ccs (* return final C asts *)
1582 Common.profile_code
"bigloop" (fun () -> bigloop2 a b
)
1584 let initial_final_bigloop2 ty rebuild
r =
1585 if !Flag_cocci.show_ctl_text
then
1587 Common.pr_xxxxxxxxxxxxxxxxx
();
1588 pr
(ty ^
": " ^
r.language
);
1589 Common.pr_xxxxxxxxxxxxxxxxx
();
1591 adjust_pp_with_indent
(fun () ->
1592 Format.force_newline
();
1593 Pretty_print_cocci.unparse
(rebuild
r.scr_ast_rule
r.scr_dependencies
));
1596 match r.language
with
1598 (* include_match makes no sense in an initial or final rule, although
1599 we have no way to prevent it *)
1600 let _ = apply_python_rule r [] [] [] [] (ref []) in
1603 Printf.printf
"Unknown language for initial/final script: %s\n"
1606 let initial_final_bigloop a b c
=
1607 Common.profile_code
"initial_final_bigloop"
1608 (fun () -> initial_final_bigloop2 a b c
)
1610 (*****************************************************************************)
1611 (* The main functions *)
1612 (*****************************************************************************)
1614 let pre_engine2 (coccifile
, isofile
) =
1615 show_or_not_cocci coccifile isofile
;
1616 Pycocci.set_coccifile coccifile
;
1619 if not
(Common.lfile_exists
isofile)
1621 pr2
("warning: Can't find default iso file: " ^
isofile);
1624 else Some
isofile in
1626 (* useful opti when use -dir *)
1627 let (metavars,astcocci
,free_var_lists
,negated_pos_lists
,used_after_lists
,
1628 positions_lists
,toks
,_) =
1629 sp_of_file coccifile
isofile in
1630 let ctls = ctls_of_ast astcocci used_after_lists positions_lists
in
1632 g_contain_typedmetavar := sp_contain_typed_metavar astcocci
;
1634 check_macro_in_sp_and_adjust toks
;
1636 show_or_not_ctl_tex astcocci
ctls;
1639 prepare_cocci ctls free_var_lists negated_pos_lists
1640 used_after_lists positions_lists
metavars astcocci
in
1642 let used_languages =
1644 (function languages
->
1646 ScriptRuleCocciInfo
(r) ->
1647 if List.mem
r.language languages
then
1650 r.language
::languages
1654 let initialized_languages =
1656 (function languages
->
1658 InitialScriptRuleCocciInfo
(r) ->
1659 (if List.mem
r.language languages
1662 ("double initializer found for "^
r.language
));
1663 if interpret_dependencies [] [] r.scr_dependencies
1666 initial_final_bigloop "initial"
1667 (fun (x
,_,y
) -> fun deps ->
1668 Ast_cocci.InitialScriptRule
(x
,deps,y
))
1670 r.language
::languages
1676 let uninitialized_languages =
1678 (fun used
-> not
(List.mem used
initialized_languages))
1681 List.iter
(fun lgg
->
1682 initial_final_bigloop "initial"
1683 (fun (x
,_,y
) -> fun deps ->
1684 Ast_cocci.InitialScriptRule
(x
,deps,y
))
1685 (make_init (-1) lgg
Ast_cocci.NoDep
"");
1687 uninitialized_languages;
1692 Common.profile_code
"pre_engine" (fun () -> pre_engine2 a
)
1694 let full_engine2 (cocci_infos,toks
) cfiles
=
1696 show_or_not_cfiles cfiles
;
1698 (* optimisation allowing to launch coccinelle on all the drivers *)
1699 if !Flag_cocci.worth_trying_opt
&& not
(worth_trying cfiles toks
)
1702 pr2
("No matches found for " ^
(Common.join
" " (Common.union_all toks
))
1703 ^
"\nSkipping:" ^
(Common.join
" " cfiles
));
1704 cfiles
+> List.map
(fun s -> s, None
)
1709 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1710 if !Flag.show_misc
then pr
"let's go";
1711 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1713 let choose_includes =
1714 match !Flag_cocci.include_options
with
1715 Flag_cocci.I_UNSPECIFIED
->
1716 if !g_contain_typedmetavar
1717 then Flag_cocci.I_NORMAL_INCLUDES
1718 else Flag_cocci.I_NO_INCLUDES
1720 let c_infos = prepare_c cfiles
choose_includes in
1722 (* ! the big loop ! *)
1723 let c_infos'
= bigloop cocci_infos c_infos in
1725 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1726 if !Flag.show_misc
then pr
"Finished";
1727 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1728 if !Flag_ctl.graphical_trace
then gen_pdf_graph ();
1730 c_infos'
+> List.map
(fun c_or_h
->
1731 if !(c_or_h
.was_modified_once
)
1735 Common.new_temp_file
"cocci-output" ("-" ^ c_or_h
.fname
) in
1737 if c_or_h
.fkind
=*= Header
1738 then pr2
("a header file was modified: " ^ c_or_h
.fname
);
1740 (* and now unparse everything *)
1741 cfile_of_program (for_unparser c_or_h
.asts
) outfile;
1743 show_or_not_diff c_or_h
.fpath
outfile;
1746 if !Flag.sgrep_mode2
then None
else Some
outfile)
1748 else (c_or_h
.fpath
, None
))
1751 let full_engine a b
=
1752 Common.profile_code
"full_engine"
1753 (fun () -> let res = full_engine2 a b
in (*Gc.print_stat stderr; *)res)
1755 let post_engine2 (cocci_infos,_) =
1758 (function languages
->
1760 FinalScriptRuleCocciInfo
(r) ->
1761 (if List.mem
r.language languages
1762 then failwith
("double finalizer found for "^
r.language
));
1763 initial_final_bigloop "final"
1764 (fun (x
,_,y
) -> fun deps -> Ast_cocci.FinalScriptRule
(x
,deps,y
))
1766 r.language
::languages
1772 Common.profile_code
"post_engine" (fun () -> post_engine2 a
)
1774 (*****************************************************************************)
1775 (* check duplicate from result of full_engine *)
1776 (*****************************************************************************)
1778 let check_duplicate_modif2 xs =
1779 (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
1780 if !Flag_cocci.verbose_cocci
1781 then pr2
("Check duplication for " ^ i_to_s
(List.length
xs) ^
" files");
1783 let groups = Common.group_assoc_bykey_eff
xs in
1784 groups +> Common.map_filter
(fun (file, xs) ->
1786 | [] -> raise Impossible
1787 | [res] -> Some
(file, res)
1791 if not
(List.for_all
(fun res2
-> res2
=*= None
) xs)
1793 pr2
("different modification result for " ^
file);
1796 else Some
(file, None
)
1798 if not
(List.for_all
(fun res2
->
1802 let diff = Common.cmd_to_list
("diff -u -b -B "^
res^
" "^res2
)
1806 pr2
("different modification result for " ^
file);
1809 else Some
(file, Some
res)
1811 let check_duplicate_modif a
=
1812 Common.profile_code
"check_duplicate" (fun () -> check_duplicate_modif2 a
)