X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/951c78018cc91c58699aef95c0ccc20f34065162..1b9ae60616d2f065ce16fe26385b684e13b40284:/parsing_c/test_parsing_c.ml diff --git a/parsing_c/test_parsing_c.ml b/parsing_c/test_parsing_c.ml index 482ce1b..633c30d 100644 --- a/parsing_c/test_parsing_c.ml +++ b/parsing_c/test_parsing_c.ml @@ -4,7 +4,7 @@ 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 @@ -12,35 +12,123 @@ 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 = - + +(* Was in main, but using it in test_parsing_c *) +let get_files path = + let ch = + cmd_to_list (* same as "true, "", _" case *) + (if !Flag.include_headers + (* FIXME : Could we remove xs ? + -use_glimpse requires a singleton. + This is checked some lines before. + then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"") + else ("find "^(join " " (x::xs))^" -name \"*.c\"") + *) + then ("find "^ path ^" -name \"*.[ch]\"") + else ("find "^ path ^" -name \"*.c\"")) in + let cpp = + if !Flag.c_plus_plus + then cmd_to_list ("find "^ path ^" -name \"*.cpp\"") + else [] in + cpp @ ch + +let new_test_parse_gen xs = + 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 + process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in + *) + let fullxs = xs +> List.map get_files +> List.concat in + + let stat_list = ref [] in + let newscore = Common.empty_score () in + + Common.check_stack_nbfiles (List.length fullxs); + + fullxs +> List.iter (fun 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; + 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) + ); + +(* 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 + 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_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 = + match xs with + | [x] when is_directory x -> Some x + | _ -> None + 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 @@ -50,7 +138,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"); @@ -59,13 +147,13 @@ let test_parse_gen xs ext = pr2 ("PARSING: " ^ file); let (xs, stat) = Parse_c.parse_c_and_cpp file in - xs +> List.iter (fun (ast, (s, toks)) -> + 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 @@ -74,7 +162,7 @@ let test_parse_gen xs ext = ); (* uses an explicit path; to fix - dirname_opt +> Common.do_option (fun dirname -> + dirname_opt +> Common.do_option (fun dirname -> pr2_xxxxxxxxxxxxxxxxx(); pr2 "regression testing information"; pr2_xxxxxxxxxxxxxxxxx(); @@ -84,14 +172,14 @@ let test_parse_gen xs ext = let filename = "score_parsing__" ^str ^ def ^ ext ^ ".marshalled" in if Sys.file_exists filename then - Common.regression_testing newscore + Common.regression_testing newscore (Filename.concat score_path ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled")) ); *) - if not (null !stat_list) - then begin + if not (null !stat_list) + then begin Parsing_stat.print_recurring_problematic_tokens !stat_list; Parsing_stat.print_parsing_stat_list !stat_list; end; @@ -100,15 +188,15 @@ let test_parse_gen xs ext = 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 +(* 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 = +let test_parse_i xs = test_parse_gen xs "i" @@ -119,66 +207,75 @@ let test_parse_i 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_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 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 @@ -188,12 +285,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_c_and_cpp infile 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; @@ -204,10 +301,11 @@ let test_parse_unparse infile = () -let parse_and_print_sexp file = +(* +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 = + let _ast = Type_annoter_c.annotate_program !Type_annoter_c.initial_env ast in @@ -219,27 +317,27 @@ let parse_and_print_sexp file = 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_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; @@ -249,74 +347,74 @@ let test_type_c infile = (* ---------------------------------------------------------------------- *) (* ex: demos/platform_ifdef.c *) -let test_comment_annotater infile = +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" @@ -324,7 +422,7 @@ let test_attributes file = pr2 (spf "%-30s: %s" idname sattr); ); | _ -> () - + ); } ast; () @@ -332,44 +430,44 @@ 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_ifdef_statementize ast in - - + + () -(* CONFIG [ch] ? also do for .c ? maybe less needed now that I +(* 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 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 -> + 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 = + let macros = if selection - then Cpp_analysis_c.extract_dangerous_macros macros_and_filename + then Cpp_analysis_c.extract_dangerous_macros macros_and_filename else macros_and_filename in - macros +> List.iter (fun (file, defs) -> + macros +> List.iter (fun (file, defs) -> pr ("/* PARSING: " ^ file ^ " */"); - defs +> List.iter (fun (s, def) -> + defs +> List.iter (fun (s, def) -> let str = Cpp_token_c.string_of_define_def def in pr str; ) @@ -377,36 +475,36 @@ let extract_macros ~selection dir = () -let test_parse xs = +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 = + let dirname_opt = match xs with | [x] when is_directory x -> Some x | _ -> None in - dirname_opt +> Common.do_option (fun dir -> + dirname_opt +> Common.do_option (fun dir -> - let ext = "h" in + 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 -> + 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 + 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 + 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 ? *) @@ -422,7 +520,7 @@ let test_parse xs = let stat_list = ref [] in 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"); @@ -430,15 +528,15 @@ let test_parse xs = pr2 ("PARSING: " ^ file); let (xs, stat) = Parse_c.parse_c_and_cpp file in - xs +> List.iter (fun (ast, (s, toks)) -> + xs +> List.iter (fun (ast, (s, toks)) -> Parse_c.print_commentized toks ); Common.push2 stat stat_list; ); - - if not (null !stat_list) - then begin + + if not (null !stat_list) + then begin Parsing_stat.print_recurring_problematic_tokens !stat_list; Parsing_stat.print_parsing_stat_list !stat_list; end; @@ -452,7 +550,7 @@ let test_parse xs = (* ---------------------------------------------------------------------- *) -let test_xxx a = +let test_xxx a = () (* @@ -473,53 +571,57 @@ 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; - "-parse_i", " ", + "--parse-i", " ", Common.mk_action_n_arg test_parse_i; + "--parse-c++", " ", + Common.mk_action_n_arg new_test_parse_gen; - "-parse", " ", + "--parse", " ", Common.mk_action_n_arg test_parse; - "-show_flow", " ", - Common.mk_action_1_arg test_cfg; - "-control_flow", " ", - Common.mk_action_1_arg test_cfg; - "-test_cfg_ifdef", " ", + "--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; - "-parse_and_print_sexp", " ", - Common.mk_action_1_arg parse_and_print_sexp; - "-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", " ", + "--extract-macros", " ", Common.mk_action_1_arg (extract_macros ~selection:false) ; - "-extract_macros_select", " ", + "--extract-macros-select", " ", Common.mk_action_1_arg (extract_macros ~selection:true); - "-xxx", " <>", + "--xxx", " <>", Common.mk_action_n_arg test_xxx; ]