main.ml

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