2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
26 * Copyright 2010, INRIA, University of Copenhagen
27 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
28 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
29 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
30 * This file is part of Coccinelle.
32 * Coccinelle is free software: you can redistribute it and/or modify
33 * it under the terms of the GNU General Public License as published by
34 * the Free Software Foundation, according to version 2 of the License.
36 * Coccinelle is distributed in the hope that it will be useful,
37 * but WITHOUT ANY WARRANTY; without even the implied warranty of
38 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
39 * GNU General Public License for more details.
41 * You should have received a copy of the GNU General Public License
42 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
44 * The authors reserve the right to distribute this or future versions of
45 * Coccinelle under other licenses.
50 module FC
= Flag_cocci
52 (*****************************************************************************)
54 (*****************************************************************************)
56 (* In addition to flags that can be tweaked via -xxx options (cf the
57 * full list of options in "the spatch options" section below), the
58 * spatch program also depends on external files, described in
59 * globals/config.ml, mainly a standard.h and standard.iso file *)
61 let cocci_file = ref ""
63 let output_file = ref ""
64 let inplace_modif = ref false (* but keeps nothing *)
66 ref (None
: string option) (* suffix for backup if one is desired *)
67 let outplace_modif = ref false (* generates a .cocci_res *)
68 let preprocess = ref false (* run the C preprocessor before cocci *)
69 let compat_mode = ref false
70 let ignore_unknown_opt = ref false
72 (* somehow obsolete now *)
75 let include_headers = ref false
76 let kbuild_info = ref ""
78 let macro_file = ref ""
81 let test_mode = ref false
82 let test_all = ref false
83 let test_okfailed = ref false
84 let test_regression_okfailed = ref false
85 let expected_score_file = ref ""
91 (* works with -test but also in "normal" spatch mode *)
92 let compare_with_expected = ref false
94 let distrib_index = ref (None
: int option)
95 let distrib_max = ref (None
: int option)
96 let mod_distrib = ref false
99 (*****************************************************************************)
101 (*****************************************************************************)
103 (* pair of (list of flags to set true, list of flags to set false *)
104 let very_quiet_profile = (
108 (* FC.show_diff; just leave this as it is *)
110 Common.print_to_stderr
;
118 FC.show_before_fixed_flow
;
121 FC.show_binding_in_out
;
125 Flag_parsing_c.show_parsing_error
;
127 Flag_parsing_c.verbose_lexing
;
128 Flag_parsing_c.verbose_parsing
;
129 Flag_parsing_c.verbose_type
;
130 Flag_parsing_c.verbose_cfg
;
131 Flag_parsing_c.verbose_unparsing
;
132 Flag_parsing_c.verbose_visit
;
133 Flag_parsing_c.verbose_cpp_ast
;
135 Flag_matcher.verbose_matcher
;
136 Flag_matcher.debug_engine
;
138 Flag_parsing_c.debug_unparsing
;
140 Flag_parsing_cocci.show_SP
;
141 Flag_parsing_cocci.show_iso_failures
;
143 Flag_ctl.verbose_ctl_engine
;
144 Flag_ctl.verbose_match
;
149 let quiet_profile = (
151 Common.print_to_stderr
154 (* FC.show_diff; just leave this as it is *)
163 FC.show_before_fixed_flow
;
166 FC.show_binding_in_out
;
170 Flag_parsing_c.show_parsing_error
;
172 Flag_parsing_c.verbose_lexing
;
173 Flag_parsing_c.verbose_parsing
;
174 Flag_parsing_c.verbose_type
;
175 Flag_parsing_c.verbose_cfg
;
176 Flag_parsing_c.verbose_unparsing
;
177 Flag_parsing_c.verbose_visit
;
178 Flag_parsing_c.verbose_cpp_ast
;
180 Flag_matcher.verbose_matcher
;
181 Flag_matcher.debug_engine
;
183 Flag_parsing_c.debug_unparsing
;
185 Flag_parsing_cocci.show_SP
;
186 Flag_parsing_cocci.show_iso_failures
;
188 Flag_ctl.verbose_ctl_engine
;
189 Flag_ctl.verbose_match
;
194 (* some information that is useful in seeing why a semantic patch doesn't
196 let debug_profile = (
198 Common.print_to_stderr
;
204 FC.show_binding_in_out
;
205 FC.show_dependencies
;
207 Flag_parsing_cocci.show_iso_failures
;
211 Flag_parsing_c.verbose_cfg
;
212 Flag_parsing_c.verbose_unparsing
;
213 Flag_parsing_c.verbose_visit
;
215 Flag_matcher.verbose_matcher
;
217 Flag_parsing_c.show_parsing_error
;
225 FC.show_before_fixed_flow
;
229 Flag_parsing_cocci.show_SP
;
230 Flag_ctl.verbose_ctl_engine
;
231 Flag_ctl.verbose_match
;
232 Flag_matcher.debug_engine
;
233 Flag_parsing_c.debug_unparsing
;
234 Flag_parsing_c.verbose_type
;
235 Flag_parsing_c.verbose_parsing
;
241 Common.print_to_stderr
;
251 FC.show_before_fixed_flow
;
254 FC.show_binding_in_out
;
256 Flag_parsing_cocci.show_SP
;
257 Flag_parsing_cocci.show_iso_failures
;
258 Flag_ctl.verbose_ctl_engine
;
259 Flag_ctl.verbose_match
;
260 Flag_matcher.debug_engine
;
261 Flag_parsing_c.debug_unparsing
;
262 Flag_parsing_c.verbose_type
;
263 Flag_parsing_c.verbose_parsing
;
267 let (set_to_true
, set_to_false
) = p
in
268 List.iter
(fun x
-> x
:= false) set_to_false
;
269 List.iter
(fun x
-> x
:= true) set_to_true
271 (*****************************************************************************)
272 (* The spatch options *)
273 (*****************************************************************************)
276 "Usage: " ^ basename
Sys.argv
.(0) ^
277 " -sp_file <SP> <infile> [-o <outfile>] [-iso_file <iso>] [options]" ^
278 "\n" ^
"Options are:"
280 (* forward reference trick *)
281 let short_usage_func = ref (fun () -> ())
282 let long_usage_func = ref (fun () -> ())
285 (* The short_options are user-oriented. The other options are for
286 * the developers of coccinelle or advanced-users that know
287 * quite well the underlying semantics of coccinelle.
291 (* will be printed when use only ./spatch. For the rest you have to
292 * use -longhelp to see them.
294 let short_options = [
295 "-sp_file", Arg.Set_string
cocci_file,
296 " <file> the semantic patch file";
298 "-o", Arg.Set_string
output_file,
299 " <file> the output file";
300 "-in_place", Arg.Set
inplace_modif,
301 " do the modification on the file directly";
302 "-backup_suffix", Arg.String
(function s
-> backup_suffix := Some s
),
303 " suffix to use when making a backup for inplace";
304 "-out_place", Arg.Set
outplace_modif,
305 " store modifications in a .cocci_res file";
307 "-U", Arg.Int
(fun n
-> Flag_parsing_c.diff_lines
:= Some
(i_to_s n
)),
308 " set number of diff context lines";
309 "-partial_match", Arg.Set
Flag_ctl.partial_match
,
310 " report partial matches of the SP on the C file";
312 "-iso_file", Arg.Set_string
Config.std_iso
,
313 " <file> (default=" ^
!Config.std_iso ^
")";
314 "-macro_file", Arg.Set_string
macro_file,
316 "-macro_file_builtins", Arg.Set_string
Config.std_h
,
317 " <file> (default=" ^
!Config.std_h ^
")";
319 "-recursive_includes",
320 Arg.Unit
(function _
-> FC.include_options
:= FC.I_REALLY_ALL_INCLUDES
),
321 " causes all available include files, both those included in the C file(s) and those included in header files, to be used";
323 Arg.Unit
(function _
-> FC.include_options
:= FC.I_ALL_INCLUDES
),
324 " causes all available include files included in the C file(s) to be used";
326 Arg.Unit
(function _
-> FC.include_options
:= FC.I_NO_INCLUDES
),
327 " causes not even local include files to be used";
329 Arg.Unit
(function _
-> FC.include_options
:= FC.I_NORMAL_INCLUDES
),
330 " causes local include files to be used";
331 "-ignore_unknown_options", Arg.Set
ignore_unknown_opt,
332 " For integration in a toolchain (must be set before the first unknown option)";
333 "-include_headers", Arg.Set
include_headers,
334 " process header files independently";
335 "-I", Arg.String
(fun x
->
336 FC.include_path
:= x
::!FC.include_path
338 " <dir> containing the header files (optional)";
340 "-preprocess", Arg.Set
preprocess,
341 " run the C preprocessor before applying the semantic match";
343 "-c", Arg.Set
compat_mode, " gcc/cpp compatibility mode";
346 " <dir> process all files in directory recursively";
348 "-use_glimpse", Arg.Unit
(function _
-> Flag.scanner
:= Flag.Glimpse
),
349 " works with -dir, use info generated by glimpseindex";
350 "-use_google", Arg.String
(function s
-> Flag.scanner
:= Flag.Google s
),
351 " find relevant files using google code search";
352 "-use_idutils", Arg.Unit
(function s
-> Flag.scanner
:= Flag.IdUtils
),
353 " find relevant files using id-utils";
355 Arg.String
(function s
-> Flag.patch
:= Some
(Cocci.normalize_path s
)),
356 (" <dir> path name with respect to which a patch should be created\n"^
357 " \"\" for a file in the current directory");
358 "-kbuild_info", Arg.Set_string
kbuild_info,
359 " <file> improve -dir by grouping related c files";
360 "-pyoutput", Arg.Set_string
Flag.pyoutput
,
361 " Sets output routine: Standard values: <coccilib.output.Gtk|coccilib.output.Console>";
364 "-version", Arg.Unit
(fun () ->
365 let withpython = if Pycocci.python_support
then "with" else "without" in
366 pr2
(spf
"spatch version %s %s Python support" Config.version
withpython);
371 "-date", Arg.Unit
(fun () ->
372 pr2
"version: $Date: 2010/11/13 21:06:27 $";
373 raise
(Common.UnixExit
0)
377 "-shorthelp", Arg.Unit
(fun () ->
379 raise
(Common.UnixExit
0)
381 " see short list of options";
382 "-longhelp", Arg.Unit
(fun () ->
384 raise
(Common.UnixExit
0)
386 " see all the available options in different categories";
387 "-help", Arg.Unit
(fun () ->
389 raise
(Common.UnixExit
0)
392 "--help", Arg.Unit
(fun () ->
394 raise
(Common.UnixExit
0)
399 (* the format is a list of triples:
400 * (title of section * (optional) explanation of sections * option list)
402 let other_options = [
403 "aliases and obsolete options",
406 "-sp", Arg.Set_string
cocci_file, " short option of -sp_file";
407 "-iso", Arg.Set_string
Config.std_iso
, " short option of -iso_file";
409 "-cocci_file", Arg.Set_string
cocci_file,
410 " <file> the semantic patch file";
411 (* "-c", Arg.Set_string cocci_file, " short option of -sp_file"; *)
414 "most useful show options",
417 "-show_diff" , Arg.Set
FC.show_diff
, " ";
418 "-no_show_diff" , Arg.Clear
FC.show_diff
, " ";
419 "-show_flow" , Arg.Set
FC.show_flow
, " ";
420 (* works in conjunction with -show_ctl_text *)
423 (function _
-> FC.show_ctl_text
:= true; FC.inline_let_ctl
:= true), " ";
424 "-ctl_show_mcodekind",
426 (function _
-> FC.show_ctl_text
:= true; FC.show_mcodekind_in_ctl
:= true),
428 "-show_bindings", Arg.Set
FC.show_binding_in_out
, " ";
429 "-show_transinfo", Arg.Set
Flag.show_transinfo
, " ";
430 "-show_misc", Arg.Set
Flag.show_misc
, " ";
431 "-show_trying", Arg.Set
Flag.show_trying
,
432 " show the name of each function being processed";
433 "-show_dependencies",
434 Arg.Unit
(function _
-> FC.show_dependencies
:= true;
435 FC.show_binding_in_out
:= true),
436 " show the dependencies related to each rule";
439 "verbose subsystems options",
442 "-verbose_ctl_engine",
443 Arg.Unit
(function _
->
444 Flag_ctl.verbose_ctl_engine
:= true; FC.show_ctl_text
:= true) , " ";
445 "-verbose_match", Arg.Set
Flag_ctl.verbose_match
, " ";
446 "-verbose_engine", Arg.Set
Flag_matcher.debug_engine
, " ";
447 "-graphical_trace", Arg.Set
Flag_ctl.graphical_trace
, " generate a pdf file representing the matching process";
449 Arg.Unit
(function _
->
450 Flag_ctl.graphical_trace
:= true; Flag_ctl.gt_without_label
:= true),
451 " remove graph label (requires option -graphical_trace)";
453 "-parse_error_msg", Arg.Set
Flag_parsing_c.show_parsing_error
, " ";
455 Arg.Unit
(fun _
-> Flag_parsing_c.verbose_parsing
:= true;
456 Flag_parsing_c.show_parsing_error
:= true), " ";
457 "-type_error_msg", Arg.Set
Flag_parsing_c.verbose_type
, " ";
458 (* could also use Flag_parsing_c.options_verbose *)
461 "other show options",
464 "-show_c" , Arg.Set
FC.show_c
, " ";
465 "-show_cocci" , Arg.Set
FC.show_cocci
, " ";
466 "-show_before_fixed_flow" , Arg.Set
FC.show_before_fixed_flow
, " ";
467 "-show_ctl_tex" , Arg.Set
FC.show_ctl_tex
, " ";
468 "-show_ctl_text" , Arg.Set
FC.show_ctl_text
, " ";
469 "-show_SP" , Arg.Set
Flag_parsing_cocci.show_SP
, " ";
473 "debug C parsing/unparsing",
476 "-debug_cpp", Arg.Set
Flag_parsing_c.debug_cpp
, " ";
477 "-debug_lexer", Arg.Set
Flag_parsing_c.debug_lexer
, " ";
478 "-debug_etdt", Arg.Set
Flag_parsing_c.debug_etdt
, " ";
479 "-debug_typedef", Arg.Set
Flag_parsing_c.debug_typedef
, " ";
481 "-filter_msg", Arg.Set
Flag_parsing_c.filter_msg
,
482 " filter some cpp message when the macro is a \"known\" cpp construct";
483 "-filter_define_error", Arg.Set
Flag_parsing_c.filter_define_error
," ";
484 "-filter_msg_define_error", Arg.Set
Flag_parsing_c.filter_msg_define_error
,
485 " filter the error msg";
486 "-filter_passed_level", Arg.Set_int
Flag_parsing_c.filter_passed_level
," ";
487 (* debug cfg doesn't seem to have any effect, so drop it as an option *)
488 (* "-debug_cfg", Arg.Set Flag_parsing_c.debug_cfg , " "; *)
489 "-debug_unparsing", Arg.Set
Flag_parsing_c.debug_unparsing
, " ";
492 (* could use Flag_parsing_c.options_debug_with_title instead *)
495 "shortcut for enabling/disabling a set of debugging options at once",
498 (* todo: other profile ? *)
499 "-quiet", Arg.Unit
(fun () -> run_profile quiet_profile), " ";
500 "-very_quiet", Arg.Unit
(fun () -> run_profile very_quiet_profile), " ";
501 "-debug", Arg.Unit
(fun () -> run_profile debug_profile), " ";
502 "-pad", Arg.Unit
(fun () -> run_profile pad_profile), " ";
509 "-profile", Arg.Unit
(function () -> Common.profile
:= Common.PALL
) ,
510 " gather timing information about the main coccinelle functions";
511 "-bench", Arg.Int
(function x
-> Flag_ctl.bench
:= x
),
512 " <level> for profiling the CTL engine";
513 "-timeout", Arg.Int
(fun x
-> FC.timeout
:= Some x
),
514 " <sec> timeout in seconds";
515 "-steps", Arg.Int
(fun x
-> Flag_ctl.steps
:= Some x
),
516 " max number of model checking steps per code unit";
517 "-iso_limit", Arg.Int
(fun x
-> Flag_parsing_cocci.iso_limit
:= Some x
),
518 " max depth of iso application";
519 "-no_iso_limit", Arg.Unit
(fun _
-> Flag_parsing_cocci.iso_limit
:= None
),
520 " disable limit on max depth of iso application";
521 "-track_iso", Arg.Set
Flag.track_iso_usage
,
522 " gather information about isomorphism usage";
525 (fun s
-> Flag_parsing_cocci.disabled_isos
:=
526 s
:: !Flag_parsing_cocci.disabled_isos
),
527 " disable a specific isomorphism";
532 (*post_engine not included, because it doesn't use isos*)
533 PSOME
["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
534 " gather information about the cost of isomorphism usage"
539 "change of algorithm options",
542 "-popl", Arg.Set
FC.popl
,
543 " simplified SmPL, for the popl paper";
547 (function _
-> FC.popl
:= true; Flag_popl.mark_all
:= true),
548 " simplified SmPL, for the popl paper";
550 "-popl_keep_all_wits",
552 (function _
-> FC.popl
:= true; Flag_popl.keep_all_wits
:= true),
553 " simplified SmPL, for the popl paper";
557 Flag.make_hrule
:= Some s
; FC.include_options
:= FC.I_NO_INCLUDES
),
558 " semantic patch generation";
560 "-keep_comments", Arg.Set
Flag_parsing_c.keep_comments
,
561 " keep comments around removed code";
563 "-loop", Arg.Set
Flag_ctl.loop_in_src_code
, " ";
564 "-no_loops", Arg.Set
Flag_parsing_c.no_loops
,
565 " drop all back edges derived from looping constructs - unsafe";
566 "-no_gotos", Arg.Set
Flag_parsing_c.no_gotos
,
567 " drop all jumps derived from gotos - unsafe";
569 "-l1", Arg.Clear
Flag_parsing_c.label_strategy_2
, " ";
570 "-ifdef_to_if", Arg.Set
FC.ifdef_to_if
,
571 " convert ifdef to if (experimental)";
572 "-no_ifdef_to_if", Arg.Clear
FC.ifdef_to_if
,
573 " convert ifdef to if (experimental)";
575 "-disable_multi_pass", Arg.Set
Flag_parsing_c.disable_multi_pass
, " ";
577 "-noif0_passing", Arg.Clear
Flag_parsing_c.if0_passing
,
579 "-noadd_typedef_root", Arg.Clear
Flag_parsing_c.add_typedef_root
, " ";
580 (* could use Flag_parsing_c.options_algo instead *)
583 "-disallow_nested_exps", Arg.Set
Flag_matcher.disallow_nested_exps
,
584 " disallow an expresion pattern from matching a term and its subterm";
585 "-disable_worth_trying_opt", Arg.Clear
FC.worth_trying_opt
,
587 "-only_return_is_error_exit",
588 Arg.Set
Flag_matcher.only_return_is_error_exit
,
589 "if this flag is not set, then break and continue are also error exits";
590 (* the following is a hack to make it easier to add code in sgrep-like
591 code, essentially to compensate for the fact that we don't have
592 any way of printing things out *)
593 "-allow_inconsistent_paths",
594 Arg.Set
Flag_matcher.allow_inconsistent_paths
,
595 " if this flag is set don't check for inconsistent paths; dangerous";
596 "-no_safe_expressions",
597 Arg.Set
Flag_matcher.no_safe_expressions
,
598 " make an expression disjunction not prioritise the topmost disjunct";
599 "-int_bits", Arg.Int
Flag_parsing_c.set_int_bits
,
600 " the number of bits in an unsigned int";
601 "-long_bits", Arg.Int
Flag_parsing_c.set_long_bits
,
602 " the number of bits in an unsigned long";
603 "-linux_spacing", Arg.Unit
Flag_parsing_c.set_linux_spacing
,
604 " spacing of + code follows the conventions of Linux";
605 "-smpl_spacing", Arg.Unit
Flag_parsing_c.set_smpl_spacing
,
606 " spacing of + code follows the semantic patch";
607 "-D", Arg.String
Flag.set_defined_virtual_rules
,
608 " indicate that a virtual rule should be considered to be matched";
614 "-debugger", Arg.Set
Common.debugger
,
615 " option to set if launch spatch in ocamldebug";
616 "-disable_once", Arg.Set
Common.disable_pr2_once
,
617 " to print more messages";
618 "-show_trace_profile", Arg.Set
Common.show_trace_profile
,
620 "-save_tmp_files", Arg.Set
Common.save_tmp_files
, " ";
626 "-index", Arg.Int
(function x
-> distrib_index := Some x
) ,
627 " the processor to use for this run of spatch";
628 "-max", Arg.Int
(function x
-> distrib_max := Some x
) ,
629 " the number of processors available";
630 "-mod_distrib", Arg.Set
mod_distrib,
631 " use mod to distribute files among the processors";
637 "-use_cache", Arg.Set
Flag_parsing_c.use_cache
,
638 " use .ast_raw pre-parsed cached C file";
639 (* could use Flag_parsing_c.options_pad instead *)
644 "test mode and test options (works with tests/ or .ok files)",
645 "The test options don't work with the -sp_file and so on.",
647 "-test", Arg.Set
test_mode,
648 " <file> launch spatch on tests/file.[c,cocci]";
649 "-testall", Arg.Set
test_all,
650 " launch spatch on all files in tests/ having a .res";
651 "-test_okfailed", Arg.Set
test_okfailed,
652 " generates .{ok,failed,spatch_ok} files using .res files";
653 "-test_regression_okfailed", Arg.Set
test_regression_okfailed,
654 " process the .{ok,failed,spatch_ok} files in current dir";
656 "-compare_with_expected", Arg.Set
compare_with_expected,
657 " use also file.res";
658 "-expected_score_file", Arg.Set_string
expected_score_file,
659 " which score file to compare with in -testall";
660 "-relax_include_path", Arg.Set
FC.relax_include_path
,
665 ("The action options don't work with the -sp_file and so on." ^
"\n" ^
666 "It's for the other (internal) uses of the spatch program."
669 (* -token_c, -parse_c, etc *)
670 ((Common.options_of_actions
action (Test_parsing_c.actions
())) ++
672 (let s = "-parse_cocci" in s, Arg.Unit
(fun () -> action := s),
674 (let s = "-compare_c" in s, Arg.Unit
(fun () -> action := s),
681 short_options ++ List.concat
(List.map
Common.thd3
other_options)
683 (* I don't want the -help and --help that are appended by Arg.align *)
685 Arg.align xs
+> List.rev
+> Common.drop
2 +> List.rev
688 Ignore unknown option
690 This simplifies the integration of Coccinelle in toolchain. For
691 instance, spatch can then be used as a checker in the Linux build
695 let check_include_path () =
696 let opt = Array.get
Sys.argv
!Arg.current
in
697 let is_include_re = Str.regexp
"-I\\(.*\\)" in
698 if Str.string_match
is_include_re opt 0 then
699 let path = Str.matched_group
1 opt in
700 FC.include_path
:= path::!FC.include_path
703 let rec arg_parse_no_fail l f msg
=
705 check_include_path ();
706 Arg.parse_argv
Sys.argv l f msg
;
709 arg_parse_no_fail l f msg
710 | Arg.Help msg
-> (* printf "%s" msg; exit 0; *)
711 raise Impossible
(* -help is specified in speclist *)
713 (* copy paste of Arg.parse. Don't want the default -help msg *)
714 let arg_parse2 l f msg
=
716 Arg.parse_argv
Sys.argv l f msg
;
718 | Arg.Bad emsg
-> (* eprintf "%s" msg; exit 2; *)
719 if not
!ignore_unknown_opt then
721 let xs = Common.lines emsg
in
722 (* take only head, it's where the error msg is *)
725 raise
(Common.UnixExit
(2))
728 arg_parse_no_fail l f msg
;
729 | Arg.Help msg
-> (* printf "%s" msg; exit 0; *)
730 raise Impossible
(* -help is specified in speclist *)
736 Common.short_usage usage_msg short_options;
738 pr2
"Example of use:";
739 pr2
" ./spatch -sp_file foo.cocci foo.c -o /tmp/newfoo.c";
745 Common.long_usage usage_msg short_options other_options
747 let _ = short_usage_func := short_usage
748 let _ = long_usage_func := long_usage
750 (*****************************************************************************)
752 (*****************************************************************************)
754 let adjust_stdin cfile k
=
760 let (dir, base
, ext
) = Common.dbe_of_filename cfile
in
761 let varfile = Common.filename_of_dbe
(dir, base
, "var") in
762 if ext
=$
= "c" && Common.lfile_exists
varfile
765 with Invalid_argument
("Filename.chop_extension") -> None
767 Common.redirect_stdin_opt
newin k
769 let glimpse_filter (coccifile
, isofile
) dir =
770 let (_metavars
,astcocci
,_free_var_lists
,_negated_positions
,
771 _used_after_lists
,_positions_lists
,(_,query
,_)) =
772 Cocci.sp_of_file coccifile
(Some isofile
) in
774 None
-> pr2
"no inferred glimpse keywords"; None
776 let suffixes = if !include_headers then ["c";"h"] else ["c"] in
777 let rec loop = function
778 [] -> None
(* error, eg due to pattern too big *)
780 Printf.fprintf stderr
"%s\n" ("glimpse request = " ^ query
);
781 let command = spf
"glimpse -y -H %s -N -W -w '%s'" dir query
in
782 let (glimpse_res
,stat
) = Common.cmd_to_list_and_status
command in
784 Unix.WEXITED
(0) | Unix.WEXITED
(1) ->
785 Printf.fprintf stderr
"got files\n"; flush stderr
;
789 (fun file
-> List.mem
(Common.filesuffix file
) suffixes))
790 | _ -> loop queries
(* error, eg due to pattern too big *) in
793 let idutils_filter (coccifile
, isofile
) dir =
794 let (_metavars
,astcocci
,_free_var_lists
,_negated_positions
,
795 _used_after_lists
,_positions_lists
,(_,_,query
)) =
796 Cocci.sp_of_file coccifile
(Some isofile
) in
798 None
-> pr2
"no inferred idutils keywords"; None
800 let suffixes = if !include_headers then ["c";"h"] else ["c"] in
801 let files = Id_utils.interpret
dir query
in
802 Printf.fprintf stderr
"got files\n"; flush stderr
;
805 List.filter
(fun file
-> List.mem
(Common.filesuffix file
) suffixes))
807 (*****************************************************************************)
809 (*****************************************************************************)
815 (* a more general solution would be to use
816 * Common.files_of_dir_or_files (x::xs)
817 * as some elements in xs may also be directories, or individual
820 if Common.is_directory x
823 adjust_stdin x
(fun () ->
824 if !cocci_file =$
= ""
825 then failwith
"I need a cocci file, use -sp_file <file>";
827 if !dir && !Flag.patch
=*= None
830 | [] -> Flag.patch
:= Some
(Cocci.normalize_path x
)
833 ("warning: patch output can only be created when only one\n"^
834 "directory is specified or when the -patch flag is used")
839 Common.profile_code
"Main.infiles computation" (fun () ->
840 match !dir, !kbuild_info, !Flag.scanner
with
842 | false, _, (Flag.Glimpse
|Flag.IdUtils
) ->
843 failwith
"-use_glimpse or -id_utils works only with -dir"
844 | true, s, (Flag.Glimpse
|Flag.IdUtils
) when s <> "" ->
845 failwith
"-use_glimpse or -id_utils does not work with -kbuild"
846 | true, "", Flag.Glimpse
->
848 then failwith
"-use_glimpse can accept only one dir");
851 match glimpse_filter (!cocci_file, !Config.std_iso
) x
with
853 Common.cmd_to_list
(* same as "true, "", _" case *)
855 (* FIXME : Could we remove xs ?
856 -use_glimpse requires a singleton.
857 This is checked some lines before.
858 then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
859 else ("find "^(join " " (x::xs))^" -name \"*.c\""))
861 then ("find "^ x ^
" -name \"*.[ch]\"")
862 else ("find "^ x ^
" -name \"*.c\""))
863 | Some
files -> files in
864 files +> List.map
(fun x
-> [x
])
865 | true, "", Flag.IdUtils
->
867 then failwith
"-id_utils can accept only one dir");
870 match idutils_filter (!cocci_file, !Config.std_iso
) x
with
872 Common.cmd_to_list
(* same as "true, "", _" case *)
874 (* FIXME : Could we remove xs ?
875 -use_glimpse requires a singleton.
876 This is checked some lines before.
877 then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
878 else ("find "^(join " " (x::xs))^" -name \"*.c\""))
880 then ("find "^ x ^
" -name \"*.[ch]\"")
881 else ("find "^ x ^
" -name \"*.c\""))
882 | Some
files -> files in
883 files +> List.map
(fun x
-> [x
])
885 | false, _, _ -> [x
::xs]
889 then ("find "^
(join
" " (x
::xs))^
" -name \"*.[ch]\"")
890 else ("find "^
(join
" " (x
::xs))^
" -name \"*.c\""))
891 +> List.map
(fun x
-> [x
])
894 | true, kbuild_info_file
,_ ->
896 Common.cmd_to_list
("find "^
(join
" " (x
::xs))^
" -type d")
898 let info = Kbuild.parse_kbuild_info kbuild_info_file
in
899 let groups = Kbuild.files_in_dirs
dirs info in
901 groups +> List.map
(function Kbuild.Group
xs -> xs)
906 match (!distrib_index,!distrib_max) with
907 (None
,None
) -> infiles
908 | (Some index
,Some max
) ->
911 failwith
"index starts at 0, and so must be less than max");
914 let rec loop ct
= function
917 if (ct
mod max
) =|= index
918 then x
::(loop (ct
+1) xs)
919 else loop (ct
+1) xs in
923 let all_files = List.length
infiles in
924 let regions = (all_files + (max
- 1)) / max
in
925 let this_min = index
* regions in
926 let this_max = (index
+1) * regions in
927 let rec loop ct
= function
930 if this_min <= ct
&& ct
< this_max
931 then x
::(loop (ct
+1) xs)
932 else loop (ct
+1) xs in
935 | _ -> failwith
"inconsistent distribution information" in
938 Common.profile_code
"Main.outfiles computation" (fun () ->
940 Cocci.pre_engine
(!cocci_file, !Config.std_iso
) in
942 infiles +> List.map
(fun cfiles
->
943 pr2
("HANDLING: " ^
(join
" " cfiles
));
944 Common.timeout_function_opt
!FC.timeout
(fun () ->
945 Common.report_if_take_time
10 (join
" " cfiles
) (fun () ->
946 (*let s = profile_diagnostic() in*)
950 if !output_file <> "" && !compat_mode then
955 Common.redirect_stdout_opt
optfile (fun () ->
956 (* this is the main call *)
957 Cocci.full_engine
cocci_infos cfiles
960 | Common.UnixExit x
-> raise
(Common.UnixExit x
)
961 | Pycocci.Pycocciexception
->
962 raise
Pycocci.Pycocciexception
967 pr2(profile_diagnostic());*)
970 pr2
("EXN:" ^
Printexc.to_string e
);
974 Cocci.post_engine
cocci_infos;
979 Common.profile_code
"Main.result analysis" (fun () ->
980 Ctlcocci_integration.print_bench
();
981 let outfiles = Cocci.check_duplicate_modif
outfiles in
982 outfiles +> List.iter
(fun (infile
, outopt
) ->
983 outopt
+> Common.do_option
(fun outfile
->
986 (match !backup_suffix with
987 Some
backup_suffix ->
988 Common.command2
("cp "^infile^
" "^infile^
backup_suffix)
990 Common.command2
("cp "^outfile^
" "^infile
);
994 then Common.command2
("cp "^outfile^
" "^infile^
".cocci_res");
996 (* potential source of security pb if the /tmp/ file is
997 * a symlink, so simpler to not produce any regular file
998 * (files created by Common.new_temp_file are still ok)
1002 if !output_file =$= ""
1004 let tmpfile = "/tmp/"^Common.basename infile in
1005 pr2 (spf "One file modified. Result is here: %s" tmpfile);
1006 Common.command2 ("cp "^outfile^" "^tmpfile);
1010 if !output_file <> "" && not
!compat_mode then
1011 (match outfiles with
1012 | [infile
, Some outfile
] when infile
=$
= x
&& null
xs ->
1013 Common.command2
("cp " ^outfile^
" " ^
!output_file);
1014 | [infile
, None
] when infile
=$
= x
&& null
xs ->
1015 Common.command2
("cp " ^infile^
" " ^
!output_file);
1018 ("-o can not be applied because there is multiple " ^
1021 if !compare_with_expected
1022 then Testing.compare_with_expected outfiles))
1024 | [] -> raise Impossible
1027 (*****************************************************************************)
1028 (* The coccinelle main entry point *)
1029 (*****************************************************************************)
1032 let arglist = Array.to_list
Sys.argv
in
1034 if not
(null
(Common.inter_set
arglist
1035 ["-cocci_file";"-sp_file";"-sp";"-test";"-testall";
1036 "-test_okfailed";"-test_regression_okfailed"]))
1037 then run_profile quiet_profile;
1039 let args = ref [] in
1041 (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*)
1043 (* this call can set up many global flag variables via the cmd line *)
1044 arg_parse2 (Arg.align
all_options) (fun x
-> args := x
::!args) usage_msg;
1046 (* julia hack so that one can override directories specified on
1047 * the command line. *)
1051 if List.length
!args > 1
1054 let chosen = List.hd
!args in
1056 pr2
("ignoring all but the last specified directory: "^
chosen);
1060 else List.hd
!args in
1061 if !FC.include_path
=*= []
1062 then FC.include_path
:= [Filename.concat
chosen_dir "include"]);
1064 args := List.rev
!args;
1066 if !cocci_file <> "" && (not
(!cocci_file =~
".*\\.\\(sgrep\\|spatch\\)$"))
1067 then cocci_file := Common.adjust_ext_if_needed
!cocci_file ".cocci";
1069 if !Config.std_iso
<> ""
1070 then Config.std_iso
:= Common.adjust_ext_if_needed
!Config.std_iso
".iso";
1071 if !Config.std_h
<> ""
1072 then Config.std_h
:= Common.adjust_ext_if_needed
!Config.std_h
".h";
1074 if !Config.std_h
<> ""
1075 then Parse_c.init_defs_builtins
!Config.std_h
;
1077 if !macro_file <> ""
1078 then Parse_c.init_defs_macros
!macro_file;
1081 (* must be done after Arg.parse, because Common.profile is set by it *)
1082 Common.profile_code
"Main total" (fun () ->
1085 let all_actions = Test_parsing_c.actions
() in
1089 (* --------------------------------------------------------- *)
1090 (* The test framework. Works with tests/ or .ok and .failed *)
1091 (* --------------------------------------------------------- *)
1092 | [x
] when !test_mode ->
1094 let prefix = "tests/" in
1095 let testfile = x ^
".cocci" in
1096 if Sys.file_exists
(prefix ^
testfile) then
1098 FC.include_path
:= [prefix^
"include"];
1099 Testing.testone
prefix x
!compare_with_expected
1102 if Sys.file_exists
testfile then
1104 FC.include_path
:= ["include"];
1105 Testing.testone
"" x
!compare_with_expected
1108 pr2
(spf
"ERROR: File %s does not exist" testfile)
1111 | [] when !test_all ->
1112 FC.include_path
:= ["tests/include"];
1113 if !expected_score_file <> ""
1114 then Testing.testall ~
expected_score_file:!expected_score_file ()
1115 else Testing.testall
()
1117 | [] when !test_regression_okfailed ->
1118 Testing.test_regression_okfailed ()
1120 | x
::xs when !test_okfailed ->
1121 (* do its own timeout on FC.timeout internally *)
1122 FC.relax_include_path
:= true;
1123 adjust_stdin x
(fun () ->
1124 Testing.test_okfailed !cocci_file (x
::xs)
1127 (* --------------------------------------------------------- *)
1128 (* Actions, useful to debug subpart of coccinelle *)
1129 (* --------------------------------------------------------- *)
1131 | xs when List.mem
!action (Common.action_list
all_actions) ->
1132 Common.do_action
!action xs all_actions
1134 | [file
] when !action =$
= "-parse_cocci" ->
1135 Testing.test_parse_cocci file
1137 (* I think this is used by some scripts in some Makefile for our
1138 * big-tests. So dont remove.
1140 | [file1
;file2
] when !action =$
= "-compare_c" ->
1141 Test_parsing_c.test_compare_c file1 file2
(* result = unix code *)
1143 (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
1146 (* --------------------------------------------------------- *)
1147 (* This is the main entry *)
1148 (* --------------------------------------------------------- *)
1149 | x
::xs -> main_action (x
::xs)
1151 (* --------------------------------------------------------- *)
1153 (* --------------------------------------------------------- *)
1154 | [] -> short_usage()
1156 if !Pycocci.initialised
&& (Pycocci.py_isinitialized
()) != 0 then begin
1157 ignore
(Pycocci.pyrun_simplestring
"cocci.finalise()");
1159 then Common.pr2
"Finalizing python\n";
1160 Pycocci.py_finalize
();
1165 let main_with_better_error_report () =
1166 if !Common.debugger
then main ()
1171 | Unix.Unix_error
(e
, "stat", filename
) ->
1173 (spf
"ERROR: File %s does not exist: %s"
1174 filename
(Unix.error_message e
));
1175 raise
(UnixExit
(-1))
1176 | Parse_cocci.Bad_virt
s ->
1177 Common.pr2
(Printf.sprintf
"virtual rule %s not supported" s);
1178 raise
(UnixExit
(-1))
1180 (*****************************************************************************)
1182 Common.main_boilerplate
(fun () ->
1183 main_with_better_error_report ();
1184 Ctlcocci_integration.print_bench
();