open Common
+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
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");
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
+ 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 Parsing_stat.print_parsing_stat_list !stat_list;
-
- dirname_opt +> Common.do_option (fun dirname ->
- pr2 "--------------------------------";
+
+(* uses an explicit path; to fix
+ dirname_opt +> Common.do_option (fun dirname ->
+ pr2_xxxxxxxxxxxxxxxxx();
pr2 "regression testing information";
- pr2 "--------------------------------";
+ 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 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_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"
(* ---------------------------------------------------------------------- *)
(* 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 = 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_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
+ let flow = Ast_to_flow.ast_to_control_flow e in
+ 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
+ )
+ with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x
+ )
+ )
(* ---------------------------------------------------------------------- *)
-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;
()
+(*
+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 true
+ 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;
();;
+(* ---------------------------------------------------------------------- *)
+(* ex: demos/platform_ifdef.c *)
+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) +>
+ 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 ->
+ Pretty_print_c.pp_toplevel_simple ast;
+ );
+ );
+
+ let _ = Comment_annotater_c.annotate_program toks asts in
+
+ Common.adjust_pp_with_indent (fun () ->
+ pr2 "pretty print, after comment annotation: --->";
+ 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_xxx a =
+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) ->
+ 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 ->
+ match decl with
+ | DeclList (xs, ii) ->
+ xs +> List.iter (fun (onedecl, iicomma) ->
+
+ let sattr = Ast_c.s_of_attr onedecl.v_attr in
+ let idname =
+ match onedecl.v_namei with
+ | Some (name, ini) -> Ast_c.str_of_name name
+ | None -> "novar"
+ in
+ pr2 (spf "%-30s: %s" idname sattr);
+ );
+ | _ -> ()
+
+ );
+ } ast;
+ ()
+
+
+let cpp_options () = [
+ Cpp_ast_c.I "/home/yyzhou/pad/linux/include";
+] ++
+ Cpp_ast_c.cpp_option_of_cmdline
+ (!Flag_parsing_c.cpp_i_opts,!Flag_parsing_c.cpp_d_opts)
+
+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
+ * 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 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;
-
- "-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;
- "-parse_unparse", " <file>",
+ "-parse_i", " <file or dir>",
+ Common.mk_action_n_arg test_parse_i;
+
+ "-parse", " <file or dir>",
+ Common.mk_action_n_arg test_parse;
+
+ "-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>",
Common.mk_action_1_arg test_parse_unparse;
- "-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>",
+ Common.mk_action_1_arg test_comment_annotater;
- "-compare_c_hardcoded", " ",
+ "-compare_c_hardcoded", " ",
Common.mk_action_0_arg test_compare_c_hardcoded;
- "-xxx", " <file1> <>",
+ "-test_attributes", " <file>",
+ Common.mk_action_1_arg test_attributes;
+ "-test_cpp", " <file>",
+ Common.mk_action_1_arg test_cpp;
+
+ "-extract_macros", " <file or dir>",
+ Common.mk_action_1_arg (extract_macros ~selection:false) ;
+
+ "-extract_macros_select", " <file or dir>",
+ Common.mk_action_1_arg (extract_macros ~selection:true);
+
+
+ "-xxx", " <file1> <>",
Common.mk_action_n_arg test_xxx;
]
HCoop / bpt / coccinelle.git / blobdiff