Release coccinelle-0.2.0
[bpt/coccinelle.git] / main.ml
CommitLineData
9f8e26f4
C
1(*
2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
4 * This file is part of Coccinelle.
5 *
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.
9 *
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.
14 *
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/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
34e49164 23open Common
faf9a90c 24module FC = Flag_cocci
34e49164
C
25
26(*****************************************************************************)
27(* Flags *)
28(*****************************************************************************)
29
30(* In addition to flags that can be tweaked via -xxx options (cf the
31 * full list of options in "the spatch options" section below), the
32 * spatch program also depends on external files, described in
33 * globals/config.ml, mainly a standard.h and standard.iso file *)
34
35let cocci_file = ref ""
36
37let output_file = ref ""
38let inplace_modif = ref false (* but keeps a .cocci_orig *)
39let outplace_modif = ref false (* generates a .cocci_res *)
978fd7e5
C
40let preprocess = ref false (* run the C preprocessor before cocci *)
41let compat_mode = ref false
34e49164 42
708f4980 43(* somehow obsolete now *)
978fd7e5 44let dir = ref false
34e49164
C
45
46let include_headers = ref false
47let kbuild_info = ref ""
48
978fd7e5 49let macro_file = ref ""
708f4980 50
34e49164
C
51(* test mode *)
52let test_mode = ref false
53let test_all = ref false
54let test_okfailed = ref false
55let test_regression_okfailed = ref false
708f4980 56let expected_score_file = ref ""
34e49164
C
57
58
59(* action mode *)
60let action = ref ""
61
62(* works with -test but also in "normal" spatch mode *)
63let compare_with_expected = ref false
64
34e49164
C
65let distrib_index = ref (None : int option)
66let distrib_max = ref (None : int option)
67let mod_distrib = ref false
68
69
70(*****************************************************************************)
71(* Profiles *)
72(*****************************************************************************)
73
74(* pair of (list of flags to set true, list of flags to set false *)
75let quiet_profile = (
76 [
77 ],
78 [
faf9a90c 79 (* FC.show_diff; just leave this as it is *)
34e49164
C
80
81 Flag.show_misc;
82 Flag.show_trying;
faf9a90c 83 Flag.show_transinfo;
34e49164 84
faf9a90c
C
85 FC.show_c;
86 FC.show_cocci;
87 FC.show_flow;
88 FC.show_before_fixed_flow;
89 FC.show_ctl_tex;
90 FC.show_ctl_text;
91 FC.show_binding_in_out;
34e49164 92
708f4980
C
93 FC.verbose_cocci;
94
95 Flag_parsing_c.show_parsing_error;
96
97 Flag_parsing_c.verbose_lexing;
98 Flag_parsing_c.verbose_parsing;
99 Flag_parsing_c.verbose_type;
100 Flag_parsing_c.verbose_cfg;
101 Flag_parsing_c.verbose_unparsing;
102 Flag_parsing_c.verbose_visit;
978fd7e5 103 Flag_parsing_c.verbose_cpp_ast;
708f4980
C
104
105 Flag_matcher.verbose_matcher;
106 Flag_matcher.debug_engine;
107
108 Flag_parsing_c.debug_unparsing;
109
34e49164
C
110 Flag_parsing_cocci.show_SP;
111 Flag_parsing_cocci.show_iso_failures;
708f4980 112
34e49164
C
113 Flag_ctl.verbose_ctl_engine;
114 Flag_ctl.verbose_match;
708f4980
C
115
116
34e49164
C
117 ])
118
faf9a90c
C
119(* some information that is useful in seeing why a semantic patch doesn't
120work properly *)
121let debug_profile = (
122 [
123 Flag.show_misc;
708f4980
C
124 Flag.show_transinfo;
125
faf9a90c
C
126 FC.show_diff;
127 FC.show_cocci;
128 FC.show_binding_in_out;
129 FC.show_dependencies;
708f4980 130
faf9a90c 131 Flag_parsing_cocci.show_iso_failures;
708f4980
C
132
133 FC.verbose_cocci;
134
135 Flag_parsing_c.verbose_cfg;
136 Flag_parsing_c.verbose_unparsing;
137 Flag_parsing_c.verbose_visit;
138
139 Flag_matcher.verbose_matcher;
140
141 Flag_parsing_c.show_parsing_error;
faf9a90c
C
142 ],
143 [
144
145 Flag.show_misc;
146
147 FC.show_c;
148 FC.show_flow;
149 FC.show_before_fixed_flow;
150 FC.show_ctl_tex;
151 FC.show_ctl_text;
152
153 Flag_parsing_cocci.show_SP;
154 Flag_ctl.verbose_ctl_engine;
155 Flag_ctl.verbose_match;
156 Flag_matcher.debug_engine;
157 Flag_parsing_c.debug_unparsing;
158 Flag_parsing_c.verbose_type;
159 Flag_parsing_c.verbose_parsing;
160 ])
161
34e49164
C
162let pad_profile = (
163 [
faf9a90c 164 FC.show_diff;
34e49164
C
165 ],
166 [
167
168 Flag.show_misc;
faf9a90c 169 Flag.show_transinfo;
34e49164 170
faf9a90c
C
171 FC.show_c;
172 FC.show_cocci;
173 FC.show_flow;
174 FC.show_before_fixed_flow;
175 FC.show_ctl_tex;
176 FC.show_ctl_text;
177 FC.show_binding_in_out;
34e49164
C
178
179 Flag_parsing_cocci.show_SP;
180 Flag_parsing_cocci.show_iso_failures;
181 Flag_ctl.verbose_ctl_engine;
182 Flag_ctl.verbose_match;
485bce71 183 Flag_matcher.debug_engine;
34e49164
C
184 Flag_parsing_c.debug_unparsing;
185 Flag_parsing_c.verbose_type;
186 Flag_parsing_c.verbose_parsing;
187 ])
188
faf9a90c
C
189let run_profile p =
190 let (set_to_true, set_to_false) = p in
191 List.iter (fun x -> x := false) set_to_false;
192 List.iter (fun x -> x := true) set_to_true
193
34e49164
C
194(*****************************************************************************)
195(* The spatch options *)
196(*****************************************************************************)
197
978fd7e5
C
198let usage_msg =
199 "Usage: " ^ basename Sys.argv.(0) ^
200 " -sp_file <SP> <infile> [-o <outfile>] [-iso_file <iso>] [options]" ^
34e49164
C
201 "\n" ^ "Options are:"
202
203(* forward reference trick *)
204let short_usage_func = ref (fun () -> ())
205let long_usage_func = ref (fun () -> ())
206
207
208(* The short_options are user-oriented. The other options are for
209 * the developers of coccinelle or advanced-users that know
210 * quite well the underlying semantics of coccinelle.
211 *)
978fd7e5 212
34e49164
C
213
214(* will be printed when use only ./spatch. For the rest you have to
978fd7e5 215 * use -longhelp to see them.
34e49164 216 *)
978fd7e5
C
217let short_options = [
218 "-sp_file", Arg.Set_string cocci_file,
34e49164
C
219 " <file> the semantic patch file";
220
221 "-o", Arg.Set_string output_file,
222 " <file> the output file";
223 "-inplace", Arg.Set inplace_modif,
224 " do the modification on the file directly";
225 "-outplace", Arg.Set outplace_modif,
226 " store modifications in a .cocci_res file";
227
978fd7e5 228 "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
34e49164 229 " set number of diff context lines";
978fd7e5 230 "-partial_match", Arg.Set Flag_ctl.partial_match,
34e49164
C
231 " report partial matches of the SP on the C file";
232
978fd7e5 233 "-iso_file", Arg.Set_string Config.std_iso,
34e49164 234 " <file> (default=" ^ !Config.std_iso ^")";
708f4980
C
235 "-macro_file", Arg.Set_string macro_file,
236 " <file>";
237 "-macro_file_builtins", Arg.Set_string Config.std_h,
34e49164
C
238 " <file> (default=" ^ !Config.std_h ^ ")";
239
faf9a90c
C
240 "-all_includes",
241 Arg.Unit (function _ -> FC.include_options := FC.I_ALL_INCLUDES),
34e49164 242 " causes all available include files to be used";
faf9a90c
C
243 "-no_includes",
244 Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES),
34e49164 245 " causes not even local include files to be used";
faf9a90c
C
246 "-local_includes",
247 Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES),
248 " causes local include files to be used";
249 "-include_headers", Arg.Set include_headers,
250 " process header files independently";
b1b2de81
C
251 "-I", Arg.String (function x -> FC.include_path := Some x),
252 " <dir> containing the header files (optional)";
34e49164 253
978fd7e5
C
254 "-preprocess", Arg.Set preprocess,
255 " run the C preprocessor before applying the semantic match";
256
257 "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode";
34e49164
C
258
259 "-dir", Arg.Set dir,
260 " <dir> process all files in directory recursively";
261
951c7801 262 "-use_glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse),
34e49164 263 " works with -dir, use info generated by glimpseindex";
951c7801
C
264 "-use_google", Arg.String (function s -> Flag.scanner := Flag.Google s),
265 " find relevant files using google code search";
34e49164
C
266 "-patch", Arg.String (function s -> Flag.patch := Some s),
267 (" <dir> path name with respect to which a patch should be created\n"^
268 " \"\" for a file in the current directory");
978fd7e5 269 "-kbuild_info", Arg.Set_string kbuild_info,
34e49164
C
270 " <file> improve -dir by grouping related c files";
271 "-pyoutput", Arg.Set_string Flag.pyoutput,
272 " Sets output routine: Standard values: <coccilib.output.Gtk|coccilib.output.Console>";
273
274
978fd7e5 275 "-version", Arg.Unit (fun () ->
7f004419
C
276 let withpython = if Pycocci.python_support then "with" else "without" in
277 pr2 (spf "spatch version %s %s Python support" Config.version withpython);
34e49164 278 exit 0;
978fd7e5 279 ),
34e49164
C
280 " guess what";
281
978fd7e5 282 "-date", Arg.Unit (fun () ->
7f004419 283 pr2 "version: $Date: 2010/01/04 11:16:30 $";
34e49164 284 raise (Common.UnixExit 0)
978fd7e5 285 ),
34e49164
C
286 " guess what";
287
978fd7e5 288 "-shorthelp", Arg.Unit (fun () ->
34e49164
C
289 !short_usage_func();
290 raise (Common.UnixExit 0)
978fd7e5 291 ),
34e49164 292 " see short list of options";
978fd7e5 293 "-longhelp", Arg.Unit (fun () ->
34e49164
C
294 !long_usage_func();
295 raise (Common.UnixExit 0)
978fd7e5 296 ),
34e49164 297 " see all the available options in different categories";
978fd7e5 298 "-help", Arg.Unit (fun () ->
34e49164
C
299 !long_usage_func();
300 raise (Common.UnixExit 0)
301 ),
302 " ";
978fd7e5 303 "--help", Arg.Unit (fun () ->
34e49164
C
304 !long_usage_func();
305 raise (Common.UnixExit 0)
306 ),
307 " ";
34e49164
C
308]
309
310(* the format is a list of triples:
311 * (title of section * (optional) explanation of sections * option list)
312 *)
313let other_options = [
978fd7e5 314 "aliases and obsolete options",
34e49164 315 "",
978fd7e5 316 [
708f4980
C
317 "-sp", Arg.Set_string cocci_file, " short option of -sp_file";
318 "-iso", Arg.Set_string Config.std_iso, " short option of -iso_file";
319
978fd7e5 320 "-cocci_file", Arg.Set_string cocci_file,
34e49164 321 " <file> the semantic patch file";
978fd7e5 322(* "-c", Arg.Set_string cocci_file, " short option of -sp_file"; *)
34e49164
C
323 ];
324
978fd7e5 325 "most useful show options",
34e49164
C
326 "",
327 [
faf9a90c
C
328 "-show_diff" , Arg.Set FC.show_diff, " ";
329 "-no_show_diff" , Arg.Clear FC.show_diff, " ";
330 "-show_flow" , Arg.Set FC.show_flow, " ";
331 (* works in conjunction with -show_ctl_text *)
978fd7e5 332 "-ctl_inline_let",
faf9a90c
C
333 Arg.Unit
334 (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " ";
335 "-ctl_show_mcodekind",
336 Arg.Unit
337 (function _ -> FC.show_ctl_text := true; FC.show_mcodekind_in_ctl := true),
338 " ";
339 "-show_bindings", Arg.Set FC.show_binding_in_out, " ";
340 "-show_transinfo", Arg.Set Flag.show_transinfo, " ";
341 "-show_misc", Arg.Set Flag.show_misc, " ";
34e49164
C
342 "-show_trying", Arg.Set Flag.show_trying,
343 " show the name of each function being processed";
1be43e12 344 "-show_dependencies",
faf9a90c
C
345 Arg.Unit (function _ -> FC.show_dependencies := true;
346 FC.show_binding_in_out := true),
1be43e12 347 " show the dependencies related to each rule";
34e49164
C
348 ];
349
978fd7e5 350 "verbose subsystems options",
34e49164
C
351 "",
352 [
faf9a90c
C
353 "-verbose_ctl_engine",
354 Arg.Unit (function _ ->
355 Flag_ctl.verbose_ctl_engine := true; FC.show_ctl_text := true) , " ";
485bce71
C
356 "-verbose_match", Arg.Set Flag_ctl.verbose_match, " ";
357 "-verbose_engine", Arg.Set Flag_matcher.debug_engine, " ";
358 "-graphical_trace", Arg.Set Flag_ctl.graphical_trace, " generate a pdf file representing the matching process";
faf9a90c
C
359 "-gt_without_label",
360 Arg.Unit (function _ ->
361 Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true),
362 " remove graph label (requires option -graphical_trace)";
34e49164 363
faf9a90c
C
364 "-parse_error_msg", Arg.Set Flag_parsing_c.verbose_parsing, " ";
365 "-type_error_msg", Arg.Set Flag_parsing_c.verbose_type, " ";
34e49164
C
366 (* could also use Flag_parsing_c.options_verbose *)
367 ];
368
369 "other show options",
370 "",
371 [
faf9a90c
C
372 "-show_c" , Arg.Set FC.show_c, " ";
373 "-show_cocci" , Arg.Set FC.show_cocci, " ";
374 "-show_before_fixed_flow" , Arg.Set FC.show_before_fixed_flow, " ";
375 "-show_ctl_tex" , Arg.Set FC.show_ctl_tex, " ";
376 "-show_ctl_text" , Arg.Set FC.show_ctl_text, " ";
377 "-show_SP" , Arg.Set Flag_parsing_cocci.show_SP, " ";
34e49164
C
378 ];
379
380
381 "debug C parsing/unparsing",
382 "",
383 [
384 "-debug_cpp", Arg.Set Flag_parsing_c.debug_cpp, " ";
385 "-debug_lexer", Arg.Set Flag_parsing_c.debug_lexer , " ";
386 "-debug_etdt", Arg.Set Flag_parsing_c.debug_etdt , " ";
387 "-debug_typedef", Arg.Set Flag_parsing_c.debug_typedef, " ";
388
978fd7e5 389 "-filter_msg", Arg.Set Flag_parsing_c.filter_msg ,
34e49164 390 " filter some cpp message when the macro is a \"known\" cpp construct";
978fd7e5
C
391 "-filter_define_error", Arg.Set Flag_parsing_c.filter_define_error," ";
392 "-filter_msg_define_error", Arg.Set Flag_parsing_c.filter_msg_define_error,
708f4980 393 " filter the error msg";
978fd7e5 394 "-filter_passed_level", Arg.Set_int Flag_parsing_c.filter_passed_level," ";
faf9a90c
C
395(* debug cfg doesn't seem to have any effect, so drop it as an option *)
396(* "-debug_cfg", Arg.Set Flag_parsing_c.debug_cfg , " "; *)
978fd7e5 397 "-debug_unparsing", Arg.Set Flag_parsing_c.debug_unparsing, " ";
34e49164
C
398
399 ];
400 (* could use Flag_parsing_c.options_debug_with_title instead *)
401
402
403 "shortcut for enabling/disabling a set of debugging options at once",
404 "",
405 [
406 (* todo: other profile ? *)
faf9a90c
C
407 "-quiet", Arg.Unit (fun () -> run_profile quiet_profile), " ";
408 "-debug", Arg.Unit (fun () -> run_profile debug_profile), " ";
409 "-pad", Arg.Unit (fun () -> run_profile pad_profile), " ";
34e49164
C
410
411 ];
412
413 "bench options",
414 "",
415 [
978fd7e5 416 "-profile", Arg.Unit (function () -> Common.profile := Common.PALL) ,
34e49164 417 " gather timing information about the main coccinelle functions";
978fd7e5 418 "-bench", Arg.Int (function x -> Flag_ctl.bench := x),
34e49164 419 " <level> for profiling the CTL engine";
978fd7e5 420 "-timeout", Arg.Int (fun x -> FC.timeout := Some x),
34e49164 421 " <sec> timeout in seconds";
978fd7e5 422 "-steps", Arg.Int (fun x -> Flag_ctl.steps := Some x),
34e49164 423 " max number of model checking steps per code unit";
b1b2de81
C
424 "-iso_limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x),
425 " max depth of iso application";
426 "-no_iso_limit", Arg.Unit (fun _ -> Flag_parsing_cocci.iso_limit := None),
427 " disable limit on max depth of iso application";
34e49164
C
428 "-track_iso", Arg.Set Flag.track_iso_usage,
429 " gather information about isomorphism usage";
430 "-profile_iso",
431 Arg.Unit
432 (function () ->
b1b2de81
C
433 Common.profile :=
434 (*post_engine not included, because it doesn't use isos*)
435 PSOME ["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
34e49164
C
436 " gather information about the cost of isomorphism usage"
437 ];
438
439
440
441 "change of algorithm options",
951c7801
C
442 "",
443 [
978fd7e5 444 "-popl", Arg.Set FC.popl,
34e49164
C
445 " simplified SmPL, for the popl paper";
446
447 "-popl_mark_all",
448 Arg.Unit
978fd7e5 449 (function _ -> FC.popl := true; Flag_popl.mark_all := true),
34e49164
C
450 " simplified SmPL, for the popl paper";
451
452 "-popl_keep_all_wits",
453 Arg.Unit
978fd7e5 454 (function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
34e49164
C
455 " simplified SmPL, for the popl paper";
456
faf9a90c
C
457 "-hrule", Arg.String
458 (function s ->
459 Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
34e49164
C
460 " semantic patch generation";
461
7f004419
C
462 "-keep_comments", Arg.Set Flag_parsing_c.keep_comments,
463 " keep comments around removed code";
464
34e49164 465 "-loop", Arg.Set Flag_ctl.loop_in_src_code, " ";
978fd7e5
C
466 "-no_loops", Arg.Set Flag_parsing_c.no_loops,
467 " drop all back edges derived from looping constructs - unsafe";
951c7801
C
468 "-no_gotos", Arg.Set Flag_parsing_c.no_gotos,
469 " drop all jumps derived from gotos - unsafe";
34e49164
C
470
471 "-l1", Arg.Clear Flag_parsing_c.label_strategy_2, " ";
978fd7e5 472 "-ifdef_to_if", Arg.Set FC.ifdef_to_if,
485bce71 473 " convert ifdef to if (experimental)";
978fd7e5 474 "-no_ifdef_to_if", Arg.Clear FC.ifdef_to_if,
708f4980
C
475 " convert ifdef to if (experimental)";
476
477 "-disable_multi_pass", Arg.Set Flag_parsing_c.disable_multi_pass, " ";
485bce71 478
978fd7e5 479 "-noif0_passing", Arg.Clear Flag_parsing_c.if0_passing,
34e49164 480 " ";
978fd7e5 481 "-noadd_typedef_root", Arg.Clear Flag_parsing_c.add_typedef_root, " ";
34e49164
C
482 (* could use Flag_parsing_c.options_algo instead *)
483
484
485bce71 485 "-disallow_nested_exps", Arg.Set Flag_matcher.disallow_nested_exps,
7f004419 486 " disallow an expresion pattern from matching a term and its subterm";
faf9a90c 487 "-disable_worth_trying_opt", Arg.Clear FC.worth_trying_opt,
34e49164
C
488 " ";
489 "-only_return_is_error_exit",
485bce71 490 Arg.Set Flag_matcher.only_return_is_error_exit,
34e49164
C
491 "if this flag is not set, then break and continue are also error exits";
492 (* the following is a hack to make it easier to add code in sgrep-like
493 code, essentially to compensate for the fact that we don't have
494 any way of printing things out *)
495 "-allow_inconsistent_paths",
485bce71 496 Arg.Set Flag_matcher.allow_inconsistent_paths,
708f4980 497 " if this flag is set don't check for inconsistent paths; dangerous";
978fd7e5
C
498 "-no_safe_expressions",
499 Arg.Set Flag_matcher.no_safe_expressions,
500 " make an expression disjunction not prioritise the topmost disjunct";
708f4980
C
501 "-int_bits", Arg.Int Flag_parsing_c.set_int_bits,
502 " the number of bits in an unsigned int";
503 "-long_bits", Arg.Int Flag_parsing_c.set_long_bits,
504 " the number of bits in an unsigned long";
505 "-linux_spacing", Arg.Unit Flag_parsing_c.set_linux_spacing,
506 " spacing of + code follows the conventions of Linux";
507 "-smpl_spacing", Arg.Unit Flag_parsing_c.set_smpl_spacing,
508 " spacing of + code follows the semantic patch";
951c7801
C
509 "-D", Arg.String Flag_parsing_cocci.set_defined_virtual_rules,
510 " indicate that a virtual rule should be considered to be matched";
34e49164
C
511 ];
512
513 "misc options",
514 "",
515 [
978fd7e5 516 "-debugger", Arg.Set Common.debugger,
34e49164 517 " option to set if launch spatch in ocamldebug";
978fd7e5 518 "-disable_once", Arg.Set Common.disable_pr2_once,
34e49164 519 " to print more messages";
978fd7e5 520 "-show_trace_profile", Arg.Set Common.show_trace_profile,
708f4980 521 " show trace";
978fd7e5 522 "-save_tmp_files", Arg.Set Common.save_tmp_files, " ";
34e49164
C
523 ];
524
525 "concurrency",
526 "",
527 [
978fd7e5 528 "-index", Arg.Int (function x -> distrib_index := Some x) ,
34e49164 529 " the processor to use for this run of spatch";
978fd7e5 530 "-max", Arg.Int (function x -> distrib_max := Some x) ,
34e49164
C
531 " the number of processors available";
532 "-mod_distrib", Arg.Set mod_distrib,
533 " use mod to distribute files among the processors";
534 ];
535
536 "pad options",
537 "",
538 [
978fd7e5 539 "-use_cache", Arg.Set Flag_parsing_c.use_cache,
34e49164
C
540 " use .ast_raw pre-parsed cached C file";
541 (* could use Flag_parsing_c.options_pad instead *)
542 ];
543
544
545
546 "test mode and test options (works with tests/ or .ok files)",
547 "The test options don't work with the -sp_file and so on.",
548 [
978fd7e5 549 "-test", Arg.Set test_mode,
34e49164 550 " <file> launch spatch on tests/file.[c,cocci]";
978fd7e5 551 "-testall", Arg.Set test_all,
34e49164
C
552 " launch spatch on all files in tests/ having a .res";
553 "-test_okfailed", Arg.Set test_okfailed,
554 " generates .{ok,failed,spatch_ok} files using .res files";
555 "-test_regression_okfailed", Arg.Set test_regression_okfailed,
556 " process the .{ok,failed,spatch_ok} files in current dir";
557
978fd7e5
C
558 "-compare_with_expected", Arg.Set compare_with_expected,
559 " use also file.res";
560 "-expected_score_file", Arg.Set_string expected_score_file,
561 " which score file to compare with in -testall";
faf9a90c 562 "-relax_include_path", Arg.Set FC.relax_include_path,
34e49164 563 " ";
34e49164
C
564 ];
565
566 "action mode",
567 ("The action options don't work with the -sp_file and so on." ^ "\n" ^
568 "It's for the other (internal) uses of the spatch program."
569 ),
570
571 (* -token_c, -parse_c, etc *)
572 ((Common.options_of_actions action (Test_parsing_c.actions())) ++
573 [
574 (let s = "-parse_cocci" in s, Arg.Unit (fun () -> action := s),
575 " <file>");
576 (let s = "-compare_c" in s, Arg.Unit (fun () -> action := s),
577 " <file1> <file2>");
578 ]);
579]
580
581
978fd7e5 582let all_options =
34e49164 583 short_options ++ List.concat (List.map Common.thd3 other_options)
978fd7e5 584
34e49164
C
585(* I don't want the -help and --help that are appended by Arg.align *)
586let arg_align2 xs =
587 Arg.align xs +> List.rev +> Common.drop 2 +> List.rev
588
589(* copy paste of Arg.parse. Don't want the default -help msg *)
590let arg_parse2 l f msg =
591 (try
592 Arg.parse_argv Sys.argv l f msg;
593 with
594 | Arg.Bad msg -> (* eprintf "%s" msg; exit 2; *)
595 let xs = Common.lines msg in
596 (* take only head, it's where the error msg is *)
597 pr2 (List.hd xs);
598 !short_usage_func();
599 raise (Common.UnixExit (2))
600 | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
601 raise Impossible (* -help is specified in speclist *)
602 )
603
604
605let short_usage () =
606 begin
978fd7e5 607 Common.short_usage usage_msg short_options;
34e49164
C
608 pr2 "";
609 pr2 "Example of use:";
610 pr2 " ./spatch -sp_file foo.cocci foo.c -o /tmp/newfoo.c";
611 pr2 "";
612 end
613
614
978fd7e5 615let long_usage () =
34e49164
C
616 Common.long_usage usage_msg short_options other_options
617
618let _ = short_usage_func := short_usage
619let _ = long_usage_func := long_usage
620
621(*****************************************************************************)
622(* Helpers *)
623(*****************************************************************************)
624
625let adjust_stdin cfile k =
626 if !dir
627 then k()
628 else
978fd7e5 629 let newin =
485bce71
C
630 try
631 let (dir, base, ext) = Common.dbe_of_filename cfile in
632 let varfile = Common.filename_of_dbe (dir, base, "var") in
b1b2de81 633 if ext =$= "c" && Common.lfile_exists varfile
485bce71 634 then Some varfile
978fd7e5 635 else None
485bce71
C
636 with Invalid_argument("Filename.chop_extension") -> None
637 in
34e49164
C
638 Common.redirect_stdin_opt newin k
639
978fd7e5 640let glimpse_filter (coccifile, isofile) dir =
faf9a90c 641 let (_metavars,astcocci,_free_var_lists,_negated_positions,
7f004419 642 _used_after_lists,_positions_lists,_,query) =
34e49164
C
643 Cocci.sp_of_file coccifile (Some isofile) in
644 match query with
faf9a90c 645 None -> pr2 "no glimpse keyword inferred from snippet"; None
951c7801
C
646 | Some [query] ->
647 (let suffixes = if !include_headers then ["c";"h"] else ["c"] in
34e49164
C
648 pr2 ("glimpse request = " ^ query);
649 let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in
650 let (glimpse_res,stat) = Common.cmd_to_list_and_status command in
651 match stat with
652 Unix.WEXITED(0) | Unix.WEXITED(1) ->
653 Some
654 (glimpse_res +>
655 List.filter
656 (fun file -> List.mem (Common.filesuffix file) suffixes))
951c7801
C
657 | _ -> None (* error, eg due to pattern too big *))
658 | _ -> failwith "not possible"
34e49164 659
34e49164 660(*****************************************************************************)
b1b2de81 661(* Main action *)
34e49164 662(*****************************************************************************)
34e49164 663
978fd7e5 664let main_action xs =
b1b2de81
C
665 match xs with
666 | x::xs ->
708f4980 667
978fd7e5
C
668 (* a more general solution would be to use
669 * Common.files_of_dir_or_files (x::xs)
708f4980
C
670 * as some elements in xs may also be directories, or individual
671 * files.
672 *)
673 if Common.is_directory x
674 then dir := true;
675
676 adjust_stdin x (fun () ->
677 if !cocci_file =$= ""
678 then failwith "I need a cocci file, use -sp_file <file>";
679
680 if !dir && !Flag.patch =*= None
681 then
682 (match xs with
683 | [] -> Flag.patch := Some x
684 | _ ->
685 pr2
686 ("warning: patch output can only be created when only one\n"^
687 "directory is specified or when the -patch flag is used")
688 );
689
978fd7e5
C
690 let infiles =
691 Common.profile_code "Main.infiles computation" (fun () ->
951c7801 692 match !dir, !kbuild_info, !Flag.scanner = Flag.Glimpse with
708f4980 693 (* glimpse *)
978fd7e5 694 | false, _, true ->
708f4980 695 failwith "-use_glimpse works only with -dir"
978fd7e5 696 | true, s, true when s <> "" ->
708f4980 697 failwith "-use_glimpse does not work with -kbuild"
978fd7e5 698 | true, "", true ->
708f4980
C
699 if not (null xs)
700 then failwith "-use_glimpse can accept only one dir";
701
702 Flag.dir := x;
703 let files =
704 match glimpse_filter (!cocci_file, !Config.std_iso) x with
705 None ->
706 Common.cmd_to_list (* same as "true, "", _" case *)
707 (if !include_headers
708 (* FIXME : Could we remove xs ?
709 -use_glimpse requires a singleton.
710 This is checked some lines before.
711 then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
712 else ("find "^(join " " (x::xs))^" -name \"*.c\""))
713 *)
714 then ("find "^ x ^" -name \"*.[ch]\"")
715 else ("find "^ x ^" -name \"*.c\""))
716 | Some files -> files in
717 files +> List.map (fun x -> [x])
718 (* normal *)
719 | false, _, _ -> [x::xs]
978fd7e5 720 | true, "", _ ->
708f4980
C
721 Common.cmd_to_list
722 (if !include_headers
723 then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
34e49164 724 else ("find "^(join " " (x::xs))^" -name \"*.c\""))
708f4980
C
725 +> List.map (fun x -> [x])
726
727 (* kbuild *)
978fd7e5
C
728 | true, kbuild_info_file,_ ->
729 let dirs =
730 Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d")
708f4980
C
731 in
732 let info = Kbuild.parse_kbuild_info kbuild_info_file in
733 let groups = Kbuild.files_in_dirs dirs info in
978fd7e5 734
708f4980
C
735 groups +> List.map (function Kbuild.Group xs -> xs)
736 )
737 in
738
739 let infiles =
740 match (!distrib_index,!distrib_max) with
741 (None,None) -> infiles
742 | (Some index,Some max) ->
743 (if index >= max
744 then
745 failwith "index starts at 0, and so must be less than max");
746 if !mod_distrib
747 then
748 let rec loop ct = function
749 [] -> []
750 | x::xs ->
751 if (ct mod max) =|= index
752 then x::(loop (ct+1) xs)
753 else loop (ct+1) xs in
754 loop 0 infiles
755 else
756 begin
757 let all_files = List.length infiles in
758 let regions = (all_files + (max - 1)) / max in
759 let this_min = index * regions in
760 let this_max = (index+1) * regions in
34e49164 761 let rec loop ct = function
708f4980 762 [] -> []
34e49164 763 | x::xs ->
708f4980 764 if this_min <= ct && ct < this_max
34e49164
C
765 then x::(loop (ct+1) xs)
766 else loop (ct+1) xs in
767 loop 0 infiles
708f4980
C
768 end
769 | _ -> failwith "inconsistent distribution information" in
978fd7e5
C
770
771 let outfiles =
708f4980
C
772 Common.profile_code "Main.outfiles computation" (fun () ->
773 let cocci_infos =
774 Cocci.pre_engine (!cocci_file, !Config.std_iso) in
775 let res =
978fd7e5 776 infiles +> List.map (fun cfiles ->
708f4980 777 pr2 ("HANDLING: " ^ (join " " cfiles));
978fd7e5
C
778 Common.timeout_function_opt !FC.timeout (fun () ->
779 Common.report_if_take_time 10 (join " " cfiles) (fun () ->
fc1ad971 780 (*let s = profile_diagnostic() in*)
34e49164 781 (* Unix.sleep 1; *)
978fd7e5
C
782 try
783 let optfile =
784 if !output_file <> "" && !compat_mode then
785 Some !output_file
786 else
787 None
788 in
789 Common.redirect_stdout_opt optfile (fun () ->
790 (* this is the main call *)
791 Cocci.full_engine cocci_infos cfiles
792 )
793 with
794 | Common.UnixExit x -> raise (Common.UnixExit x)
795 | e ->
fc1ad971
C
796 (*pr2 "previous";
797 pr2 s;
798 pr2 "new";
799 pr2(profile_diagnostic());*)
978fd7e5
C
800 if !dir
801 then begin
802 pr2 ("EXN:" ^ Printexc.to_string e);
803 [] (* *)
804 end
805 else raise e))) in
806 Cocci.post_engine cocci_infos;
807 res
808 ) +> List.concat
708f4980
C
809 in
810
978fd7e5 811 Common.profile_code "Main.result analysis" (fun () ->
708f4980 812 Ctlcocci_integration.print_bench();
708f4980 813 let outfiles = Cocci.check_duplicate_modif outfiles in
978fd7e5
C
814 outfiles +> List.iter (fun (infile, outopt) ->
815 outopt +> Common.do_option (fun outfile ->
708f4980
C
816 if !inplace_modif
817 then begin
818 Common.command2 ("cp "^infile^" "^infile^".cocci_orig");
819 Common.command2 ("cp "^outfile^" "^infile);
820 end;
821
822 if !outplace_modif
823 then Common.command2 ("cp "^outfile^" "^infile^".cocci_res");
978fd7e5
C
824
825 (* potential source of security pb if the /tmp/ file is
826 * a symlink, so simpler to not produce any regular file
827 * (files created by Common.new_temp_file are still ok)
828 * anymore in /tmp.
829 *)
830 (*
831 if !output_file =$= ""
832 then begin
833 let tmpfile = "/tmp/"^Common.basename infile in
834 pr2 (spf "One file modified. Result is here: %s" tmpfile);
835 Common.command2 ("cp "^outfile^" "^tmpfile);
836 end
837 *)
708f4980 838 ));
978fd7e5
C
839 if !output_file <> "" && not !compat_mode then
840 (match outfiles with
841 | [infile, Some outfile] when infile =$= x && null xs ->
708f4980 842 Common.command2 ("cp " ^outfile^ " " ^ !output_file);
978fd7e5 843 | [infile, None] when infile =$= x && null xs ->
708f4980 844 Common.command2 ("cp " ^infile^ " " ^ !output_file);
978fd7e5
C
845 | _ ->
846 failwith
708f4980
C
847 ("-o can not be applied because there is multiple " ^
848 "modified files");
849 );
708f4980
C
850 if !compare_with_expected
851 then Testing.compare_with_expected outfiles))
b1b2de81
C
852
853 | [] -> raise Impossible
854
855
856(*****************************************************************************)
857(* The coccinelle main entry point *)
858(*****************************************************************************)
978fd7e5 859let main () =
b1b2de81
C
860 begin
861 let arglist = Array.to_list Sys.argv in
862
863 if not (null (Common.inter_set arglist
002099fc 864 ["-cocci_file";"-sp_file";"-sp";"-test";"-testall";
b1b2de81
C
865 "-test_okfailed";"-test_regression_okfailed"]))
866 then run_profile quiet_profile;
867
868 let args = ref [] in
869
708f4980
C
870 (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*)
871
b1b2de81
C
872 (* this call can set up many global flag variables via the cmd line *)
873 arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg;
874
708f4980
C
875 (* julia hack so that one can override directories specified on
876 * the command line. *)
b1b2de81
C
877 (if !dir
878 then
879 let chosen_dir =
880 if List.length !args > 1
881 then
882 begin
883 let chosen = List.hd !args in
884 pr2 ("ignoring all but the last specified directory: "^chosen);
885 args := [chosen];
886 chosen
887 end
888 else List.hd !args in
889 if !FC.include_path =*= None
890 then FC.include_path := Some (Filename.concat chosen_dir "include"));
708f4980 891
b1b2de81
C
892 args := List.rev !args;
893
894 if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$"))
895 then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci";
896
978fd7e5 897 if !Config.std_iso <> ""
b1b2de81 898 then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso";
978fd7e5 899 if !Config.std_h <> ""
b1b2de81
C
900 then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h";
901
978fd7e5 902 if !Config.std_h <> ""
708f4980
C
903 then Parse_c.init_defs_builtins !Config.std_h;
904
978fd7e5 905 if !macro_file <> ""
708f4980 906 then Parse_c.init_defs_macros !macro_file;
b1b2de81
C
907
908
909 (* must be done after Arg.parse, because Common.profile is set by it *)
978fd7e5 910 Common.profile_code "Main total" (fun () ->
b1b2de81
C
911
912
913 let all_actions = Test_parsing_c.actions() in
914
915 (match (!args) with
916
917 (* --------------------------------------------------------- *)
918 (* The test framework. Works with tests/ or .ok and .failed *)
919 (* --------------------------------------------------------- *)
978fd7e5 920 | [x] when !test_mode ->
b1b2de81
C
921 FC.include_path := Some "tests/include";
922 Testing.testone x !compare_with_expected
923
978fd7e5 924 | [] when !test_all ->
b1b2de81 925 FC.include_path := Some "tests/include";
708f4980
C
926 if !expected_score_file <> ""
927 then Testing.testall ~expected_score_file:!expected_score_file ()
928 else Testing.testall ()
b1b2de81 929
978fd7e5 930 | [] when !test_regression_okfailed ->
b1b2de81
C
931 Testing.test_regression_okfailed ()
932
978fd7e5 933 | x::xs when !test_okfailed ->
b1b2de81
C
934 (* do its own timeout on FC.timeout internally *)
935 FC.relax_include_path := true;
978fd7e5 936 adjust_stdin x (fun () ->
b1b2de81
C
937 Testing.test_okfailed !cocci_file (x::xs)
938 )
939
940 (* --------------------------------------------------------- *)
941 (* Actions, useful to debug subpart of coccinelle *)
942 (* --------------------------------------------------------- *)
943
944 | xs when List.mem !action (Common.action_list all_actions) ->
945 Common.do_action !action xs all_actions
946
978fd7e5 947 | [file] when !action =$= "-parse_cocci" ->
b1b2de81
C
948 Testing.test_parse_cocci file
949
950 (* I think this is used by some scripts in some Makefile for our
951 * big-tests. So dont remove.
952 *)
978fd7e5 953 | [file1;file2] when !action =$= "-compare_c" ->
b1b2de81
C
954 Test_parsing_c.test_compare_c file1 file2 (* result = unix code *)
955
956 (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
957
958
959 (* --------------------------------------------------------- *)
960 (* This is the main entry *)
961 (* --------------------------------------------------------- *)
fc1ad971 962 | x::xs -> main_action (x::xs)
b1b2de81 963
34e49164
C
964 (* --------------------------------------------------------- *)
965 (* empty entry *)
966 (* --------------------------------------------------------- *)
967 | [] -> short_usage()
34e49164
C
968 ));
969 if !Pycocci.initialised && (Pycocci.py_isinitialized ()) != 0 then begin
970 ignore(Pycocci.pyrun_simplestring "cocci.finalise()");
978fd7e5 971 if !Flag.show_misc
34e49164
C
972 then Common.pr2 "Finalizing python\n";
973 Pycocci.py_finalize ();
974 end
975 end
976
708f4980 977
978fd7e5
C
978let main_with_better_error_report () =
979 if !Common.debugger then main ()
980 else
981 try
982 main ()
708f4980 983 with
978fd7e5 984 | Unix.Unix_error (_, "stat", filename) ->
708f4980
C
985 pr2 (spf "ERROR: File %s does not exist" filename);
986 raise (UnixExit (-1))
708f4980 987
34e49164 988(*****************************************************************************)
708f4980 989let start =
978fd7e5 990 Common.main_boilerplate (fun () ->
708f4980 991 main_with_better_error_report ();
34e49164
C
992 Ctlcocci_integration.print_bench();
993 )