.#main.ml.1.242

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