Commit | Line | Data |
---|---|---|
34e49164 C |
1 | open Common |
2 | ||
91eba41f C |
3 | open Ast_c |
4 | ||
34e49164 C |
5 | let score_path = "/home/pad/c-yacfe/tmp" |
6 | ||
7 | let tmpfile = "/tmp/output.c" | |
8 | ||
708f4980 | 9 | module Ast_to_flow = Control_flow_c_build |
91eba41f | 10 | |
34e49164 C |
11 | (*****************************************************************************) |
12 | (* Subsystem testing *) | |
13 | (*****************************************************************************) | |
14 | ||
15 | let test_tokens_c file = | |
16 | if not (file =~ ".*\\.c") | |
17 | then pr2 "warning: seems not a .c file"; | |
18 | ||
19 | Flag_parsing_c.debug_lexer := true; | |
20 | Flag_parsing_c.verbose_lexing := true; | |
21 | Flag_parsing_c.verbose_parsing := true; | |
22 | ||
23 | Parse_c.tokens file +> List.iter (fun x -> pr2_gen x); | |
24 | () | |
25 | ||
26 | ||
27 | ||
28 | (* ---------------------------------------------------------------------- *) | |
29 | let test_parse_gen xs ext = | |
30 | ||
31 | Flag_parsing_c.debug_typedef := true; | |
32 | Flag_parsing_c.debug_cpp := true; | |
33 | Flag_parsing_c.debug_etdt := false; | |
34 | Flag_parsing_c.filter_msg := true; | |
35 | ||
36 | let dirname_opt = | |
37 | match xs with | |
38 | | [x] when is_directory x -> Some x | |
39 | | _ -> None | |
40 | in | |
41 | ||
42 | (* old: | |
43 | let xs = if !Flag.dir then | |
44 | process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in | |
45 | *) | |
485bce71 | 46 | let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in |
34e49164 C |
47 | |
48 | let stat_list = ref [] in | |
49 | let newscore = Common.empty_score () in | |
50 | ||
485bce71 | 51 | Common.check_stack_nbfiles (List.length fullxs); |
34e49164 C |
52 | |
53 | fullxs +> List.iter (fun file -> | |
54 | if not (file =~ (".*\\."^ext)) | |
55 | then pr2 ("warning: seems not a ."^ext^" file"); | |
56 | ||
57 | ||
58 | pr2 ""; | |
59 | pr2 ("PARSING: " ^ file); | |
60 | ||
978fd7e5 | 61 | let (xs, stat) = Parse_c.parse_c_and_cpp file in |
34e49164 C |
62 | xs +> List.iter (fun (ast, (s, toks)) -> |
63 | Parse_c.print_commentized toks | |
64 | ); | |
65 | ||
66 | Common.push2 stat stat_list; | |
67 | let s = | |
68 | sprintf "bad = %d, timeout = %B" | |
485bce71 | 69 | stat.Parsing_stat.bad stat.Parsing_stat.have_timeout |
34e49164 | 70 | in |
b1b2de81 | 71 | if stat.Parsing_stat.bad =|= 0 && not stat.Parsing_stat.have_timeout |
34e49164 C |
72 | then Hashtbl.add newscore file (Common.Ok) |
73 | else Hashtbl.add newscore file (Common.Pb s) | |
74 | ); | |
75 | ||
34e49164 | 76 | dirname_opt +> Common.do_option (fun dirname -> |
91eba41f | 77 | pr2_xxxxxxxxxxxxxxxxx(); |
34e49164 | 78 | pr2 "regression testing information"; |
91eba41f | 79 | pr2_xxxxxxxxxxxxxxxxx(); |
34e49164 C |
80 | let str = Str.global_replace (Str.regexp "/") "__" dirname in |
81 | let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in | |
b1b2de81 | 82 | let ext = if ext =$= "c" then "" else ext in |
34e49164 C |
83 | Common.regression_testing newscore |
84 | (Filename.concat score_path | |
85 | ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled")) | |
708f4980 C |
86 | ); |
87 | ||
88 | if not (null !stat_list) | |
89 | then begin | |
90 | Parsing_stat.print_recurring_problematic_tokens !stat_list; | |
91 | Parsing_stat.print_parsing_stat_list !stat_list; | |
92 | end; | |
93 | () | |
34e49164 C |
94 | |
95 | ||
96 | let test_parse_c xs = | |
97 | test_parse_gen xs "c" | |
98 | let test_parse_h xs = | |
99 | test_parse_gen xs "h" | |
100 | let test_parse_ch xs = | |
101 | test_parse_gen xs "[ch]" | |
102 | ||
978fd7e5 C |
103 | (* could use a simpler parser than heavy parse_c_and_cpp here as there |
104 | * is no more cpp stuff in the .i files | |
105 | *) | |
106 | let test_parse_i xs = | |
107 | test_parse_gen xs "i" | |
34e49164 C |
108 | |
109 | ||
110 | ||
111 | ||
112 | ||
113 | ||
114 | ||
115 | (* ---------------------------------------------------------------------- *) | |
116 | (* file can be "foo.c" or "foo.c:main" *) | |
117 | let test_cfg file = | |
34e49164 C |
118 | let (file, specific_func) = |
119 | if file =~ "\\(.*\\.c\\):\\(.*\\)" | |
120 | then | |
121 | let (a,b) = matched2 file in | |
122 | a, Some b | |
123 | else | |
124 | file, None | |
125 | in | |
126 | ||
127 | if not (file =~ ".*\\.c") | |
128 | then pr2 "warning: seems not a .c file"; | |
129 | ||
978fd7e5 | 130 | let (program, _stat) = Parse_c.parse_c_and_cpp file in |
34e49164 C |
131 | |
132 | program +> List.iter (fun (e,_) -> | |
133 | let toprocess = | |
134 | match specific_func, e with | |
135 | | None, _ -> true | |
485bce71 | 136 | | Some s, Ast_c.Definition (defbis,_) -> |
b1b2de81 | 137 | s =$= Ast_c.str_of_name (defbis.Ast_c.f_name) |
34e49164 C |
138 | | _, _ -> false |
139 | in | |
140 | ||
141 | if toprocess | |
142 | then | |
143 | (* old: Flow_to_ast.test !Flag.show_flow def *) | |
144 | (try | |
145 | let flow = Ast_to_flow.ast_to_control_flow e in | |
146 | flow +> do_option (fun flow -> | |
147 | Ast_to_flow.deadcode_detection flow; | |
148 | let flow = Ast_to_flow.annotate_loop_nodes flow in | |
149 | ||
150 | let flow' = | |
151 | (* | |
152 | if !Flag_cocci.show_before_fixed_flow | |
153 | then flow | |
154 | else Ctlcocci_integration.fix_flow_ctl flow | |
155 | *) | |
156 | flow | |
157 | in | |
485bce71 C |
158 | let filename = Filename.temp_file "output" ".dot" in |
159 | Ograph_extended.print_ograph_mutable flow' (filename) true | |
34e49164 C |
160 | ) |
161 | with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x | |
162 | ) | |
163 | ) | |
164 | ||
165 | ||
166 | ||
91eba41f | 167 | let test_cfg_ifdef file = |
978fd7e5 | 168 | let (ast2, _stat) = Parse_c.parse_c_and_cpp file in |
91eba41f C |
169 | let ast = Parse_c.program_of_program2 ast2 in |
170 | ||
171 | let ast = Cpp_ast_c.cpp_ifdef_statementize ast in | |
172 | ||
173 | ast +> List.iter (fun e -> | |
174 | (try | |
175 | let flow = Ast_to_flow.ast_to_control_flow e in | |
176 | flow +> do_option (fun flow -> | |
177 | Ast_to_flow.deadcode_detection flow; | |
178 | let flow = Ast_to_flow.annotate_loop_nodes flow in | |
179 | Ograph_extended.print_ograph_mutable flow ("/tmp/output.dot") true | |
180 | ) | |
181 | with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x | |
182 | ) | |
183 | ) | |
184 | ||
34e49164 C |
185 | (* ---------------------------------------------------------------------- *) |
186 | let test_parse_unparse infile = | |
187 | if not (infile =~ ".*\\.c") | |
188 | then pr2 "warning: seems not a .c file"; | |
189 | ||
978fd7e5 | 190 | let (program2, _stat) = Parse_c.parse_c_and_cpp infile in |
34e49164 | 191 | let program2_with_ppmethod = |
485bce71 | 192 | program2 +> List.map (fun x -> x, Unparse_c.PPnormal) |
34e49164 | 193 | in |
485bce71 | 194 | Unparse_c.pp_program program2_with_ppmethod tmpfile; |
34e49164 C |
195 | Common.command2 ("cat " ^ tmpfile); |
196 | (* if want see diff of space => no -b -B *) | |
197 | Common.command2 (spf "diff -u -p %s %s" infile tmpfile); | |
198 | (* +> Transformation.test_simple_trans1;*) | |
34e49164 C |
199 | () |
200 | ||
201 | ||
978fd7e5 C |
202 | let parse_and_print_sexp file = |
203 | let (ast2,_stat) = Parse_c.parse_c_and_cpp file in | |
204 | let ast = Parse_c.program_of_program2 ast2 in | |
205 | let _ast = | |
206 | Type_annoter_c.annotate_program !Type_annoter_c.initial_env ast | |
207 | in | |
208 | ||
209 | (* | |
210 | let sexp = Sexp_ast_c.sexp_of_program ast in | |
211 | let s = Sexp.to_string_hum sexp in | |
212 | *) | |
213 | Sexp_ast_c.show_info := false; | |
214 | let s = Sexp_ast_c.string_of_program ast in | |
215 | pr2 s; | |
216 | () | |
217 | ||
34e49164 C |
218 | |
219 | ||
220 | let test_type_c infile = | |
221 | if not (infile =~ ".*\\.c") | |
222 | then pr2 "warning: seems not a .c file"; | |
223 | ||
224 | Flag_parsing_c.pretty_print_type_info := true; | |
225 | ||
978fd7e5 | 226 | let (program2, _stat) = Parse_c.parse_c_and_cpp infile in |
34e49164 C |
227 | let _program2 = |
228 | program2 | |
229 | +> Common.unzip | |
230 | +> (fun (program, infos) -> | |
91eba41f | 231 | Type_annoter_c.annotate_program !Type_annoter_c.initial_env |
34e49164 C |
232 | program +> List.map fst, |
233 | infos | |
234 | ) | |
235 | +> Common.uncurry Common.zip | |
236 | in | |
34e49164 | 237 | let program2_with_ppmethod = |
485bce71 | 238 | program2 +> List.map (fun x -> x, Unparse_c.PPnormal) |
34e49164 | 239 | in |
485bce71 | 240 | Unparse_c.pp_program program2_with_ppmethod tmpfile; |
34e49164 C |
241 | Common.command2 ("cat " ^ tmpfile); |
242 | ();; | |
243 | ||
244 | ||
0708f913 C |
245 | (* ---------------------------------------------------------------------- *) |
246 | (* ex: demos/platform_ifdef.c *) | |
247 | let test_comment_annotater infile = | |
978fd7e5 | 248 | let (program2, _stat) = Parse_c.parse_c_and_cpp infile in |
0708f913 C |
249 | let asts = program2 +> List.map (fun (ast,_) -> ast) in |
250 | let toks = program2 +> List.map (fun (ast, (s, toks)) -> toks) +> | |
251 | List.flatten in | |
252 | ||
253 | Flag_parsing_c.pretty_print_comment_info := true; | |
254 | ||
255 | pr2 "pretty print, before comment annotation: --->"; | |
256 | Common.adjust_pp_with_indent (fun () -> | |
257 | asts +> List.iter (fun ast -> | |
258 | Pretty_print_c.pp_toplevel_simple ast; | |
259 | ); | |
260 | ); | |
261 | ||
262 | let _ = Comment_annotater_c.annotate_program toks asts in | |
263 | ||
264 | Common.adjust_pp_with_indent (fun () -> | |
265 | pr2 "pretty print, after comment annotation: --->"; | |
266 | asts +> List.iter (fun ast -> | |
267 | Pretty_print_c.pp_toplevel_simple ast; | |
268 | ); | |
269 | ); | |
270 | ||
271 | ||
272 | () | |
273 | ||
274 | ||
34e49164 C |
275 | (* ---------------------------------------------------------------------- *) |
276 | (* used by generic_makefile now *) | |
277 | let test_compare_c file1 file2 = | |
278 | let (correct, diffxs) = Compare_c.compare_default file1 file2 in | |
279 | let res = Compare_c.compare_result_to_bool correct in | |
280 | if res | |
281 | then raise (Common.UnixExit 0) | |
282 | else raise (Common.UnixExit (-1)) | |
283 | ||
284 | ||
285 | let test_compare_c_hardcoded () = | |
286 | Compare_c.compare_default | |
287 | "tests/compare1.c" | |
288 | "tests/compare2.c" | |
289 | (* | |
290 | "tests/equal_modulo1.c" | |
291 | "tests/equal_modulo2.c" | |
292 | *) | |
293 | +> Compare_c.compare_result_to_string | |
294 | +> pr2 | |
295 | ||
296 | ||
297 | ||
91eba41f C |
298 | (* ---------------------------------------------------------------------- *) |
299 | let test_attributes file = | |
300 | let (ast2, _stat) = Parse_c.parse_c_and_cpp file in | |
301 | let ast = Parse_c.program_of_program2 ast2 in | |
302 | ||
303 | Visitor_c.vk_program { Visitor_c.default_visitor_c with | |
304 | Visitor_c.kdef = (fun (k, bigf) (defbis, ii) -> | |
305 | let sattr = Ast_c.s_of_attr defbis.f_attr in | |
b1b2de81 | 306 | pr2 (spf "%-30s: %s" (Ast_c.str_of_name (defbis.f_name)) sattr); |
91eba41f C |
307 | ); |
308 | Visitor_c.kdecl = (fun (k, bigf) decl -> | |
309 | match decl with | |
310 | | DeclList (xs, ii) -> | |
311 | xs +> List.iter (fun (onedecl, iicomma) -> | |
312 | ||
313 | let sattr = Ast_c.s_of_attr onedecl.v_attr in | |
314 | let idname = | |
315 | match onedecl.v_namei with | |
b1b2de81 | 316 | | Some (name, ini) -> Ast_c.str_of_name name |
91eba41f C |
317 | | None -> "novar" |
318 | in | |
319 | pr2 (spf "%-30s: %s" idname sattr); | |
320 | ); | |
321 | | _ -> () | |
322 | ||
323 | ); | |
324 | } ast; | |
325 | () | |
326 | ||
327 | ||
328 | let cpp_options () = [ | |
329 | Cpp_ast_c.I "/home/yyzhou/pad/linux/include"; | |
330 | ] ++ | |
331 | Cpp_ast_c.cpp_option_of_cmdline | |
332 | (!Flag_parsing_c.cpp_i_opts,!Flag_parsing_c.cpp_d_opts) | |
333 | ||
334 | let test_cpp file = | |
335 | let (ast2, _stat) = Parse_c.parse_c_and_cpp file in | |
336 | let dirname = Filename.dirname file in | |
337 | let ast = Parse_c.program_of_program2 ast2 in | |
978fd7e5 C |
338 | let ast = Cpp_ast_c.cpp_expand_include (cpp_options()) dirname ast in |
339 | let _ast = Cpp_ast_c.cpp_ifdef_statementize ast in | |
340 | ||
91eba41f C |
341 | |
342 | () | |
343 | ||
344 | ||
345 | ||
978fd7e5 C |
346 | (* CONFIG [ch] ? also do for .c ? maybe less needed now that I |
347 | * add local_macros. | |
348 | *) | |
349 | let extract_macros ~selection dir = | |
708f4980 | 350 | let ext = "h" in |
978fd7e5 C |
351 | let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in |
352 | let macros_and_filename = | |
353 | fullxs +> List.map (fun file -> | |
354 | pr2 (spf "processing: %s" file); | |
355 | let xs = Parse_c.extract_macros file in | |
356 | file, xs | |
357 | ) | |
358 | in | |
359 | ||
360 | let macros = | |
361 | if selection | |
362 | then Cpp_analysis_c.extract_dangerous_macros macros_and_filename | |
363 | else macros_and_filename | |
364 | in | |
365 | macros +> List.iter (fun (file, defs) -> | |
708f4980 | 366 | pr ("/* PARSING: " ^ file ^ " */"); |
978fd7e5 C |
367 | defs +> List.iter (fun (s, def) -> |
368 | let str = Cpp_token_c.string_of_define_def def in | |
369 | pr str; | |
370 | ) | |
371 | ); | |
372 | () | |
373 | ||
374 | ||
375 | let test_parse xs = | |
376 | ||
377 | Flag_parsing_c.filter_msg_define_error := true; | |
378 | Flag_parsing_c.filter_define_error := true; | |
379 | Flag_parsing_c.verbose_lexing := false; | |
380 | Flag_parsing_c.verbose_parsing := false; | |
381 | ||
382 | let dirname_opt = | |
383 | match xs with | |
384 | | [x] when is_directory x -> Some x | |
385 | | _ -> None | |
386 | in | |
387 | dirname_opt +> Common.do_option (fun dir -> | |
388 | ||
389 | let ext = "h" in | |
390 | let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in | |
391 | ||
392 | let macros_and_filename = | |
393 | fullxs +> List.map (fun file -> | |
394 | pr2 (spf "processing: %s" file); | |
395 | let xs = Parse_c.extract_macros file in | |
396 | file, xs | |
397 | ) | |
398 | in | |
399 | let macros = | |
400 | Cpp_analysis_c.extract_dangerous_macros macros_and_filename | |
401 | in | |
402 | macros +> List.iter (fun (file, xs) -> | |
403 | xs +> List.iter (fun (x, def) -> | |
404 | let (s, params, body) = def in | |
405 | let str = Cpp_token_c.string_of_define_def def in | |
406 | pr str; | |
407 | (* builtins ? *) | |
408 | Hashtbl.replace !Parse_c._defs_builtins s (s, params, body); | |
708f4980 C |
409 | ); |
410 | ); | |
411 | ); | |
978fd7e5 C |
412 | |
413 | let ext = "[ch]" in | |
414 | ||
415 | let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in | |
416 | ||
417 | let stat_list = ref [] in | |
418 | Common.check_stack_nbfiles (List.length fullxs); | |
419 | ||
420 | fullxs +> List.iter (fun file -> | |
421 | if not (file =~ (".*\\."^ext)) | |
422 | then pr2 ("warning: seems not a ."^ext^" file"); | |
423 | ||
424 | pr2 ""; | |
425 | pr2 ("PARSING: " ^ file); | |
426 | ||
427 | let (xs, stat) = Parse_c.parse_c_and_cpp file in | |
428 | xs +> List.iter (fun (ast, (s, toks)) -> | |
429 | Parse_c.print_commentized toks | |
430 | ); | |
431 | ||
432 | Common.push2 stat stat_list; | |
433 | ); | |
434 | ||
435 | if not (null !stat_list) | |
436 | then begin | |
437 | Parsing_stat.print_recurring_problematic_tokens !stat_list; | |
438 | Parsing_stat.print_parsing_stat_list !stat_list; | |
439 | end; | |
708f4980 C |
440 | () |
441 | ||
442 | ||
91eba41f | 443 | |
978fd7e5 C |
444 | |
445 | ||
446 | ||
447 | ||
448 | ||
34e49164 C |
449 | (* ---------------------------------------------------------------------- *) |
450 | let test_xxx a = | |
451 | () | |
452 | ||
453 | (* | |
454 | ignore(Parse_c.parse_cpp_define_file "standard.h") | |
455 | pr2 "pr2"; | |
456 | pr "pr" | |
457 | ||
458 | Format.print_newline(); | |
459 | Format.printf "@[<v 5>--@,--@,@[<v 5>--@,--@,@]--@,--@,@]"; | |
460 | Format.print_newline(); | |
461 | Format.printf "@[<v>(---@[<v>(---@[<v>(---@,)@]@,)@]@,)@]" | |
462 | *) | |
463 | ||
464 | ||
465 | ||
466 | (*****************************************************************************) | |
467 | (* Main entry for Arg *) | |
468 | (*****************************************************************************) | |
469 | ||
470 | let actions () = [ | |
471 | "-tokens_c", " <file>", | |
472 | Common.mk_action_1_arg test_tokens_c; | |
473 | "-parse_c", " <file or dir>", | |
474 | Common.mk_action_n_arg test_parse_c; | |
475 | "-parse_h", " <file or dir>", | |
476 | Common.mk_action_n_arg test_parse_h; | |
477 | "-parse_ch", " <file or dir>", | |
478 | Common.mk_action_n_arg test_parse_ch; | |
978fd7e5 C |
479 | "-parse_i", " <file or dir>", |
480 | Common.mk_action_n_arg test_parse_i; | |
34e49164 | 481 | |
708f4980 C |
482 | "-parse", " <file or dir>", |
483 | Common.mk_action_n_arg test_parse; | |
484 | ||
34e49164 C |
485 | "-show_flow", " <file or file:function>", |
486 | Common.mk_action_1_arg test_cfg; | |
487 | "-control_flow", " <file or file:function>", | |
488 | Common.mk_action_1_arg test_cfg; | |
91eba41f C |
489 | "-test_cfg_ifdef", " <file>", |
490 | Common.mk_action_1_arg test_cfg_ifdef; | |
34e49164 C |
491 | "-parse_unparse", " <file>", |
492 | Common.mk_action_1_arg test_parse_unparse; | |
978fd7e5 C |
493 | "-parse_and_print_sexp", " <file>", |
494 | Common.mk_action_1_arg parse_and_print_sexp; | |
34e49164 C |
495 | "-type_c", " <file>", |
496 | Common.mk_action_1_arg test_type_c; | |
497 | "-compare_c", " <file1> <file2>", | |
498 | Common.mk_action_2_arg test_compare_c (* result is in unix code *); | |
0708f913 C |
499 | "-comment_annotater_c", " <file>", |
500 | Common.mk_action_1_arg test_comment_annotater; | |
34e49164 C |
501 | |
502 | "-compare_c_hardcoded", " ", | |
503 | Common.mk_action_0_arg test_compare_c_hardcoded; | |
504 | ||
91eba41f C |
505 | "-test_attributes", " <file>", |
506 | Common.mk_action_1_arg test_attributes; | |
507 | "-test_cpp", " <file>", | |
508 | Common.mk_action_1_arg test_cpp; | |
509 | ||
708f4980 C |
510 | "-extract_macros", " <file or dir>", |
511 | Common.mk_action_1_arg (extract_macros ~selection:false) ; | |
512 | ||
513 | "-extract_macros_select", " <file or dir>", | |
514 | Common.mk_action_1_arg (extract_macros ~selection:true); | |
91eba41f C |
515 | |
516 | ||
34e49164 C |
517 | "-xxx", " <file1> <>", |
518 | Common.mk_action_n_arg test_xxx; | |
519 | ] | |
520 |