3 module CCI
= Ctlcocci_integration
4 module TAC
= Type_annoter_c
6 module Ast_to_flow
= Control_flow_c_build
8 (*****************************************************************************)
9 (* This file is a kind of driver. It gathers all the important functions
10 * from coccinelle in one place. The different entities in coccinelle are:
14 * - flow (contain nodes)
15 * - ctl (contain rule_elems)
16 * This file contains functions to transform one in another.
18 (*****************************************************************************)
20 (* --------------------------------------------------------------------- *)
22 (* --------------------------------------------------------------------- *)
23 let cprogram_of_file file
=
24 let (program2
, _stat
) = Parse_c.parse_c_and_cpp file
in
27 let cprogram_of_file_cached file
=
28 let (program2
, _stat
) = Parse_c.parse_cache file
in
29 if !Flag_cocci.ifdef_to_if
31 program2
+> Parse_c.with_program2
(fun asts
->
32 Cpp_ast_c.cpp_ifdef_statementize asts
36 let cfile_of_program program2_with_ppmethod outf
=
37 Unparse_c.pp_program program2_with_ppmethod outf
39 (* for memoization, contains only one entry, the one for the SP *)
40 let _hparse = Hashtbl.create
101
41 let _hctl = Hashtbl.create
101
43 (* --------------------------------------------------------------------- *)
45 (* --------------------------------------------------------------------- *)
46 let sp_of_file2 file iso
=
47 Common.memoized
_hparse (file
, iso
) (fun () ->
48 Parse_cocci.process file iso
false)
49 let sp_of_file file iso
=
50 Common.profile_code
"parse cocci" (fun () -> sp_of_file2 file iso
)
53 (* --------------------------------------------------------------------- *)
55 (* --------------------------------------------------------------------- *)
57 Ograph_extended.print_ograph_mutable flow
"/tmp/test.dot" true
60 let ast_to_flow_with_error_messages2 x
=
62 try Ast_to_flow.ast_to_control_flow x
63 with Ast_to_flow.Error x
->
64 Ast_to_flow.report_error x
;
67 flowopt +> do_option
(fun flow
->
68 (* This time even if there is a deadcode, we still have a
69 * flow graph, so I can try the transformation and hope the
70 * deadcode will not bother us.
72 try Ast_to_flow.deadcode_detection flow
73 with Ast_to_flow.Error
(Ast_to_flow.DeadCode x
) ->
74 Ast_to_flow.report_error
(Ast_to_flow.DeadCode x
);
77 let ast_to_flow_with_error_messages a
=
78 Common.profile_code
"flow" (fun () -> ast_to_flow_with_error_messages2 a
)
81 (* --------------------------------------------------------------------- *)
83 (* --------------------------------------------------------------------- *)
85 let ctls_of_ast2 ast
(ua
,fua
,fuas
) pos
=
87 (function ast
-> function (ua
,(fua
,(fuas
,pos
))) ->
91 else Asttoctl2.asttoctl ast
(ua
,fua
,fuas
) pos
)
92 (Asttomember.asttomember ast ua
))
93 ast
(List.combine ua
(List.combine fua
(List.combine fuas pos
)))
95 let ctls_of_ast ast ua
=
96 Common.profile_code
"asttoctl2" (fun () -> ctls_of_ast2 ast ua
)
98 (*****************************************************************************)
99 (* Some debugging functions *)
100 (*****************************************************************************)
104 let show_or_not_cfile2 cfile
=
105 if !Flag_cocci.show_c
then begin
106 Common.pr2_xxxxxxxxxxxxxxxxx
();
107 pr2
("processing C file: " ^ cfile
);
108 Common.pr2_xxxxxxxxxxxxxxxxx
();
109 Common.command2
("cat " ^ cfile
);
111 let show_or_not_cfile a
=
112 Common.profile_code
"show_xxx" (fun () -> show_or_not_cfile2 a
)
114 let show_or_not_cfiles cfiles
= List.iter
show_or_not_cfile cfiles
117 let show_or_not_cocci2 coccifile isofile
=
118 if !Flag_cocci.show_cocci
then begin
119 Common.pr2_xxxxxxxxxxxxxxxxx
();
120 pr2
("processing semantic patch file: " ^ coccifile
);
121 isofile
+> (fun s
-> pr2
("with isos from: " ^ s
));
122 Common.pr2_xxxxxxxxxxxxxxxxx
();
123 Common.command2
("cat " ^ coccifile
);
126 let show_or_not_cocci a b
=
127 Common.profile_code
"show_xxx" (fun () -> show_or_not_cocci2 a b
)
131 let show_or_not_diff2 cfile outfile show_only_minus
=
132 if !Flag_cocci.show_diff
then begin
133 match Common.fst
(Compare_c.compare_to_original cfile outfile
) with
134 Compare_c.Correct
-> () (* diff only in spacing, etc *)
136 (* may need --strip-trailing-cr under windows *)
140 match !Flag_parsing_c.diff_lines
with
141 | None
-> "diff -u -p " ^ cfile ^
" " ^ outfile
142 | Some n
-> "diff -U "^n^
" -p "^cfile^
" "^outfile
in
144 let res = Common.cmd_to_list
line in
145 match (!Flag.patch
,res) with
146 (* create something that looks like the output of patch *)
147 (Some prefix
,minus_file
::plus_file
::rest
) ->
148 let drop_prefix file
=
152 let lp = String.length prefix
in
153 String.sub file
lp ((String.length file
) - lp) in
155 match List.rev
(Str.split
(Str.regexp
" ") line) with
156 new_file
::old_file
::cmdrev
->
160 (List.rev
("/tmp/nothing" :: old_file
:: cmdrev
))
162 let old_base_file = drop_prefix old_file
in
165 (("b"^
old_base_file)::("a"^
old_base_file)::cmdrev
))
166 | _
-> failwith
"bad command" in
167 let (minus_line
,plus_line
) =
169 then (minus_file
,plus_file
)
171 match (Str.split
(Str.regexp
"[ \t]") minus_file
,
172 Str.split
(Str.regexp
"[ \t]") plus_file
) with
173 ("---"::old_file
::old_rest
,"+++"::new_file
::new_rest
) ->
174 let old_base_file = drop_prefix old_file
in
176 ("---"::("a"^
old_base_file)::old_rest
),
178 ("+++"::("b"^
old_base_file)::new_rest
))
181 (Printf.sprintf
"bad diff header lines: %s %s"
182 (String.concat
":" l1
) (String.concat
":" l2
)) in
183 diff_line::minus_line
::plus_line
::rest
185 xs +> List.iter
(fun s
->
186 if s
=~
"^\\+" && show_only_minus
190 let show_or_not_diff a b c
=
191 Common.profile_code
"show_xxx" (fun () -> show_or_not_diff2 a b c
)
194 (* the derived input *)
196 let show_or_not_ctl_tex2 astcocci ctls
=
197 if !Flag_cocci.show_ctl_tex
then begin
198 Ctltotex.totex
("/tmp/__cocci_ctl.tex") astcocci ctls
;
199 Common.command2
("cd /tmp; latex __cocci_ctl.tex; " ^
200 "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
201 "gv __cocci_ctl.ps &");
203 let show_or_not_ctl_tex a b
=
204 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_tex2 a b
)
208 let show_or_not_rule_name ast rulenb
=
209 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
210 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
215 Ast_cocci.CocciRule
(nm
, (deps
, drops
, exists
), x
, _
, _
) -> nm
216 | _
-> i_to_s rulenb
in
217 Common.pr_xxxxxxxxxxxxxxxxx
();
219 Common.pr_xxxxxxxxxxxxxxxxx
()
222 let show_or_not_scr_rule_name rulenb
=
223 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
224 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
227 let name = i_to_s rulenb
in
228 Common.pr_xxxxxxxxxxxxxxxxx
();
229 pr
("script rule " ^
name ^
" = ");
230 Common.pr_xxxxxxxxxxxxxxxxx
()
233 let show_or_not_ctl_text2 ctl ast rulenb
=
234 if !Flag_cocci.show_ctl_text
then begin
236 adjust_pp_with_indent
(fun () ->
237 Format.force_newline
();
238 Pretty_print_cocci.print_plus_flag
:= true;
239 Pretty_print_cocci.print_minus_flag
:= true;
240 Pretty_print_cocci.unparse ast
;
245 adjust_pp_with_indent
(fun () ->
246 Format.force_newline
();
247 Pretty_print_engine.pp_ctlcocci
248 !Flag_cocci.show_mcodekind_in_ctl
!Flag_cocci.inline_let_ctl ctl
;
252 let show_or_not_ctl_text a b c
=
253 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_text2 a b c
)
257 (* running information *)
258 let get_celem celem
: string =
260 Ast_c.Definition
({Ast_c.f_name
= namefuncs
;},_
) ->
261 Ast_c.str_of_name namefuncs
263 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name, _
);}, _
], _
)) ->
264 Ast_c.str_of_name
name
267 let show_or_not_celem2 prelude celem
=
270 | Ast_c.Definition
({Ast_c.f_name
= namefuncs
},_
) ->
271 let funcs = Ast_c.str_of_name namefuncs
in
272 Flag.current_element
:= funcs;
273 (" function: ",funcs)
275 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name,_
)}, _
], _
)) ->
276 let s = Ast_c.str_of_name
name in
277 Flag.current_element
:= s;
280 Flag.current_element
:= "something_else";
281 (" ","something else");
283 if !Flag.show_trying
then pr2
(prelude ^ tag ^ trying
)
285 let show_or_not_celem a b
=
286 Common.profile_code
"show_xxx" (fun () -> show_or_not_celem2 a b
)
289 let show_or_not_trans_info2 trans_info
=
290 (* drop witness tree indices for printing *)
292 List.map
(function (index
,trans_info) -> trans_info) trans_info in
293 if !Flag.show_transinfo
then begin
294 if null
trans_info then pr2
"transformation info is empty"
296 pr2
"transformation info returned:";
298 List.sort
(function (i1
,_
,_
) -> function (i2
,_
,_
) -> compare i1 i2
)
302 trans_info +> List.iter
(fun (i
, subst
, re
) ->
303 pr2
("transform state: " ^
(Common.i_to_s i
));
305 adjust_pp_with_indent_and_header
"with rule_elem: " (fun () ->
306 Pretty_print_cocci.print_plus_flag
:= true;
307 Pretty_print_cocci.print_minus_flag
:= true;
308 Pretty_print_cocci.rule_elem
"" re
;
310 adjust_pp_with_indent_and_header
"with binding: " (fun () ->
311 Pretty_print_engine.pp_binding subst
;
318 let show_or_not_trans_info a
=
319 Common.profile_code
"show_xxx" (fun () -> show_or_not_trans_info2 a
)
323 let show_or_not_binding2 s binding
=
324 if !Flag_cocci.show_binding_in_out
then begin
325 adjust_pp_with_indent_and_header
("binding " ^
s ^
" = ") (fun () ->
326 Pretty_print_engine.pp_binding binding
329 let show_or_not_binding a b
=
330 Common.profile_code
"show_xxx" (fun () -> show_or_not_binding2 a b
)
334 (*****************************************************************************)
335 (* Some helper functions *)
336 (*****************************************************************************)
338 let worth_trying cfiles tokens
=
339 (* drop the following line for a list of list by rules. since we don't
340 allow multiple minirules, all the tokens within a rule should be in
341 a single CFG entity *)
342 let tokens = Common.union_all
tokens in
343 if not
!Flag_cocci.windows
&& not
(null
tokens)
345 (* could also modify the code in get_constants.ml *)
346 let tokens = tokens +> List.map
(fun s ->
348 | _
when s =~
"^[A-Za-z_][A-Za-z_0-9]*$" ->
351 | _
when s =~
"^[A-Za-z_]" ->
354 | _
when s =~
".*[A-Za-z_]$" ->
359 let com = sprintf
"egrep -q '(%s)' %s" (join
"|" tokens) (join
" " cfiles
)
361 (match Sys.command
com with
362 | 0 (* success *) -> true
365 then Printf.printf
"grep failed: %s\n" com);
366 false (* no match, so not worth trying *)
370 let check_macro_in_sp_and_adjust tokens =
371 let tokens = Common.union_all
tokens in
372 tokens +> List.iter
(fun s ->
373 if Hashtbl.mem
!Parse_c._defs
s
375 if !Flag_cocci.verbose_cocci
then begin
376 pr2
"warning: macro in semantic patch was in macro definitions";
377 pr2
("disabling macro expansion for " ^
s);
379 Hashtbl.remove
!Parse_c._defs
s
384 let contain_loop gopt
=
387 g#nodes#tolist
+> List.exists
(fun (xi
, node
) ->
388 Control_flow_c.extract_is_loop node
390 | None
-> true (* means nothing, if no g then will not model check *)
394 let sp_contain_typed_metavar_z toplevel_list_list
=
395 let bind x y
= x
or y
in
396 let option_default = false in
397 let mcode _ _
= option_default in
398 let donothing r k e
= k e
in
400 let expression r k e
=
401 match Ast_cocci.unwrap e
with
402 | Ast_cocci.MetaExpr
(_
,_
,_
,Some t
,_
,_
) -> true
403 | Ast_cocci.MetaExpr
(_
,_
,_
,_
,Ast_cocci.LocalID
,_
) -> true
408 Visitor_ast.combiner bind option_default
409 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
410 donothing donothing donothing donothing
411 donothing expression donothing donothing donothing donothing donothing
412 donothing donothing donothing donothing donothing
414 toplevel_list_list
+>
416 (function (nm
,_
,rule
) ->
417 (List.exists
combiner.Visitor_ast.combiner_top_level rule
))
420 let sp_contain_typed_metavar rules
=
421 sp_contain_typed_metavar_z
425 Ast_cocci.CocciRule
(a
,b
,c
,d
,_
) -> (a
,b
,c
)
426 | _
-> failwith
"error in filter")
430 Ast_cocci.CocciRule
(a
,b
,c
,d
,Ast_cocci.Normal
) -> true
436 (* finding among the #include the one that we need to parse
437 * because they may contain useful type definition or because
438 * we may have to modify them
440 * For the moment we base in part our heuristic on the name of the file, e.g.
441 * serio.c is related we think to #include <linux/serio.h>
444 let interpret_include_path _
=
445 match !Flag_cocci.include_path
with
449 let (includes_to_parse
:
450 (Common.filename
* Parse_c.program2
) list
->
451 Flag_cocci.include_options
-> 'a
) = fun xs choose_includes
->
452 match choose_includes
with
453 Flag_cocci.I_UNSPECIFIED
-> failwith
"not possible"
454 | Flag_cocci.I_NO_INCLUDES
-> []
456 let all_includes = x
=*= Flag_cocci.I_ALL_INCLUDES
in
457 xs +> List.map
(fun (file
, cs
) ->
458 let dir = Common.dirname file
in
460 cs
+> Common.map_filter
(fun (c
,_info_item
) ->
464 {Ast_c.i_include
= ((x
,ii
)); i_rel_pos
= info_h_pos
;}) ->
467 let f = Filename.concat
dir (Common.join
"/" xs) in
468 (* for our tests, all the files are flat in the current dir *)
469 if not
(Sys.file_exists
f) && !Flag_cocci.relax_include_path
471 let attempt2 = Filename.concat
dir (Common.last
xs) in
472 if not
(Sys.file_exists
f) && all_includes
473 then Some
(Filename.concat
(interpret_include_path())
474 (Common.join
"/" xs))
478 | Ast_c.NonLocal
xs ->
480 Common.fileprefix
(Common.last
xs) =$
= Common.fileprefix file
482 Some
(Filename.concat
(interpret_include_path())
483 (Common.join
"/" xs))
485 | Ast_c.Weird _
-> None
491 let rec interpret_dependencies local global
= function
492 Ast_cocci.Dep
s -> List.mem
s local
493 | Ast_cocci.AntiDep
s ->
494 (if !Flag_ctl.steps
!= None
495 then failwith
"steps and ! dependency incompatible");
496 not
(List.mem
s local
)
497 | Ast_cocci.EverDep
s -> List.mem
s global
498 | Ast_cocci.NeverDep
s ->
499 (if !Flag_ctl.steps
!= None
500 then failwith
"steps and ! dependency incompatible");
501 not
(List.mem
s global
)
502 | Ast_cocci.AndDep
(s1
,s2
) ->
503 (interpret_dependencies local global s1
) &&
504 (interpret_dependencies local global s2
)
505 | Ast_cocci.OrDep
(s1
,s2
) ->
506 (interpret_dependencies local global s1
) or
507 (interpret_dependencies local global s2
)
508 | Ast_cocci.NoDep
-> true
509 | Ast_cocci.FailDep
-> false
511 let rec print_dependencies str local global dep
=
512 if !Flag_cocci.show_dependencies
517 let rec loop = function
518 Ast_cocci.Dep
s | Ast_cocci.AntiDep
s ->
519 if not
(List.mem
s !seen)
523 then pr2
(s^
" satisfied")
524 else pr2
(s^
" not satisfied");
527 | Ast_cocci.EverDep
s | Ast_cocci.NeverDep
s ->
528 if not
(List.mem
s !seen)
532 then pr2
(s^
" satisfied")
533 else pr2
(s^
" not satisfied");
536 | Ast_cocci.AndDep
(s1
,s2
) ->
539 | Ast_cocci.OrDep
(s1
,s2
) ->
542 | Ast_cocci.NoDep
-> ()
543 | Ast_cocci.FailDep
-> pr2
"False not satisfied" in
547 (* --------------------------------------------------------------------- *)
548 (* #include relative position in the file *)
549 (* --------------------------------------------------------------------- *)
551 (* compute the set of new prefixes
553 * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *)
557 * it would give
for the first element
558 * ""; "a"; "a/b"; "a/b/x"
562 * update
: if the
include is inside a ifdef a put nothing
. cf
-test incl
.
563 * this is because we dont want code added inside ifdef
.
566 let compute_new_prefixes xs =
567 xs +> Common.map_withenv
(fun already
xs ->
568 let subdirs_prefixes = Common.inits
xs in
569 let new_first = subdirs_prefixes +> List.filter
(fun x
->
570 not
(List.mem x already
)
579 (* does via side effect on the ref in the Include in Ast_c *)
580 let rec update_include_rel_pos cs
=
581 let only_include = cs
+> Common.map_filter
(fun c
->
583 | Ast_c.CppTop
(Ast_c.Include
{Ast_c.i_include
= ((x
,_
));
585 i_is_in_ifdef
= inifdef
}) ->
587 | Ast_c.Weird _
-> None
596 let (locals
, nonlocals
) =
597 only_include +> Common.partition_either
(fun (c
, aref
) ->
599 | Ast_c.Local x
-> Left
(x
, aref
)
600 | Ast_c.NonLocal x
-> Right
(x
, aref
)
601 | Ast_c.Weird x
-> raise Impossible
604 update_rel_pos_bis locals
;
605 update_rel_pos_bis nonlocals
;
607 and update_rel_pos_bis
xs =
608 let xs'
= List.map fst
xs in
609 let the_first = compute_new_prefixes xs'
in
610 let the_last = List.rev
(compute_new_prefixes (List.rev
xs'
)) in
611 let merged = Common.zip
xs (Common.zip
the_first the_last) in
612 merged +> List.iter
(fun ((x
, aref
), (the_first, the_last)) ->
615 Ast_c.first_of
= the_first;
616 Ast_c.last_of
= the_last;
625 (*****************************************************************************)
626 (* All the information needed around the C elements and Cocci rules *)
627 (*****************************************************************************)
629 type toplevel_c_info
= {
630 ast_c
: Ast_c.toplevel
; (* contain refs so can be modified *)
631 tokens_c
: Parser_c.token list
;
634 flow
: Control_flow_c.cflow
option; (* it's the "fixed" flow *)
637 env_typing_before
: TAC.environment
;
638 env_typing_after
: TAC.environment
;
640 was_modified
: bool ref;
645 type toplevel_cocci_info_script_rule
= {
646 scr_ast_rule
: string * (string * (string * string)) list
* string;
648 scr_dependencies
: Ast_cocci.dependency
;
653 type toplevel_cocci_info_cocci_rule
= {
654 ctl
: Lib_engine.ctlcocci
* (CCI.pred list list
);
655 metavars
: Ast_cocci.metavar list
;
656 ast_rule
: Ast_cocci.rule
;
657 isexp
: bool; (* true if + code is an exp, only for Flag.make_hrule *)
660 dependencies
: Ast_cocci.dependency
;
661 (* There are also some hardcoded rule names in parse_cocci.ml:
662 * let reserved_names = ["all";"optional_storage";"optional_qualifier"]
664 dropped_isos
: string list
;
665 free_vars
: Ast_cocci.meta_name list
;
666 negated_pos_vars
: Ast_cocci.meta_name list
;
667 used_after
: Ast_cocci.meta_name list
;
668 positions
: Ast_cocci.meta_name list
;
671 ruletype
: Ast_cocci.ruletype
;
673 was_matched
: bool ref;
676 type toplevel_cocci_info
=
677 ScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
678 | InitialScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
679 | FinalScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
680 | CocciRuleCocciInfo
of toplevel_cocci_info_cocci_rule
682 type cocci_info
= toplevel_cocci_info list
* string list list
(* tokens *)
684 type kind_file
= Header
| Source
688 was_modified_once
: bool ref;
689 asts
: toplevel_c_info list
;
694 let g_contain_typedmetavar = ref false
697 let last_env_toplevel_c_info xs =
698 (Common.last
xs).env_typing_after
700 let concat_headers_and_c (ccs
: file_info list
)
701 : (toplevel_c_info
* string) list
=
702 (List.concat
(ccs
+> List.map
(fun x
->
703 x
.asts
+> List.map
(fun x'
->
706 let for_unparser xs =
707 xs +> List.map
(fun x
->
708 (x
.ast_c
, (x
.fullstring
, x
.tokens_c
)), Unparse_c.PPviastr
711 let gen_pdf_graph () =
712 (Ctl_engine.get_graph_files
()) +> List.iter
(fun outfile
->
713 Printf.printf
"Generation of %s%!" outfile
;
714 let filename_stack = Ctl_engine.get_graph_comp_files outfile
in
715 List.iter
(fun filename
->
716 ignore
(Unix.system
("dot " ^ filename ^
" -Tpdf -o " ^ filename ^
".pdf;"))
718 let (head
,tail
) = (List.hd
filename_stack, List.tl
filename_stack) in
719 ignore
(Unix.system
("cp " ^ head ^
".pdf " ^ outfile ^
".pdf;"));
720 tail
+> List.iter
(fun filename
->
721 ignore
(Unix.system
("mv " ^ outfile ^
".pdf /tmp/tmp.pdf;"));
722 ignore
(Unix.system
("pdftk " ^ filename ^
".pdf /tmp/tmp.pdf cat output " ^ outfile ^
".pdf"));
724 ignore
(Unix.system
("rm /tmp/tmp.pdf;"));
725 List.iter
(fun filename
->
726 ignore
(Unix.system
("rm " ^ filename ^
" " ^ filename ^
".pdf;"))
728 Printf.printf
" - Done\n")
731 (* --------------------------------------------------------------------- *)
732 let prepare_cocci ctls free_var_lists negated_pos_lists
733 (ua
,fua
,fuas
) positions_list metavars astcocci
=
735 let gathered = Common.index_list_1
736 (zip
(zip
(zip
(zip
(zip
(zip
(zip
(zip ctls metavars
) astcocci
)
738 negated_pos_lists
) ua
) fua
) fuas
) positions_list
)
741 (fun (((((((((ctl_toplevel_list
,metavars
),ast
),free_var_list
),
742 negated_pos_list
),ua
),fua
),fuas
),positions_list
),rulenb
) ->
744 let is_script_rule r
=
746 Ast_cocci.ScriptRule _
747 | Ast_cocci.InitialScriptRule _
| Ast_cocci.FinalScriptRule _
-> true
750 if not
(List.length ctl_toplevel_list
=|= 1) && not
(is_script_rule ast
)
751 then failwith
"not handling multiple minirules";
754 Ast_cocci.ScriptRule
(lang
,deps
,mv
,code
) ->
757 scr_ast_rule
= (lang
, mv
, code
);
759 scr_dependencies
= deps
;
763 in ScriptRuleCocciInfo
r
764 | Ast_cocci.InitialScriptRule
(lang
,code
) ->
766 let deps = Ast_cocci.NoDep
in
769 scr_ast_rule
= (lang
, mv, code
);
771 scr_dependencies
= deps;
775 in InitialScriptRuleCocciInfo
r
776 | Ast_cocci.FinalScriptRule
(lang
,code
) ->
778 let deps = Ast_cocci.NoDep
in
781 scr_ast_rule
= (lang
, mv, code
);
783 scr_dependencies
= deps;
787 in FinalScriptRuleCocciInfo
r
788 | Ast_cocci.CocciRule
789 (rulename
,(dependencies
,dropped_isos
,z
),restast
,isexp
,ruletype
) ->
792 ctl
= List.hd ctl_toplevel_list
;
795 isexp
= List.hd isexp
;
797 dependencies
= dependencies
;
798 dropped_isos
= dropped_isos
;
799 free_vars
= List.hd free_var_list
;
800 negated_pos_vars
= List.hd negated_pos_list
;
801 used_after
= (List.hd ua
) @ (List.hd fua
);
802 positions
= List.hd positions_list
;
805 was_matched
= ref false;
810 (* --------------------------------------------------------------------- *)
812 let build_info_program cprogram env
=
814 let (cs
, parseinfos
) =
815 Common.unzip cprogram
in
818 parseinfos
+> List.map
(fun (s,toks
) -> toks
) +> List.flatten
in
820 (* I use cs' but really annotate_xxx work by doing side effects on cs *)
822 Comment_annotater_c.annotate_program
alltoks cs in
824 Type_annoter_c.annotate_program env
(*!g_contain_typedmetavar*) cs'
827 zip
cs_with_envs parseinfos
+> List.map
(fun ((c
, (enva
,envb
)), parseinfo
)->
828 let (fullstr
, tokens) = parseinfo
in
831 ast_to_flow_with_error_messages c
+>
832 Common.map_option
(fun flow ->
833 let flow = Ast_to_flow.annotate_loop_nodes
flow in
835 (* remove the fake nodes for julia *)
836 let fixed_flow = CCI.fix_flow_ctl
flow in
838 if !Flag_cocci.show_flow
then print_flow fixed_flow;
839 if !Flag_cocci.show_before_fixed_flow
then print_flow flow;
846 ast_c
= c
; (* contain refs so can be modified *)
848 fullstring
= fullstr
;
852 contain_loop = contain_loop flow;
854 env_typing_before
= enva
;
855 env_typing_after
= envb
;
857 was_modified
= ref false;
863 (* Optimisation. Try not unparse/reparse the whole file when have modifs *)
864 let rebuild_info_program cs file isexp
=
865 cs +> List.map
(fun c
->
868 let file = Common.new_temp_file
"cocci_small_output" ".c" in
870 [(c
.ast_c
, (c
.fullstring
, c
.tokens_c
)), Unparse_c.PPnormal
]
873 (* Common.command2 ("cat " ^ file); *)
874 let cprogram = cprogram_of_file file in
875 let xs = build_info_program cprogram c
.env_typing_before
in
877 (* TODO: assert env has not changed,
878 * if yes then must also reparse what follows even if not modified.
879 * Do that only if contain_typedmetavar of course, so good opti.
881 (* Common.list_init xs *) (* get rid of the FinalDef *)
887 let rebuild_info_c_and_headers ccs isexp
=
888 ccs
+> List.iter
(fun c_or_h
->
889 if c_or_h
.asts
+> List.exists
(fun c
-> !(c
.was_modified
))
890 then c_or_h
.was_modified_once
:= true;
892 ccs
+> List.map
(fun c_or_h
->
895 rebuild_info_program c_or_h
.asts c_or_h
.full_fname isexp
}
904 let prepare_c files choose_includes
: file_info list
=
905 let cprograms = List.map
cprogram_of_file_cached files
in
906 let includes = includes_to_parse
(zip files
cprograms) choose_includes
in
908 (* todo?: may not be good to first have all the headers and then all the c *)
910 (includes +> List.map
(fun hpath
-> Right hpath
))
912 ((zip files
cprograms) +> List.map
(fun (file, asts
) -> Left
(file, asts
)))
915 let env = ref !TAC.initial_env
in
917 let ccs = all +> Common.map_filter
(fun x
->
920 if not
(Common.lfile_exists hpath
)
922 pr2
("TYPE: header " ^ hpath ^
" not found");
926 let h_cs = cprogram_of_file_cached hpath
in
927 let info_h_cs = build_info_program h_cs !env in
931 else last_env_toplevel_c_info info_h_cs
934 fname
= Common.basename hpath
;
937 was_modified_once
= ref false;
941 | Left
(file, cprogram) ->
942 (* todo?: don't update env ? *)
943 let cs = build_info_program cprogram !env in
944 (* we do that only for the c, not for the h *)
945 ignore
(update_include_rel_pos (cs +> List.map
(fun x
-> x
.ast_c
)));
947 fname
= Common.basename
file;
950 was_modified_once
= ref false;
959 (*****************************************************************************)
960 (* Processing the ctls and toplevel C elements *)
961 (*****************************************************************************)
963 (* The main algorithm =~
964 * The algorithm is roughly:
965 * for_all ctl rules in SP
966 * for_all minirule in rule (no more)
967 * for_all binding (computed during previous phase)
969 * match control flow of function vs minirule
970 * with the binding and update the set of possible
971 * bindings, and returned the possibly modified function.
972 * pretty print modified C elements and reparse it.
975 * On ne prends que les newbinding ou returned_any_state est vrai.
976 * Si ca ne donne rien, on prends ce qu'il y avait au depart.
977 * Mais au nouveau depart de quoi ?
978 * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?
979 * - ou alors si ca donne rien, apres avoir traité toutes les fonctions
980 * avec tous les bindings du round d'avant ?
982 * Julia pense qu'il faut prendre la premiere solution.
983 * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
984 * la regle ctl 1. On arrive sur la regle ctl 2.
985 * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
986 * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
989 * I have not to look at used_after_list to decide to restart from
990 * scratch. I just need to look if the binding list is empty.
991 * Indeed, let's suppose that a SP have 3 regions/rules. If we
992 * don't find a match for the first region, then if this first
993 * region does not bind metavariable used after, that is if
994 * used_after_list is empty, then mysat(), even if does not find a
995 * match, will return a Left, with an empty transformation_info,
996 * and so current_binding will grow. On the contrary if the first
997 * region must bind some metavariables used after, and that we
998 * dont find any such region, then mysat() will returns lots of
999 * Right, and current_binding will not grow, and so we will have
1000 * an empty list of binding, and we will catch such a case.
1002 * opti: julia says that because the binding is
1003 * determined by the used_after_list, the items in the list
1004 * are kind of sorted, so could optimise the insert_set operations.
1008 (* r(ule), c(element in C code), e(nvironment) *)
1011 let rec loop k
= function
1015 then Some
(x
, function n
-> k
(n
:: xs))
1016 else loop (function vs
-> k
(x
:: vs
)) xs in
1017 loop (function x
-> x
) l
1019 let merge_env new_e old_e
=
1022 (function (ext
,old_e
) ->
1023 function (e
,rules
) as elem
->
1024 match findk (function (e1
,_
) -> e
=*= e1
) old_e
with
1025 None
-> (elem
:: ext
,old_e
)
1026 | Some
((_
,old_rules
),k
) ->
1027 (ext
,k
(e
,Common.union_set rules old_rules
)))
1029 old_e
@ (List.rev ext
)
1031 let apply_python_rule r cache newes e rules_that_have_matched
1032 rules_that_have_ever_matched
=
1033 Common.profile_code
"python" (fun () ->
1034 show_or_not_scr_rule_name r.scr_ruleid
;
1035 if not
(interpret_dependencies rules_that_have_matched
1036 !rules_that_have_ever_matched
r.scr_dependencies
)
1039 print_dependencies "dependencies for script not satisfied:"
1040 rules_that_have_matched
1041 !rules_that_have_ever_matched
r.scr_dependencies
;
1042 show_or_not_binding "in environment" e
;
1043 (cache
, (e
, rules_that_have_matched
)::newes
)
1047 let (_
, mv, _
) = r.scr_ast_rule
in
1048 let not_bound x
= not
(Pycocci.contains_binding e x
) in
1049 (match List.filter
not_bound mv with
1051 let relevant_bindings =
1053 (function ((re
,rm
),_
) ->
1054 List.exists
(function (_
,(r,m
)) -> r =$
= re
&& m
=$
= rm
) mv)
1057 if List.mem
relevant_bindings cache
1061 "dependencies for script satisfied, but cached:"
1062 rules_that_have_matched
1063 !rules_that_have_ever_matched
1065 show_or_not_binding "in" e
;
1070 print_dependencies "dependencies for script satisfied:"
1071 rules_that_have_matched
1072 !rules_that_have_ever_matched
1074 show_or_not_binding "in" e
;
1075 Pycocci.build_classes
(List.map
(function (x
,y
) -> x
) e
);
1076 Pycocci.construct_variables
mv e
;
1077 let _ = Pycocci.pyrun_simplestring
1078 ("import coccinelle\nfrom coccinelle "^
1079 "import *\ncocci = Cocci()\n" ^
1081 relevant_bindings :: cache
1083 if !Pycocci.inc_match
1084 then (new_cache, merge_env [(e
, rules_that_have_matched
)] newes
)
1085 else (new_cache, newes
)
1087 (if !Flag_cocci.show_dependencies
1089 let m2c (_,(r,x
)) = r^
"."^x
in
1090 pr2
(Printf.sprintf
"script not applied: %s not bound"
1091 (String.concat
", " (List.map
m2c unbound
))));
1092 (cache
, merge_env [(e
, rules_that_have_matched
)] newes
))
1095 let rec apply_cocci_rule r rules_that_have_ever_matched es
1096 (ccs:file_info list
ref) =
1097 Common.profile_code
r.rulename
(fun () ->
1098 show_or_not_rule_name r.ast_rule
r.ruleid
;
1099 show_or_not_ctl_text r.ctl
r.ast_rule
r.ruleid
;
1101 let reorganized_env =
1102 reassociate_positions
r.free_vars
r.negated_pos_vars
!es
in
1104 (* looping over the environments *)
1105 let (_,newes
(* envs for next round/rule *)) =
1107 (function (cache
,newes
) ->
1108 function ((e
,rules_that_have_matched
),relevant_bindings) ->
1109 if not
(interpret_dependencies rules_that_have_matched
1110 !rules_that_have_ever_matched
1115 ("dependencies for rule "^
r.rulename^
" not satisfied:")
1116 rules_that_have_matched
1117 !rules_that_have_ever_matched
r.dependencies
;
1118 show_or_not_binding "in environment" e
;
1121 [(e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
),
1122 rules_that_have_matched
)]
1127 try List.assoc
relevant_bindings cache
1131 ("dependencies for rule "^
r.rulename^
" satisfied:")
1132 rules_that_have_matched
1133 !rules_that_have_ever_matched
1135 show_or_not_binding "in" e
;
1136 show_or_not_binding "relevant in" relevant_bindings;
1138 (* applying the rule *)
1139 (match r.ruletype
with
1141 (* looping over the functions and toplevel elements in
1144 (concat_headers_and_c !ccs +>
1145 List.fold_left
(fun children_e
(c
,f) ->
1148 (* does also some side effects on c and r *)
1150 process_a_ctl_a_env_a_toplevel
r
1151 relevant_bindings c
f in
1152 match processed with
1153 | None
-> children_e
1154 | Some newbindings
->
1157 (fun children_e newbinding
->
1158 if List.mem newbinding children_e
1160 else newbinding
:: children_e
)
1164 | Ast_cocci.Generated
->
1165 process_a_generated_a_env_a_toplevel
r
1166 relevant_bindings !ccs;
1169 let old_bindings_to_keep =
1171 (e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
)) in
1173 if null
new_bindings
1176 (*use the old bindings, specialized to the used_after_list*)
1177 if !Flag_ctl.partial_match
1180 "Empty list of bindings, I will restart from old env\n";
1181 [(old_bindings_to_keep,rules_that_have_matched
)]
1184 (* combine the new bindings with the old ones, and
1185 specialize to the used_after_list *)
1186 let old_variables = List.map fst
old_bindings_to_keep in
1187 (* have to explicitly discard the inherited variables
1188 because we want the inherited value of the positions
1189 variables not the extended one created by
1190 reassociate_positions. want to reassociate freshly
1191 according to the free variables of each rule. *)
1192 let new_bindings_to_add =
1198 List.mem
s r.used_after
&&
1199 not
(List.mem
s old_variables)))) in
1201 (function new_binding_to_add
->
1204 old_bindings_to_keep new_binding_to_add
),
1205 r.rulename
::rules_that_have_matched
))
1206 new_bindings_to_add in
1207 ((relevant_bindings,new_bindings)::cache
,
1208 merge_env new_e newes
))
1209 ([],[]) reorganized_env in (* end iter es *)
1211 then Common.push2
r.rulename rules_that_have_ever_matched
;
1215 (* apply the tagged modifs and reparse *)
1216 if not
!Flag.sgrep_mode2
1217 then ccs := rebuild_info_c_and_headers !ccs r.isexp
)
1219 and reassociate_positions free_vars negated_pos_vars envs
=
1220 (* issues: isolate the bindings that are relevant to a given rule.
1221 separate out the position variables
1222 associate all of the position variables for a given set of relevant
1223 normal variable bindings with each set of relevant normal variable
1224 bindings. Goal: if eg if@p (E) matches in two places, then both inherited
1225 occurrences of E should see both bindings of p, not just its own.
1226 Otherwise, a position constraint for something that matches in two
1227 places will never be useful, because the position can always be
1228 different from the other one. *)
1232 List.filter
(function (x
,_) -> List.mem x free_vars
) e
)
1234 let splitted_relevant =
1235 (* separate the relevant variables into the non-position ones and the
1240 (function (non_pos
,pos
) ->
1241 function (v
,_) as x
->
1242 if List.mem v negated_pos_vars
1243 then (non_pos
,x
::pos
)
1244 else (x
::non_pos
,pos
))
1247 let splitted_relevant =
1249 (function (non_pos
,pos
) ->
1250 (List.sort compare non_pos
,List.sort compare pos
))
1251 splitted_relevant in
1254 (function non_pos
->
1256 if List.mem np non_pos
then non_pos
else np
::non_pos
)
1257 [] splitted_relevant in
1258 let extended_relevant =
1259 (* extend the position variables with the values found at other identical
1260 variable bindings *)
1262 (function non_pos
->
1265 (function (other_non_pos
,other_pos
) ->
1266 (* do we want equal? or just somehow compatible? eg non_pos
1267 binds only E, but other_non_pos binds both E and E1 *)
1268 non_pos
=*= other_non_pos
)
1269 splitted_relevant in
1273 (combine_pos negated_pos_vars
1274 (List.map
(function (_,x
) -> x
) others)))))
1277 (List.map
(function (non_pos
,_) -> List.assoc non_pos
extended_relevant)
1280 and combine_pos negated_pos_vars
others =
1284 Ast_c.MetaPosValList
1287 (function positions
->
1288 function other_list
->
1290 match List.assoc posvar other_list
with
1291 Ast_c.MetaPosValList l1
->
1292 Common.union_set l1 positions
1293 | _ -> failwith
"bad value for a position variable"
1294 with Not_found
-> positions
)
1298 and process_a_generated_a_env_a_toplevel2
r env = function
1303 (rule
,_) when rule
=$
= r.rulename
-> false
1304 | (_,"ARGS") -> false
1307 let env_domain = List.map
(function (nm
,vl
) -> nm
) env in
1311 let (rl
,_) = Ast_cocci.get_meta_name md
in
1314 if Common.include_set
free_vars env_domain
1315 then Unparse_hrule.pp_rule
metavars r.ast_rule
env cfile
.full_fname
1316 | _ -> failwith
"multiple files not supported"
1318 and process_a_generated_a_env_a_toplevel rule
env ccs =
1319 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1320 (fun () -> process_a_generated_a_env_a_toplevel2 rule
env ccs)
1322 (* does side effects on C ast and on Cocci info rule *)
1323 and process_a_ctl_a_env_a_toplevel2
r e c
f =
1324 indent_do
(fun () ->
1325 show_or_not_celem "trying" c
.ast_c
;
1326 Flag.currentfile
:= Some
(f ^
":" ^
get_celem c
.ast_c
);
1327 let (trans_info, returned_any_states
, inherited_bindings
, newbindings
) =
1328 Common.save_excursion
Flag_ctl.loop_in_src_code
(fun () ->
1329 Flag_ctl.loop_in_src_code
:= !Flag_ctl.loop_in_src_code
||c
.contain_loop;
1331 (***************************************)
1332 (* !Main point! The call to the engine *)
1333 (***************************************)
1334 let model_ctl = CCI.model_for_ctl
r.dropped_isos
(Common.some c
.flow) e
1335 in CCI.mysat
model_ctl r.ctl
(r.used_after
, e
)
1338 if not returned_any_states
1341 show_or_not_celem "found match in" c
.ast_c
;
1342 show_or_not_trans_info trans_info;
1343 List.iter
(show_or_not_binding "out") newbindings
;
1345 r.was_matched
:= true;
1347 if not
(null
trans_info)
1349 c
.was_modified
:= true;
1351 (* les "more than one var in a decl" et "already tagged token"
1352 * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
1353 * failed. Le try limite le scope des crashes pendant la
1354 * trasformation au fichier concerne. *)
1356 (* modify ast via side effect *)
1357 ignore
(Transformation_c.transform
r.rulename
r.dropped_isos
1358 inherited_bindings
trans_info (Common.some c
.flow));
1359 with Timeout
-> raise Timeout
| UnixExit i
-> raise
(UnixExit i
)
1362 Some
(List.map
(function x
-> x
@inherited_bindings
) newbindings
)
1366 and process_a_ctl_a_env_a_toplevel a b c
f=
1367 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1368 (fun () -> process_a_ctl_a_env_a_toplevel2 a b c
f)
1371 let rec bigloop2 rs
(ccs: file_info list
) =
1372 let init_es = [(Ast_c.emptyMetavarsBinding
,[])] in
1373 let es = ref init_es in
1374 let ccs = ref ccs in
1375 let rules_that_have_ever_matched = ref [] in
1377 (* looping over the rules *)
1378 rs
+> List.iter
(fun r ->
1380 InitialScriptRuleCocciInfo
r | FinalScriptRuleCocciInfo
r -> ()
1381 | ScriptRuleCocciInfo
r ->
1382 if !Flag_cocci.show_ctl_text
then begin
1383 Common.pr_xxxxxxxxxxxxxxxxx
();
1384 pr
("script: " ^
r.language
);
1385 Common.pr_xxxxxxxxxxxxxxxxx
();
1387 adjust_pp_with_indent
(fun () ->
1388 Format.force_newline
();
1389 let (l
,mv,code
) = r.scr_ast_rule
in
1390 let deps = r.scr_dependencies
in
1391 Pretty_print_cocci.unparse
1392 (Ast_cocci.ScriptRule
(l
,deps,mv,code
)));
1395 if !Flag.show_misc
then print_endline
"RESULT =";
1399 (function (cache
, newes
) ->
1400 function (e
, rules_that_have_matched
) ->
1401 match r.language
with
1403 apply_python_rule r cache newes e rules_that_have_matched
1404 rules_that_have_ever_matched
1406 concat_headers_and_c !ccs +> List.iter
(fun (c
,_) ->
1409 Printf.printf
"Flow: %s\r\nFlow!\r\n%!" c
.fullstring
);
1412 Printf.printf
"Unknown language: %s\n" r.language
;
1417 es := (if newes
= [] then init_es else newes
);
1418 | CocciRuleCocciInfo
r ->
1419 apply_cocci_rule r rules_that_have_ever_matched
1422 if !Flag.sgrep_mode2
1424 (* sgrep can lead to code that is not parsable, but we must
1425 * still call rebuild_info_c_and_headers to pretty print the
1426 * action (MINUS), so that later the diff will show what was
1427 * matched by sgrep. But we don't want the parsing error message
1428 * hence the following flag setting. So this code propably
1429 * will generate a NotParsedCorrectly for the matched parts
1430 * and the very final pretty print and diff will work
1432 Flag_parsing_c.verbose_parsing
:= false;
1433 ccs := rebuild_info_c_and_headers !ccs false
1435 !ccs (* return final C asts *)
1438 Common.profile_code
"bigloop" (fun () -> bigloop2 a b
)
1440 let initial_final_bigloop2 ty rebuild
r =
1441 if !Flag_cocci.show_ctl_text
then
1443 Common.pr_xxxxxxxxxxxxxxxxx
();
1444 pr
(ty ^
": " ^
r.language
);
1445 Common.pr_xxxxxxxxxxxxxxxxx
();
1447 adjust_pp_with_indent
(fun () ->
1448 Format.force_newline
();
1449 Pretty_print_cocci.unparse
(rebuild
r.scr_ast_rule
));
1452 match r.language
with
1454 (* include_match makes no sense in an initial or final rule, although
1455 er have no way to prevent it *)
1456 let _ = apply_python_rule r [] [] [] [] (ref []) in
1459 Printf.printf
"Unknown language for initial/final script: %s\n"
1462 let initial_final_bigloop a b c
=
1463 Common.profile_code
"initial_final_bigloop"
1464 (fun () -> initial_final_bigloop2 a b c
)
1466 (*****************************************************************************)
1467 (* The main functions *)
1468 (*****************************************************************************)
1470 let pre_engine2 (coccifile
, isofile
) =
1471 show_or_not_cocci coccifile isofile
;
1472 Pycocci.set_coccifile coccifile
;
1475 if not
(Common.lfile_exists
isofile)
1477 pr2
("warning: Can't find default iso file: " ^
isofile);
1480 else Some
isofile in
1482 (* useful opti when use -dir *)
1483 let (metavars,astcocci
,free_var_lists
,negated_pos_lists
,used_after_lists
,
1484 positions_lists
,toks
,_) =
1485 sp_of_file coccifile
isofile in
1486 let ctls = ctls_of_ast astcocci used_after_lists positions_lists
in
1488 g_contain_typedmetavar := sp_contain_typed_metavar astcocci
;
1490 check_macro_in_sp_and_adjust toks
;
1492 show_or_not_ctl_tex astcocci
ctls;
1495 prepare_cocci ctls free_var_lists negated_pos_lists
1496 used_after_lists positions_lists
metavars astcocci
in
1500 (function languages
->
1502 InitialScriptRuleCocciInfo
(r) ->
1503 (if List.mem
r.language languages
1504 then failwith
("double initializer found for "^
r.language
));
1505 initial_final_bigloop "initial"
1506 (function(x
,_,y
) -> Ast_cocci.InitialScriptRule
(x
,y
))
1508 r.language
::languages
1515 Common.profile_code
"pre_engine" (fun () -> pre_engine2 a
)
1517 let full_engine2 (cocci_infos,toks
) cfiles
=
1519 show_or_not_cfiles cfiles
;
1521 (* optimisation allowing to launch coccinelle on all the drivers *)
1522 if !Flag_cocci.worth_trying_opt
&& not
(worth_trying cfiles toks
)
1525 pr2
("No matches found for " ^
(Common.join
" " (Common.union_all toks
))
1526 ^
"\nSkipping:" ^
(Common.join
" " cfiles
));
1527 cfiles
+> List.map
(fun s -> s, None
)
1532 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1533 if !Flag.show_misc
then pr
"let's go";
1534 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1536 let choose_includes =
1537 match !Flag_cocci.include_options
with
1538 Flag_cocci.I_UNSPECIFIED
->
1539 if !g_contain_typedmetavar
1540 then Flag_cocci.I_NORMAL_INCLUDES
1541 else Flag_cocci.I_NO_INCLUDES
1543 let c_infos = prepare_c cfiles
choose_includes in
1545 (* ! the big loop ! *)
1546 let c_infos'
= bigloop cocci_infos c_infos in
1548 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1549 if !Flag.show_misc
then pr
"Finished";
1550 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1551 if !Flag_ctl.graphical_trace
then gen_pdf_graph ();
1553 c_infos'
+> List.map
(fun c_or_h
->
1554 if !(c_or_h
.was_modified_once
)
1558 Common.new_temp_file
"cocci-output" ("-" ^ c_or_h
.fname
) in
1560 if c_or_h
.fkind
=*= Header
1561 then pr2
("a header file was modified: " ^ c_or_h
.fname
);
1563 (* and now unparse everything *)
1564 cfile_of_program (for_unparser c_or_h
.asts
) outfile;
1566 let show_only_minus = !Flag.sgrep_mode2
in
1567 show_or_not_diff c_or_h
.fpath
outfile show_only_minus;
1570 if !Flag.sgrep_mode2
then None
else Some
outfile)
1572 else (c_or_h
.fpath
, None
))
1575 let full_engine a b
=
1576 Common.profile_code
"full_engine"
1577 (fun () -> let res = full_engine2 a b
in (*Gc.print_stat stderr; *)res)
1579 let post_engine2 (cocci_infos,_) =
1582 (function languages
->
1584 FinalScriptRuleCocciInfo
(r) ->
1585 (if List.mem
r.language languages
1586 then failwith
("double finalizer found for "^
r.language
));
1587 initial_final_bigloop "final"
1588 (function(x
,_,y
) -> Ast_cocci.FinalScriptRule
(x
,y
))
1590 r.language
::languages
1596 Common.profile_code
"post_engine" (fun () -> post_engine2 a
)
1598 (*****************************************************************************)
1599 (* check duplicate from result of full_engine *)
1600 (*****************************************************************************)
1602 let check_duplicate_modif2 xs =
1603 (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
1604 if !Flag_cocci.verbose_cocci
1605 then pr2
("Check duplication for " ^ i_to_s
(List.length
xs) ^
" files");
1607 let groups = Common.group_assoc_bykey_eff
xs in
1608 groups +> Common.map_filter
(fun (file, xs) ->
1610 | [] -> raise Impossible
1611 | [res] -> Some
(file, res)
1615 if not
(List.for_all
(fun res2
-> res2
=*= None
) xs)
1617 pr2
("different modification result for " ^
file);
1620 else Some
(file, None
)
1622 if not
(List.for_all
(fun res2
->
1626 let diff = Common.cmd_to_list
("diff -u -b -B "^
res^
" "^res2
)
1630 pr2
("different modification result for " ^
file);
1633 else Some
(file, Some
res)
1637 let check_duplicate_modif a
=
1638 Common.profile_code
"check_duplicate" (fun () -> check_duplicate_modif2 a
)