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