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.
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
)
229 let show_or_not_rule_name ast rulenb
=
230 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
231 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
236 Ast_cocci.CocciRule
(nm
, (deps
, drops
, exists
), x
, _
, _
) -> nm
237 | _
-> i_to_s rulenb
in
238 Common.pr_xxxxxxxxxxxxxxxxx
();
240 Common.pr_xxxxxxxxxxxxxxxxx
()
243 let show_or_not_scr_rule_name rulenb
=
244 if !Flag_cocci.show_ctl_text
or !Flag.show_trying
or
245 !Flag.show_transinfo
or !Flag_cocci.show_binding_in_out
248 let name = i_to_s rulenb
in
249 Common.pr_xxxxxxxxxxxxxxxxx
();
250 pr
("script rule " ^
name ^
" = ");
251 Common.pr_xxxxxxxxxxxxxxxxx
()
254 let show_or_not_ctl_text2 ctl ast rulenb
=
255 if !Flag_cocci.show_ctl_text
then begin
257 adjust_pp_with_indent
(fun () ->
258 Format.force_newline
();
259 Pretty_print_cocci.print_plus_flag
:= true;
260 Pretty_print_cocci.print_minus_flag
:= true;
261 Pretty_print_cocci.unparse ast
;
266 adjust_pp_with_indent
(fun () ->
267 Format.force_newline
();
268 Pretty_print_engine.pp_ctlcocci
269 !Flag_cocci.show_mcodekind_in_ctl
!Flag_cocci.inline_let_ctl ctl
;
273 let show_or_not_ctl_text a b c
=
274 Common.profile_code
"show_xxx" (fun () -> show_or_not_ctl_text2 a b c
)
278 (* running information *)
279 let get_celem celem
: string =
281 Ast_c.Definition
({Ast_c.f_name
= namefuncs
;},_
) ->
282 Ast_c.str_of_name namefuncs
284 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name, _
);}, _
], _
)) ->
285 Ast_c.str_of_name
name
288 let show_or_not_celem2 prelude celem
=
291 | Ast_c.Definition
({Ast_c.f_name
= namefuncs
},_
) ->
292 let funcs = Ast_c.str_of_name namefuncs
in
293 Flag.current_element
:= funcs;
294 (" function: ",funcs)
296 (Ast_c.DeclList
([{Ast_c.v_namei
= Some
(name,_
)}, _
], _
)) ->
297 let s = Ast_c.str_of_name
name in
298 Flag.current_element
:= s;
301 Flag.current_element
:= "something_else";
302 (" ","something else");
304 if !Flag.show_trying
then pr2
(prelude ^ tag ^ trying
)
306 let show_or_not_celem a b
=
307 Common.profile_code
"show_xxx" (fun () -> show_or_not_celem2 a b
)
310 let show_or_not_trans_info2 trans_info
=
311 (* drop witness tree indices for printing *)
313 List.map
(function (index
,trans_info) -> trans_info) trans_info in
314 if !Flag.show_transinfo
then begin
315 if null
trans_info then pr2
"transformation info is empty"
317 pr2
"transformation info returned:";
319 List.sort
(function (i1
,_
,_
) -> function (i2
,_
,_
) -> compare i1 i2
)
323 trans_info +> List.iter
(fun (i
, subst
, re
) ->
324 pr2
("transform state: " ^
(Common.i_to_s i
));
326 adjust_pp_with_indent_and_header
"with rule_elem: " (fun () ->
327 Pretty_print_cocci.print_plus_flag
:= true;
328 Pretty_print_cocci.print_minus_flag
:= true;
329 Pretty_print_cocci.rule_elem
"" re
;
331 adjust_pp_with_indent_and_header
"with binding: " (fun () ->
332 Pretty_print_engine.pp_binding subst
;
339 let show_or_not_trans_info a
=
340 Common.profile_code
"show_xxx" (fun () -> show_or_not_trans_info2 a
)
344 let show_or_not_binding2 s binding
=
345 if !Flag_cocci.show_binding_in_out
then begin
346 adjust_pp_with_indent_and_header
("binding " ^
s ^
" = ") (fun () ->
347 Pretty_print_engine.pp_binding binding
350 let show_or_not_binding a b
=
351 Common.profile_code
"show_xxx" (fun () -> show_or_not_binding2 a b
)
355 (*****************************************************************************)
356 (* Some helper functions *)
357 (*****************************************************************************)
359 let worth_trying cfiles tokens
=
360 (* drop the following line for a list of list by rules. since we don't
361 allow multiple minirules, all the tokens within a rule should be in
362 a single CFG entity *)
363 let tokens = Common.union_all
tokens in
364 if not
!Flag_cocci.windows
&& not
(null
tokens)
366 (* could also modify the code in get_constants.ml *)
367 let tokens = tokens +> List.map
(fun s ->
369 | _
when s =~
"^[A-Za-z_][A-Za-z_0-9]*$" ->
372 | _
when s =~
"^[A-Za-z_]" ->
375 | _
when s =~
".*[A-Za-z_]$" ->
380 let com = sprintf
"egrep -q '(%s)' %s" (join
"|" tokens) (join
" " cfiles
)
382 (match Sys.command
com with
383 | 0 (* success *) -> true
386 then Printf.printf
"grep failed: %s\n" com);
387 false (* no match, so not worth trying *)
391 let check_macro_in_sp_and_adjust tokens =
392 let tokens = Common.union_all
tokens in
393 tokens +> List.iter
(fun s ->
394 if Hashtbl.mem
!Parse_c._defs
s
396 if !Flag_cocci.verbose_cocci
then begin
397 pr2
"warning: macro in semantic patch was in macro definitions";
398 pr2
("disabling macro expansion for " ^
s);
400 Hashtbl.remove
!Parse_c._defs
s
405 let contain_loop gopt
=
408 g#nodes#tolist
+> List.exists
(fun (xi
, node
) ->
409 Control_flow_c.extract_is_loop node
411 | None
-> true (* means nothing, if no g then will not model check *)
415 let sp_contain_typed_metavar_z toplevel_list_list
=
416 let bind x y
= x
or y
in
417 let option_default = false in
418 let mcode _ _
= option_default in
419 let donothing r k e
= k e
in
421 let expression r k e
=
422 match Ast_cocci.unwrap e
with
423 | Ast_cocci.MetaExpr
(_
,_
,_
,Some t
,_
,_
) -> true
424 | Ast_cocci.MetaExpr
(_
,_
,_
,_
,Ast_cocci.LocalID
,_
) -> true
429 Visitor_ast.combiner bind option_default
430 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
431 donothing donothing donothing donothing
432 donothing expression donothing donothing donothing donothing donothing
433 donothing donothing donothing donothing donothing
435 toplevel_list_list
+>
437 (function (nm
,_
,rule
) ->
438 (List.exists
combiner.Visitor_ast.combiner_top_level rule
))
440 let sp_contain_typed_metavar rules
=
441 sp_contain_typed_metavar_z
445 Ast_cocci.CocciRule
(a
,b
,c
,d
,_
) -> (a
,b
,c
)
446 | _
-> failwith
"error in filter")
450 Ast_cocci.CocciRule
(a
,b
,c
,d
,Ast_cocci.Normal
) -> true
456 (* finding among the #include the one that we need to parse
457 * because they may contain useful type definition or because
458 * we may have to modify them
460 * For the moment we base in part our heuristic on the name of the file, e.g.
461 * serio.c is related we think to #include <linux/serio.h>
464 let interpret_include_path _
=
465 match !Flag_cocci.include_path
with
469 let (includes_to_parse
:
470 (Common.filename
* Parse_c.program2
) list
->
471 Flag_cocci.include_options
-> 'a
) = fun xs choose_includes
->
472 match choose_includes
with
473 Flag_cocci.I_UNSPECIFIED
-> failwith
"not possible"
474 | Flag_cocci.I_NO_INCLUDES
-> []
476 let all_includes = x
=*= Flag_cocci.I_ALL_INCLUDES
in
477 xs +> List.map
(fun (file
, cs
) ->
478 let dir = Common.dirname file
in
480 cs
+> Common.map_filter
(fun (c
,_info_item
) ->
484 {Ast_c.i_include
= ((x
,ii
)); i_rel_pos
= info_h_pos
;}) ->
487 let f = Filename.concat
dir (Common.join
"/" xs) in
488 (* for our tests, all the files are flat in the current dir *)
489 if not
(Sys.file_exists
f) && !Flag_cocci.relax_include_path
491 let attempt2 = Filename.concat
dir (Common.last
xs) in
492 if not
(Sys.file_exists
f) && all_includes
493 then Some
(Filename.concat
(interpret_include_path())
494 (Common.join
"/" xs))
498 | Ast_c.NonLocal
xs ->
500 Common.fileprefix
(Common.last
xs) =$
= Common.fileprefix file
502 Some
(Filename.concat
(interpret_include_path())
503 (Common.join
"/" xs))
505 | Ast_c.Weird _
-> None
511 let rec interpret_dependencies local global
= function
512 Ast_cocci.Dep
s -> List.mem
s local
513 | Ast_cocci.AntiDep
s ->
514 (if !Flag_ctl.steps
!= None
515 then failwith
"steps and ! dependency incompatible");
516 not
(List.mem
s local
)
517 | Ast_cocci.EverDep
s -> List.mem
s global
518 | Ast_cocci.NeverDep
s ->
519 (if !Flag_ctl.steps
!= None
520 then failwith
"steps and ! dependency incompatible");
521 not
(List.mem
s global
)
522 | Ast_cocci.AndDep
(s1
,s2
) ->
523 (interpret_dependencies local global s1
) &&
524 (interpret_dependencies local global s2
)
525 | Ast_cocci.OrDep
(s1
,s2
) ->
526 (interpret_dependencies local global s1
) or
527 (interpret_dependencies local global s2
)
528 | Ast_cocci.NoDep
-> true
529 | Ast_cocci.FailDep
-> false
531 let rec print_dependencies str local global dep
=
532 if !Flag_cocci.show_dependencies
537 let rec loop = function
538 Ast_cocci.Dep
s | Ast_cocci.AntiDep
s ->
539 if not
(List.mem
s !seen)
543 then pr2
(s^
" satisfied")
544 else pr2
(s^
" not satisfied");
547 | Ast_cocci.EverDep
s | Ast_cocci.NeverDep
s ->
548 if not
(List.mem
s !seen)
552 then pr2
(s^
" satisfied")
553 else pr2
(s^
" not satisfied");
556 | Ast_cocci.AndDep
(s1
,s2
) ->
559 | Ast_cocci.OrDep
(s1
,s2
) ->
562 | Ast_cocci.NoDep
-> ()
563 | Ast_cocci.FailDep
-> pr2
"False not satisfied" in
567 (* --------------------------------------------------------------------- *)
568 (* #include relative position in the file *)
569 (* --------------------------------------------------------------------- *)
571 (* compute the set of new prefixes
573 * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *)
577 * it would give
for the first element
578 * ""; "a"; "a/b"; "a/b/x"
582 * update
: if the
include is inside a ifdef a put nothing
. cf
-test incl
.
583 * this is because we dont want code added inside ifdef
.
586 let compute_new_prefixes xs =
587 xs +> Common.map_withenv
(fun already
xs ->
588 let subdirs_prefixes = Common.inits
xs in
589 let new_first = subdirs_prefixes +> List.filter
(fun x
->
590 not
(List.mem x already
)
599 (* does via side effect on the ref in the Include in Ast_c *)
600 let rec update_include_rel_pos cs
=
601 let only_include = cs
+> Common.map_filter
(fun c
->
603 | Ast_c.CppTop
(Ast_c.Include
{Ast_c.i_include
= ((x
,_
));
605 i_is_in_ifdef
= inifdef
}) ->
607 | Ast_c.Weird _
-> None
616 let (locals
, nonlocals
) =
617 only_include +> Common.partition_either
(fun (c
, aref
) ->
619 | Ast_c.Local x
-> Left
(x
, aref
)
620 | Ast_c.NonLocal x
-> Right
(x
, aref
)
621 | Ast_c.Weird x
-> raise Impossible
624 update_rel_pos_bis locals
;
625 update_rel_pos_bis nonlocals
;
627 and update_rel_pos_bis
xs =
628 let xs'
= List.map fst
xs in
629 let the_first = compute_new_prefixes xs'
in
630 let the_last = List.rev
(compute_new_prefixes (List.rev
xs'
)) in
631 let merged = Common.zip
xs (Common.zip
the_first the_last) in
632 merged +> List.iter
(fun ((x
, aref
), (the_first, the_last)) ->
635 Ast_c.first_of
= the_first;
636 Ast_c.last_of
= the_last;
641 (*****************************************************************************)
642 (* All the information needed around the C elements and Cocci rules *)
643 (*****************************************************************************)
645 type toplevel_c_info
= {
646 ast_c
: Ast_c.toplevel
; (* contain refs so can be modified *)
647 tokens_c
: Parser_c.token list
;
650 flow
: Control_flow_c.cflow
option; (* it's the "fixed" flow *)
653 env_typing_before
: TAC.environment
;
654 env_typing_after
: TAC.environment
;
656 was_modified
: bool ref;
661 type toplevel_cocci_info_script_rule
= {
662 scr_ast_rule
: string * (string * Ast_cocci.meta_name
) list
* string;
664 scr_dependencies
: Ast_cocci.dependency
;
669 type toplevel_cocci_info_cocci_rule
= {
670 ctl
: Lib_engine.ctlcocci
* (CCI.pred list list
);
671 metavars
: Ast_cocci.metavar list
;
672 ast_rule
: Ast_cocci.rule
;
673 isexp
: bool; (* true if + code is an exp, only for Flag.make_hrule *)
676 dependencies
: Ast_cocci.dependency
;
677 (* There are also some hardcoded rule names in parse_cocci.ml:
678 * let reserved_names = ["all";"optional_storage";"optional_qualifier"]
680 dropped_isos
: string list
;
681 free_vars
: Ast_cocci.meta_name list
;
682 negated_pos_vars
: Ast_cocci.meta_name list
;
683 used_after
: Ast_cocci.meta_name list
;
684 positions
: Ast_cocci.meta_name list
;
687 ruletype
: Ast_cocci.ruletype
;
689 was_matched
: bool ref;
692 type toplevel_cocci_info
=
693 ScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
694 | InitialScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
695 | FinalScriptRuleCocciInfo
of toplevel_cocci_info_script_rule
696 | CocciRuleCocciInfo
of toplevel_cocci_info_cocci_rule
698 type cocci_info
= toplevel_cocci_info list
* string list list
(* tokens *)
700 type kind_file
= Header
| Source
704 was_modified_once
: bool ref;
705 asts
: toplevel_c_info list
;
710 let g_contain_typedmetavar = ref false
713 let last_env_toplevel_c_info xs =
714 (Common.last
xs).env_typing_after
716 let concat_headers_and_c (ccs
: file_info list
)
717 : (toplevel_c_info
* string) list
=
718 (List.concat
(ccs
+> List.map
(fun x
->
719 x
.asts
+> List.map
(fun x'
->
722 let for_unparser xs =
723 xs +> List.map
(fun x
->
724 (x
.ast_c
, (x
.fullstring
, x
.tokens_c
)), Unparse_c.PPviastr
727 let gen_pdf_graph () =
728 (Ctl_engine.get_graph_files
()) +> List.iter
(fun outfile
->
729 Printf.printf
"Generation of %s%!" outfile
;
730 let filename_stack = Ctl_engine.get_graph_comp_files outfile
in
731 List.iter
(fun filename
->
732 ignore
(Unix.system
("dot " ^ filename ^
" -Tpdf -o " ^ filename ^
".pdf;"))
734 let (head
,tail
) = (List.hd
filename_stack, List.tl
filename_stack) in
735 ignore
(Unix.system
("cp " ^ head ^
".pdf " ^ outfile ^
".pdf;"));
736 tail
+> List.iter
(fun filename
->
737 ignore
(Unix.system
("mv " ^ outfile ^
".pdf /tmp/tmp.pdf;"));
738 ignore
(Unix.system
("pdftk " ^ filename ^
".pdf /tmp/tmp.pdf cat output " ^ outfile ^
".pdf"));
740 ignore
(Unix.system
("rm /tmp/tmp.pdf;"));
741 List.iter
(fun filename
->
742 ignore
(Unix.system
("rm " ^ filename ^
" " ^ filename ^
".pdf;"))
744 Printf.printf
" - Done\n")
746 let local_python_code =
747 "from coccinelle import *\n"
750 "import coccinelle\n"^
752 "import coccilib.org\n"^
753 "import coccilib.report\n" ^
757 let make_init rulenb lang code
=
759 let deps = Ast_cocci.NoDep
in
761 scr_ast_rule
= (lang
, mv, code
);
763 scr_dependencies
= deps;
765 script_code
= (if lang
= "python" then python_code else "") ^code
768 (* --------------------------------------------------------------------- *)
769 let prepare_cocci ctls free_var_lists negated_pos_lists
770 (ua
,fua
,fuas
) positions_list metavars astcocci
=
772 let gathered = Common.index_list_1
773 (zip
(zip
(zip
(zip
(zip
(zip
(zip
(zip ctls metavars
) astcocci
)
775 negated_pos_lists
) ua
) fua
) fuas
) positions_list
)
778 (fun (((((((((ctl_toplevel_list
,metavars
),ast
),free_var_list
),
779 negated_pos_list
),ua
),fua
),fuas
),positions_list
),rulenb
) ->
781 let is_script_rule r
=
783 Ast_cocci.ScriptRule _
784 | Ast_cocci.InitialScriptRule _
| Ast_cocci.FinalScriptRule _
-> true
787 if not
(List.length ctl_toplevel_list
=|= 1) && not
(is_script_rule ast
)
788 then failwith
"not handling multiple minirules";
791 Ast_cocci.ScriptRule
(lang
,deps,mv,code
) ->
794 scr_ast_rule
= (lang
, mv, code
);
796 scr_dependencies
= deps;
800 in ScriptRuleCocciInfo
r
801 | Ast_cocci.InitialScriptRule
(lang
,code
) ->
802 let r = make_init rulenb lang code
in
803 InitialScriptRuleCocciInfo
r
804 | Ast_cocci.FinalScriptRule
(lang
,code
) ->
806 let deps = Ast_cocci.NoDep
in
809 scr_ast_rule
= (lang
, mv, code
);
811 scr_dependencies
= deps;
815 in FinalScriptRuleCocciInfo
r
816 | Ast_cocci.CocciRule
817 (rulename
,(dependencies
,dropped_isos
,z
),restast
,isexp
,ruletype
) ->
820 ctl
= List.hd ctl_toplevel_list
;
823 isexp
= List.hd isexp
;
825 dependencies
= dependencies
;
826 dropped_isos
= dropped_isos
;
827 free_vars
= List.hd free_var_list
;
828 negated_pos_vars
= List.hd negated_pos_list
;
829 used_after
= (List.hd ua
) @ (List.hd fua
);
830 positions
= List.hd positions_list
;
833 was_matched
= ref false;
838 (* --------------------------------------------------------------------- *)
840 let build_info_program cprogram env
=
842 let (cs
, parseinfos
) =
843 Common.unzip cprogram
in
846 parseinfos
+> List.map
(fun (s,toks
) -> toks
) +> List.flatten
in
848 (* I use cs' but really annotate_xxx work by doing side effects on cs *)
850 Comment_annotater_c.annotate_program
alltoks cs in
852 Type_annoter_c.annotate_program env
(*!g_contain_typedmetavar*) cs'
855 zip
cs_with_envs parseinfos
+> List.map
(fun ((c
, (enva
,envb
)), parseinfo
)->
856 let (fullstr
, tokens) = parseinfo
in
859 ast_to_flow_with_error_messages c
+>
860 Common.map_option
(fun flow ->
861 let flow = Ast_to_flow.annotate_loop_nodes
flow in
863 (* remove the fake nodes for julia *)
864 let fixed_flow = CCI.fix_flow_ctl
flow in
866 if !Flag_cocci.show_flow
then print_flow fixed_flow;
867 if !Flag_cocci.show_before_fixed_flow
then print_flow flow;
874 ast_c
= c
; (* contain refs so can be modified *)
876 fullstring
= fullstr
;
880 contain_loop = contain_loop flow;
882 env_typing_before
= enva
;
883 env_typing_after
= envb
;
885 was_modified
= ref false;
891 (* Optimisation. Try not unparse/reparse the whole file when have modifs *)
892 let rebuild_info_program cs file isexp
=
893 cs +> List.map
(fun c
->
896 let file = Common.new_temp_file
"cocci_small_output" ".c" in
898 [(c
.ast_c
, (c
.fullstring
, c
.tokens_c
)), Unparse_c.PPnormal
]
901 (* Common.command2 ("cat " ^ file); *)
902 let cprogram = cprogram_of_file file in
903 let xs = build_info_program cprogram c
.env_typing_before
in
905 (* TODO: assert env has not changed,
906 * if yes then must also reparse what follows even if not modified.
907 * Do that only if contain_typedmetavar of course, so good opti.
909 (* Common.list_init xs *) (* get rid of the FinalDef *)
915 let rebuild_info_c_and_headers ccs isexp
=
916 ccs
+> List.iter
(fun c_or_h
->
917 if c_or_h
.asts
+> List.exists
(fun c
-> !(c
.was_modified
))
918 then c_or_h
.was_modified_once
:= true;
920 ccs
+> List.map
(fun c_or_h
->
923 rebuild_info_program c_or_h
.asts c_or_h
.full_fname isexp
}
932 let prepare_c files choose_includes
: file_info list
=
933 let cprograms = List.map
cprogram_of_file_cached files
in
934 let includes = includes_to_parse
(zip files
cprograms) choose_includes
in
936 (* todo?: may not be good to first have all the headers and then all the c *)
938 (includes +> List.map
(fun hpath
-> Right hpath
))
940 ((zip files
cprograms) +> List.map
(fun (file, asts
) -> Left
(file, asts
)))
943 let env = ref !TAC.initial_env
in
945 let ccs = all +> Common.map_filter
(fun x
->
948 if not
(Common.lfile_exists hpath
)
950 pr2
("TYPE: header " ^ hpath ^
" not found");
954 let h_cs = cprogram_of_file_cached hpath
in
955 let info_h_cs = build_info_program h_cs !env in
959 else last_env_toplevel_c_info info_h_cs
962 fname
= Common.basename hpath
;
965 was_modified_once
= ref false;
969 | Left
(file, cprogram) ->
970 (* todo?: don't update env ? *)
971 let cs = build_info_program cprogram !env in
972 (* we do that only for the c, not for the h *)
973 ignore
(update_include_rel_pos (cs +> List.map
(fun x
-> x
.ast_c
)));
975 fname
= Common.basename
file;
978 was_modified_once
= ref false;
987 (*****************************************************************************)
988 (* Processing the ctls and toplevel C elements *)
989 (*****************************************************************************)
991 (* The main algorithm =~
992 * The algorithm is roughly:
993 * for_all ctl rules in SP
994 * for_all minirule in rule (no more)
995 * for_all binding (computed during previous phase)
997 * match control flow of function vs minirule
998 * with the binding and update the set of possible
999 * bindings, and returned the possibly modified function.
1000 * pretty print modified C elements and reparse it.
1003 * On ne prends que les newbinding ou returned_any_state est vrai.
1004 * Si ca ne donne rien, on prends ce qu'il y avait au depart.
1005 * Mais au nouveau depart de quoi ?
1006 * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?
1007 * - ou alors si ca donne rien, apres avoir traité toutes les fonctions
1008 * avec tous les bindings du round d'avant ?
1010 * Julia pense qu'il faut prendre la premiere solution.
1011 * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
1012 * la regle ctl 1. On arrive sur la regle ctl 2.
1013 * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
1014 * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
1017 * I have not to look at used_after_list to decide to restart from
1018 * scratch. I just need to look if the binding list is empty.
1019 * Indeed, let's suppose that a SP have 3 regions/rules. If we
1020 * don't find a match for the first region, then if this first
1021 * region does not bind metavariable used after, that is if
1022 * used_after_list is empty, then mysat(), even if does not find a
1023 * match, will return a Left, with an empty transformation_info,
1024 * and so current_binding will grow. On the contrary if the first
1025 * region must bind some metavariables used after, and that we
1026 * dont find any such region, then mysat() will returns lots of
1027 * Right, and current_binding will not grow, and so we will have
1028 * an empty list of binding, and we will catch such a case.
1030 * opti: julia says that because the binding is
1031 * determined by the used_after_list, the items in the list
1032 * are kind of sorted, so could optimise the insert_set operations.
1036 (* r(ule), c(element in C code), e(nvironment) *)
1039 let rec loop k
= function
1043 then Some
(x
, function n
-> k
(n
:: xs))
1044 else loop (function vs
-> k
(x
:: vs
)) xs in
1045 loop (function x
-> x
) l
1047 let merge_env new_e old_e
=
1050 (function (ext
,old_e
) ->
1051 function (e
,rules
) as elem
->
1052 match findk (function (e1
,_
) -> e
=*= e1
) old_e
with
1053 None
-> (elem
:: ext
,old_e
)
1054 | Some
((_
,old_rules
),k
) ->
1055 (ext
,k
(e
,Common.union_set rules old_rules
)))
1057 old_e
@ (List.rev ext
)
1059 let apply_python_rule r cache newes e rules_that_have_matched
1060 rules_that_have_ever_matched
=
1061 Common.profile_code
"python" (fun () ->
1062 show_or_not_scr_rule_name r.scr_ruleid
;
1063 if not
(interpret_dependencies rules_that_have_matched
1064 !rules_that_have_ever_matched
r.scr_dependencies
)
1067 print_dependencies "dependencies for script not satisfied:"
1068 rules_that_have_matched
1069 !rules_that_have_ever_matched
r.scr_dependencies
;
1070 show_or_not_binding "in environment" e
;
1071 (cache
, (e
, rules_that_have_matched
)::newes
)
1075 let (_
, mv, _
) = r.scr_ast_rule
in
1077 (List.map
(function (n
,v
) -> (("virtual",n
),Ast_c.MetaIdVal v
))
1078 !Flag.defined_virtual_env
) @ e
in
1079 let not_bound x
= not
(Pycocci.contains_binding
ve x
) in
1080 (match List.filter
not_bound mv with
1082 let relevant_bindings =
1084 (function ((re
,rm
),_
) ->
1085 List.exists
(function (_
,(r,m
)) -> r =*= re
&& m
=$
= rm
) mv)
1088 if List.mem
relevant_bindings cache
1092 "dependencies for script satisfied, but cached:"
1093 rules_that_have_matched
1094 !rules_that_have_ever_matched
1096 show_or_not_binding "in" e
;
1101 print_dependencies "dependencies for script satisfied:"
1102 rules_that_have_matched
1103 !rules_that_have_ever_matched
1105 show_or_not_binding "in" e
;
1106 Pycocci.build_classes
(List.map
(function (x
,y
) -> x
) ve);
1107 Pycocci.construct_variables
mv ve;
1108 let _ = Pycocci.pyrun_simplestring
(local_python_code ^
r.script_code
) in
1109 relevant_bindings :: cache
1111 if !Pycocci.inc_match
1112 then (new_cache, merge_env [(e
, rules_that_have_matched
)] newes
)
1113 else (new_cache, newes
)
1115 (if !Flag_cocci.show_dependencies
1117 let m2c (_,(r,x
)) = r^
"."^x
in
1118 pr2
(Printf.sprintf
"script not applied: %s not bound"
1119 (String.concat
", " (List.map
m2c unbound
))));
1120 (cache
, merge_env [(e
, rules_that_have_matched
)] newes
))
1123 let rec apply_cocci_rule r rules_that_have_ever_matched es
1124 (ccs:file_info list
ref) =
1125 Common.profile_code
r.rulename
(fun () ->
1126 show_or_not_rule_name r.ast_rule
r.ruleid
;
1127 show_or_not_ctl_text r.ctl
r.ast_rule
r.ruleid
;
1129 let reorganized_env =
1130 reassociate_positions
r.free_vars
r.negated_pos_vars
!es
in
1132 (* looping over the environments *)
1133 let (_,newes
(* envs for next round/rule *)) =
1135 (function (cache
,newes
) ->
1136 function ((e
,rules_that_have_matched
),relevant_bindings) ->
1137 if not
(interpret_dependencies rules_that_have_matched
1138 !rules_that_have_ever_matched
1143 ("dependencies for rule "^
r.rulename^
" not satisfied:")
1144 rules_that_have_matched
1145 !rules_that_have_ever_matched
r.dependencies
;
1146 show_or_not_binding "in environment" e
;
1149 [(e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
),
1150 rules_that_have_matched
)]
1155 try List.assoc
relevant_bindings cache
1159 ("dependencies for rule "^
r.rulename^
" satisfied:")
1160 rules_that_have_matched
1161 !rules_that_have_ever_matched
1163 show_or_not_binding "in" e
;
1164 show_or_not_binding "relevant in" relevant_bindings;
1166 (* applying the rule *)
1167 (match r.ruletype
with
1169 (* looping over the functions and toplevel elements in
1172 (concat_headers_and_c !ccs +>
1173 List.fold_left
(fun children_e
(c
,f) ->
1176 (* does also some side effects on c and r *)
1178 process_a_ctl_a_env_a_toplevel
r
1179 relevant_bindings c
f in
1180 match processed with
1181 | None
-> children_e
1182 | Some newbindings
->
1185 (fun children_e newbinding
->
1186 if List.mem newbinding children_e
1188 else newbinding
:: children_e
)
1192 | Ast_cocci.Generated
->
1193 process_a_generated_a_env_a_toplevel
r
1194 relevant_bindings !ccs;
1197 let old_bindings_to_keep =
1199 (e
+> List.filter
(fun (s,v
) -> List.mem
s r.used_after
)) in
1201 if null
new_bindings
1204 (*use the old bindings, specialized to the used_after_list*)
1205 if !Flag_ctl.partial_match
1208 "Empty list of bindings, I will restart from old env\n";
1209 [(old_bindings_to_keep,rules_that_have_matched
)]
1212 (* combine the new bindings with the old ones, and
1213 specialize to the used_after_list *)
1214 let old_variables = List.map fst
old_bindings_to_keep in
1215 (* have to explicitly discard the inherited variables
1216 because we want the inherited value of the positions
1217 variables not the extended one created by
1218 reassociate_positions. want to reassociate freshly
1219 according to the free variables of each rule. *)
1220 let new_bindings_to_add =
1226 List.mem
s r.used_after
&&
1227 not
(List.mem
s old_variables)))) in
1229 (function new_binding_to_add
->
1232 old_bindings_to_keep new_binding_to_add
),
1233 r.rulename
::rules_that_have_matched
))
1234 new_bindings_to_add in
1235 ((relevant_bindings,new_bindings)::cache
,
1236 merge_env new_e newes
))
1237 ([],[]) reorganized_env in (* end iter es *)
1239 then Common.push2
r.rulename rules_that_have_ever_matched
;
1243 (* apply the tagged modifs and reparse *)
1244 if not
!Flag.sgrep_mode2
1245 then ccs := rebuild_info_c_and_headers !ccs r.isexp
)
1247 and reassociate_positions free_vars negated_pos_vars envs
=
1248 (* issues: isolate the bindings that are relevant to a given rule.
1249 separate out the position variables
1250 associate all of the position variables for a given set of relevant
1251 normal variable bindings with each set of relevant normal variable
1252 bindings. Goal: if eg if@p (E) matches in two places, then both inherited
1253 occurrences of E should see both bindings of p, not just its own.
1254 Otherwise, a position constraint for something that matches in two
1255 places will never be useful, because the position can always be
1256 different from the other one. *)
1260 List.filter
(function (x
,_) -> List.mem x free_vars
) e
)
1262 let splitted_relevant =
1263 (* separate the relevant variables into the non-position ones and the
1268 (function (non_pos
,pos
) ->
1269 function (v
,_) as x
->
1270 if List.mem v negated_pos_vars
1271 then (non_pos
,x
::pos
)
1272 else (x
::non_pos
,pos
))
1275 let splitted_relevant =
1277 (function (non_pos
,pos
) ->
1278 (List.sort compare non_pos
,List.sort compare pos
))
1279 splitted_relevant in
1282 (function non_pos
->
1284 if List.mem np non_pos
then non_pos
else np
::non_pos
)
1285 [] splitted_relevant in
1286 let extended_relevant =
1287 (* extend the position variables with the values found at other identical
1288 variable bindings *)
1290 (function non_pos
->
1293 (function (other_non_pos
,other_pos
) ->
1294 (* do we want equal? or just somehow compatible? eg non_pos
1295 binds only E, but other_non_pos binds both E and E1 *)
1296 non_pos
=*= other_non_pos
)
1297 splitted_relevant in
1301 (combine_pos negated_pos_vars
1302 (List.map
(function (_,x
) -> x
) others)))))
1305 (List.map
(function (non_pos
,_) -> List.assoc non_pos
extended_relevant)
1308 and combine_pos negated_pos_vars
others =
1312 Ast_c.MetaPosValList
1315 (function positions
->
1316 function other_list
->
1318 match List.assoc posvar other_list
with
1319 Ast_c.MetaPosValList l1
->
1320 Common.union_set l1 positions
1321 | _ -> failwith
"bad value for a position variable"
1322 with Not_found
-> positions
)
1326 and process_a_generated_a_env_a_toplevel2
r env = function
1331 (rule
,_) when rule
=$
= r.rulename
-> false
1332 | (_,"ARGS") -> false
1335 let env_domain = List.map
(function (nm
,vl
) -> nm
) env in
1339 let (rl
,_) = Ast_cocci.get_meta_name md
in rl
=$
= r.rulename
)
1341 if Common.include_set
free_vars env_domain
1342 then Unparse_hrule.pp_rule
metavars r.ast_rule
env cfile
.full_fname
1343 | _ -> failwith
"multiple files not supported"
1345 and process_a_generated_a_env_a_toplevel rule
env ccs =
1346 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1347 (fun () -> process_a_generated_a_env_a_toplevel2 rule
env ccs)
1349 (* does side effects on C ast and on Cocci info rule *)
1350 and process_a_ctl_a_env_a_toplevel2
r e c
f =
1351 indent_do
(fun () ->
1352 show_or_not_celem "trying" c
.ast_c
;
1353 Flag.currentfile
:= Some
(f ^
":" ^
get_celem c
.ast_c
);
1354 let (trans_info, returned_any_states
, inherited_bindings
, newbindings
) =
1355 Common.save_excursion
Flag_ctl.loop_in_src_code
(fun () ->
1356 Flag_ctl.loop_in_src_code
:= !Flag_ctl.loop_in_src_code
||c
.contain_loop;
1358 (***************************************)
1359 (* !Main point! The call to the engine *)
1360 (***************************************)
1361 let model_ctl = CCI.model_for_ctl
r.dropped_isos
(Common.some c
.flow) e
1362 in CCI.mysat
model_ctl r.ctl
(r.used_after
, e
)
1365 if not returned_any_states
1368 show_or_not_celem "found match in" c
.ast_c
;
1369 show_or_not_trans_info trans_info;
1370 List.iter
(show_or_not_binding "out") newbindings
;
1372 r.was_matched
:= true;
1374 if not
(null
trans_info)
1376 c
.was_modified
:= true;
1378 (* les "more than one var in a decl" et "already tagged token"
1379 * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
1380 * failed. Le try limite le scope des crashes pendant la
1381 * trasformation au fichier concerne. *)
1383 (* modify ast via side effect *)
1384 ignore
(Transformation_c.transform
r.rulename
r.dropped_isos
1385 inherited_bindings
trans_info (Common.some c
.flow));
1386 with Timeout
-> raise Timeout
| UnixExit i
-> raise
(UnixExit i
)
1389 Some
(List.map
(function x
-> x
@inherited_bindings
) newbindings
)
1393 and process_a_ctl_a_env_a_toplevel a b c
f=
1394 Common.profile_code
"process_a_ctl_a_env_a_toplevel"
1395 (fun () -> process_a_ctl_a_env_a_toplevel2 a b c
f)
1398 let rec bigloop2 rs
(ccs: file_info list
) =
1399 let init_es = [(Ast_c.emptyMetavarsBinding
,[])] in
1400 let es = ref init_es in
1401 let ccs = ref ccs in
1402 let rules_that_have_ever_matched = ref [] in
1404 (* looping over the rules *)
1405 rs
+> List.iter
(fun r ->
1407 InitialScriptRuleCocciInfo
r | FinalScriptRuleCocciInfo
r -> ()
1408 | ScriptRuleCocciInfo
r ->
1409 if !Flag_cocci.show_ctl_text
then begin
1410 Common.pr_xxxxxxxxxxxxxxxxx
();
1411 pr
("script: " ^
r.language
);
1412 Common.pr_xxxxxxxxxxxxxxxxx
();
1414 adjust_pp_with_indent
(fun () ->
1415 Format.force_newline
();
1416 let (l
,mv,code
) = r.scr_ast_rule
in
1417 let deps = r.scr_dependencies
in
1418 Pretty_print_cocci.unparse
1419 (Ast_cocci.ScriptRule
(l
,deps,mv,code
)));
1422 if !Flag.show_misc
then print_endline
"RESULT =";
1426 (function (cache
, newes
) ->
1427 function (e
, rules_that_have_matched
) ->
1428 match r.language
with
1430 apply_python_rule r cache newes e rules_that_have_matched
1431 rules_that_have_ever_matched
1433 concat_headers_and_c !ccs +> List.iter
(fun (c
,_) ->
1436 Printf.printf
"Flow: %s\r\nFlow!\r\n%!" c
.fullstring
);
1439 Printf.printf
"Unknown language: %s\n" r.language
;
1444 es := (if newes
= [] then init_es else newes
);
1445 | CocciRuleCocciInfo
r ->
1446 apply_cocci_rule r rules_that_have_ever_matched
1449 if !Flag.sgrep_mode2
1451 (* sgrep can lead to code that is not parsable, but we must
1452 * still call rebuild_info_c_and_headers to pretty print the
1453 * action (MINUS), so that later the diff will show what was
1454 * matched by sgrep. But we don't want the parsing error message
1455 * hence the following flag setting. So this code propably
1456 * will generate a NotParsedCorrectly for the matched parts
1457 * and the very final pretty print and diff will work
1459 Flag_parsing_c.verbose_parsing
:= false;
1460 ccs := rebuild_info_c_and_headers !ccs false
1462 !ccs (* return final C asts *)
1465 Common.profile_code
"bigloop" (fun () -> bigloop2 a b
)
1467 let initial_final_bigloop2 ty rebuild
r =
1468 if !Flag_cocci.show_ctl_text
then
1470 Common.pr_xxxxxxxxxxxxxxxxx
();
1471 pr
(ty ^
": " ^
r.language
);
1472 Common.pr_xxxxxxxxxxxxxxxxx
();
1474 adjust_pp_with_indent
(fun () ->
1475 Format.force_newline
();
1476 Pretty_print_cocci.unparse
(rebuild
r.scr_ast_rule
));
1479 match r.language
with
1481 (* include_match makes no sense in an initial or final rule, although
1482 er have no way to prevent it *)
1483 let _ = apply_python_rule r [] [] [] [] (ref []) in
1486 Printf.printf
"Unknown language for initial/final script: %s\n"
1489 let initial_final_bigloop a b c
=
1490 Common.profile_code
"initial_final_bigloop"
1491 (fun () -> initial_final_bigloop2 a b c
)
1493 (*****************************************************************************)
1494 (* The main functions *)
1495 (*****************************************************************************)
1497 let pre_engine2 (coccifile
, isofile
) =
1498 show_or_not_cocci coccifile isofile
;
1499 Pycocci.set_coccifile coccifile
;
1502 if not
(Common.lfile_exists
isofile)
1504 pr2
("warning: Can't find default iso file: " ^
isofile);
1507 else Some
isofile in
1509 (* useful opti when use -dir *)
1510 let (metavars,astcocci
,free_var_lists
,negated_pos_lists
,used_after_lists
,
1511 positions_lists
,toks
,_) =
1512 sp_of_file coccifile
isofile in
1513 let ctls = ctls_of_ast astcocci used_after_lists positions_lists
in
1515 g_contain_typedmetavar := sp_contain_typed_metavar astcocci
;
1517 check_macro_in_sp_and_adjust toks
;
1519 show_or_not_ctl_tex astcocci
ctls;
1522 prepare_cocci ctls free_var_lists negated_pos_lists
1523 used_after_lists positions_lists
metavars astcocci
in
1525 let used_languages =
1527 (function languages
->
1529 ScriptRuleCocciInfo
(r) ->
1530 if List.mem
r.language languages
then
1533 r.language
::languages
1537 let initialized_languages =
1539 (function languages
->
1541 InitialScriptRuleCocciInfo
(r) ->
1542 (if List.mem
r.language languages
1543 then failwith
("double initializer found for "^
r.language
));
1544 initial_final_bigloop "initial"
1545 (function(x
,_,y
) -> Ast_cocci.InitialScriptRule
(x
,y
))
1547 r.language
::languages
1551 let uninitialized_languages =
1553 (fun used
-> not
(List.mem used
initialized_languages))
1556 List.iter
(fun lgg
->
1557 initial_final_bigloop "initial"
1558 (function(x
,_,y
) -> Ast_cocci.InitialScriptRule
(x
,y
))
1559 (make_init (-1) lgg
"");
1561 uninitialized_languages;
1566 Common.profile_code
"pre_engine" (fun () -> pre_engine2 a
)
1568 let full_engine2 (cocci_infos,toks
) cfiles
=
1570 show_or_not_cfiles cfiles
;
1572 (* optimisation allowing to launch coccinelle on all the drivers *)
1573 if !Flag_cocci.worth_trying_opt
&& not
(worth_trying cfiles toks
)
1576 pr2
("No matches found for " ^
(Common.join
" " (Common.union_all toks
))
1577 ^
"\nSkipping:" ^
(Common.join
" " cfiles
));
1578 cfiles
+> List.map
(fun s -> s, None
)
1583 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1584 if !Flag.show_misc
then pr
"let's go";
1585 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1587 let choose_includes =
1588 match !Flag_cocci.include_options
with
1589 Flag_cocci.I_UNSPECIFIED
->
1590 if !g_contain_typedmetavar
1591 then Flag_cocci.I_NORMAL_INCLUDES
1592 else Flag_cocci.I_NO_INCLUDES
1594 let c_infos = prepare_c cfiles
choose_includes in
1596 (* ! the big loop ! *)
1597 let c_infos'
= bigloop cocci_infos c_infos in
1599 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1600 if !Flag.show_misc
then pr
"Finished";
1601 if !Flag.show_misc
then Common.pr_xxxxxxxxxxxxxxxxx
();
1602 if !Flag_ctl.graphical_trace
then gen_pdf_graph ();
1604 c_infos'
+> List.map
(fun c_or_h
->
1605 if !(c_or_h
.was_modified_once
)
1609 Common.new_temp_file
"cocci-output" ("-" ^ c_or_h
.fname
) in
1611 if c_or_h
.fkind
=*= Header
1612 then pr2
("a header file was modified: " ^ c_or_h
.fname
);
1614 (* and now unparse everything *)
1615 cfile_of_program (for_unparser c_or_h
.asts
) outfile;
1617 let show_only_minus = !Flag.sgrep_mode2
in
1618 show_or_not_diff c_or_h
.fpath
outfile show_only_minus;
1621 if !Flag.sgrep_mode2
then None
else Some
outfile)
1623 else (c_or_h
.fpath
, None
))
1626 let full_engine a b
=
1627 Common.profile_code
"full_engine"
1628 (fun () -> let res = full_engine2 a b
in (*Gc.print_stat stderr; *)res)
1630 let post_engine2 (cocci_infos,_) =
1633 (function languages
->
1635 FinalScriptRuleCocciInfo
(r) ->
1636 (if List.mem
r.language languages
1637 then failwith
("double finalizer found for "^
r.language
));
1638 initial_final_bigloop "final"
1639 (function(x
,_,y
) -> Ast_cocci.FinalScriptRule
(x
,y
))
1641 r.language
::languages
1647 Common.profile_code
"post_engine" (fun () -> post_engine2 a
)
1649 (*****************************************************************************)
1650 (* check duplicate from result of full_engine *)
1651 (*****************************************************************************)
1653 let check_duplicate_modif2 xs =
1654 (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
1655 if !Flag_cocci.verbose_cocci
1656 then pr2
("Check duplication for " ^ i_to_s
(List.length
xs) ^
" files");
1658 let groups = Common.group_assoc_bykey_eff
xs in
1659 groups +> Common.map_filter
(fun (file, xs) ->
1661 | [] -> raise Impossible
1662 | [res] -> Some
(file, res)
1666 if not
(List.for_all
(fun res2
-> res2
=*= None
) xs)
1668 pr2
("different modification result for " ^
file);
1671 else Some
(file, None
)
1673 if not
(List.for_all
(fun res2
->
1677 let diff = Common.cmd_to_list
("diff -u -b -B "^
res^
" "^res2
)
1681 pr2
("different modification result for " ^
file);
1684 else Some
(file, Some
res)
1686 let check_duplicate_modif a
=
1687 Common.profile_code
"check_duplicate" (fun () -> check_duplicate_modif2 a
)