()
+(* ---------------------------------------------------------------------- *)
+
+(* 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 =
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
(* ---------------------------------------------------------------------- *)
(* file can be "foo.c" or "foo.c:main" *)
-let test_cfg file =
+(* local function that is parameterized by whether to launch gv *)
+let local_test_cfg launchgv file =
let (file, specific_func) =
if file =~ "\\(.*\\.c\\):\\(.*\\)"
then
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;
*)
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 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 s = Sexp_ast_c.string_of_program ast in
pr2 s;
()
-
+*)
let test_type_c infile =
(*****************************************************************************)
let actions () = [
- "-tokens_c", " <file>",
+ "--tokens-c", " <file>",
Common.mk_action_1_arg test_tokens_c;
- "-parse_c", " <file or dir>",
+ "--parse-c", " <file or dir>",
Common.mk_action_n_arg test_parse_c;
- "-parse_h", " <file or dir>",
+ "--parse-h", " <file or dir>",
Common.mk_action_n_arg test_parse_h;
- "-parse_ch", " <file or dir>",
+ "--parse-ch", " <file or dir>",
Common.mk_action_n_arg test_parse_ch;
- "-parse_i", " <file or dir>",
+ "--parse-i", " <file or dir>",
Common.mk_action_n_arg test_parse_i;
+ "--parse-c++", " <file or dir>",
+ Common.mk_action_n_arg new_test_parse_gen;
- "-parse", " <file or dir>",
+ "--parse", " <file or dir>",
Common.mk_action_n_arg test_parse;
- "-show_flow", " <file or file:function>",
- Common.mk_action_1_arg test_cfg;
- "-control_flow", " <file or file:function>",
- Common.mk_action_1_arg test_cfg;
- "-test_cfg_ifdef", " <file>",
+ "--show-flow", " <file or file:function>",
+ Common.mk_action_1_arg (local_test_cfg true);
+ "--control-flow", " <file or file:function>",
+ Common.mk_action_1_arg (local_test_cfg true);
+ "--control-flow-to-file", " <file or file:function>",
+ Common.mk_action_1_arg (local_test_cfg false);
+ "--test-cfg-ifdef", " <file>",
Common.mk_action_1_arg test_cfg_ifdef;
- "-parse_unparse", " <file>",
+ "--parse-unparse", " <file>",
Common.mk_action_1_arg test_parse_unparse;
- "-parse_and_print_sexp", " <file>",
- Common.mk_action_1_arg parse_and_print_sexp;
- "-type_c", " <file>",
+(* "--parse-and-print-sexp", " <file>",
+ Common.mk_action_1_arg parse_and_print_sexp;*)
+ "--type-c", " <file>",
Common.mk_action_1_arg test_type_c;
- "-compare_c", " <file1> <file2>",
+ "--compare-c", " <file1> <file2>",
Common.mk_action_2_arg test_compare_c (* result is in unix code *);
- "-comment_annotater_c", " <file>",
+ "--comment-annotater-c", " <file>",
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", " <file>",
+ "--test-attributes", " <file>",
Common.mk_action_1_arg test_attributes;
- "-test_cpp", " <file>",
+ "--test-cpp", " <file>",
Common.mk_action_1_arg test_cpp;
- "-extract_macros", " <file or dir>",
+ "--extract-macros", " <file or dir>",
Common.mk_action_1_arg (extract_macros ~selection:false) ;
- "-extract_macros_select", " <file or dir>",
+ "--extract-macros-select", " <file or dir>",
Common.mk_action_1_arg (extract_macros ~selection:true);
- "-xxx", " <file1> <>",
+ "--xxx", " <file1> <>",
Common.mk_action_n_arg test_xxx;
]