X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/1eddfd5052863e93b723b26a1d1266471882f234..1b9ae60616d2f065ce16fe26385b684e13b40284:/parsing_c/test_parsing_c.ml diff --git a/parsing_c/test_parsing_c.ml b/parsing_c/test_parsing_c.ml index fc0e980..633c30d 100644 --- a/parsing_c/test_parsing_c.ml +++ b/parsing_c/test_parsing_c.ml @@ -24,6 +24,94 @@ let test_tokens_c file = () +(* ---------------------------------------------------------------------- *) + +(* 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 = + match xs with + | [x] when is_directory x -> Some x + | _ -> None + 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 = @@ -138,16 +226,18 @@ let local_test_cfg launchgv file = program +> List.iter (fun (e,_) -> let toprocess = match specific_func, e with - | None, _ -> true + | None, Ast_c.Definition (defbis,_) -> + Some (Ast_c.str_of_name (defbis.Ast_c.f_name)) | Some s, Ast_c.Definition (defbis,_) -> - s =$= Ast_c.str_of_name (defbis.Ast_c.f_name) - | _, _ -> false + 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 -> Ast_to_flow.deadcode_detection flow; @@ -161,12 +251,16 @@ let local_test_cfg launchgv file = *) flow in - let filename = Filename.temp_file "output" ".dot" in + 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 @@ -477,55 +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", " ", + "--show-flow", " ", Common.mk_action_1_arg (local_test_cfg true); - "-control_flow", " ", + "--control-flow", " ", Common.mk_action_1_arg (local_test_cfg true); - "-control_flow_to_file", " ", + "--control-flow-to-file", " ", Common.mk_action_1_arg (local_test_cfg false); - "-test_cfg_ifdef", " ", + "--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", " ", +(* "--parse-and-print-sexp", " ", Common.mk_action_1_arg parse_and_print_sexp;*) - "-type_c", " ", + "--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; ]