parsing_c/test_parsing_c.ml

   1 open Common
   2
   3 open Ast_c
   4
   5 let score_path = "/home/pad/c-yacfe/tmp"
   6
   7 let tmpfile = "/tmp/output.c"
   8
   9
  10 (*****************************************************************************)
  11 (* Subsystem testing *)
  12 (*****************************************************************************)
  13
  14 let test_tokens_c file =
  15   if not (file =~ ".*\\.c")
  16   then pr2 "warning: seems not a .c file";
  17
  18   Flag_parsing_c.debug_lexer := true;
  19   Flag_parsing_c.verbose_lexing := true;
  20   Flag_parsing_c.verbose_parsing := true;
  21
  22   Parse_c.tokens file +> List.iter (fun x -> pr2_gen x);
  23   ()
  24
  25
  26
  27 (* ---------------------------------------------------------------------- *)
  28 let test_parse_gen xs ext =
  29
  30   Flag_parsing_c.debug_typedef := true;
  31   Flag_parsing_c.debug_cpp := true;
  32   Flag_parsing_c.debug_etdt := false;
  33   Flag_parsing_c.filter_msg := true;
  34
  35   let dirname_opt =
  36     match xs with
  37     | [x] when is_directory x -> Some x
  38     | _ -> None
  39   in
  40
  41   (* old:
  42      let xs = if !Flag.dir then
  43      process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in
  44   *)
  45   let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in
  46
  47   let stat_list = ref [] in
  48   let newscore  = Common.empty_score () in
  49
  50   Common.check_stack_nbfiles (List.length fullxs);
  51
  52   fullxs +> List.iter (fun file ->
  53     if not (file =~ (".*\\."^ext))
  54     then pr2 ("warning: seems not a ."^ext^" file");
  55
  56
  57     pr2 "";
  58     pr2 ("PARSING: " ^ file);
  59
  60     let (xs, stat) = Parse_c.parse_print_error_heuristic file in
  61     xs +> List.iter (fun (ast, (s, toks)) ->
  62       Parse_c.print_commentized toks
  63     );
  64
  65     Common.push2 stat stat_list;
  66     let s =
  67       sprintf "bad = %d, timeout = %B"
  68         stat.Parsing_stat.bad stat.Parsing_stat.have_timeout
  69     in
  70     if stat.Parsing_stat.bad =|= 0 && not stat.Parsing_stat.have_timeout
  71     then Hashtbl.add newscore file (Common.Ok)
  72     else Hashtbl.add newscore file (Common.Pb s)
  73   );
  74
  75   if not (null !stat_list)
  76   then begin
  77     Parsing_stat.print_recurring_problematic_tokens !stat_list;
  78     Parsing_stat.print_parsing_stat_list !stat_list;
  79   end;
  80
  81   dirname_opt +> Common.do_option (fun dirname ->
  82     pr2_xxxxxxxxxxxxxxxxx();
  83     pr2 "regression testing  information";
  84     pr2_xxxxxxxxxxxxxxxxx();
  85     let str = Str.global_replace (Str.regexp "/") "__" dirname in
  86     let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in
  87     let ext = if ext =$= "c" then "" else ext in
  88     Common.regression_testing newscore
  89       (Filename.concat score_path
  90        ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled"))
  91   )
  92
  93
  94 let test_parse_c xs =
  95   test_parse_gen xs "c"
  96 let test_parse_h xs =
  97   test_parse_gen xs "h"
  98 let test_parse_ch xs =
  99   test_parse_gen xs "[ch]"
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112 (* ---------------------------------------------------------------------- *)
 113 (* file can be   "foo.c"  or "foo.c:main" *)
 114 let test_cfg file =
 115   let (file, specific_func) =
 116     if file =~ "\\(.*\\.c\\):\\(.*\\)"
 117     then
 118       let (a,b) = matched2 file in
 119       a, Some b
 120     else
 121       file, None
 122   in
 123
 124   if not (file =~ ".*\\.c")
 125   then pr2 "warning: seems not a .c file";
 126
 127   let (program, _stat) = Parse_c.parse_print_error_heuristic file in
 128
 129   program +> List.iter (fun (e,_) ->
 130     let toprocess =
 131       match specific_func, e with
 132       | None, _ -> true
 133       | Some s, Ast_c.Definition (defbis,_)  ->
 134           s =$= Ast_c.str_of_name (defbis.Ast_c.f_name)
 135       | _, _ -> false
 136     in
 137
 138     if toprocess
 139     then
 140       (* old: Flow_to_ast.test !Flag.show_flow def *)
 141       (try
 142           let flow = Ast_to_flow.ast_to_control_flow e in
 143           flow +> do_option (fun flow ->
 144             Ast_to_flow.deadcode_detection flow;
 145             let flow = Ast_to_flow.annotate_loop_nodes flow in
 146
 147             let flow' =
 148 (*
 149               if !Flag_cocci.show_before_fixed_flow
 150               then flow
 151               else Ctlcocci_integration.fix_flow_ctl flow
 152 *)
 153               flow
 154             in
 155             let filename = Filename.temp_file "output" ".dot" in
 156             Ograph_extended.print_ograph_mutable flow' (filename) true
 157           )
 158         with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x
 159       )
 160   )
 161
 162
 163
 164 let test_cfg_ifdef file =
 165   let (ast2, _stat) = Parse_c.parse_print_error_heuristic file in
 166   let ast = Parse_c.program_of_program2 ast2 in
 167
 168   let ast = Cpp_ast_c.cpp_ifdef_statementize ast in
 169
 170   ast +> List.iter (fun e ->
 171     (try
 172         let flow = Ast_to_flow.ast_to_control_flow e in
 173         flow +> do_option (fun flow ->
 174           Ast_to_flow.deadcode_detection flow;
 175           let flow = Ast_to_flow.annotate_loop_nodes flow in
 176           Ograph_extended.print_ograph_mutable flow ("/tmp/output.dot") true
 177         )
 178       with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x
 179     )
 180   )
 181
 182 (* ---------------------------------------------------------------------- *)
 183 let test_parse_unparse infile =
 184   if not (infile =~ ".*\\.c")
 185   then pr2 "warning: seems not a .c file";
 186
 187   let (program2, _stat) = Parse_c.parse_print_error_heuristic infile in
 188   let program2_with_ppmethod =
 189     program2 +> List.map (fun x -> x, Unparse_c.PPnormal)
 190   in
 191   Unparse_c.pp_program program2_with_ppmethod tmpfile;
 192   Common.command2 ("cat " ^ tmpfile);
 193   (* if want see diff of space => no -b -B *)
 194   Common.command2 (spf "diff -u -p  %s %s" infile tmpfile);
 195   (* +> Transformation.test_simple_trans1;*)
 196   ()
 197
 198
 199
 200
 201 let test_type_c infile =
 202   if not (infile =~ ".*\\.c")
 203   then pr2 "warning: seems not a .c file";
 204
 205   Flag_parsing_c.pretty_print_type_info := true;
 206
 207   let (program2, _stat) =  Parse_c.parse_print_error_heuristic infile in
 208   let _program2 =
 209     program2
 210     +> Common.unzip
 211     +> (fun (program, infos) ->
 212       Type_annoter_c.annotate_program !Type_annoter_c.initial_env
 213         program +> List.map fst,
 214       infos
 215     )
 216     +> Common.uncurry Common.zip
 217   in
 218   let program2_with_ppmethod =
 219     program2 +> List.map (fun x -> x, Unparse_c.PPnormal)
 220   in
 221   Unparse_c.pp_program program2_with_ppmethod tmpfile;
 222   Common.command2 ("cat " ^ tmpfile);
 223   ();;
 224
 225
 226 (* ---------------------------------------------------------------------- *)
 227 (* ex: demos/platform_ifdef.c *)
 228 let test_comment_annotater infile =
 229   let (program2, _stat) =  Parse_c.parse_print_error_heuristic infile in
 230   let asts = program2 +> List.map (fun (ast,_) -> ast) in
 231   let toks = program2 +> List.map (fun (ast, (s, toks)) -> toks) +>
 232     List.flatten in
 233
 234   Flag_parsing_c.pretty_print_comment_info := true;
 235
 236   pr2 "pretty print, before comment annotation: --->";
 237   Common.adjust_pp_with_indent (fun () ->
 238   asts +> List.iter (fun ast ->
 239     Pretty_print_c.pp_toplevel_simple ast;
 240   );
 241   );
 242
 243   let _ = Comment_annotater_c.annotate_program toks asts in
 244
 245   Common.adjust_pp_with_indent (fun () ->
 246   pr2 "pretty print, after comment annotation: --->";
 247   asts +> List.iter (fun ast ->
 248     Pretty_print_c.pp_toplevel_simple ast;
 249   );
 250   );
 251
 252
 253   ()
 254
 255
 256 (* ---------------------------------------------------------------------- *)
 257 (* used by generic_makefile now *)
 258 let test_compare_c file1 file2 =
 259   let (correct, diffxs) = Compare_c.compare_default file1 file2 in
 260   let res = Compare_c.compare_result_to_bool correct in
 261   if res
 262   then raise (Common.UnixExit 0)
 263   else raise (Common.UnixExit (-1))
 264
 265
 266 let test_compare_c_hardcoded () =
 267   Compare_c.compare_default
 268     "tests/compare1.c"
 269     "tests/compare2.c"
 270     (*
 271       "tests/equal_modulo1.c"
 272       "tests/equal_modulo2.c"
 273     *)
 274   +> Compare_c.compare_result_to_string
 275   +> pr2
 276
 277
 278
 279 (* ---------------------------------------------------------------------- *)
 280 let test_attributes file =
 281   let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
 282   let ast = Parse_c.program_of_program2 ast2 in
 283
 284   Visitor_c.vk_program { Visitor_c.default_visitor_c with
 285     Visitor_c.kdef = (fun (k, bigf) (defbis, ii) ->
 286       let sattr  = Ast_c.s_of_attr defbis.f_attr in
 287       pr2 (spf "%-30s: %s" (Ast_c.str_of_name (defbis.f_name)) sattr);
 288     );
 289     Visitor_c.kdecl = (fun (k, bigf) decl ->
 290       match decl with
 291       | DeclList (xs, ii) ->
 292           xs +> List.iter (fun (onedecl, iicomma) ->
 293
 294             let sattr  = Ast_c.s_of_attr onedecl.v_attr in
 295             let idname =
 296               match onedecl.v_namei with
 297               | Some (name, ini) -> Ast_c.str_of_name name
 298               | None -> "novar"
 299             in
 300             pr2 (spf "%-30s: %s" idname sattr);
 301           );
 302       | _ -> ()
 303
 304     );
 305   } ast;
 306   ()
 307
 308
 309 let cpp_options () = [
 310   Cpp_ast_c.I "/home/yyzhou/pad/linux/include";
 311 ] ++
 312   Cpp_ast_c.cpp_option_of_cmdline
 313   (!Flag_parsing_c.cpp_i_opts,!Flag_parsing_c.cpp_d_opts)
 314
 315 let test_cpp file =
 316   let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
 317   let dirname = Filename.dirname file in
 318   let ast = Parse_c.program_of_program2 ast2 in
 319   let _ast' = Cpp_ast_c.cpp_expand_include (cpp_options()) dirname ast in
 320
 321   ()
 322
 323
 324
 325
 326 (* ---------------------------------------------------------------------- *)
 327 let test_xxx a  =
 328   ()
 329
 330 (*
 331   ignore(Parse_c.parse_cpp_define_file "standard.h")
 332   pr2 "pr2";
 333   pr  "pr"
 334
 335   Format.print_newline();
 336   Format.printf "@[<v 5>--@,--@,@[<v 5>--@,--@,@]--@,--@,@]";
 337   Format.print_newline();
 338   Format.printf "@[<v>(---@[<v>(---@[<v>(---@,)@]@,)@]@,)@]"
 339 *)
 340
 341
 342
 343 (*****************************************************************************)
 344 (* Main entry for Arg *)
 345 (*****************************************************************************)
 346
 347 let actions () = [
 348   "-tokens_c", "   <file>",
 349   Common.mk_action_1_arg test_tokens_c;
 350   "-parse_c", "   <file or dir>",
 351   Common.mk_action_n_arg test_parse_c;
 352   "-parse_h", "   <file or dir>",
 353   Common.mk_action_n_arg test_parse_h;
 354   "-parse_ch", "   <file or dir>",
 355   Common.mk_action_n_arg test_parse_ch;
 356
 357   "-show_flow", "   <file or file:function>",
 358   Common.mk_action_1_arg test_cfg;
 359   "-control_flow", "   <file or file:function>",
 360   Common.mk_action_1_arg test_cfg;
 361   "-test_cfg_ifdef", " <file>",
 362   Common.mk_action_1_arg test_cfg_ifdef;
 363   "-parse_unparse", "   <file>",
 364   Common.mk_action_1_arg test_parse_unparse;
 365   "-type_c", "   <file>",
 366   Common.mk_action_1_arg test_type_c;
 367   "-compare_c", "   <file1> <file2>",
 368   Common.mk_action_2_arg test_compare_c (* result is in unix code *);
 369   "-comment_annotater_c", "   <file>",
 370   Common.mk_action_1_arg test_comment_annotater;
 371
 372   "-compare_c_hardcoded", "  ",
 373   Common.mk_action_0_arg test_compare_c_hardcoded;
 374
 375   "-test_attributes", " <file>",
 376   Common.mk_action_1_arg test_attributes;
 377   "-test_cpp", " <file>",
 378   Common.mk_action_1_arg test_cpp;
 379
 380
 381
 382   "-xxx", "   <file1> <>",
 383   Common.mk_action_n_arg test_xxx;
 384 ]
 385