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.
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.
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.
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/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
24 module FC
= Flag_cocci
26 (*****************************************************************************)
28 (*****************************************************************************)
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 *)
35 let cocci_file = ref ""
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 *)
41 (* could be avoided by using Common.files_of_dir_or_files instead *)
44 let include_headers = ref false
45 let kbuild_info = ref ""
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
57 (* works with -test but also in "normal" spatch mode *)
58 let compare_with_expected = ref false
61 let distrib_index = ref (None
: int option)
62 let distrib_max = ref (None
: int option)
63 let mod_distrib = ref false
66 (*****************************************************************************)
68 (*****************************************************************************)
70 (* pair of (list of flags to set true, list of flags to set false *)
75 (* FC.show_diff; just leave this as it is *)
84 FC.show_before_fixed_flow
;
87 FC.show_binding_in_out
;
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
;
99 (* some information that is useful in seeing why a semantic patch doesn't
101 let debug_profile = (
106 FC.show_binding_in_out
;
107 FC.show_dependencies
;
109 Flag_parsing_cocci.show_iso_failures
;
117 FC.show_before_fixed_flow
;
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
;
142 FC.show_before_fixed_flow
;
145 FC.show_binding_in_out
;
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
;
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
162 (*****************************************************************************)
163 (* The spatch options *)
164 (*****************************************************************************)
167 "Usage: " ^ basename
Sys.argv
.(0) ^
168 " -sp_file <SP> <infile> [-o <outfile>] [-iso_file <iso>] [options]" ^
169 "\n" ^
"Options are:"
171 (* forward reference trick *)
172 let short_usage_func = ref (fun () -> ())
173 let long_usage_func = ref (fun () -> ())
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.
182 (* will be printed when use only ./spatch. For the rest you have to
183 * use -longhelp to see them.
185 let short_options = [
186 "-sp_file", Arg.Set_string
cocci_file,
187 " <file> the semantic patch file";
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";
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";
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 ^
")";
207 Arg.Unit
(function _
-> FC.include_options
:= FC.I_ALL_INCLUDES
),
208 " causes all available include files to be used";
210 Arg.Unit
(function _
-> FC.include_options
:= FC.I_NO_INCLUDES
),
211 " causes not even local include files to be used";
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.String
(function x
-> FC.include_path
:= Some x
),
218 " <dir> containing the header files (optional)";
222 " <dir> process all files in directory recursively";
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>";
235 "-version", Arg.Unit
(fun () ->
236 pr2
(spf
"spatch version: %s" Config.version
);
241 "-date", Arg.Unit
(fun () ->
242 pr2
"version: $Date: 2009/04/15 18:01:55 $";
243 raise
(Common.UnixExit
0)
247 "-shorthelp", Arg.Unit
(fun () ->
249 raise
(Common.UnixExit
0)
251 " see short list of options";
252 "-longhelp", Arg.Unit
(fun () ->
254 raise
(Common.UnixExit
0)
256 " see all the available options in different categories";
257 "-help", Arg.Unit
(fun () ->
259 raise
(Common.UnixExit
0)
262 "--help", Arg.Unit
(fun () ->
264 raise
(Common.UnixExit
0)
270 (* the format is a list of triples:
271 * (title of section * (optional) explanation of sections * option list)
273 let other_options = [
274 "aliases and obsolete options",
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";
284 "most useful show options",
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 *)
293 (function _
-> FC.show_ctl_text
:= true; FC.inline_let_ctl
:= true), " ";
294 "-ctl_show_mcodekind",
296 (function _
-> FC.show_ctl_text
:= true; FC.show_mcodekind_in_ctl
:= true),
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";
309 "verbose subsystems options",
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";
319 Arg.Unit
(function _
->
320 Flag_ctl.graphical_trace
:= true; Flag_ctl.gt_without_label
:= true),
321 " remove graph label (requires option -graphical_trace)";
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 *)
328 "other show options",
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
, " ";
340 "debug C parsing/unparsing",
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
, " ";
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
, " ";
357 (* could use Flag_parsing_c.options_debug_with_title instead *)
360 "shortcut for enabling/disabling a set of debugging options at once",
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), " ";
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 "-iso_limit", Arg.Int
(fun x
-> Flag_parsing_cocci.iso_limit
:= Some x
),
382 " max depth of iso application";
383 "-no_iso_limit", Arg.Unit
(fun _
-> Flag_parsing_cocci.iso_limit
:= None
),
384 " disable limit on max depth of iso application";
385 "-track_iso", Arg.Set
Flag.track_iso_usage
,
386 " gather information about isomorphism usage";
391 (*post_engine not included, because it doesn't use isos*)
392 PSOME
["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
393 " gather information about the cost of isomorphism usage"
398 "change of algorithm options",
401 (* no popl in official version
402 "-popl", Arg.Set FC.popl,
403 " simplified SmPL, for the popl paper";
407 (function _ -> FC.popl := true; Flag_popl.mark_all := true),
408 " simplified SmPL, for the popl paper";
410 "-popl_keep_all_wits",
412 (function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
413 " simplified SmPL, for the popl paper";
418 Flag.make_hrule
:= Some s
; FC.include_options
:= FC.I_NO_INCLUDES
),
419 " semantic patch generation";
421 "-loop", Arg.Set
Flag_ctl.loop_in_src_code
, " ";
423 "-l1", Arg.Clear
Flag_parsing_c.label_strategy_2
, " ";
424 "-ifdef_to_if", Arg.Set
FC.ifdef_to_if
,
425 " convert ifdef to if (experimental)";
427 "-noif0_passing", Arg.Clear
Flag_parsing_c.if0_passing
,
429 "-noadd_typedef_root", Arg.Clear
Flag_parsing_c.add_typedef_root
, " ";
430 (* could use Flag_parsing_c.options_algo instead *)
433 "-disallow_nested_exps", Arg.Set
Flag_matcher.disallow_nested_exps
,
434 "disallow an expresion pattern from matching a term and its subterm";
435 "-disable_worth_trying_opt", Arg.Clear
FC.worth_trying_opt
,
437 "-only_return_is_error_exit",
438 Arg.Set
Flag_matcher.only_return_is_error_exit
,
439 "if this flag is not set, then break and continue are also error exits";
440 (* the following is a hack to make it easier to add code in sgrep-like
441 code, essentially to compensate for the fact that we don't have
442 any way of printing things out *)
443 "-allow_inconsistent_paths",
444 Arg.Set
Flag_matcher.allow_inconsistent_paths
,
445 "if this flag is set don't check for inconsistent paths; dangerous";
451 "-debugger", Arg.Set
Common.debugger
,
452 " option to set if launch spatch in ocamldebug";
453 "-disable_once", Arg.Set
Common.disable_pr2_once
,
454 " to print more messages";
455 "-save_tmp_files", Arg.Set
Common.save_tmp_files
, " ";
461 "-index", Arg.Int
(function x
-> distrib_index := Some x
) ,
462 " the processor to use for this run of spatch";
463 "-max", Arg.Int
(function x
-> distrib_max := Some x
) ,
464 " the number of processors available";
465 "-mod_distrib", Arg.Set
mod_distrib,
466 " use mod to distribute files among the processors";
472 "-use_cache", Arg.Set
Flag_parsing_c.use_cache
,
473 " use .ast_raw pre-parsed cached C file";
474 (* could use Flag_parsing_c.options_pad instead *)
479 "test mode and test options (works with tests/ or .ok files)",
480 "The test options don't work with the -sp_file and so on.",
482 "-test", Arg.Set
test_mode,
483 " <file> launch spatch on tests/file.[c,cocci]";
484 "-testall", Arg.Set
test_all,
485 " launch spatch on all files in tests/ having a .res";
486 "-test_okfailed", Arg.Set
test_okfailed,
487 " generates .{ok,failed,spatch_ok} files using .res files";
488 "-test_regression_okfailed", Arg.Set
test_regression_okfailed,
489 " process the .{ok,failed,spatch_ok} files in current dir";
491 "-compare_with_expected", Arg.Set
compare_with_expected,
492 " use also file.res";
493 "-relax_include_path", Arg.Set
FC.relax_include_path
,
499 ("The action options don't work with the -sp_file and so on." ^
"\n" ^
500 "It's for the other (internal) uses of the spatch program."
503 (* -token_c, -parse_c, etc *)
504 ((Common.options_of_actions
action (Test_parsing_c.actions
())) ++
506 (let s = "-parse_cocci" in s, Arg.Unit
(fun () -> action := s),
508 (let s = "-compare_c" in s, Arg.Unit
(fun () -> action := s),
515 short_options ++ List.concat
(List.map
Common.thd3
other_options)
519 (* I don't want the -help and --help that are appended by Arg.align *)
521 Arg.align xs
+> List.rev
+> Common.drop
2 +> List.rev
523 (* copy paste of Arg.parse. Don't want the default -help msg *)
524 let arg_parse2 l f msg
=
526 Arg.parse_argv
Sys.argv l f msg
;
528 | Arg.Bad msg
-> (* eprintf "%s" msg; exit 2; *)
529 let xs = Common.lines msg
in
530 (* take only head, it's where the error msg is *)
533 raise
(Common.UnixExit
(2))
534 | Arg.Help msg
-> (* printf "%s" msg; exit 0; *)
535 raise Impossible
(* -help is specified in speclist *)
541 Common.short_usage usage_msg short_options;
543 pr2
"Example of use:";
544 pr2
" ./spatch -sp_file foo.cocci foo.c -o /tmp/newfoo.c";
550 Common.long_usage usage_msg short_options other_options
552 let _ = short_usage_func := short_usage
553 let _ = long_usage_func := long_usage
555 (*****************************************************************************)
557 (*****************************************************************************)
559 let adjust_stdin cfile k
=
565 let (dir, base
, ext
) = Common.dbe_of_filename cfile
in
566 let varfile = Common.filename_of_dbe
(dir, base
, "var") in
567 if ext
=$
= "c" && Common.lfile_exists
varfile
570 with Invalid_argument
("Filename.chop_extension") -> None
572 Common.redirect_stdin_opt
newin k
574 let glimpse_filter (coccifile
, isofile
) dir =
575 let (_metavars
,astcocci
,_free_var_lists
,_negated_positions
,
576 _used_after_lists
,_positions_lists
,_,query
) =
577 Cocci.sp_of_file coccifile
(Some isofile
) in
579 None
-> pr2
"no glimpse keyword inferred from snippet"; None
581 let suffixes = if !include_headers then ["c";"h"] else ["c"] in
582 pr2
("glimpse request = " ^ query
);
583 let command = spf
"glimpse -y -H %s -N -W -w '%s'" dir query
in
584 let (glimpse_res
,stat
) = Common.cmd_to_list_and_status
command in
586 Unix.WEXITED
(0) | Unix.WEXITED
(1) ->
590 (fun file
-> List.mem
(Common.filesuffix file
) suffixes))
591 | _ -> None
(* error, eg due to pattern too big *)
595 (*****************************************************************************)
597 (*****************************************************************************)
602 adjust_stdin x
(fun () ->
603 if !cocci_file =$
= ""
604 then failwith
"I need a cocci file, use -sp_file <file>";
606 if !dir && !Flag.patch
=*= None
609 | [] -> Flag.patch
:= Some x
612 ("warning: patch output can only be created when only one\n"^
613 "directory is specified or when the -patch flag is used")
617 Common.profile_code
"Main.infiles computation" (fun () ->
618 match !dir, !kbuild_info, !Flag.use_glimpse
with
621 failwith
"-use_glimpse works only with -dir"
622 | true, s, true when s <> "" ->
623 failwith
"-use_glimpse does not work with -kbuild"
626 then failwith
"-use_glimpse can accept only one dir";
630 match glimpse_filter (!cocci_file, !Config.std_iso
) x
with
632 Common.cmd_to_list
(* same as "true, "", _" case *)
634 (* FIXME : Could we remove xs ?
635 -use_glimpse requires a singleton.
636 This is checked some lines before.
637 then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"")
638 else ("find "^(join " " (x::xs))^" -name \"*.c\""))
640 then ("find "^ x ^
" -name \"*.[ch]\"")
641 else ("find "^ x ^
" -name \"*.c\""))
642 | Some
files -> files in
643 files +> List.map
(fun x
-> [x
])
645 | false, _, _ -> [x
::xs]
649 then ("find "^
(join
" " (x
::xs))^
" -name \"*.[ch]\"")
650 else ("find "^
(join
" " (x
::xs))^
" -name \"*.c\""))
651 +> List.map
(fun x
-> [x
])
654 | true, kbuild_info_file
,_ ->
656 Common.cmd_to_list
("find "^
(join
" " (x
::xs))^
" -type d")
658 let info = Kbuild.parse_kbuild_info kbuild_info_file
in
659 let groups = Kbuild.files_in_dirs
dirs info in
661 groups +> List.map
(function Kbuild.Group
xs -> xs)
666 match (!distrib_index,!distrib_max) with
667 (None
,None
) -> infiles
668 | (Some index
,Some max
) ->
671 failwith
"index starts at 0, and so must be less than max");
674 let rec loop ct
= function
677 if (ct
mod max
) =|= index
678 then x
::(loop (ct
+1) xs)
679 else loop (ct
+1) xs in
683 let all_files = List.length
infiles in
684 let regions = (all_files + (max
- 1)) / max
in
685 let this_min = index
* regions in
686 let this_max = (index
+1) * regions in
687 let rec loop ct
= function
690 if this_min <= ct
&& ct
< this_max
691 then x
::(loop (ct
+1) xs)
692 else loop (ct
+1) xs in
695 | _ -> failwith
"inconsistent distribution information" in
698 Common.profile_code
"Main.outfiles computation" (fun () ->
700 Cocci.pre_engine
(!cocci_file, !Config.std_iso
) in
702 infiles +> List.map
(fun cfiles
->
703 pr2
("HANDLING: " ^
(join
" " cfiles
));
704 Common.timeout_function_opt
!FC.timeout
(fun () ->
705 Common.report_if_take_time
10 (join
" " cfiles
) (fun () ->
708 (* this is the main call *)
709 Cocci.full_engine
cocci_infos cfiles
711 | Common.UnixExit x
-> raise
(Common.UnixExit x
)
715 pr2
("EXN:" ^
Printexc.to_string e
);
719 Cocci.post_engine
cocci_infos;
724 Common.profile_code
"Main.result analysis" (fun () ->
726 Ctlcocci_integration.print_bench
();
728 let outfiles = Cocci.check_duplicate_modif
outfiles in
730 outfiles +> List.iter
(fun (infile
, outopt
) ->
731 outopt
+> Common.do_option
(fun outfile
->
734 Common.command2
("cp "^infile^
" "^infile^
".cocci_orig");
735 Common.command2
("cp "^outfile^
" "^infile
);
739 then Common.command2
("cp "^outfile^
" "^infile^
".cocci_res");
741 if !output_file =$
= ""
743 let tmpfile = "/tmp/"^
Common.basename infile
in
744 pr2
(spf
"One file modified. Result is here: %s" tmpfile);
745 Common.command2
("cp "^outfile^
" "^
tmpfile);
748 if !output_file <> "" then
750 | [infile
, Some outfile
] when infile
=$
= x
&& null
xs ->
751 Common.command2
("cp " ^outfile^
" " ^
!output_file);
752 | [infile
, None
] when infile
=$
= x
&& null
xs ->
753 Common.command2
("cp " ^infile^
" " ^
!output_file);
756 ("-o can not be applied because there is multiple " ^
760 if !compare_with_expected
761 then Testing.compare_with_expected outfiles))
763 | [] -> raise Impossible
766 (*****************************************************************************)
767 (* The coccinelle main entry point *)
768 (*****************************************************************************)
771 let arglist = Array.to_list
Sys.argv
in
773 if not
(null
(Common.inter_set
arglist
774 ["-cocci_file";"-sp_file";"-test";"-testall";
775 "-test_okfailed";"-test_regression_okfailed"]))
776 then run_profile quiet_profile;
780 (* this call can set up many global flag variables via the cmd line *)
781 arg_parse2 (Arg.align
all_options) (fun x
-> args := x
::!args) usage_msg;
786 if List.length
!args > 1
789 let chosen = List.hd
!args in
790 pr2
("ignoring all but the last specified directory: "^
chosen);
794 else List.hd
!args in
795 if !FC.include_path
=*= None
796 then FC.include_path
:= Some
(Filename.concat
chosen_dir "include"));
797 args := List.rev
!args;
799 if !cocci_file <> "" && (not
(!cocci_file =~
".*\\.\\(sgrep\\|spatch\\)$"))
800 then cocci_file := Common.adjust_ext_if_needed
!cocci_file ".cocci";
802 if !Config.std_iso
<> ""
803 then Config.std_iso
:= Common.adjust_ext_if_needed
!Config.std_iso
".iso";
804 if !Config.std_h
<> ""
805 then Config.std_h
:= Common.adjust_ext_if_needed
!Config.std_h
".h";
807 if !Config.std_h
<> ""
808 then Parse_c.init_defs
!Config.std_h
;
811 (* must be done after Arg.parse, because Common.profile is set by it *)
812 Common.profile_code
"Main total" (fun () ->
815 let all_actions = Test_parsing_c.actions
() in
819 (* --------------------------------------------------------- *)
820 (* The test framework. Works with tests/ or .ok and .failed *)
821 (* --------------------------------------------------------- *)
822 | [x
] when !test_mode ->
823 FC.include_path
:= Some
"tests/include";
824 Testing.testone x
!compare_with_expected
826 | [] when !test_all ->
827 FC.include_path
:= Some
"tests/include";
830 | [] when !test_regression_okfailed ->
831 Testing.test_regression_okfailed ()
833 | x
::xs when !test_okfailed ->
834 (* do its own timeout on FC.timeout internally *)
835 FC.relax_include_path
:= true;
836 adjust_stdin x
(fun () ->
837 Testing.test_okfailed !cocci_file (x
::xs)
840 (* --------------------------------------------------------- *)
841 (* Actions, useful to debug subpart of coccinelle *)
842 (* --------------------------------------------------------- *)
844 | xs when List.mem
!action (Common.action_list
all_actions) ->
845 Common.do_action
!action xs all_actions
847 | [file
] when !action =$
= "-parse_cocci" ->
848 Testing.test_parse_cocci file
850 (* I think this is used by some scripts in some Makefile for our
851 * big-tests. So dont remove.
853 | [file1
;file2
] when !action =$
= "-compare_c" ->
854 Test_parsing_c.test_compare_c file1 file2
(* result = unix code *)
856 (* could add the Test_parsing_c.test_actions such as -parse_c & co *)
859 (* --------------------------------------------------------- *)
860 (* This is the main entry *)
861 (* --------------------------------------------------------- *)
865 (* --------------------------------------------------------- *)
867 (* --------------------------------------------------------- *)
868 | [] -> short_usage()
871 if !Pycocci.initialised
&& (Pycocci.py_isinitialized
()) != 0 then begin
872 ignore
(Pycocci.pyrun_simplestring
"cocci.finalise()");
874 then Common.pr2
"Finalizing python\n";
875 Pycocci.py_finalize
();
879 (*****************************************************************************)
881 Common.main_boilerplate
(fun () ->
883 Ctlcocci_integration.print_bench
();