3 let score_path = "/home/pad/c-yacfe/tmp"
5 let tmpfile = "/tmp/output.c"
7 (*****************************************************************************)
8 (* Subsystem testing *)
9 (*****************************************************************************)
11 let test_tokens_c file
=
12 if not
(file
=~
".*\\.c")
13 then pr2
"warning: seems not a .c file";
15 Flag_parsing_c.debug_lexer
:= true;
16 Flag_parsing_c.verbose_lexing
:= true;
17 Flag_parsing_c.verbose_parsing
:= true;
19 Parse_c.tokens file
+> List.iter
(fun x
-> pr2_gen x
);
24 (* ---------------------------------------------------------------------- *)
25 let test_parse_gen xs ext
=
27 Flag_parsing_c.debug_typedef
:= true;
28 Flag_parsing_c.debug_cpp
:= true;
29 Flag_parsing_c.debug_etdt
:= false;
30 Flag_parsing_c.filter_msg
:= true;
34 | [x
] when is_directory x
-> Some x
39 let xs = if !Flag.dir then
40 process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in
42 let fullxs = Common.files_of_dir_or_files_no_vcs ext
xs in
44 let stat_list = ref [] in
45 let newscore = Common.empty_score
() in
47 Common.check_stack_nbfiles
(List.length
fullxs);
49 fullxs +> List.iter
(fun file
->
50 if not
(file
=~
(".*\\."^ext
))
51 then pr2
("warning: seems not a ."^ext^
" file");
55 pr2
("PARSING: " ^ file
);
57 let (xs, stat
) = Parse_c.parse_print_error_heuristic file
in
58 xs +> List.iter
(fun (ast
, (s
, toks
)) ->
59 Parse_c.print_commentized toks
62 Common.push2 stat
stat_list;
64 sprintf
"bad = %d, timeout = %B"
65 stat
.Parsing_stat.bad stat
.Parsing_stat.have_timeout
67 if stat
.Parsing_stat.bad
= 0 && not stat
.Parsing_stat.have_timeout
68 then Hashtbl.add
newscore file
(Common.Ok
)
69 else Hashtbl.add
newscore file
(Common.Pb
s)
72 if not
(null
!stat_list)
73 then Parsing_stat.print_parsing_stat_list
!stat_list;
75 dirname_opt +> Common.do_option
(fun dirname
->
76 pr2
"--------------------------------";
77 pr2
"regression testing information";
78 pr2
"--------------------------------";
79 let str = Str.global_replace
(Str.regexp
"/") "__" dirname
in
80 let def = if !Flag_parsing_c.filter_define_error
then "_def_" else "" in
81 let ext = if ext = "c" then "" else ext in
82 Common.regression_testing
newscore
83 (Filename.concat
score_path
84 ("score_parsing__" ^
str ^
def ^
ext ^
".marshalled"))
92 let test_parse_ch xs =
93 test_parse_gen xs "[ch]"
106 (* ---------------------------------------------------------------------- *)
107 (* file can be "foo.c" or "foo.c:main" *)
109 let (file
, specific_func
) =
110 if file
=~
"\\(.*\\.c\\):\\(.*\\)"
112 let (a
,b
) = matched2 file
in
118 if not
(file
=~
".*\\.c")
119 then pr2
"warning: seems not a .c file";
121 let (program
, _stat
) = Parse_c.parse_print_error_heuristic file
in
123 program
+> List.iter
(fun (e
,_
) ->
125 match specific_func
, e
with
127 | Some
s, Ast_c.Definition
(defbis
,_
) ->
128 s = defbis
.Ast_c.f_name
134 (* old: Flow_to_ast.test !Flag.show_flow def *)
136 let flow = Ast_to_flow.ast_to_control_flow e
in
137 flow +> do_option
(fun flow ->
138 Ast_to_flow.deadcode_detection
flow;
139 let flow = Ast_to_flow.annotate_loop_nodes
flow in
143 if !Flag_cocci.show_before_fixed_flow
145 else Ctlcocci_integration.fix_flow_ctl flow
149 let filename = Filename.temp_file
"output" ".dot" in
150 Ograph_extended.print_ograph_mutable
flow'
(filename) true
152 with Ast_to_flow.Error
(x
) -> Ast_to_flow.report_error x
158 (* ---------------------------------------------------------------------- *)
159 let test_parse_unparse infile
=
160 if not
(infile
=~
".*\\.c")
161 then pr2
"warning: seems not a .c file";
163 let (program2
, _stat
) = Parse_c.parse_print_error_heuristic infile
in
164 let program2_with_ppmethod =
165 program2
+> List.map
(fun x
-> x
, Unparse_c.PPnormal
)
167 Unparse_c.pp_program
program2_with_ppmethod tmpfile;
168 Common.command2
("cat " ^
tmpfile);
169 (* if want see diff of space => no -b -B *)
170 Common.command2
(spf
"diff -u -p %s %s" infile
tmpfile);
171 (* +> Transformation.test_simple_trans1;*)
177 let test_type_c infile
=
178 if not
(infile
=~
".*\\.c")
179 then pr2
"warning: seems not a .c file";
181 Flag_parsing_c.pretty_print_type_info
:= true;
183 let (program2
, _stat
) = Parse_c.parse_print_error_heuristic infile
in
187 +> (fun (program
, infos
) ->
188 Type_annoter_c.annotate_program
Type_annoter_c.initial_env
true
189 program
+> List.map fst
,
192 +> Common.uncurry
Common.zip
194 let program2_with_ppmethod =
195 program2
+> List.map
(fun x
-> x
, Unparse_c.PPnormal
)
197 Unparse_c.pp_program
program2_with_ppmethod tmpfile;
198 Common.command2
("cat " ^
tmpfile);
202 (* ---------------------------------------------------------------------- *)
203 (* used by generic_makefile now *)
204 let test_compare_c file1 file2
=
205 let (correct
, diffxs
) = Compare_c.compare_default file1 file2
in
206 let res = Compare_c.compare_result_to_bool correct
in
208 then raise
(Common.UnixExit
0)
209 else raise
(Common.UnixExit
(-1))
212 let test_compare_c_hardcoded () =
213 Compare_c.compare_default
217 "tests/equal_modulo1.c"
218 "tests/equal_modulo2.c"
220 +> Compare_c.compare_result_to_string
225 (* ---------------------------------------------------------------------- *)
230 ignore(Parse_c.parse_cpp_define_file "standard.h")
234 Format.print_newline();
235 Format.printf "@[<v 5>--@,--@,@[<v 5>--@,--@,@]--@,--@,@]";
236 Format.print_newline();
237 Format.printf "@[<v>(---@[<v>(---@[<v>(---@,)@]@,)@]@,)@]"
242 (*****************************************************************************)
243 (* Main entry for Arg *)
244 (*****************************************************************************)
247 "-tokens_c", " <file>",
248 Common.mk_action_1_arg
test_tokens_c;
249 "-parse_c", " <file or dir>",
250 Common.mk_action_n_arg
test_parse_c;
251 "-parse_h", " <file or dir>",
252 Common.mk_action_n_arg
test_parse_h;
253 "-parse_ch", " <file or dir>",
254 Common.mk_action_n_arg
test_parse_ch;
256 "-show_flow", " <file or file:function>",
257 Common.mk_action_1_arg
test_cfg;
258 "-control_flow", " <file or file:function>",
259 Common.mk_action_1_arg
test_cfg;
260 "-parse_unparse", " <file>",
261 Common.mk_action_1_arg
test_parse_unparse;
262 "-type_c", " <file>",
263 Common.mk_action_1_arg
test_type_c;
264 "-compare_c", " <file1> <file2>",
265 Common.mk_action_2_arg
test_compare_c (* result is in unix code *);
267 "-compare_c_hardcoded", " ",
268 Common.mk_action_0_arg
test_compare_c_hardcoded;
270 "-xxx", " <file1> <>",
271 Common.mk_action_n_arg
test_xxx;