X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/b1b2de814d2c59af2526bc19d41bb22a0c1fd16d..17ba07880e1838028b4516ba7a2db2147b3aa1c9:/parsing_c/test_parsing_c.ml diff --git a/parsing_c/test_parsing_c.ml b/parsing_c/test_parsing_c.ml index 96cc546..02c66bc 100644 --- a/parsing_c/test_parsing_c.ml +++ b/parsing_c/test_parsing_c.ml @@ -4,42 +4,43 @@ open Ast_c let score_path = "/home/pad/c-yacfe/tmp" -let tmpfile = "/tmp/output.c" +let tmpfile = "/tmp/output.c" +module Ast_to_flow = Control_flow_c_build (*****************************************************************************) (* Subsystem testing *) (*****************************************************************************) -let test_tokens_c file = - if not (file =~ ".*\\.c") +let test_tokens_c file = + if not (file =~ ".*\\.c") then pr2 "warning: seems not a .c file"; - Flag_parsing_c.debug_lexer := true; + Flag_parsing_c.debug_lexer := true; Flag_parsing_c.verbose_lexing := true; Flag_parsing_c.verbose_parsing := true; Parse_c.tokens file +> List.iter (fun x -> pr2_gen x); () - + (* ---------------------------------------------------------------------- *) -let test_parse_gen xs ext = - +let test_parse_gen xs ext = + Flag_parsing_c.debug_typedef := true; Flag_parsing_c.debug_cpp := true; Flag_parsing_c.debug_etdt := false; Flag_parsing_c.filter_msg := true; - let dirname_opt = + (*let dirname_opt = match xs with | [x] when is_directory x -> Some x | _ -> None - in + in*) (* old: - let xs = if !Flag.dir then + let xs = if !Flag.dir then process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in *) let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in @@ -49,7 +50,7 @@ let test_parse_gen xs ext = Common.check_stack_nbfiles (List.length fullxs); - fullxs +> List.iter (fun file -> + fullxs +> List.iter (fun file -> if not (file =~ (".*\\."^ext)) then pr2 ("warning: seems not a ."^ext^" file"); @@ -57,51 +58,58 @@ let test_parse_gen xs ext = pr2 ""; pr2 ("PARSING: " ^ file); - let (xs, stat) = Parse_c.parse_print_error_heuristic file in - xs +> List.iter (fun (ast, (s, toks)) -> + let (xs, stat) = Parse_c.parse_c_and_cpp file in + xs +> List.iter (fun (ast, (s, toks)) -> Parse_c.print_commentized toks ); Common.push2 stat stat_list; - let s = - sprintf "bad = %d, timeout = %B" + let s = + sprintf "bad = %d, timeout = %B" stat.Parsing_stat.bad stat.Parsing_stat.have_timeout in if stat.Parsing_stat.bad =|= 0 && not stat.Parsing_stat.have_timeout then Hashtbl.add newscore file (Common.Ok) else Hashtbl.add newscore file (Common.Pb s) ); - - if not (null !stat_list) - then begin - Parsing_stat.print_recurring_problematic_tokens !stat_list; - Parsing_stat.print_parsing_stat_list !stat_list; - end; - - dirname_opt +> Common.do_option (fun dirname -> + +(* uses an explicit path; to fix + dirname_opt +> Common.do_option (fun dirname -> pr2_xxxxxxxxxxxxxxxxx(); pr2 "regression testing information"; pr2_xxxxxxxxxxxxxxxxx(); let str = Str.global_replace (Str.regexp "/") "__" dirname in let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in let ext = if ext =$= "c" then "" else ext in - Common.regression_testing newscore - (Filename.concat score_path - ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled")) - ) + let filename = "score_parsing__" ^str ^ def ^ ext ^ ".marshalled" in + if Sys.file_exists filename + then + Common.regression_testing newscore + (Filename.concat score_path + ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled")) + ); +*) + + if not (null !stat_list) + then begin + Parsing_stat.print_recurring_problematic_tokens !stat_list; + Parsing_stat.print_parsing_stat_list !stat_list; + end; + () -let test_parse_c xs = +let test_parse_c xs = test_parse_gen xs "c" -let test_parse_h xs = +let test_parse_h xs = test_parse_gen xs "h" -let test_parse_ch xs = +let test_parse_ch xs = test_parse_gen xs "[ch]" - - - - +(* could use a simpler parser than heavy parse_c_and_cpp here as there + * is no more cpp stuff in the .i files + *) +let test_parse_i xs = + test_parse_gen xs "i" @@ -111,66 +119,75 @@ let test_parse_ch xs = (* ---------------------------------------------------------------------- *) (* file can be "foo.c" or "foo.c:main" *) -let test_cfg file = - let (file, specific_func) = +(* local function that is parameterized by whether to launch gv *) +let local_test_cfg launchgv file = + let (file, specific_func) = if file =~ "\\(.*\\.c\\):\\(.*\\)" - then - let (a,b) = matched2 file in + then + let (a,b) = matched2 file in a, Some b - else + else file, None in - if not (file =~ ".*\\.c") + if not (file =~ ".*\\.c") then pr2 "warning: seems not a .c file"; - let (program, _stat) = Parse_c.parse_print_error_heuristic file in + let (program, _stat) = Parse_c.parse_c_and_cpp file in - program +> List.iter (fun (e,_) -> - let toprocess = + program +> List.iter (fun (e,_) -> + let toprocess = match specific_func, e with - | None, _ -> true - | Some s, Ast_c.Definition (defbis,_) -> - s =$= Ast_c.str_of_name (defbis.Ast_c.f_name) - | _, _ -> false + | None, Ast_c.Definition (defbis,_) -> + Some (Ast_c.str_of_name (defbis.Ast_c.f_name)) + | Some s, Ast_c.Definition (defbis,_) -> + let nm = Ast_c.str_of_name (defbis.Ast_c.f_name) in + if s =$= nm then Some nm else None + | _, _ -> None in - - if toprocess - then - (* old: Flow_to_ast.test !Flag.show_flow def *) - (try + + match toprocess with + None -> () + | Some fn -> (* old: Flow_to_ast.test !Flag.show_flow def *) + try let flow = Ast_to_flow.ast_to_control_flow e in - flow +> do_option (fun flow -> + flow +> do_option (fun flow -> Ast_to_flow.deadcode_detection flow; let flow = Ast_to_flow.annotate_loop_nodes flow in - let flow' = + let flow' = (* - if !Flag_cocci.show_before_fixed_flow + if !Flag_cocci.show_before_fixed_flow then flow else Ctlcocci_integration.fix_flow_ctl flow *) flow in - let filename = Filename.temp_file "output" ".dot" in - Ograph_extended.print_ograph_mutable flow' (filename) true + let filename = + if launchgv + then Filename.temp_file "output" ".dot" + else + let fl = Filename.chop_extension (Filename.basename file) in + fl^":"^fn^".dot" in + Ograph_extended.print_ograph_mutable flow' (filename) launchgv ) with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x ) - ) +let test_cfg = local_test_cfg true -let test_cfg_ifdef file = - let (ast2, _stat) = Parse_c.parse_print_error_heuristic file in + +let test_cfg_ifdef file = + let (ast2, _stat) = Parse_c.parse_c_and_cpp file in let ast = Parse_c.program_of_program2 ast2 in let ast = Cpp_ast_c.cpp_ifdef_statementize ast in - ast +> List.iter (fun e -> - (try + ast +> List.iter (fun e -> + (try let flow = Ast_to_flow.ast_to_control_flow e in - flow +> do_option (fun flow -> + flow +> do_option (fun flow -> Ast_to_flow.deadcode_detection flow; let flow = Ast_to_flow.annotate_loop_nodes flow in Ograph_extended.print_ograph_mutable flow ("/tmp/output.dot") true @@ -180,12 +197,12 @@ let test_cfg_ifdef file = ) (* ---------------------------------------------------------------------- *) -let test_parse_unparse infile = - if not (infile =~ ".*\\.c") +let test_parse_unparse infile = + if not (infile =~ ".*\\.c") then pr2 "warning: seems not a .c file"; - let (program2, _stat) = Parse_c.parse_print_error_heuristic infile in - let program2_with_ppmethod = + let (program2, _stat) = Parse_c.parse_c_and_cpp infile in + let program2_with_ppmethod = program2 +> List.map (fun x -> x, Unparse_c.PPnormal) in Unparse_c.pp_program program2_with_ppmethod tmpfile; @@ -196,26 +213,43 @@ let test_parse_unparse infile = () +(* +let parse_and_print_sexp file = + let (ast2,_stat) = Parse_c.parse_c_and_cpp file in + let ast = Parse_c.program_of_program2 ast2 in + let _ast = + Type_annoter_c.annotate_program !Type_annoter_c.initial_env ast + in + (* + let sexp = Sexp_ast_c.sexp_of_program ast in + let s = Sexp.to_string_hum sexp in + *) + Sexp_ast_c.show_info := false; + let s = Sexp_ast_c.string_of_program ast in + pr2 s; + () +*) -let test_type_c infile = - if not (infile =~ ".*\\.c") + +let test_type_c infile = + if not (infile =~ ".*\\.c") then pr2 "warning: seems not a .c file"; Flag_parsing_c.pretty_print_type_info := true; - let (program2, _stat) = Parse_c.parse_print_error_heuristic infile in + let (program2, _stat) = Parse_c.parse_c_and_cpp infile in let _program2 = - program2 - +> Common.unzip - +> (fun (program, infos) -> - Type_annoter_c.annotate_program !Type_annoter_c.initial_env + program2 + +> Common.unzip + +> (fun (program, infos) -> + Type_annoter_c.annotate_program !Type_annoter_c.initial_env program +> List.map fst, infos ) +> Common.uncurry Common.zip in - let program2_with_ppmethod = + let program2_with_ppmethod = program2 +> List.map (fun x -> x, Unparse_c.PPnormal) in Unparse_c.pp_program program2_with_ppmethod tmpfile; @@ -225,74 +259,74 @@ let test_type_c infile = (* ---------------------------------------------------------------------- *) (* ex: demos/platform_ifdef.c *) -let test_comment_annotater infile = - let (program2, _stat) = Parse_c.parse_print_error_heuristic infile in +let test_comment_annotater infile = + let (program2, _stat) = Parse_c.parse_c_and_cpp infile in let asts = program2 +> List.map (fun (ast,_) -> ast) in - let toks = program2 +> List.map (fun (ast, (s, toks)) -> toks) +> + let toks = program2 +> List.map (fun (ast, (s, toks)) -> toks) +> List.flatten in Flag_parsing_c.pretty_print_comment_info := true; pr2 "pretty print, before comment annotation: --->"; - Common.adjust_pp_with_indent (fun () -> - asts +> List.iter (fun ast -> + Common.adjust_pp_with_indent (fun () -> + asts +> List.iter (fun ast -> Pretty_print_c.pp_toplevel_simple ast; ); ); let _ = Comment_annotater_c.annotate_program toks asts in - Common.adjust_pp_with_indent (fun () -> + Common.adjust_pp_with_indent (fun () -> pr2 "pretty print, after comment annotation: --->"; - asts +> List.iter (fun ast -> + asts +> List.iter (fun ast -> Pretty_print_c.pp_toplevel_simple ast; ); ); () - - + + (* ---------------------------------------------------------------------- *) (* used by generic_makefile now *) -let test_compare_c file1 file2 = +let test_compare_c file1 file2 = let (correct, diffxs) = Compare_c.compare_default file1 file2 in let res = Compare_c.compare_result_to_bool correct in - if res + if res then raise (Common.UnixExit 0) else raise (Common.UnixExit (-1)) let test_compare_c_hardcoded () = - Compare_c.compare_default - "tests/compare1.c" - "tests/compare2.c" + Compare_c.compare_default + "tests/compare1.c" + "tests/compare2.c" (* - "tests/equal_modulo1.c" - "tests/equal_modulo2.c" + "tests/equal_modulo1.c" + "tests/equal_modulo2.c" *) - +> Compare_c.compare_result_to_string + +> Compare_c.compare_result_to_string +> pr2 (* ---------------------------------------------------------------------- *) -let test_attributes file = +let test_attributes file = let (ast2, _stat) = Parse_c.parse_c_and_cpp file in let ast = Parse_c.program_of_program2 ast2 in Visitor_c.vk_program { Visitor_c.default_visitor_c with - Visitor_c.kdef = (fun (k, bigf) (defbis, ii) -> + Visitor_c.kdef = (fun (k, bigf) (defbis, ii) -> let sattr = Ast_c.s_of_attr defbis.f_attr in pr2 (spf "%-30s: %s" (Ast_c.str_of_name (defbis.f_name)) sattr); ); - Visitor_c.kdecl = (fun (k, bigf) decl -> + Visitor_c.kdecl = (fun (k, bigf) decl -> match decl with - | DeclList (xs, ii) -> - xs +> List.iter (fun (onedecl, iicomma) -> - + | DeclList (xs, ii) -> + xs +> List.iter (fun (onedecl, iicomma) -> + let sattr = Ast_c.s_of_attr onedecl.v_attr in - let idname = + let idname = match onedecl.v_namei with | Some (name, ini) -> Ast_c.str_of_name name | None -> "novar" @@ -300,7 +334,7 @@ let test_attributes file = pr2 (spf "%-30s: %s" idname sattr); ); | _ -> () - + ); } ast; () @@ -308,23 +342,127 @@ let test_attributes file = let cpp_options () = [ Cpp_ast_c.I "/home/yyzhou/pad/linux/include"; -] ++ - Cpp_ast_c.cpp_option_of_cmdline +] ++ + Cpp_ast_c.cpp_option_of_cmdline (!Flag_parsing_c.cpp_i_opts,!Flag_parsing_c.cpp_d_opts) -let test_cpp file = +let test_cpp file = let (ast2, _stat) = Parse_c.parse_c_and_cpp file in let dirname = Filename.dirname file in let ast = Parse_c.program_of_program2 ast2 in - let _ast' = Cpp_ast_c.cpp_expand_include (cpp_options()) dirname ast in - + let ast = Cpp_ast_c.cpp_expand_include (cpp_options()) dirname ast in + let _ast = Cpp_ast_c.cpp_ifdef_statementize ast in + + + () + + + +(* CONFIG [ch] ? also do for .c ? maybe less needed now that I + * add local_macros. + *) +let extract_macros ~selection dir = + let ext = "h" in + let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in + let macros_and_filename = + fullxs +> List.map (fun file -> + pr2 (spf "processing: %s" file); + let xs = Parse_c.extract_macros file in + file, xs + ) + in + + let macros = + if selection + then Cpp_analysis_c.extract_dangerous_macros macros_and_filename + else macros_and_filename + in + macros +> List.iter (fun (file, defs) -> + pr ("/* PARSING: " ^ file ^ " */"); + defs +> List.iter (fun (s, def) -> + let str = Cpp_token_c.string_of_define_def def in + pr str; + ) + ); () +let test_parse xs = + + Flag_parsing_c.filter_msg_define_error := true; + Flag_parsing_c.filter_define_error := true; + Flag_parsing_c.verbose_lexing := false; + Flag_parsing_c.verbose_parsing := false; + + let dirname_opt = + match xs with + | [x] when is_directory x -> Some x + | _ -> None + in + dirname_opt +> Common.do_option (fun dir -> + + let ext = "h" in + let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in + + let macros_and_filename = + fullxs +> List.map (fun file -> + pr2 (spf "processing: %s" file); + let xs = Parse_c.extract_macros file in + file, xs + ) + in + let macros = + Cpp_analysis_c.extract_dangerous_macros macros_and_filename + in + macros +> List.iter (fun (file, xs) -> + xs +> List.iter (fun (x, def) -> + let (s, params, body) = def in + let str = Cpp_token_c.string_of_define_def def in + pr str; + (* builtins ? *) + Hashtbl.replace !Parse_c._defs_builtins s (s, params, body); + ); + ); + ); + + let ext = "[ch]" in + + let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in + + let stat_list = ref [] in + Common.check_stack_nbfiles (List.length fullxs); + + fullxs +> List.iter (fun file -> + if not (file =~ (".*\\."^ext)) + then pr2 ("warning: seems not a ."^ext^" file"); + + pr2 ""; + pr2 ("PARSING: " ^ file); + + let (xs, stat) = Parse_c.parse_c_and_cpp file in + xs +> List.iter (fun (ast, (s, toks)) -> + Parse_c.print_commentized toks + ); + + Common.push2 stat stat_list; + ); + + if not (null !stat_list) + then begin + Parsing_stat.print_recurring_problematic_tokens !stat_list; + Parsing_stat.print_parsing_stat_list !stat_list; + end; + () + + + + + + (* ---------------------------------------------------------------------- *) -let test_xxx a = +let test_xxx a = () (* @@ -345,41 +483,55 @@ let test_xxx a = (*****************************************************************************) let actions () = [ - "-tokens_c", " ", + "--tokens-c", " ", Common.mk_action_1_arg test_tokens_c; - "-parse_c", " ", + "--parse-c", " ", Common.mk_action_n_arg test_parse_c; - "-parse_h", " ", + "--parse-h", " ", Common.mk_action_n_arg test_parse_h; - "-parse_ch", " ", + "--parse-ch", " ", Common.mk_action_n_arg test_parse_ch; - - "-show_flow", " ", - Common.mk_action_1_arg test_cfg; - "-control_flow", " ", - Common.mk_action_1_arg test_cfg; - "-test_cfg_ifdef", " ", + "--parse-i", " ", + Common.mk_action_n_arg test_parse_i; + + "--parse", " ", + Common.mk_action_n_arg test_parse; + + "--show-flow", " ", + Common.mk_action_1_arg (local_test_cfg true); + "--control-flow", " ", + Common.mk_action_1_arg (local_test_cfg true); + "--control-flow-to-file", " ", + Common.mk_action_1_arg (local_test_cfg false); + "--test-cfg-ifdef", " ", Common.mk_action_1_arg test_cfg_ifdef; - "-parse_unparse", " ", + "--parse-unparse", " ", Common.mk_action_1_arg test_parse_unparse; - "-type_c", " ", +(* "--parse-and-print-sexp", " ", + Common.mk_action_1_arg parse_and_print_sexp;*) + "--type-c", " ", Common.mk_action_1_arg test_type_c; - "-compare_c", " ", + "--compare-c", " ", Common.mk_action_2_arg test_compare_c (* result is in unix code *); - "-comment_annotater_c", " ", + "--comment-annotater-c", " ", Common.mk_action_1_arg test_comment_annotater; - "-compare_c_hardcoded", " ", + "--compare-c-hardcoded", " ", Common.mk_action_0_arg test_compare_c_hardcoded; - "-test_attributes", " ", + "--test-attributes", " ", Common.mk_action_1_arg test_attributes; - "-test_cpp", " ", + "--test-cpp", " ", Common.mk_action_1_arg test_cpp; + "--extract-macros", " ", + Common.mk_action_1_arg (extract_macros ~selection:false) ; + + "--extract-macros-select", " ", + Common.mk_action_1_arg (extract_macros ~selection:true); - "-xxx", " <>", + "--xxx", " <>", Common.mk_action_n_arg test_xxx; ]