permit multiline comments and strings in macros
[bpt/coccinelle.git] / main.ml
1 (*
2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
9 *
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
13 *
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
18 *
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
21 *
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
24 *)
25
26
27 # 0 "./main.ml"
28 open Common
29 module FC = Flag_cocci
30
31 (*****************************************************************************)
32 (* Flags *)
33 (*****************************************************************************)
34
35 (* In addition to flags that can be tweaked via -xxx options (cf the
36 * full list of options in "the spatch options" section below), the
37 * spatch program also depends on external files, described in
38 * globals/config.ml, mainly a standard.h and standard.iso file *)
39
40 let cocci_file = ref ""
41
42 let output_file = ref ""
43 let inplace_modif = ref false (* but keeps nothing *)
44 let backup_suffix =
45 ref (None : string option) (* suffix for backup if one is desired *)
46 let outplace_modif = ref false (* generates a .cocci_res *)
47 let preprocess = ref false (* run the C preprocessor before cocci *)
48 let compat_mode = ref false
49 let ignore_unknown_opt = ref false
50
51 (* somehow obsolete now *)
52 let dir = ref false
53
54 let kbuild_info = ref ""
55
56 let macro_file = ref ""
57
58 (* test mode *)
59 let test_mode = ref false
60 let test_all = ref false
61 let test_okfailed = ref false
62 let test_regression_okfailed = ref false
63 let expected_score_file = ref ""
64 let allow_update_score_file = ref true
65
66 (* action mode *)
67 let action = ref ""
68
69 (* works with -test but also in "normal" spatch mode *)
70 let compare_with_expected = ref false
71
72 let distrib_index = ref (None : int option)
73 let distrib_max = ref (None : int option)
74 let mod_distrib = ref false
75
76 (*****************************************************************************)
77 (* Profiles *)
78 (*****************************************************************************)
79
80 (* pair of (list of flags to set true, list of flags to set false *)
81 let very_quiet_profile = (
82 [
83 ],
84 [
85 (* FC.show_diff; just leave this as it is *)
86
87 Common.print_to_stderr;
88 Flag.show_misc;
89 Flag.show_trying;
90 Flag.show_transinfo;
91
92 FC.show_c;
93 FC.show_cocci;
94 FC.show_flow;
95 FC.show_before_fixed_flow;
96 FC.show_ctl_tex;
97 FC.show_ctl_text;
98 FC.show_binding_in_out;
99
100 FC.verbose_cocci;
101
102 Flag_parsing_c.show_parsing_error;
103
104 Flag_parsing_c.verbose_lexing;
105 Flag_parsing_c.verbose_parsing;
106 Flag_parsing_c.verbose_type;
107 Flag_parsing_c.verbose_cfg;
108 Flag_parsing_c.verbose_unparsing;
109 Flag_parsing_c.verbose_visit;
110 Flag_parsing_c.verbose_cpp_ast;
111
112 Flag_matcher.verbose_matcher;
113 Flag_matcher.debug_engine;
114
115 Flag_parsing_c.debug_unparsing;
116
117 Flag_parsing_cocci.show_SP;
118 Flag_parsing_cocci.show_iso_failures;
119
120 Flag_ctl.verbose_ctl_engine;
121 Flag_ctl.verbose_match;
122
123
124 ])
125
126 let quiet_profile = (
127 [
128 Common.print_to_stderr
129 ],
130 [
131 (* FC.show_diff; just leave this as it is *)
132
133 Flag.show_misc;
134 Flag.show_trying;
135 Flag.show_transinfo;
136
137 FC.show_c;
138 FC.show_cocci;
139 FC.show_flow;
140 FC.show_before_fixed_flow;
141 FC.show_ctl_tex;
142 FC.show_ctl_text;
143 FC.show_binding_in_out;
144
145 FC.verbose_cocci;
146
147 Flag_parsing_c.show_parsing_error;
148
149 Flag_parsing_c.verbose_lexing;
150 Flag_parsing_c.verbose_parsing;
151 Flag_parsing_c.verbose_type;
152 Flag_parsing_c.verbose_cfg;
153 Flag_parsing_c.verbose_unparsing;
154 Flag_parsing_c.verbose_visit;
155 Flag_parsing_c.verbose_cpp_ast;
156
157 Flag_matcher.verbose_matcher;
158 Flag_matcher.debug_engine;
159
160 Flag_parsing_c.debug_unparsing;
161
162 Flag_parsing_cocci.show_SP;
163 Flag_parsing_cocci.show_iso_failures;
164
165 Flag_ctl.verbose_ctl_engine;
166 Flag_ctl.verbose_match;
167
168
169 ])
170
171 (* some information that is useful in seeing why a semantic patch doesn't
172 work properly *)
173 let debug_profile = (
174 [
175 Common.print_to_stderr;
176 Flag.show_misc;
177 Flag.show_transinfo;
178
179 FC.show_diff;
180 FC.show_cocci;
181 FC.show_binding_in_out;
182 FC.show_dependencies;
183
184 Flag_parsing_cocci.keep_ml_script;
185 Flag_parsing_cocci.show_iso_failures;
186
187 FC.verbose_cocci;
188
189 Flag_parsing_c.verbose_cfg;
190 Flag_parsing_c.verbose_unparsing;
191 Flag_parsing_c.verbose_visit;
192
193 Flag_matcher.verbose_matcher;
194
195 Flag_parsing_c.show_parsing_error;
196 ],
197 [
198
199 Flag.show_misc;
200
201 FC.show_c;
202 FC.show_flow;
203 FC.show_before_fixed_flow;
204 FC.show_ctl_tex;
205 FC.show_ctl_text;
206
207 Flag_parsing_cocci.show_SP;
208 Flag_ctl.verbose_ctl_engine;
209 Flag_ctl.verbose_match;
210 Flag_matcher.debug_engine;
211 Flag_parsing_c.debug_unparsing;
212 Flag_parsing_c.verbose_type;
213 Flag_parsing_c.verbose_parsing;
214 ])
215
216 let pad_profile = (
217 [
218 FC.show_diff;
219 Common.print_to_stderr;
220 ],
221 [
222
223 Flag.show_misc;
224 Flag.show_transinfo;
225
226 FC.show_c;
227 FC.show_cocci;
228 FC.show_flow;
229 FC.show_before_fixed_flow;
230 FC.show_ctl_tex;
231 FC.show_ctl_text;
232 FC.show_binding_in_out;
233
234 Flag_parsing_cocci.show_SP;
235 Flag_parsing_cocci.show_iso_failures;
236 Flag_ctl.verbose_ctl_engine;
237 Flag_ctl.verbose_match;
238 Flag_matcher.debug_engine;
239 Flag_parsing_c.debug_unparsing;
240 Flag_parsing_c.verbose_type;
241 Flag_parsing_c.verbose_parsing;
242 ])
243
244 let run_profile p =
245 let (set_to_true, set_to_false) = p in
246 List.iter (fun x -> x := false) set_to_false;
247 List.iter (fun x -> x := true) set_to_true
248
249 (*****************************************************************************)
250 (* The spatch options *)
251 (*****************************************************************************)
252
253 let usage_msg =
254 "Usage: " ^ basename Sys.argv.(0) ^
255 " --sp-file <SP> <infile> [-o <outfile>] [--iso-file <iso>] [options]" ^
256 "\n" ^ "Options are:"
257
258 (* forward reference trick *)
259 let short_usage_func = ref (fun () -> ())
260 let long_usage_func = ref (fun () -> ())
261
262
263 (* The short_options are user-oriented. The other options are for
264 * the developers of coccinelle or advanced-users that know
265 * quite well the underlying semantics of coccinelle.
266 *)
267
268
269 (* will be printed when use only ./spatch. For the rest you have to
270 * use -longhelp to see them.
271 *)
272 let short_options = [
273 "--sp-file", Arg.Set_string cocci_file,
274 " <file> the semantic patch file";
275
276 "-o", Arg.Set_string output_file,
277 " <file> the output file";
278 "--in-place", Arg.Set inplace_modif,
279 " do the modification on the file directly";
280 "--backup-suffix", Arg.String (function s -> backup_suffix := Some s),
281 " suffix to use when making a backup for inplace";
282 "--out-place", Arg.Set outplace_modif,
283 " store modifications in a .cocci_res file";
284 "--reverse", Arg.Set Flag_parsing_cocci.interpret_inverted,
285 " invert the semantic patch before applying it";
286
287 "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
288 " set number of diff context lines";
289 "--partial-match", Arg.Set Flag_ctl.partial_match,
290 " report partial matches of the SP on the C file";
291
292 "--iso-file", Arg.Set_string Config.std_iso,
293 " <file> (default=" ^ !Config.std_iso ^")";
294 "--macro-file", Arg.Set_string macro_file,
295 " <file>";
296 "--macro-file-builtins", Arg.Set_string Config.std_h,
297 " <file> (default=" ^ !Config.std_h ^ ")";
298
299 "--recursive-includes",
300 Arg.Unit (function _ -> FC.include_options := FC.I_REALLY_ALL_INCLUDES),
301 " causes all available include files, both those included in the C file(s) and those included in header files, to be used";
302 "--all-includes",
303 Arg.Unit (function _ -> FC.include_options := FC.I_ALL_INCLUDES),
304 " causes all available include files included in the C file(s) to be used";
305 "--no-includes",
306 Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES),
307 " causes not even local include files to be used";
308 "--local-includes",
309 Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES),
310 " causes local include files to be used";
311 "--ignore-unknown-options", Arg.Set ignore_unknown_opt,
312 " For integration in a toolchain (must be set before the first unknown option)";
313 "--include-headers", Arg.Set Flag.include_headers,
314 " process header files independently";
315 "-I", Arg.String (fun x -> FC.include_path:= x::!FC.include_path),
316 " <dir> containing the header files";
317 "--include", Arg.String (fun x -> FC.extra_includes:=x::!FC.extra_includes),
318 " file to consider as being included";
319
320 "--preprocess", Arg.Set preprocess,
321 " run the C preprocessor before applying the semantic match";
322
323 "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode";
324
325 "--dir", Arg.Set dir,
326 " <dir> process all files in directory recursively";
327
328 "--use-glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse),
329 " works with -dir, use info generated by glimpseindex";
330 "--use-google", Arg.String (function s -> Flag.scanner := Flag.Google s),
331 " find relevant files using google code search";
332 "--use-idutils", Arg.Unit (function s -> Flag.scanner := Flag.IdUtils),
333 " find relevant files using id-utils";
334 "--patch",
335 Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)),
336 (" <dir> path name with respect to which a patch should be created\n"^
337 " \"\" for a file in the current directory");
338 "--kbuild-info", Arg.Set_string kbuild_info,
339 " <file> improve -dir by grouping related c files";
340 "--pyoutput", Arg.Set_string Flag.pyoutput,
341 " Sets output routine: Standard values: <coccilib.output.Gtk|coccilib.output.Console>";
342
343
344 "--version", Arg.Unit (fun () ->
345 let withpython = if Pycocci.python_support then "with" else "without" in
346 let whichregexp =
347 if !Regexp.pcre_support then "with PCRE support"
348 else "with Str regexp support "
349 in
350 pr2 (spf "spatch version %s %s Python support and %s" Config.version withpython whichregexp);
351 exit 0;
352 ),
353 " guess what";
354
355 "--date", Arg.Unit (fun () ->
356 pr2 "version: $Date$";
357 raise (Common.UnixExit 0)
358 ),
359 " guess what";
360
361 "--shorthelp", Arg.Unit (fun () ->
362 !short_usage_func();
363 raise (Common.UnixExit 0)
364 ),
365 " see short list of options";
366 "--longhelp", Arg.Unit (fun () ->
367 !long_usage_func();
368 raise (Common.UnixExit 0)
369 ),
370 " see all the available options in different categories";
371 "-help", Arg.Unit (fun () ->
372 !long_usage_func();
373 raise (Common.UnixExit 0)
374 ),
375 " ";
376 "--help", Arg.Unit (fun () ->
377 !long_usage_func();
378 raise (Common.UnixExit 0)
379 ),
380 " ";
381 ]
382
383 (* the format is a list of triples:
384 * (title of section * (optional) explanation of sections * option list)
385 *)
386 let other_options = [
387 "aliases and obsolete options",
388 "",
389 [
390 "--sp", Arg.Unit (function _ -> failwith "impossible"),
391 " command line semantic patch";
392 "--iso", Arg.Set_string Config.std_iso, " short option of --iso-file";
393
394 "--cocci-file", Arg.Set_string cocci_file,
395 " <file> the semantic patch file";
396 (* "-c", Arg.Set_string cocci_file, " short option of -sp_file"; *)
397 ];
398
399 "most useful show options",
400 "",
401 [
402 "--show-diff" , Arg.Set FC.show_diff, " ";
403 "--no-show-diff" , Arg.Clear FC.show_diff, " ";
404 "--force-diff" , Arg.Set FC.force_diff,
405 "show diff even if only spacing changes";
406 "--show-flow" , Arg.Set FC.show_flow, " ";
407 (* works in conjunction with -show_ctl_text *)
408 "--ctl-inline-let",
409 Arg.Unit
410 (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " ";
411 "--ctl-show-mcodekind",
412 Arg.Unit
413 (function _ -> FC.show_ctl_text := true; FC.show_mcodekind_in_ctl := true),
414 " ";
415 "--show-bindings", Arg.Set FC.show_binding_in_out, " ";
416 "--show-transinfo", Arg.Set Flag.show_transinfo, " ";
417 "--show-misc", Arg.Set Flag.show_misc, " ";
418 "--show-trying", Arg.Set Flag.show_trying,
419 " show the name of each function being processed";
420 "--show-dependencies",
421 Arg.Unit (function _ -> FC.show_dependencies := true;
422 FC.show_binding_in_out := true),
423 " show the dependencies related to each rule";
424 ];
425
426 "verbose subsystems options",
427 "",
428 [
429 "--verbose-ctl-engine",
430 Arg.Unit (function _ ->
431 Flag_ctl.verbose_ctl_engine := true; FC.show_ctl_text := true) , " ";
432 "--verbose-match", Arg.Set Flag_ctl.verbose_match, " ";
433 "--verbose-engine", Arg.Set Flag_matcher.debug_engine, " ";
434 "--graphical-trace", Arg.Set Flag_ctl.graphical_trace, " generate a pdf file representing the matching process";
435 "--gt-without-label",
436 Arg.Unit (function _ ->
437 Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true),
438 " remove graph label (requires option -graphical-trace)";
439
440 "--parse-error-msg", Arg.Set Flag_parsing_c.show_parsing_error, " ";
441 "--verbose-parsing",
442 Arg.Unit (fun _ -> Flag_parsing_c.verbose_parsing := true;
443 Flag_parsing_c.show_parsing_error := true), " ";
444 "--type-error-msg", Arg.Set Flag_parsing_c.verbose_type, " ";
445 (* could also use Flag_parsing_c.options_verbose *)
446 ];
447
448 "other show options",
449 "",
450 [
451 "--show-c" , Arg.Set FC.show_c, " ";
452 "--show-cocci" , Arg.Set FC.show_cocci, " ";
453 "--show-before-fixed-flow" , Arg.Set FC.show_before_fixed_flow, " ";
454 "--show-ctl-tex" , Arg.Set FC.show_ctl_tex, " ";
455 "--show-ctl-text" , Arg.Set FC.show_ctl_text, " ";
456 "--show-SP" , Arg.Set Flag_parsing_cocci.show_SP, " ";
457 ];
458
459
460 "debug C parsing/unparsing",
461 "",
462 [
463 "--debug-cpp", Arg.Set Flag_parsing_c.debug_cpp, " ";
464 "--debug-lexer", Arg.Set Flag_parsing_c.debug_lexer , " ";
465 "--debug-etdt", Arg.Set Flag_parsing_c.debug_etdt , " ";
466 "--debug-typedef", Arg.Set Flag_parsing_c.debug_typedef, " ";
467
468 "--filter-msg", Arg.Set Flag_parsing_c.filter_msg ,
469 " filter some cpp message when the macro is a \"known\" cpp construct";
470 "--filter-define-error", Arg.Set Flag_parsing_c.filter_define_error," ";
471 "--filter-msg-define-error", Arg.Set Flag_parsing_c.filter_msg_define_error,
472 " filter the error msg";
473 "--filter-passed-level", Arg.Set_int Flag_parsing_c.filter_passed_level," ";
474 (* debug cfg doesn't seem to have any effect, so drop it as an option *)
475 (* "--debug_cfg", Arg.Set Flag_parsing_c.debug_cfg , " "; *)
476 "--debug-unparsing", Arg.Set Flag_parsing_c.debug_unparsing, " ";
477
478 ];
479 (* could use Flag_parsing_c.options_debug_with_title instead *)
480
481
482 "shortcut for enabling/disabling a set of debugging options at once",
483 "",
484 [
485 (* todo: other profile ? *)
486 "--quiet", Arg.Unit (fun () -> run_profile quiet_profile), " ";
487 "--very-quiet", Arg.Unit (fun () -> run_profile very_quiet_profile), " ";
488 "--debug", Arg.Unit (fun () -> run_profile debug_profile), " ";
489 "--pad", Arg.Unit (fun () -> run_profile pad_profile), " ";
490
491 ];
492
493 "bench options",
494 "",
495 [
496 "--profile", Arg.Unit (function () -> Common.profile := Common.PALL) ,
497 " gather timing information about the main coccinelle functions";
498 "--bench", Arg.Int (function x -> Flag_ctl.bench := x),
499 " <level> for profiling the CTL engine";
500 "--timeout", Arg.Int (fun x -> FC.timeout := Some x),
501 " <sec> timeout in seconds";
502 "--steps", Arg.Int (fun x -> Flag_ctl.steps := Some x),
503 " max number of model checking steps per code unit";
504 "--iso-limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x),
505 " max depth of iso application";
506 "--no-iso-limit", Arg.Unit (fun _ -> Flag_parsing_cocci.iso_limit := None),
507 " disable limit on max depth of iso application";
508 "--track-iso", Arg.Set Flag.track_iso_usage,
509 " gather information about isomorphism usage";
510 "--disable-iso",
511 Arg.String
512 (fun s -> Flag_parsing_cocci.disabled_isos :=
513 s :: !Flag_parsing_cocci.disabled_isos),
514 " disable a specific isomorphism";
515 "--profile-iso",
516 Arg.Unit
517 (function () ->
518 Common.profile :=
519 (*post_engine not included, because it doesn't use isos*)
520 PSOME ["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
521 " gather information about the cost of isomorphism usage"
522 ];
523
524
525
526 "change of algorithm options",
527 "",
528 [
529 (* "--popl", Arg.Set FC.popl,
530 " simplified SmPL, for the popl paper";
531
532 "--popl_mark_all",
533 Arg.Unit
534 (function _ -> FC.popl := true; Flag_popl.mark_all := true),
535 " simplified SmPL, for the popl paper";
536
537 "--popl_keep_all_wits",
538 Arg.Unit
539 (function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
540 " simplified SmPL, for the popl paper";
541
542 "--hrule", Arg.String
543 (function s ->
544 Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
545 " semantic patch generation";
546 *)
547 "--keep-comments", Arg.Set Flag_parsing_c.keep_comments,
548 " keep comments around removed code";
549
550 "--loop", Arg.Set Flag_ctl.loop_in_src_code, " ";
551 "--no-loops", Arg.Set Flag_parsing_c.no_loops,
552 " drop all back edges derived from looping constructs - unsafe";
553 "--no-gotos", Arg.Set Flag_parsing_c.no_gotos,
554 " drop all jumps derived from gotos - unsafe";
555 "--no-saved-typedefs", Arg.Clear Flag_cocci.use_saved_typedefs,
556 " drop all inferred typedefs from one parse of some code to the next";
557
558 "--ocaml-regexps", Arg.Clear Regexp.pcre_support,
559 " use OCaml Str regular expressions for constraints";
560
561 "--l1", Arg.Clear Flag_parsing_c.label_strategy_2, " ";
562 "--ifdef-to-if", Arg.Set FC.ifdef_to_if,
563 " convert ifdef to if (experimental)";
564 "--no-ifdef-to-if", Arg.Clear FC.ifdef_to_if,
565 " convert ifdef to if (experimental)";
566
567 "--disable-multi-pass", Arg.Set Flag_parsing_c.disable_multi_pass, " ";
568
569 "--noif0-passing", Arg.Clear Flag_parsing_c.if0_passing, " ";
570 "--defined", Arg.String (Flag_parsing_c.add Flag_parsing_c.defined), " ";
571 "--undefined", Arg.String
572 (Flag_parsing_c.add Flag_parsing_c.undefined), " ";
573 "--noadd-typedef-root", Arg.Clear Flag_parsing_c.add_typedef_root, " ";
574 (* could use Flag_parsing_c.options_algo instead *)
575
576
577 "--disallow-nested-exps", Arg.Set Flag_matcher.disallow_nested_exps,
578 " disallow an expresion pattern from matching a term and its subterm";
579 "--disable-worth-trying-opt", Arg.Clear FC.worth_trying_opt,
580 " ";
581 "--only-return-is-error-exit",
582 Arg.Set Flag_matcher.only_return_is_error_exit,
583 "if this flag is not set, then break and continue are also error exits";
584 (* the following is a hack to make it easier to add code in sgrep-like
585 code, essentially to compensate for the fact that we don't have
586 any way of printing things out *)
587 "--allow-inconsistent-paths",
588 Arg.Set Flag_matcher.allow_inconsistent_paths,
589 " if this flag is set don't check for inconsistent paths; dangerous";
590 "--no-safe-expressions",
591 Arg.Set Flag_matcher.no_safe_expressions,
592 " make an expression disjunction not prioritise the topmost disjunct";
593 "--int-bits", Arg.Int Flag_parsing_c.set_int_bits,
594 " the number of bits in an unsigned int";
595 "--long-bits", Arg.Int Flag_parsing_c.set_long_bits,
596 " the number of bits in an unsigned long";
597 "--linux-spacing", Arg.Unit Flag_parsing_c.set_linux_spacing,
598 " spacing of + code follows the conventions of Linux";
599 "--smpl-spacing", Arg.Unit Flag_parsing_c.set_smpl_spacing,
600 " spacing of + code follows the semantic patch";
601 "-D", Arg.String Flag.set_defined_virtual_rules,
602 " indicate that a virtual rule should be considered to be matched";
603 "--c++", Arg.Set Flag.c_plus_plus,
604 " make a small attempt to parse C++ files"
605 ];
606
607 "misc options",
608 "",
609 [
610 "--debugger", Arg.Set Common.debugger,
611 " option to set if launch spatch in ocamldebug";
612 "--disable-once", Arg.Set Common.disable_pr2_once,
613 " to print more messages";
614 "--show-trace-profile", Arg.Set Common.show_trace_profile,
615 " show trace";
616 "--save-tmp-files", Arg.Set Common.save_tmp_files, " ";
617 "--external-analysis-file", Arg.String
618 (Externalanalysis.load_external_results),
619 " import results from an external analysis";
620 ];
621
622 "concurrency",
623 "",
624 [
625 "--index", Arg.Int (function x -> distrib_index := Some x) ,
626 " the processor to use for this run of spatch";
627 "--max", Arg.Int (function x -> distrib_max := Some x) ,
628 " the number of processors available";
629 "--mod-distrib", Arg.Set mod_distrib,
630 " use mod to distribute files among the processors";
631 ];
632
633 "pad options",
634 "",
635 [
636 "--use-cache", Arg.Set Flag_parsing_c.use_cache,
637 " use .ast_raw pre-parsed cached C file";
638 "--cache-prefix",
639 Arg.String (function s ->
640 Flag_parsing_c.cache_prefix := Some s;
641 Flag_parsing_c.use_cache := true),
642 " directory of cached ASTs, sets -use-cache";
643 (* could use Flag_parsing_c.options_pad instead *)
644 "--cache-limit",
645 Arg.Int (function n ->
646 Flag_parsing_c.cache_limit := Some n),
647 " maximum number of cached ASTs, sets -use-cache";
648 ];
649
650
651
652 "test mode and test options (works with tests/ or .ok files)",
653 "The test options don't work with the --sp-file and so on.",
654 [
655 "--test", Arg.Set test_mode,
656 " <file> launch spatch on tests/file.[c,cocci]";
657 "--testall", Arg.Set test_all,
658 " launch spatch on all files in tests/ having a .res";
659 "--test-okfailed", Arg.Set test_okfailed,
660 " generates .{ok,failed,spatch_ok} files using .res files";
661 "--test-regression-okfailed", Arg.Set test_regression_okfailed,
662 " process the .{ok,failed,spatch_ok} files in current dir";
663
664 "--compare-with-expected", Arg.Set compare_with_expected,
665 " use also file.res";
666 "--expected-score-file", Arg.Set_string expected_score_file,
667 " which score file to compare with in -testall";
668 "--no-update-score-file", Arg.Clear allow_update_score_file,
669 " do not update the score file when -testall succeeds";
670 "--relax-include-path", Arg.Set FC.relax_include_path,
671 " ";
672 ];
673
674 "action mode",
675 ("The action options don't work with the --sp-file and so on." ^ "\n" ^
676 "It's for the other (internal) uses of the spatch program."
677 ),
678
679 (* -token_c, -parse_c, etc *)
680 ((Common.options_of_actions action (Test_parsing_c.actions())) ++
681 [
682 (let s = "--parse-cocci" in s, Arg.Unit (fun () -> action := s),
683 " <file>");
684 (let s = "--compare-c" in s, Arg.Unit (fun () -> action := s),
685 " <file1> <file2>");
686 ]);
687 ]
688
689
690 let all_options =
691 short_options ++ List.concat (List.map Common.thd3 other_options)
692
693 (* I don't want the -help and --help that are appended by Arg.align *)
694 let arg_align2 xs =
695 Arg.align xs +> List.rev +> Common.drop 2 +> List.rev
696
697 (*
698 Ignore unknown option
699
700 This simplifies the integration of Coccinelle in toolchain. For
701 instance, spatch can then be used as a checker in the Linux build
702 system.
703
704 *)
705 let check_include_path () =
706 let opt = Array.get Sys.argv !Arg.current in
707 let is_include_re = Str.regexp "-I\\(.*\\)" in
708 if Str.string_match is_include_re opt 0 then
709 let path = Str.matched_group 1 opt in
710 FC.include_path:= path::!FC.include_path
711 else ()
712
713 let rec arg_parse_no_fail l f msg =
714 try
715 check_include_path ();
716 Arg.parse_argv Sys.argv l f msg;
717 with
718 | Arg.Bad emsg ->
719 arg_parse_no_fail l f msg
720 | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
721 raise (Impossible 165) (* -help is specified in speclist *)
722
723 (* copy paste of Arg.parse. Don't want the default -help msg *)
724 let arg_parse2 l f msg argv =
725 (try
726 Arg.parse_argv argv l f msg;
727 with
728 | Arg.Bad emsg -> (* eprintf "%s" msg; exit 2; *)
729 if not !ignore_unknown_opt then
730 begin
731 let xs = Common.lines emsg in
732 (* take only head, it's where the error msg is *)
733 pr2 (List.hd xs);
734 !short_usage_func();
735 raise (Common.UnixExit (2))
736 end
737 else
738 arg_parse_no_fail l f msg;
739 | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
740 raise (Impossible 166) (* -help is specified in speclist *)
741 )
742
743
744 let short_usage () =
745 begin
746 Common.short_usage usage_msg short_options;
747 pr2 "";
748 pr2 "Example of use:";
749 pr2 " ./spatch --sp-file foo.cocci foo.c -o /tmp/newfoo.c";
750 pr2 "";
751 end
752
753
754 let long_usage () =
755 Common.long_usage usage_msg short_options other_options
756
757 let _ = short_usage_func := short_usage
758 let _ = long_usage_func := long_usage
759
760 (*****************************************************************************)
761 (* Helpers *)
762 (*****************************************************************************)
763
764 (* for fresh identifier information *)
765 let adjust_stdin cfiles k =
766 match cfiles with
767 [] -> failwith "not possible"
768 | cfile::_ ->
769 let newin =
770 try
771 let (dir, base, ext) = Common.dbe_of_filename cfile in
772 let varfile = Common.filename_of_dbe (dir, base, "var") in
773 if ext =$= "c" && Common.lfile_exists varfile
774 then Some varfile
775 else None
776 with Invalid_argument("Filename.chop_extension") -> None in
777 Common.redirect_stdin_opt newin k
778
779 let glimpse_filter (coccifile, isofile) dir =
780 let (_metavars,astcocci,_free_var_lists,_negated_positions,
781 _used_after_lists,_positions_lists,(_,query,_)) =
782 Cocci.sp_of_file coccifile (Some isofile) in
783 match query with
784 None -> pr2 "no inferred glimpse keywords"; None
785 | Some queries ->
786 let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in
787 let rec loop = function
788 [] -> None (* error, eg due to pattern too big *)
789 | query::queries ->
790 Printf.fprintf stderr "%s\n" ("glimpse request = " ^ query);
791 let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in
792 let (glimpse_res,stat) = Common.cmd_to_list_and_status command in
793 match stat with
794 Unix.WEXITED(0) | Unix.WEXITED(1) ->
795 Printf.fprintf stderr "got files\n"; flush stderr;
796 Some
797 (glimpse_res +>
798 List.filter
799 (fun file -> List.mem (Common.filesuffix file) suffixes))
800 | _ -> loop queries (* error, eg due to pattern too big *) in
801 loop queries
802
803 let idutils_filter (coccifile, isofile) dir =
804 let (_metavars,astcocci,_free_var_lists,_negated_positions,
805 _used_after_lists,_positions_lists,(_,_,query)) =
806 Cocci.sp_of_file coccifile (Some isofile) in
807 match query with
808 None -> pr2 "no inferred idutils keywords"; None
809 | Some query ->
810 let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in
811 let files = Id_utils.interpret dir query in
812 Printf.fprintf stderr "got files\n"; flush stderr;
813 Some
814 (files +>
815 List.filter (fun file -> List.mem (Common.filesuffix file) suffixes))
816
817 (*****************************************************************************)
818 (* Main action *)
819 (*****************************************************************************)
820
821 let rec main_action xs =
822 let (cocci_files,xs) =
823 List.partition (function nm -> Filename.check_suffix nm ".cocci") xs in
824 (match (!cocci_file,cocci_files) with
825 "",[fl] -> cocci_file := fl
826 | _,[] -> ()
827 | _ -> failwith "only one .cocci file allowed");
828 Iteration.base_file_list := xs;
829 let rec toploop = function
830 [] -> failwith "no C files provided"
831 | x::xs ->
832 (* a more general solution would be to use
833 * Common.files_of_dir_or_files (x::xs)
834 * as some elements in xs may also be directories, or individual
835 * files.
836 *)
837 dir := (Common.is_directory x);
838
839 if !cocci_file =$= ""
840 then failwith "I need a cocci file, use --sp-file <file>";
841
842 if !dir && !Flag.patch =*= None
843 then
844 (match xs with
845 | [] -> Flag.patch := Some (Cocci.normalize_path x)
846 | _ ->
847 pr2
848 ("warning: patch output can only be created when only one\n"^
849 "directory is specified or when the -patch flag is used")
850 );
851 Flag.dir := x;
852
853 let infiles =
854 Common.profile_code "Main.infiles computation" (fun () ->
855 match !dir, !kbuild_info, !Flag.scanner, xs with
856 (* glimpse *)
857 | false, _, (Flag.Glimpse|Flag.IdUtils), _ -> [x::xs]
858 | true, s, (Flag.Glimpse|Flag.IdUtils), _ when s <> "" ->
859 failwith
860 "--use-glimpse or --id-utils does not work with --kbuild"
861 | true, "", Flag.Glimpse, [] ->
862 (*if not (null xs)
863 then failwith "--use-glimpse can accept only one dir"*)
864
865 let files =
866 match glimpse_filter (!cocci_file, !Config.std_iso) x with
867 None -> Test_parsing_c.get_files x
868 | Some files -> files in
869 files +> List.map (fun x -> [x])
870 | true, "", Flag.IdUtils, [] ->
871 (*if not (null xs)
872 then failwith "--id-utils can accept only one dir"*)
873
874 let files =
875 match idutils_filter (!cocci_file, !Config.std_iso) x with
876 None -> Test_parsing_c.get_files x
877 | Some files -> files in
878 files +> List.map (fun x -> [x])
879 (* normal *)
880 | false, _, _, _ -> [x::xs]
881 | true, "", _, _ ->
882 Test_parsing_c.get_files (join " " (x::xs)) +> List.map (fun x -> [x])
883
884 (* kbuild *)
885 | true, kbuild_info_file,_,_ ->
886 let dirs =
887 Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d")
888 in
889 let info = Kbuild.parse_kbuild_info kbuild_info_file in
890 let groups = Kbuild.files_in_dirs dirs info in
891
892 groups +> List.map (function Kbuild.Group xs -> xs)
893 )
894 in
895
896 (* make cache unique in parallel case *)
897 (match (!distrib_index,!Flag_parsing_c.cache_prefix) with
898 (Some index,Some str) ->
899 Flag_parsing_c.cache_prefix :=
900 Some (Printf.sprintf "%s/d%d" str index)
901 | _ -> ());
902
903 let infiles =
904 match (!distrib_index,!distrib_max) with
905 (None,None) -> infiles
906 | (Some index,Some max) ->
907 (if index >= max
908 then
909 failwith "index starts at 0, and so must be less than max");
910 if !mod_distrib
911 then
912 let rec loop ct = function
913 [] -> []
914 | x::xs ->
915 if (ct mod max) =|= index
916 then x::(loop (ct+1) xs)
917 else loop (ct+1) xs in
918 loop 0 infiles
919 else
920 begin
921 let all_files = List.length infiles in
922 let regions = (all_files + (max - 1)) / max in
923 let this_min = index * regions in
924 let this_max = (index+1) * regions in
925 let rec loop ct = function
926 [] -> []
927 | x::xs ->
928 if this_min <= ct && ct < this_max
929 then x::(loop (ct+1) xs)
930 else loop (ct+1) xs in
931 loop 0 infiles
932 end
933 | _ -> failwith "inconsistent distribution information" in
934
935 let (cocci_infos,outfiles) =
936 Common.profile_code "Main.outfiles computation" (fun () ->
937 let cocci_infos =
938 Cocci.pre_engine (!cocci_file, !Config.std_iso) in
939 let res =
940 infiles +> List.map (fun cfiles ->
941 pr2 ("HANDLING: " ^ (join " " cfiles));
942 (*pr2 (List.hd(Common.cmd_to_list "free -m | grep Mem"));*)
943 flush stderr;
944
945 Common.timeout_function_opt !FC.timeout (fun () ->
946 Common.report_if_take_time 10 (join " " cfiles) (fun () ->
947 try
948 let optfile =
949 if !output_file <> "" && !compat_mode then
950 Some !output_file
951 else
952 None
953 in
954 adjust_stdin cfiles (fun () ->
955 Common.redirect_stdout_opt optfile (fun () ->
956 (* this is the main call *)
957 Cocci.full_engine cocci_infos cfiles
958 ))
959 with
960 | Common.UnixExit x -> raise (Common.UnixExit x)
961 | Pycocci.Pycocciexception ->
962 raise Pycocci.Pycocciexception
963 | e ->
964 if !dir
965 then begin
966 pr2 ("EXN:" ^ Printexc.to_string e);
967 [] (* *)
968 end
969 else raise e))) in
970 (cocci_infos,res)) in
971 let outfiles = List.concat outfiles in
972 (match Iteration.get_pending_instance() with
973 None ->
974 (x,xs,cocci_infos,outfiles)
975 | Some (files,virt_rules,virt_ids) ->
976 if outfiles = [] or outfiles = [] or not !FC.show_diff
977 or !inplace_modif
978 then
979 begin
980 (if !inplace_modif then generate_outfiles outfiles x xs);
981 Flag.defined_virtual_rules := virt_rules;
982 Flag.defined_virtual_env := virt_ids;
983 Common.erase_temp_files();
984 Common.clear_pr2_once();
985 distrib_index := None;
986 distrib_max := None;
987 toploop files
988 end
989 else
990 begin
991 Common.pr2
992 "Out of place transformation not compatible with iteration. Aborting.\n consider using -no_show_diff or -in_place";
993 (x,xs,cocci_infos,outfiles)
994 end) in
995 let (x,xs,cocci_infos,outfiles) = toploop xs in
996
997 Cocci.post_engine cocci_infos;
998 Common.profile_code "Main.result analysis" (fun () ->
999 Ctlcocci_integration.print_bench();
1000 generate_outfiles outfiles x xs;
1001 if !compare_with_expected
1002 then Testing.compare_with_expected outfiles)
1003
1004 and generate_outfiles outfiles x (* front file *) xs (* other files *) =
1005 let outfiles = Cocci.check_duplicate_modif outfiles in
1006 outfiles +> List.iter (fun (infile, outopt) ->
1007 outopt +> Common.do_option (fun outfile ->
1008 if !inplace_modif
1009 then begin
1010 (match !backup_suffix with
1011 Some backup_suffix ->
1012 Common.command2 ("cp "^infile^" "^infile^backup_suffix)
1013 | None -> ());
1014 Common.command2 ("cp "^outfile^" "^infile);
1015 end;
1016
1017 if !outplace_modif
1018 then Common.command2 ("cp "^outfile^" "^infile^".cocci_res")
1019
1020 (* potential source of security pb if the /tmp/ file is
1021 * a symlink, so simpler to not produce any regular file
1022 * (files created by Common.new_temp_file are still ok)
1023 * anymore in /tmp.
1024 *)
1025 (*
1026 if !output_file =$= ""
1027 then begin
1028 let tmpfile = "/tmp/"^Common.basename infile in
1029 pr2 (spf "One file modified. Result is here: %s" tmpfile);
1030 Common.command2 ("cp "^outfile^" "^tmpfile);
1031 end
1032 *)
1033 ));
1034 if !output_file <> "" && not !compat_mode then
1035 (match outfiles with
1036 | [infile, Some outfile] when infile =$= x && null xs ->
1037 Common.command2 ("cp " ^outfile^ " " ^ !output_file)
1038 | [infile, None] when infile =$= x && null xs ->
1039 Common.command2 ("cp " ^infile^ " " ^ !output_file)
1040 | _ ->
1041 failwith
1042 ("-o can not be applied because there are multiple " ^
1043 "modified files"))
1044
1045 let fix_chars s =
1046 if (String.length s) > 2 && String.get s 0 = '-'
1047 && not (String.get s 1 = '-')
1048 then "-"^(String.concat "-" (Str.split (Str.regexp_string "_") s))
1049 else s
1050
1051 (*****************************************************************************)
1052 (* The coccinelle main entry point *)
1053 (*****************************************************************************)
1054 let main () =
1055 begin
1056 let arglist = Array.to_list Sys.argv in
1057 let arglist = Command_line.command_line arglist in
1058 let arglist = List.map fix_chars arglist in
1059
1060 let contains_cocci =
1061 (* rather a hack... don't want to think about all possible options *)
1062 List.exists
1063 (function x -> Filename.check_suffix x ".cocci")
1064 arglist &&
1065 not (List.mem "--parse-cocci" arglist) in
1066 if not (null (Common.inter_set arglist
1067 ["--cocci-file";"--sp-file";"--sp";"--test";"--testall";
1068 "--test-okfailed";"--test-regression-okfailed"]))
1069 or contains_cocci
1070 then run_profile quiet_profile;
1071
1072 let args = ref [] in
1073
1074 (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*)
1075
1076 (* this call can set up many global flag variables via the cmd line *)
1077 arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg
1078 (Array.of_list arglist);
1079 args :=
1080 List.filter
1081 (function arg ->
1082 if Filename.check_suffix arg ".cocci"
1083 then
1084 begin
1085 (if !cocci_file = ""
1086 then cocci_file := arg
1087 else failwith "only one .cocci file allowed");
1088 false
1089 end
1090 else true)
1091 !args;
1092 (match (!Flag_parsing_c.cache_prefix,!distrib_index) with
1093 (Some cp,Some n) ->
1094 Flag_parsing_c.cache_prefix :=
1095 Some (Printf.sprintf "%s_%d" cp n)
1096 | _ -> ());
1097
1098 (* julia hack so that one can override directories specified on
1099 * the command line. *)
1100 (if !dir
1101 then
1102 let chosen_dir =
1103 if List.length !args > 1
1104 then
1105 begin
1106 let chosen = List.hd !args in
1107 Flag.dir := chosen;
1108 pr2 ("ignoring all but the last specified directory: "^chosen);
1109 args := [chosen];
1110 chosen
1111 end
1112 else List.hd !args in
1113 if !FC.include_path =*= []
1114 then FC.include_path := [Filename.concat chosen_dir "include"]);
1115
1116 args := List.rev !args;
1117
1118 if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$"))
1119 then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci";
1120
1121 if !Config.std_iso <> ""
1122 then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso";
1123 if !Config.std_h <> ""
1124 then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h";
1125
1126 if !Config.std_h <> ""
1127 then Parse_c.init_defs_builtins !Config.std_h;
1128
1129 if !macro_file <> ""
1130 then Parse_c.init_defs_macros !macro_file;
1131
1132
1133 (* must be done after Arg.parse, because Common.profile is set by it *)
1134 Common.profile_code "Main total" (fun () ->
1135
1136
1137 let all_actions = Test_parsing_c.actions() in
1138
1139 (match (!args) with
1140
1141 (* --------------------------------------------------------- *)
1142 (* The test framework. Works with tests/ or .ok and .failed *)
1143 (* --------------------------------------------------------- *)
1144 | [x] when !test_mode ->
1145 begin
1146 let prefix = "tests/" in
1147 let testfile = x ^ ".cocci" in
1148 if Sys.file_exists (prefix ^ testfile) then
1149 begin
1150 (if !FC.include_path = []
1151 then FC.include_path := [prefix^"include"]);
1152 Testing.testone prefix x !compare_with_expected
1153 end
1154 else
1155 if Sys.file_exists testfile then
1156 begin
1157 (if !FC.include_path = []
1158 then FC.include_path := ["include"]);
1159 Testing.testone "" x !compare_with_expected
1160 end
1161 else
1162 Printf.fprintf stderr
1163 "ERROR: File %s does not exist\n" testfile
1164 end
1165
1166 | [] when !test_all ->
1167 (if !FC.include_path = []
1168 then FC.include_path := ["tests/include"]);
1169 let score_file = if !expected_score_file <> ""
1170 then !expected_score_file
1171 else "tests/SCORE_expected.sexp" in
1172 Testing.testall score_file !allow_update_score_file
1173
1174 | [] when !test_regression_okfailed ->
1175 Testing.test_regression_okfailed ()
1176
1177 | ((x::xs) as cfiles) when !test_okfailed ->
1178 (* do its own timeout on FC.timeout internally *)
1179 FC.relax_include_path := true;
1180 adjust_stdin cfiles (fun () ->
1181 Testing.test_okfailed !cocci_file cfiles
1182 )
1183
1184 (* --------------------------------------------------------- *)
1185 (* Actions, useful to debug subpart of coccinelle *)
1186 (* --------------------------------------------------------- *)
1187
1188 | xs when List.mem !action (Common.action_list all_actions) ->
1189 Common.do_action !action xs all_actions
1190
1191 | [] when !action =$= "--parse-cocci" ->
1192 Testing.test_parse_cocci !cocci_file
1193
1194 (* I think this is used by some scripts in some Makefile for our
1195 * big-tests. So dont remove.
1196 *)
1197 | [file1;file2] when !action =$= "--compare-c" ->
1198 Test_parsing_c.test_compare_c file1 file2 (* result = unix code *)
1199
1200 (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
1201
1202
1203 (* --------------------------------------------------------- *)
1204 (* This is the main entry *)
1205 (* --------------------------------------------------------- *)
1206 | x::xs -> main_action (x::xs)
1207
1208 (* --------------------------------------------------------- *)
1209 (* empty entry *)
1210 (* --------------------------------------------------------- *)
1211 | [] -> short_usage()
1212 ));
1213 if !Pycocci.initialised && (Pycocci.py_isinitialized ()) != 0 then begin
1214 ignore(Pycocci.pyrun_simplestring "cocci.finalise()");
1215 if !Flag.show_misc
1216 then Common.pr2 "Finalizing python\n";
1217 Pycocci.py_finalize ();
1218 end
1219 end
1220
1221
1222 let main_with_better_error_report () =
1223 if !Common.debugger then main ()
1224 else
1225 try
1226 main ()
1227 with
1228 | Unix.Unix_error (e, "stat", filename) ->
1229 Printf.fprintf stderr "ERROR: File %s does not exist: %s\n"
1230 filename (Unix.error_message e);
1231 raise (UnixExit (-1))
1232 | Parse_cocci.Bad_virt s ->
1233 Printf.fprintf stderr "virtual rule %s not supported\n" s;
1234 raise (UnixExit (-1))
1235
1236 (*****************************************************************************)
1237 let start =
1238 Common.main_boilerplate (fun () ->
1239 main_with_better_error_report ();
1240 Ctlcocci_integration.print_bench();
1241 )