2 * Copyright 2005-2009, 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.
25 module CCI
= Ctlcocci_integration
26 module TAC
= Type_annoter_c
28 module Ast_to_flow
= Control_flow_c_build
30 (*****************************************************************************)
31 (* This file is a kind of driver. It gathers all the important functions
32 * from coccinelle in one place. The different entities in coccinelle are:
36 * - flow (contain nodes)
37 * - ctl (contain rule_elems)
38 * This file contains functions to transform one in another.
40 (*****************************************************************************)
42 (* --------------------------------------------------------------------- *)
44 (* --------------------------------------------------------------------- *)
45 let cprogram_of_file file
=
46 let (program2
, _stat
) = Parse_c.parse_c_and_cpp file
in
49 let cprogram_of_file_cached file
=
50 let (program2
, _stat
) = Parse_c.parse_cache file
in
51 if !Flag_cocci.ifdef_to_if
53 program2
+> Parse_c.with_program2
(fun asts
->
54 Cpp_ast_c.cpp_ifdef_statementize asts
58 let cfile_of_program program2_with_ppmethod outf
=
59 Unparse_c.pp_program program2_with_ppmethod outf
61 (* for memoization, contains only one entry, the one for the SP *)
62 let _hparse = Hashtbl.create
101
63 let _hctl = Hashtbl.create
101
65 (* --------------------------------------------------------------------- *)
67 (* --------------------------------------------------------------------- *)
68 let sp_of_file2 file iso
=
69 Common.memoized
_hparse (file
, iso
) (fun () ->
70 Parse_cocci.process file iso
false)
71 let sp_of_file file iso
=
72 Common.profile_code
"parse cocci" (fun () -> sp_of_file2 file iso
)
75 (* --------------------------------------------------------------------- *)
77 (* --------------------------------------------------------------------- *)
79 Ograph_extended.print_ograph_mutable flow
"/tmp/test.dot" true
82 let ast_to_flow_with_error_messages2 x
=
84 try Ast_to_flow.ast_to_control_flow x
85 with Ast_to_flow.Error x
->
86 Ast_to_flow.report_error x
;
89 flowopt +> do_option
(fun flow
->
90 (* This time even if there is a deadcode, we still have a
91 * flow graph, so I can try the transformation and hope the
92 * deadcode will not bother us.
94 try Ast_to_flow.deadcode_detection flow
95 with Ast_to_flow.Error
(Ast_to_flow.DeadCode x
) ->
96 Ast_to_flow.report_error
(Ast_to_flow.DeadCode x
);
99 let ast_to_flow_with_error_messages a
=
100 Common.profile_code
"flow" (fun () -> ast_to_flow_with_error_messages2 a
)
103 (* --------------------------------------------------------------------- *)
105 (* --------------------------------------------------------------------- *)
107 let ctls_of_ast2 ast
(ua
,fua
,fuas
) pos
=
109 (function ast
-> function (ua
,(fua
,(fuas
,pos
))) ->
113 else Asttoctl2.asttoctl ast
(ua
,fua
,fuas
) pos
)
114 (Asttomember.asttomember ast ua
))
115 ast
(List.combine ua
(List.combine fua
(List.combine fuas pos
)))
117 let ctls_of_ast ast ua
=
118 Common.profile_code
"asttoctl2" (fun () -> ctls_of_ast2 ast ua
)
120 (*****************************************************************************)
121 (* Some debugging functions *)
122 (*****************************************************************************)
126 let show_or_not_cfile2 cfile
=
127 if !Flag_cocci.show_c
then begin
128 Common.pr2_xxxxxxxxxxxxxxxxx
();
129 pr2
("processing C file: " ^ cfile
);
130 Common.pr2_xxxxxxxxxxxxxxxxx
();
131 Common.command2
("cat " ^ cfile
);
133 let show_or_not_cfile a
=
134 Common.profile_code
"show_xxx" (fun () -> show_or_not_cfile2 a
)
136 let show_or_not_cfiles cfiles
= List.iter
show_or_not_cfile cfiles
139 let show_or_not_cocci2 coccifile isofile
=
140 if !Flag_cocci.show_cocci
then begin
141 Common.pr2_xxxxxxxxxxxxxxxxx
();
142 pr2
("processing semantic patch file: " ^ coccifile
);
143 isofile
+> (fun s
-> pr2
("with isos from: " ^ s
));
144 Common.pr2_xxxxxxxxxxxxxxxxx
();
145 Common.command2
("cat " ^ coccifile
);
148 let show_or_not_cocci a b
=
149 Common.profile_code
"show_xxx" (fun () -> show_or_not_cocci2 a b
)
153 let show_or_not_diff2 cfile outfile show_only_minus
=
154 if !Flag_cocci.show_diff
then begin
155 match Common.fst
(Compare_c.compare_to_original cfile outfile
) with
156 Compare_c.Correct
-> () (* diff only in spacing, etc *)
158 (* may need --strip-trailing-cr under windows *)
162 match !Flag_parsing_c.diff_lines
with
163 | None
-> "diff -u -p " ^ cfile ^
" " ^ outfile
164 | Some n
-> "diff -U "^n^
" -p "^cfile^
" "^outfile
in
166 let res = Common.cmd_to_list
line in
167 match (!Flag.patch
,res) with
168 (* create something that looks like the output of patch *)
169 (Some prefix
,minus_file
::plus_file
::rest
) ->
170 let drop_prefix file
=
174 let lp = String.length prefix
in
175 String.sub file
lp ((String.length file
) - lp) in
177 match List.rev
(Str.split
(Str.regexp
" ") line) with
178 new_file
::old_file
::cmdrev
->
182 (List.rev
("/tmp/nothing" :: old_file
:: cmdrev
))
184 let old_base_file = drop_prefix old_file
in
187 (("b"^
old_base_file)::("a"^
old_base_file)::cmdrev
))
188 | _
-> failwith
"bad command" in
189 let (minus_line
,plus_line
) =
191 then (minus_file
,plus_file
)
193 match (Str.split
(Str.regexp
"[ \t]") minus_file
,
194 Str.split
(Str.regexp
"[ \t]") plus_file
) with
195 ("---"::old_file
::old_rest
,"+++"::new_file
::new_rest
) ->
196 let old_base_file = drop_prefix old_file
in
198 ("---"::("a"^
old_base_file)::old_rest
),
200 ("+++"::("b"^
old_base_file)::new_rest
))
203 (Printf.sprintf
"bad diff header lines: %s %s"
204 (String.concat
":" l1
) (String.concat
":" l2
)) in
205 diff_line::minus_line
::plus_line
::rest
207 xs +> List.iter
(fun s
->
208 if s
=~
"^\\+" && show_only_minus
212 let show_or_not_diff a b c
=
213 Common.profile_code
"show_xxx" (fun () -> show_or_not_diff2 a b c
)
216 (* the derived input *)
218 let show_or_not_ctl_tex2 astcocci ctls
=
219 if !Flag_cocci.show_ctl_tex
then begin
220 Ctltotex.totex
("/tmp/__cocci_ctl.tex") astcocci ctls
;
221 Common.command2
("cd /tmp; latex __cocci_ctl.tex; " ^
222 "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
223 "gv __cocci_ctl.ps &");
225 let show_or_not_ctl_tex a b
=
226 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_tex2 a b
)
230 let show_or_not_rule_name ast rulenb
=
231 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
232 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
237 Ast_cocci.CocciRule
(nm
, (deps
, drops
, exists
), x
, _
, _
) -> nm
238 | _
-> i_to_s rulenb
in
239 Common.pr_xxxxxxxxxxxxxxxxx
();
241 Common.pr_xxxxxxxxxxxxxxxxx
()
244 let show_or_not_scr_rule_name rulenb
=
245 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
246 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
249 let name = i_to_s rulenb
in
250 Common.pr_xxxxxxxxxxxxxxxxx
();
251 pr
("script rule " ^
name ^
" = ");
252 Common.pr_xxxxxxxxxxxxxxxxx
()
255 let show_or_not_ctl_text2 ctl ast rulenb
=
256 if !Flag_cocci.show_ctl_text
then begin
258 adjust_pp_with_indent
(fun () ->
259 Format.force_newline
();
260 Pretty_print_cocci.print_plus_flag
:= true;
261 Pretty_print_cocci.print_minus_flag
:= true;
262 Pretty_print_cocci.unparse ast
;
267 adjust_pp_with_indent
(fun () ->
268 Format.force_newline
();
269 Pretty_print_engine.pp_ctlcocci
270 !Flag_cocci.show_mcodekind_in_ctl
!Flag_cocci.inline_let_ctl ctl
;
274 let show_or_not_ctl_text a b c
=
275 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_text2 a b c
)
279 (* running information *)
280 let get_celem celem
: string =
282 Ast_c.Definition
({Ast_c.f_name
= namefuncs
;},_
) ->
283 Ast_c.str_of_name namefuncs
285 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name, _
);}, _
], _
)) ->
286 Ast_c.str_of_name
name
289 let show_or_not_celem2 prelude celem
=
292 | Ast_c.Definition
({Ast_c.f_name
= namefuncs
},_
) ->
293 let funcs = Ast_c.str_of_name namefuncs
in
294 Flag.current_element
:= funcs;
295 (" function: ",funcs)
297 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name,_
)}, _
], _
)) ->
298 let s = Ast_c.str_of_name
name in
299 Flag.current_element
:= s;
302 Flag.current_element
:= "something_else";
303 (" ","something else");
305 if !Flag.show_trying
then pr2
(prelude ^ tag ^ trying
)
307 let show_or_not_celem a b
=
308 Common.profile_code
"show_xxx" (fun () -> show_or_not_celem2 a b
)
311 let show_or_not_trans_info2 trans_info
=
312 (* drop witness tree indices for printing *)
314 List.map
(function (index
,trans_info) -> trans_info) trans_info in
315 if !Flag.show_transinfo
then begin
316 if null
trans_info then pr2
"transformation info is empty"
318 pr2
"transformation info returned:";
320 List.sort
(function (i1
,_
,_
) -> function (i2
,_
,_
) -> compare i1 i2
)
324 trans_info +> List.iter
(fun (i
, subst
, re
) ->
325 pr2
("transform state: " ^
(Common.i_to_s i
));
327 adjust_pp_with_indent_and_header
"with rule_elem: " (fun () ->
328 Pretty_print_cocci.print_plus_flag
:= true;
329 Pretty_print_cocci.print_minus_flag
:= true;
330 Pretty_print_cocci.rule_elem
"" re
;
332 adjust_pp_with_indent_and_header
"with binding: " (fun () ->
333 Pretty_print_engine.pp_binding subst
;
340 let show_or_not_trans_info a
=
341 Common.profile_code
"show_xxx" (fun () -> show_or_not_trans_info2 a
)
345 let show_or_not_binding2 s binding
=
346 if !Flag_cocci.show_binding_in_out
then begin
347 adjust_pp_with_indent_and_header
("binding " ^
s ^
" = ") (fun () ->
348 Pretty_print_engine.pp_binding binding
351 let show_or_not_binding a b
=
352 Common.profile_code
"show_xxx" (fun () -> show_or_not_binding2 a b
)
356 (*****************************************************************************)
357 (* Some helper functions *)
358 (*****************************************************************************)
360 let worth_trying cfiles tokens
=
361 (* drop the following line for a list of list by rules. since we don't
362 allow multiple minirules, all the tokens within a rule should be in
363 a single CFG entity *)
364 let tokens = Common.union_all
tokens in
365 if not
!Flag_cocci.windows
&& not
(null
tokens)
367 (* could also modify the code in get_constants.ml *)
368 let tokens = tokens +> List.map
(fun s ->
370 | _
when s =~
"^[A-Za-z_][A-Za-z_0-9]*$" ->
373 | _
when s =~
"^[A-Za-z_]" ->
376 | _
when s =~
".*[A-Za-z_]$" ->
381 let com = sprintf
"egrep -q '(%s)' %s" (join
"|" tokens) (join
" " cfiles
)
383 (match Sys.command
com with
384 | 0 (* success *) -> true
387 then Printf.printf
"grep failed: %s\n" com);
388 false (* no match, so not worth trying *)
392 let check_macro_in_sp_and_adjust tokens =
393 let tokens = Common.union_all
tokens in
394 tokens +> List.iter
(fun s ->
395 if Hashtbl.mem
!Parse_c._defs
s
397 if !Flag_cocci.verbose_cocci
then begin
398 pr2
"warning: macro in semantic patch was in macro definitions";
399 pr2
("disabling macro expansion for " ^
s);
401 Hashtbl.remove
!Parse_c._defs
s
406 let contain_loop gopt
=
409 g#nodes#tolist
+> List.exists
(fun (xi
, node
) ->
410 Control_flow_c.extract_is_loop node
412 | None
-> true (* means nothing, if no g then will not model check *)
416 let sp_contain_typed_metavar_z toplevel_list_list
=
417 let bind x y
= x
or y
in
418 let option_default = false in
419 let mcode _ _
= option_default in
420 let donothing r k e
= k e
in
422 let expression r k e
=
423 match Ast_cocci.unwrap e
with
424 | Ast_cocci.MetaExpr
(_
,_
,_
,Some t
,_
,_
) -> true
425 | Ast_cocci.MetaExpr
(_
,_
,_
,_
,Ast_cocci.LocalID
,_
) -> true
430 Visitor_ast.combiner bind option_default
431 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
432 donothing donothing donothing donothing
433 donothing expression donothing donothing donothing donothing donothing
434 donothing donothing donothing donothing donothing
436 toplevel_list_list
+>
438 (function (nm
,_
,rule
) ->
439 (List.exists
combiner.Visitor_ast.combiner_top_level rule
))
442 let sp_contain_typed_metavar rules
=
443 sp_contain_typed_metavar_z
447 Ast_cocci.CocciRule
(a
,b
,c
,d
,_
) -> (a
,b
,c
)
448 | _
-> failwith
"error in filter")
452 Ast_cocci.CocciRule
(a
,b
,c
,d
,Ast_cocci.Normal
) -> true
458 (* finding among the #include the one that we need to parse
459 * because they may contain useful type definition or because
460 * we may have to modify them
462 * For the moment we base in part our heuristic on the name of the file, e.g.
463 * serio.c is related we think to #include <linux/serio.h>
466 let interpret_include_path _
=
467 match !Flag_cocci.include_path
with
471 let (includes_to_parse
:
472 (Common.filename
* Parse_c.program2
) list
->
473 Flag_cocci.include_options
-> 'a
) = fun xs choose_includes
->
474 match choose_includes
with
475 Flag_cocci.I_UNSPECIFIED
-> failwith
"not possible"
476 | Flag_cocci.I_NO_INCLUDES
-> []
478 let all_includes = x
=*= Flag_cocci.I_ALL_INCLUDES
in
479 xs +> List.map
(fun (file
, cs
) ->
480 let dir = Common.dirname file
in
482 cs
+> Common.map_filter
(fun (c
,_info_item
) ->
486 {Ast_c.i_include
= ((x
,ii
)); i_rel_pos
= info_h_pos
;}) ->
489 let f = Filename.concat
dir (Common.join
"/" xs) in
490 (* for our tests, all the files are flat in the current dir *)
491 if not
(Sys.file_exists
f) && !Flag_cocci.relax_include_path
493 let attempt2 = Filename.concat
dir (Common.last
xs) in
494 if not
(Sys.file_exists
f) && all_includes
495 then Some
(Filename.concat
(interpret_include_path())
496 (Common.join
"/" xs))
500 | Ast_c.NonLocal
xs ->
502 Common.fileprefix
(Common.last
xs) =$
= Common.fileprefix file
504 Some
(Filename.concat
(interpret_include_path())
505 (Common.join
"/" xs))
507 | Ast_c.Weird _
-> None
513 let rec interpret_dependencies local global virt
= function
515 (try List.assoc
s virt
with Not_found
-> List.mem
s local
)
516 | Ast_cocci.AntiDep
s ->
517 (if !Flag_ctl.steps
!= None
518 then failwith
"steps and ! dependency incompatible");
519 (try not
(List.assoc
s virt
) with Not_found
-> not
(List.mem
s local
))
520 | Ast_cocci.EverDep
s ->
521 (try List.assoc
s virt
with Not_found
-> List.mem
s global
)
522 | Ast_cocci.NeverDep
s ->
523 (if !Flag_ctl.steps
!= None
524 then failwith
"steps and ! dependency incompatible");
525 (try not
(List.assoc
s virt
) with Not_found
-> not
(List.mem
s global
))
526 | Ast_cocci.AndDep
(s1
,s2
) ->
527 (interpret_dependencies local global virt s1
) &&
528 (interpret_dependencies local global virt s2
)
529 | Ast_cocci.OrDep
(s1
,s2
) ->
530 (interpret_dependencies local global virt s1
) or
531 (interpret_dependencies local global virt s2
)
532 | Ast_cocci.NoDep
-> true
534 let rec print_dependencies str local global virt dep
=
535 if !Flag_cocci.show_dependencies
540 let rec loop = function
541 Ast_cocci.Dep
s | Ast_cocci.AntiDep
s ->
542 if not
(List.mem
s !seen)
545 if try List.assoc
s virt
with Not_found
-> List.mem
s local
546 then pr2
(s^
" satisfied")
547 else pr2
(s^
" not satisfied");
550 | Ast_cocci.EverDep
s | Ast_cocci.NeverDep
s ->
551 if not
(List.mem
s !seen)
554 if try List.assoc
s virt
with Not_found
-> List.mem
s global
555 then pr2
(s^
" satisfied")
556 else pr2
(s^
" not satisfied");
559 | Ast_cocci.AndDep
(s1
,s2
) ->
562 | Ast_cocci.OrDep
(s1
,s2
) ->
565 | Ast_cocci.NoDep
-> () in
569 (* --------------------------------------------------------------------- *)
570 (* #include relative position in the file *)
571 (* --------------------------------------------------------------------- *)
573 (* compute the set of new prefixes
575 * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *)
579 * it would give
for the first element
580 * ""; "a"; "a/b"; "a/b/x"
584 * update
: if the
include is inside a ifdef a put nothing
. cf
-test incl
.
585 * this is because we dont want code added inside ifdef
.
588 let compute_new_prefixes xs =
589 xs +> Common.map_withenv
(fun already
xs ->
590 let subdirs_prefixes = Common.inits
xs in
591 let new_first = subdirs_prefixes +> List.filter
(fun x
->
592 not
(List.mem x already
)
601 (* does via side effect on the ref in the Include in Ast_c *)
602 let rec update_include_rel_pos cs
=
603 let only_include = cs
+> Common.map_filter
(fun c
->
605 | Ast_c.CppTop
(Ast_c.Include
{Ast_c.i_include
= ((x
,_
));
607 i_is_in_ifdef
= inifdef
}) ->
609 | Ast_c.Weird _
-> None
618 let (locals
, nonlocals
) =
619 only_include +> Common.partition_either
(fun (c
, aref
) ->
621 | Ast_c.Local x
-> Left
(x
, aref
)
622 | Ast_c.NonLocal x
-> Right
(x
, aref
)
623 | Ast_c.Weird x
-> raise Impossible
626 update_rel_pos_bis locals
;
627 update_rel_pos_bis nonlocals
;
629 and update_rel_pos_bis
xs =
630 let xs'
= List.map fst
xs in
631 let the_first = compute_new_prefixes xs'
in
632 let the_last = List.rev
(compute_new_prefixes (List.rev
xs'
)) in
633 let merged = Common.zip
xs (Common.zip
the_first the_last) in
634 merged +> List.iter
(fun ((x
, aref
), (the_first, the_last)) ->
637 Ast_c.first_of
= the_first;
638 Ast_c.last_of
= the_last;
647 (*****************************************************************************)
648 (* All the information needed around the C elements and Cocci rules *)
649 (*****************************************************************************)
651 type toplevel_c_info
= {
652 ast_c
: Ast_c.toplevel
; (* contain refs so can be modified *)
653 tokens_c
: Parser_c.token list
;
656 flow
: Control_flow_c.cflow
option; (* it's the "fixed" flow *)
659 env_typing_before
: TAC.environment
;
660 env_typing_after
: TAC.environment
;
662 was_modified
: bool ref;
667 type toplevel_cocci_info_script_rule
= {
668 scr_ast_rule
: string * (string * (string * string)) list
* string;
670 scr_dependencies
: Ast_cocci.dependency
;
675 type toplevel_cocci_info_cocci_rule
= {
676 ctl
: Lib_engine.ctlcocci
* (CCI.pred list list
);
677 metavars
: Ast_cocci.metavar list
;
678 ast_rule
: Ast_cocci.rule
;
679 isexp
: bool; (* true if + code is an exp, only for Flag.make_hrule *)
682 dependencies
: Ast_cocci.dependency
;
683 (* There are also some hardcoded rule names in parse_cocci.ml:
684 * let reserved_names = ["all";"optional_storage";"optional_qualifier"]
686 dropped_isos
: string list
;
687 free_vars
: Ast_cocci.meta_name list
;
688 negated_pos_vars
: Ast_cocci.meta_name list
;
689 used_after
: Ast_cocci.meta_name list
;
690 positions
: Ast_cocci.meta_name list
;
693 ruletype
: Ast_cocci.ruletype
;
695 was_matched
: bool ref;
698 type toplevel_cocci_info
=
699 ScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
700 | InitialScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
701 | FinalScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
702 | CocciRuleCocciInfo
of toplevel_cocci_info_cocci_rule
704 type cocci_info
= toplevel_cocci_info list
* string list list
(* tokens *) *
705 (string * bool) list
(* matched and unmatched virtual rules *)
707 type kind_file
= Header
| Source
711 was_modified_once
: bool ref;
712 asts
: toplevel_c_info list
;
717 let g_contain_typedmetavar = ref false
720 let last_env_toplevel_c_info xs =
721 (Common.last
xs).env_typing_after
723 let concat_headers_and_c (ccs
: file_info list
)
724 : (toplevel_c_info
* string) list
=
725 (List.concat
(ccs
+> List.map
(fun x
->
726 x
.asts
+> List.map
(fun x'
->
729 let for_unparser xs =
730 xs +> List.map
(fun x
->
731 (x
.ast_c
, (x
.fullstring
, x
.tokens_c
)), Unparse_c.PPviastr
734 let gen_pdf_graph () =
735 (Ctl_engine.get_graph_files
()) +> List.iter
(fun outfile
->
736 Printf.printf
"Generation of %s%!" outfile
;
737 let filename_stack = Ctl_engine.get_graph_comp_files outfile
in
738 List.iter
(fun filename
->
739 ignore
(Unix.system
("dot " ^ filename ^
" -Tpdf -o " ^ filename ^
".pdf;"))
741 let (head
,tail
) = (List.hd
filename_stack, List.tl
filename_stack) in
742 ignore
(Unix.system
("cp " ^ head ^
".pdf " ^ outfile ^
".pdf;"));
743 tail
+> List.iter
(fun filename
->
744 ignore
(Unix.system
("mv " ^ outfile ^
".pdf /tmp/tmp.pdf;"));
745 ignore
(Unix.system
("pdftk " ^ filename ^
".pdf /tmp/tmp.pdf cat output " ^ outfile ^
".pdf"));
747 ignore
(Unix.system
("rm /tmp/tmp.pdf;"));
748 List.iter
(fun filename
->
749 ignore
(Unix.system
("rm " ^ filename ^
" " ^ filename ^
".pdf;"))
751 Printf.printf
" - Done\n")
754 (* --------------------------------------------------------------------- *)
755 let prepare_cocci ctls free_var_lists negated_pos_lists
756 (ua
,fua
,fuas
) positions_list metavars astcocci
=
758 let gathered = Common.index_list_1
759 (zip
(zip
(zip
(zip
(zip
(zip
(zip
(zip ctls metavars
) astcocci
)
761 negated_pos_lists
) ua
) fua
) fuas
) positions_list
)
764 (fun (((((((((ctl_toplevel_list
,metavars
),ast
),free_var_list
),
765 negated_pos_list
),ua
),fua
),fuas
),positions_list
),rulenb
) ->
767 let is_script_rule r
=
769 Ast_cocci.ScriptRule _
770 | Ast_cocci.InitialScriptRule _
| Ast_cocci.FinalScriptRule _
-> true
773 if not
(List.length ctl_toplevel_list
=|= 1) && not
(is_script_rule ast
)
774 then failwith
"not handling multiple minirules";
777 Ast_cocci.ScriptRule
(lang
,deps
,mv
,code
) ->
780 scr_ast_rule
= (lang
, mv
, code
);
782 scr_dependencies
= deps
;
786 in ScriptRuleCocciInfo
r
787 | Ast_cocci.InitialScriptRule
(lang
,code
) ->
789 let deps = Ast_cocci.NoDep
in
792 scr_ast_rule
= (lang
, mv, code
);
794 scr_dependencies
= deps;
798 in InitialScriptRuleCocciInfo
r
799 | Ast_cocci.FinalScriptRule
(lang
,code
) ->
801 let deps = Ast_cocci.NoDep
in
804 scr_ast_rule
= (lang
, mv, code
);
806 scr_dependencies
= deps;
810 in FinalScriptRuleCocciInfo
r
811 | Ast_cocci.CocciRule
812 (rulename
,(dependencies
,dropped_isos
,z
),restast
,isexp
,ruletype
) ->
815 ctl
= List.hd ctl_toplevel_list
;
818 isexp
= List.hd isexp
;
820 dependencies
= dependencies
;
821 dropped_isos
= dropped_isos
;
822 free_vars
= List.hd free_var_list
;
823 negated_pos_vars
= List.hd negated_pos_list
;
824 used_after
= (List.hd ua
) @ (List.hd fua
);
825 positions
= List.hd positions_list
;
828 was_matched
= ref false;
833 (* --------------------------------------------------------------------- *)
835 let build_info_program cprogram env
=
837 let (cs
, parseinfos
) =
838 Common.unzip cprogram
in
841 parseinfos
+> List.map
(fun (s,toks
) -> toks
) +> List.flatten
in
843 (* I use cs' but really annotate_xxx work by doing side effects on cs *)
845 Comment_annotater_c.annotate_program
alltoks cs in
847 Type_annoter_c.annotate_program env
(*!g_contain_typedmetavar*) cs'
850 zip
cs_with_envs parseinfos
+> List.map
(fun ((c
, (enva
,envb
)), parseinfo
)->
851 let (fullstr
, tokens) = parseinfo
in
854 ast_to_flow_with_error_messages c
+>
855 Common.map_option
(fun flow ->
856 let flow = Ast_to_flow.annotate_loop_nodes
flow in
858 (* remove the fake nodes for julia *)
859 let fixed_flow = CCI.fix_flow_ctl
flow in
861 if !Flag_cocci.show_flow
then print_flow fixed_flow;
862 if !Flag_cocci.show_before_fixed_flow
then print_flow flow;
869 ast_c
= c
; (* contain refs so can be modified *)
871 fullstring
= fullstr
;
875 contain_loop = contain_loop flow;
877 env_typing_before
= enva
;
878 env_typing_after
= envb
;
880 was_modified
= ref false;
886 (* Optimisation. Try not unparse/reparse the whole file when have modifs *)
887 let rebuild_info_program cs file isexp
=
888 cs +> List.map
(fun c
->
891 let file = Common.new_temp_file
"cocci_small_output" ".c" in
893 [(c
.ast_c
, (c
.fullstring
, c
.tokens_c
)), Unparse_c.PPnormal
]
896 (* Common.command2 ("cat " ^ file); *)
897 let cprogram = cprogram_of_file file in
898 let xs = build_info_program cprogram c
.env_typing_before
in
900 (* TODO: assert env has not changed,
901 * if yes then must also reparse what follows even if not modified.
902 * Do that only if contain_typedmetavar of course, so good opti.
904 (* Common.list_init xs *) (* get rid of the FinalDef *)
910 let rebuild_info_c_and_headers ccs isexp
=
911 ccs
+> List.iter
(fun c_or_h
->
912 if c_or_h
.asts
+> List.exists
(fun c
-> !(c
.was_modified
))
913 then c_or_h
.was_modified_once
:= true;
915 ccs
+> List.map
(fun c_or_h
->
918 rebuild_info_program c_or_h
.asts c_or_h
.full_fname isexp
}
927 let prepare_c files choose_includes
: file_info list
=
928 let cprograms = List.map
cprogram_of_file_cached files
in
929 let includes = includes_to_parse
(zip files
cprograms) choose_includes
in
931 (* todo?: may not be good to first have all the headers and then all the c *)
933 (includes +> List.map
(fun hpath
-> Right hpath
))
935 ((zip files
cprograms) +> List.map
(fun (file, asts
) -> Left
(file, asts
)))
938 let env = ref !TAC.initial_env
in
940 let ccs = all +> Common.map_filter
(fun x
->
943 if not
(Common.lfile_exists hpath
)
945 pr2
("TYPE: header " ^ hpath ^
" not found");
949 let h_cs = cprogram_of_file_cached hpath
in
950 let info_h_cs = build_info_program h_cs !env in
954 else last_env_toplevel_c_info info_h_cs
957 fname
= Common.basename hpath
;
960 was_modified_once
= ref false;
964 | Left
(file, cprogram) ->
965 (* todo?: don't update env ? *)
966 let cs = build_info_program cprogram !env in
967 (* we do that only for the c, not for the h *)
968 ignore
(update_include_rel_pos (cs +> List.map
(fun x
-> x
.ast_c
)));
970 fname
= Common.basename
file;
973 was_modified_once
= ref false;
982 (*****************************************************************************)
983 (* Processing the ctls and toplevel C elements *)
984 (*****************************************************************************)
986 (* The main algorithm =~
987 * The algorithm is roughly:
988 * for_all ctl rules in SP
989 * for_all minirule in rule (no more)
990 * for_all binding (computed during previous phase)
992 * match control flow of function vs minirule
993 * with the binding and update the set of possible
994 * bindings, and returned the possibly modified function.
995 * pretty print modified C elements and reparse it.
998 * On ne prends que les newbinding ou returned_any_state est vrai.
999 * Si ca ne donne rien, on prends ce qu'il y avait au depart.
1000 * Mais au nouveau depart de quoi ?
1001 * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?
1002 * - ou alors si ca donne rien, apres avoir traité toutes les fonctions
1003 * avec tous les bindings du round d'avant ?
1005 * Julia pense qu'il faut prendre la premiere solution.
1006 * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
1007 * la regle ctl 1. On arrive sur la regle ctl 2.
1008 * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
1009 * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
1012 * I have not to look at used_after_list to decide to restart from
1013 * scratch. I just need to look if the binding list is empty.
1014 * Indeed, let's suppose that a SP have 3 regions/rules. If we
1015 * don't find a match for the first region, then if this first
1016 * region does not bind metavariable used after, that is if
1017 * used_after_list is empty, then mysat(), even if does not find a
1018 * match, will return a Left, with an empty transformation_info,
1019 * and so current_binding will grow. On the contrary if the first
1020 * region must bind some metavariables used after, and that we
1021 * dont find any such region, then mysat() will returns lots of
1022 * Right, and current_binding will not grow, and so we will have
1023 * an empty list of binding, and we will catch such a case.
1025 * opti: julia says that because the binding is
1026 * determined by the used_after_list, the items in the list
1027 * are kind of sorted, so could optimise the insert_set operations.
1031 (* r(ule), c(element in C code), e(nvironment) *)
1034 let rec loop k
= function
1038 then Some
(x
, function n
-> k
(n
:: xs))
1039 else loop (function vs
-> k
(x
:: vs
)) xs in
1040 loop (function x
-> x
) l
1042 let merge_env new_e old_e
=
1045 (function (ext
,old_e
) ->
1046 function (e
,rules
) as elem
->
1047 match findk (function (e1
,_
) -> e
=*= e1
) old_e
with
1048 None
-> (elem
:: ext
,old_e
)
1049 | Some
((_
,old_rules
),k
) ->
1050 (ext
,k
(e
,Common.union_set rules old_rules
)))
1052 old_e
@ (List.rev ext
)
1054 let apply_python_rule r cache newes e rules_that_have_matched
1055 rules_that_have_ever_matched virtual_methods
=
1056 Common.profile_code
"python" (fun () ->
1057 show_or_not_scr_rule_name r.scr_ruleid
;
1058 if not
(interpret_dependencies rules_that_have_matched
1059 !rules_that_have_ever_matched virtual_methods
r.scr_dependencies
)
1062 print_dependencies "dependencies for script not satisfied:"
1063 rules_that_have_matched
1064 !rules_that_have_ever_matched virtual_methods
r.scr_dependencies
;
1065 show_or_not_binding "in environment" e
;
1066 (cache
, (e
, rules_that_have_matched
)::newes
)
1070 let (_
, mv, _
) = r.scr_ast_rule
in
1071 let not_bound x
= not
(Pycocci.contains_binding e x
) in
1072 (match List.filter
not_bound mv with
1074 let relevant_bindings =
1076 (function ((re
,rm
),_
) ->
1077 List.exists
(function (_
,(r,m
)) -> r =$
= re
&& m
=$
= rm
) mv)
1080 if List.mem
relevant_bindings cache
1084 "dependencies for script satisfied, but cached:"
1085 rules_that_have_matched
1086 !rules_that_have_ever_matched virtual_methods
1088 show_or_not_binding "in" e
;
1093 print_dependencies "dependencies for script satisfied:"
1094 rules_that_have_matched
1095 !rules_that_have_ever_matched virtual_methods
1097 show_or_not_binding "in" e
;
1098 Pycocci.build_classes
(List.map
(function (x
,y
) -> x
) e
);
1099 Pycocci.construct_variables
mv e
;
1100 let _ = Pycocci.pyrun_simplestring
1101 ("import coccinelle\nfrom coccinelle "^
1102 "import *\ncocci = Cocci()\n" ^
1104 relevant_bindings :: cache
1106 if !Pycocci.inc_match
1107 then (new_cache, merge_env [(e
, rules_that_have_matched
)] newes
)
1108 else (new_cache, newes
)
1110 (if !Flag_cocci.show_dependencies
1112 let m2c (_,(r,x
)) = r^
"."^x
in
1113 pr2
(Printf.sprintf
"script not applied: %s not bound"
1114 (String.concat
", " (List.map
m2c unbound
))));
1115 (cache
, merge_env [(e
, rules_that_have_matched
)] newes
))
1118 let rec apply_cocci_rule r rules_that_have_ever_matched virtual_methods es
1119 (ccs:file_info list
ref) =
1120 Common.profile_code
r.rulename
(fun () ->
1121 show_or_not_rule_name r.ast_rule
r.ruleid
;
1122 show_or_not_ctl_text r.ctl
r.ast_rule
r.ruleid
;
1124 let reorganized_env =
1125 reassociate_positions
r.free_vars
r.negated_pos_vars
!es
in
1127 (* looping over the environments *)
1128 let (_,newes
(* envs for next round/rule *)) =
1130 (function (cache
,newes
) ->
1131 function ((e
,rules_that_have_matched
),relevant_bindings) ->
1132 if not
(interpret_dependencies rules_that_have_matched
1133 !rules_that_have_ever_matched virtual_methods
1138 ("dependencies for rule "^
r.rulename^
" not satisfied:")
1139 rules_that_have_matched
1140 !rules_that_have_ever_matched virtual_methods
r.dependencies
;
1141 show_or_not_binding "in environment" e
;
1144 [(e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
),
1145 rules_that_have_matched
)]
1150 try List.assoc
relevant_bindings cache
1154 ("dependencies for rule "^
r.rulename^
" satisfied:")
1155 rules_that_have_matched
1156 !rules_that_have_ever_matched virtual_methods
1158 show_or_not_binding "in" e
;
1159 show_or_not_binding "relevant in" relevant_bindings;
1161 (* applying the rule *)
1162 (match r.ruletype
with
1164 (* looping over the functions and toplevel elements in
1167 (concat_headers_and_c !ccs +>
1168 List.fold_left
(fun children_e
(c
,f) ->
1171 (* does also some side effects on c and r *)
1173 process_a_ctl_a_env_a_toplevel
r
1174 relevant_bindings c
f in
1175 match processed with
1176 | None
-> children_e
1177 | Some newbindings
->
1180 (fun children_e newbinding
->
1181 if List.mem newbinding children_e
1183 else newbinding
:: children_e
)
1187 | Ast_cocci.Generated
->
1188 process_a_generated_a_env_a_toplevel
r
1189 relevant_bindings !ccs;
1192 let old_bindings_to_keep =
1194 (e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
)) in
1196 if null
new_bindings
1199 (*use the old bindings, specialized to the used_after_list*)
1200 if !Flag_ctl.partial_match
1203 "Empty list of bindings, I will restart from old env";
1204 [(old_bindings_to_keep,rules_that_have_matched
)]
1207 (* combine the new bindings with the old ones, and
1208 specialize to the used_after_list *)
1209 let old_variables = List.map fst
old_bindings_to_keep in
1210 (* have to explicitly discard the inherited variables
1211 because we want the inherited value of the positions
1212 variables not the extended one created by
1213 reassociate_positions. want to reassociate freshly
1214 according to the free variables of each rule. *)
1215 let new_bindings_to_add =
1221 List.mem
s r.used_after
&&
1222 not
(List.mem
s old_variables)))) in
1224 (function new_binding_to_add
->
1227 old_bindings_to_keep new_binding_to_add
),
1228 r.rulename
::rules_that_have_matched
))
1229 new_bindings_to_add in
1230 ((relevant_bindings,new_bindings)::cache
,
1231 merge_env new_e newes
))
1232 ([],[]) reorganized_env in (* end iter es *)
1234 then Common.push2
r.rulename rules_that_have_ever_matched
;
1238 (* apply the tagged modifs and reparse *)
1239 if not
!Flag.sgrep_mode2
1240 then ccs := rebuild_info_c_and_headers !ccs r.isexp
)
1242 and reassociate_positions free_vars negated_pos_vars envs
=
1243 (* issues: isolate the bindings that are relevant to a given rule.
1244 separate out the position variables
1245 associate all of the position variables for a given set of relevant
1246 normal variable bindings with each set of relevant normal variable
1247 bindings. Goal: if eg if@p (E) matches in two places, then both inherited
1248 occurrences of E should see both bindings of p, not just its own.
1249 Otherwise, a position constraint for something that matches in two
1250 places will never be useful, because the position can always be
1251 different from the other one. *)
1255 List.filter
(function (x
,_) -> List.mem x free_vars
) e
)
1257 let splitted_relevant =
1258 (* separate the relevant variables into the non-position ones and the
1263 (function (non_pos
,pos
) ->
1264 function (v
,_) as x
->
1265 if List.mem v negated_pos_vars
1266 then (non_pos
,x
::pos
)
1267 else (x
::non_pos
,pos
))
1270 let splitted_relevant =
1272 (function (non_pos
,pos
) ->
1273 (List.sort compare non_pos
,List.sort compare pos
))
1274 splitted_relevant in
1277 (function non_pos
->
1279 if List.mem np non_pos
then non_pos
else np
::non_pos
)
1280 [] splitted_relevant in
1281 let extended_relevant =
1282 (* extend the position variables with the values found at other identical
1283 variable bindings *)
1285 (function non_pos
->
1288 (function (other_non_pos
,other_pos
) ->
1289 (* do we want equal? or just somehow compatible? eg non_pos
1290 binds only E, but other_non_pos binds both E and E1 *)
1291 non_pos
=*= other_non_pos
)
1292 splitted_relevant in
1296 (combine_pos negated_pos_vars
1297 (List.map
(function (_,x
) -> x
) others)))))
1300 (List.map
(function (non_pos
,_) -> List.assoc non_pos
extended_relevant)
1303 and combine_pos negated_pos_vars
others =
1307 Ast_c.MetaPosValList
1310 (function positions
->
1311 function other_list
->
1313 match List.assoc posvar other_list
with
1314 Ast_c.MetaPosValList l1
->
1315 Common.union_set l1 positions
1316 | _ -> failwith
"bad value for a position variable"
1317 with Not_found
-> positions
)
1321 and process_a_generated_a_env_a_toplevel2
r env = function
1326 (rule
,_) when rule
=$
= r.rulename
-> false
1327 | (_,"ARGS") -> false
1330 let env_domain = List.map
(function (nm
,vl
) -> nm
) env in
1334 let (rl
,_) = Ast_cocci.get_meta_name md
in
1337 if Common.include_set
free_vars env_domain
1338 then Unparse_hrule.pp_rule
metavars r.ast_rule
env cfile
.full_fname
1339 | _ -> failwith
"multiple files not supported"
1341 and process_a_generated_a_env_a_toplevel rule
env ccs =
1342 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1343 (fun () -> process_a_generated_a_env_a_toplevel2 rule
env ccs)
1345 (* does side effects on C ast and on Cocci info rule *)
1346 and process_a_ctl_a_env_a_toplevel2
r e c
f =
1347 indent_do
(fun () ->
1348 show_or_not_celem "trying" c
.ast_c
;
1349 Flag.currentfile
:= Some
(f ^
":" ^
get_celem c
.ast_c
);
1350 let (trans_info, returned_any_states
, inherited_bindings
, newbindings
) =
1351 Common.save_excursion
Flag_ctl.loop_in_src_code
(fun () ->
1352 Flag_ctl.loop_in_src_code
:= !Flag_ctl.loop_in_src_code
||c
.contain_loop;
1354 (***************************************)
1355 (* !Main point! The call to the engine *)
1356 (***************************************)
1357 let model_ctl = CCI.model_for_ctl
r.dropped_isos
(Common.some c
.flow) e
1358 in CCI.mysat
model_ctl r.ctl
(r.used_after
, e
)
1361 if not returned_any_states
1364 show_or_not_celem "found match in" c
.ast_c
;
1365 show_or_not_trans_info trans_info;
1366 List.iter
(show_or_not_binding "out") newbindings
;
1368 r.was_matched
:= true;
1370 if not
(null
trans_info)
1372 c
.was_modified
:= true;
1374 (* les "more than one var in a decl" et "already tagged token"
1375 * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
1376 * failed. Le try limite le scope des crashes pendant la
1377 * trasformation au fichier concerne. *)
1379 (* modify ast via side effect *)
1380 ignore
(Transformation_c.transform
r.rulename
r.dropped_isos
1381 inherited_bindings
trans_info (Common.some c
.flow));
1382 with Timeout
-> raise Timeout
| UnixExit i
-> raise
(UnixExit i
)
1385 Some
(List.map
(function x
-> x
@inherited_bindings
) newbindings
)
1389 and process_a_ctl_a_env_a_toplevel a b c
f=
1390 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1391 (fun () -> process_a_ctl_a_env_a_toplevel2 a b c
f)
1394 let rec bigloop2 rs virtual_methods
(ccs: file_info list
) =
1395 let es = ref [(Ast_c.emptyMetavarsBinding
,[])] in
1396 let ccs = ref ccs in
1397 let rules_that_have_ever_matched = ref [] in
1399 (* looping over the rules *)
1400 rs
+> List.iter
(fun r ->
1402 InitialScriptRuleCocciInfo
r | FinalScriptRuleCocciInfo
r -> ()
1403 | ScriptRuleCocciInfo
r ->
1404 if !Flag_cocci.show_ctl_text
then begin
1405 Common.pr_xxxxxxxxxxxxxxxxx
();
1406 pr
("script: " ^
r.language
);
1407 Common.pr_xxxxxxxxxxxxxxxxx
();
1409 adjust_pp_with_indent
(fun () ->
1410 Format.force_newline
();
1411 let (l
,mv,code
) = r.scr_ast_rule
in
1412 let deps = r.scr_dependencies
in
1413 Pretty_print_cocci.unparse
1414 (Ast_cocci.ScriptRule
(l
,deps,mv,code
)));
1417 if !Flag.show_misc
then print_endline
"RESULT =";
1421 (function (cache
, newes
) ->
1422 function (e
, rules_that_have_matched
) ->
1423 match r.language
with
1425 apply_python_rule r cache newes e rules_that_have_matched
1426 rules_that_have_ever_matched virtual_methods
1428 concat_headers_and_c !ccs +> List.iter
(fun (c
,_) ->
1431 Printf.printf
"Flow: %s\r\nFlow!\r\n%!" c
.fullstring
);
1434 Printf.printf
"Unknown language: %s\n" r.language
;
1440 | CocciRuleCocciInfo
r ->
1441 apply_cocci_rule r rules_that_have_ever_matched virtual_methods
1444 if !Flag.sgrep_mode2
1446 (* sgrep can lead to code that is not parsable, but we must
1447 * still call rebuild_info_c_and_headers to pretty print the
1448 * action (MINUS), so that later the diff will show what was
1449 * matched by sgrep. But we don't want the parsing error message
1450 * hence the following flag setting. So this code propably
1451 * will generate a NotParsedCorrectly for the matched parts
1452 * and the very final pretty print and diff will work
1454 Flag_parsing_c.verbose_parsing
:= false;
1455 ccs := rebuild_info_c_and_headers !ccs false
1457 !ccs (* return final C asts *)
1460 Common.profile_code
"bigloop" (fun () -> bigloop2 a b
)
1462 let initial_final_bigloop2 ty rebuild
r =
1463 if !Flag_cocci.show_ctl_text
then
1465 Common.pr_xxxxxxxxxxxxxxxxx
();
1466 pr
(ty ^
": " ^
r.language
);
1467 Common.pr_xxxxxxxxxxxxxxxxx
();
1469 adjust_pp_with_indent
(fun () ->
1470 Format.force_newline
();
1471 Pretty_print_cocci.unparse
(rebuild
r.scr_ast_rule
));
1474 match r.language
with
1476 (* include_match makes no sense in an initial or final rule, although
1477 er have no way to prevent it *)
1478 let _ = apply_python_rule r [] [] [] [] (ref []) [] in
1481 Printf.printf
"Unknown language for initial/final script: %s\n"
1484 let initial_final_bigloop a b c
=
1485 Common.profile_code
"initial_final_bigloop"
1486 (fun () -> initial_final_bigloop2 a b c
)
1488 (*****************************************************************************)
1489 (* The main functions *)
1490 (*****************************************************************************)
1492 let pre_engine2 (coccifile
, isofile
) =
1493 show_or_not_cocci coccifile isofile
;
1494 Pycocci.set_coccifile coccifile
;
1497 if not
(Common.lfile_exists
isofile)
1499 pr2
("warning: Can't find default iso file: " ^
isofile);
1502 else Some
isofile in
1504 (* useful opti when use -dir *)
1505 let (metavars,astcocci
,free_var_lists
,negated_pos_lists
,used_after_lists
,
1506 positions_lists
,toks
,_,virt
) =
1507 sp_of_file coccifile
isofile in
1508 let ctls = ctls_of_ast astcocci used_after_lists positions_lists
in
1510 g_contain_typedmetavar := sp_contain_typed_metavar astcocci
;
1512 check_macro_in_sp_and_adjust toks
;
1514 show_or_not_ctl_tex astcocci
ctls;
1517 prepare_cocci ctls free_var_lists negated_pos_lists
1518 used_after_lists positions_lists
metavars astcocci
in
1522 (function languages
->
1524 InitialScriptRuleCocciInfo
(r) ->
1525 (if List.mem
r.language languages
1526 then failwith
("double initializer found for "^
r.language
));
1527 initial_final_bigloop "initial"
1528 (function(x
,_,y
) -> Ast_cocci.InitialScriptRule
(x
,y
))
1530 r.language
::languages
1534 (cocci_infos,toks
,virt
)
1537 Common.profile_code
"pre_engine" (fun () -> pre_engine2 a
)
1539 let full_engine2 (cocci_infos,toks
,virt
) cfiles
=
1541 show_or_not_cfiles cfiles
;
1543 (* optimisation allowing to launch coccinelle on all the drivers *)
1544 if !Flag_cocci.worth_trying_opt
&& not
(worth_trying cfiles toks
)
1547 pr2
("not worth trying:" ^
Common.join
" " cfiles
);
1548 cfiles
+> List.map
(fun s -> s, None
)
1553 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1554 if !Flag.show_misc
then pr
"let's go";
1555 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1557 let choose_includes =
1558 match !Flag_cocci.include_options
with
1559 Flag_cocci.I_UNSPECIFIED
->
1560 if !g_contain_typedmetavar
1561 then Flag_cocci.I_NORMAL_INCLUDES
1562 else Flag_cocci.I_NO_INCLUDES
1564 let c_infos = prepare_c cfiles
choose_includes in
1566 (* ! the big loop ! *)
1567 let c_infos'
= bigloop cocci_infos virt
c_infos in
1569 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1570 if !Flag.show_misc
then pr
"Finished";
1571 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1572 if !Flag_ctl.graphical_trace
then gen_pdf_graph ();
1574 c_infos'
+> List.map
(fun c_or_h
->
1575 if !(c_or_h
.was_modified_once
)
1579 Common.new_temp_file
"cocci-output" ("-" ^ c_or_h
.fname
) in
1581 if c_or_h
.fkind
=*= Header
1582 then pr2
("a header file was modified: " ^ c_or_h
.fname
);
1584 (* and now unparse everything *)
1585 cfile_of_program (for_unparser c_or_h
.asts
) outfile;
1587 let show_only_minus = !Flag.sgrep_mode2
in
1588 show_or_not_diff c_or_h
.fpath
outfile show_only_minus;
1591 if !Flag.sgrep_mode2
then None
else Some
outfile)
1593 else (c_or_h
.fpath
, None
))
1596 let full_engine a b
=
1597 Common.profile_code
"full_engine"
1598 (fun () -> let res = full_engine2 a b
in (*Gc.print_stat stderr; *)res)
1600 let post_engine2 (cocci_infos,_,_) =
1603 (function languages
->
1605 FinalScriptRuleCocciInfo
(r) ->
1606 (if List.mem
r.language languages
1607 then failwith
("double finalizer found for "^
r.language
));
1608 initial_final_bigloop "final"
1609 (function(x
,_,y
) -> Ast_cocci.FinalScriptRule
(x
,y
))
1611 r.language
::languages
1617 Common.profile_code
"post_engine" (fun () -> post_engine2 a
)
1619 (*****************************************************************************)
1620 (* check duplicate from result of full_engine *)
1621 (*****************************************************************************)
1623 let check_duplicate_modif2 xs =
1624 (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
1625 if !Flag_cocci.verbose_cocci
1626 then pr2
("Check duplication for " ^ i_to_s
(List.length
xs) ^
" files");
1628 let groups = Common.group_assoc_bykey_eff
xs in
1629 groups +> Common.map_filter
(fun (file, xs) ->
1631 | [] -> raise Impossible
1632 | [res] -> Some
(file, res)
1636 if not
(List.for_all
(fun res2
-> res2
=*= None
) xs)
1638 pr2
("different modification result for " ^
file);
1641 else Some
(file, None
)
1643 if not
(List.for_all
(fun res2
->
1647 let diff = Common.cmd_to_list
("diff -u -b -B "^
res^
" "^res2
)
1651 pr2
("different modification result for " ^
file);
1654 else Some
(file, Some
res)
1658 let check_duplicate_modif a
=
1659 Common.profile_code
"check_duplicate" (fun () -> check_duplicate_modif2 a
)