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