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