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 module Ast_to_flow = Control_flow_c_build
  10
  11 (*****************************************************************************)
  12 (* Subsystem testing *)
  13 (*****************************************************************************)
  14
  15 let test_tokens_c file =
  16   if not (file =~ ".*\\.c")
  17   then pr2 "warning: seems not a .c file";
  18
  19   Flag_parsing_c.debug_lexer := true;
  20   Flag_parsing_c.verbose_lexing := true;
  21   Flag_parsing_c.verbose_parsing := true;
  22
  23   Parse_c.tokens file +> List.iter (fun x -> pr2_gen x);
  24   ()
  25
  26
  27
  28 (* ---------------------------------------------------------------------- *)
  29 let test_parse_gen xs ext =
  30
  31   Flag_parsing_c.debug_typedef := true;
  32   Flag_parsing_c.debug_cpp := true;
  33   Flag_parsing_c.debug_etdt := false;
  34   Flag_parsing_c.filter_msg := true;
  35
  36   (*let dirname_opt =
  37     match xs with
  38     | [x] when is_directory x -> Some x
  39     | _ -> None
  40   in*)
  41
  42   (* old:
  43      let xs = if !Flag.dir then
  44      process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in
  45   *)
  46   let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in
  47
  48   let stat_list = ref [] in
  49   let newscore  = Common.empty_score () in
  50
  51   Common.check_stack_nbfiles (List.length fullxs);
  52
  53   fullxs +> List.iter (fun file ->
  54     if not (file =~ (".*\\."^ext))
  55     then pr2 ("warning: seems not a ."^ext^" file");
  56
  57
  58     pr2 "";
  59     pr2 ("PARSING: " ^ file);
  60
  61     let (xs, stat) = Parse_c.parse_c_and_cpp file in
  62     xs +> List.iter (fun (ast, (s, toks)) ->
  63       Parse_c.print_commentized toks
  64     );
  65
  66     Common.push2 stat stat_list;
  67     let s =
  68       sprintf "bad = %d, timeout = %B"
  69         stat.Parsing_stat.bad stat.Parsing_stat.have_timeout
  70     in
  71     if stat.Parsing_stat.bad =|= 0 && not stat.Parsing_stat.have_timeout
  72     then Hashtbl.add newscore file (Common.Ok)
  73     else Hashtbl.add newscore file (Common.Pb s)
  74   );
  75
  76 (* uses an explicit path; to fix
  77   dirname_opt +> Common.do_option (fun dirname ->
  78     pr2_xxxxxxxxxxxxxxxxx();
  79     pr2 "regression testing  information";
  80     pr2_xxxxxxxxxxxxxxxxx();
  81     let str = Str.global_replace (Str.regexp "/") "__" dirname in
  82     let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in
  83     let ext = if ext =$= "c" then "" else ext in
  84     let filename = "score_parsing__" ^str ^ def ^ ext ^ ".marshalled" in
  85     if Sys.file_exists filename
  86     then
  87       Common.regression_testing newscore
  88         (Filename.concat score_path
  89            ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled"))
  90   );
  91 *)
  92
  93   if not (null !stat_list)
  94   then begin
  95     Parsing_stat.print_recurring_problematic_tokens !stat_list;
  96     Parsing_stat.print_parsing_stat_list !stat_list;
  97   end;
  98   ()
  99
 100
 101 let test_parse_c xs =
 102   test_parse_gen xs "c"
 103 let test_parse_h xs =
 104   test_parse_gen xs "h"
 105 let test_parse_ch xs =
 106   test_parse_gen xs "[ch]"
 107
 108 (* could use a simpler parser than heavy parse_c_and_cpp here as there
 109  * is no more cpp stuff in the .i files
 110  *)
 111 let test_parse_i xs =
 112   test_parse_gen xs "i"
 113
 114
 115
 116
 117
 118
 119
 120 (* ---------------------------------------------------------------------- *)
 121 (* file can be   "foo.c"  or "foo.c:main" *)
 122 (* local function that is parameterized by whether to launch gv *)
 123 let local_test_cfg launchgv file =
 124   let (file, specific_func) =
 125     if file =~ "\\(.*\\.c\\):\\(.*\\)"
 126     then
 127       let (a,b) = matched2 file in
 128       a, Some b
 129     else
 130       file, None
 131   in
 132
 133   if not (file =~ ".*\\.c")
 134   then pr2 "warning: seems not a .c file";
 135
 136   let (program, _stat) = Parse_c.parse_c_and_cpp file in
 137
 138   program +> List.iter (fun (e,_) ->
 139     let toprocess =
 140       match specific_func, e with
 141       | None, Ast_c.Definition (defbis,_) ->
 142           Some (Ast_c.str_of_name (defbis.Ast_c.f_name))
 143       | Some s, Ast_c.Definition (defbis,_)  ->
 144           let nm = Ast_c.str_of_name (defbis.Ast_c.f_name) in
 145           if s =$= nm then Some nm else None
 146       | _, _ -> None
 147     in
 148
 149     match toprocess with
 150       None -> ()
 151     | Some fn -> (* old: Flow_to_ast.test !Flag.show_flow def *)
 152         try
 153           let flow = Ast_to_flow.ast_to_control_flow e in
 154           flow +> do_option (fun flow ->
 155             Ast_to_flow.deadcode_detection flow;
 156             let flow = Ast_to_flow.annotate_loop_nodes flow in
 157
 158             let flow' =
 159 (*
 160               if !Flag_cocci.show_before_fixed_flow
 161               then flow
 162               else Ctlcocci_integration.fix_flow_ctl flow
 163 *)
 164               flow
 165             in
 166             let filename =
 167               if launchgv
 168               then Filename.temp_file "output" ".dot"
 169               else
 170                 let fl = Filename.chop_extension (Filename.basename file) in
 171                 fl^":"^fn^".dot" in
 172             Ograph_extended.print_ograph_mutable flow' (filename) launchgv
 173           )
 174         with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x
 175       )
 176
 177 let test_cfg = local_test_cfg true
 178
 179
 180
 181 let test_cfg_ifdef file =
 182   let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
 183   let ast = Parse_c.program_of_program2 ast2 in
 184
 185   let ast = Cpp_ast_c.cpp_ifdef_statementize ast in
 186
 187   ast +> List.iter (fun e ->
 188     (try
 189         let flow = Ast_to_flow.ast_to_control_flow e in
 190         flow +> do_option (fun flow ->
 191           Ast_to_flow.deadcode_detection flow;
 192           let flow = Ast_to_flow.annotate_loop_nodes flow in
 193           Ograph_extended.print_ograph_mutable flow ("/tmp/output.dot") true
 194         )
 195       with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x
 196     )
 197   )
 198
 199 (* ---------------------------------------------------------------------- *)
 200 let test_parse_unparse infile =
 201   if not (infile =~ ".*\\.c")
 202   then pr2 "warning: seems not a .c file";
 203
 204   let (program2, _stat) = Parse_c.parse_c_and_cpp infile in
 205   let program2_with_ppmethod =
 206     program2 +> List.map (fun x -> x, Unparse_c.PPnormal)
 207   in
 208   Unparse_c.pp_program program2_with_ppmethod tmpfile;
 209   Common.command2 ("cat " ^ tmpfile);
 210   (* if want see diff of space => no -b -B *)
 211   Common.command2 (spf "diff -u -p  %s %s" infile tmpfile);
 212   (* +> Transformation.test_simple_trans1;*)
 213   ()
 214
 215
 216 (*
 217 let parse_and_print_sexp file =
 218   let (ast2,_stat) = Parse_c.parse_c_and_cpp file in
 219   let ast = Parse_c.program_of_program2 ast2 in
 220   let _ast =
 221     Type_annoter_c.annotate_program !Type_annoter_c.initial_env ast
 222   in
 223
 224   (*
 225   let sexp = Sexp_ast_c.sexp_of_program ast in
 226   let s = Sexp.to_string_hum sexp in
 227   *)
 228   Sexp_ast_c.show_info := false;
 229   let s = Sexp_ast_c.string_of_program ast in
 230   pr2 s;
 231   ()
 232 *)
 233
 234
 235 let test_type_c infile =
 236   if not (infile =~ ".*\\.c")
 237   then pr2 "warning: seems not a .c file";
 238
 239   Flag_parsing_c.pretty_print_type_info := true;
 240
 241   let (program2, _stat) =  Parse_c.parse_c_and_cpp infile in
 242   let _program2 =
 243     program2
 244     +> Common.unzip
 245     +> (fun (program, infos) ->
 246       Type_annoter_c.annotate_program !Type_annoter_c.initial_env
 247         program +> List.map fst,
 248       infos
 249     )
 250     +> Common.uncurry Common.zip
 251   in
 252   let program2_with_ppmethod =
 253     program2 +> List.map (fun x -> x, Unparse_c.PPnormal)
 254   in
 255   Unparse_c.pp_program program2_with_ppmethod tmpfile;
 256   Common.command2 ("cat " ^ tmpfile);
 257   ();;
 258
 259
 260 (* ---------------------------------------------------------------------- *)
 261 (* ex: demos/platform_ifdef.c *)
 262 let test_comment_annotater infile =
 263   let (program2, _stat) =  Parse_c.parse_c_and_cpp infile in
 264   let asts = program2 +> List.map (fun (ast,_) -> ast) in
 265   let toks = program2 +> List.map (fun (ast, (s, toks)) -> toks) +>
 266     List.flatten in
 267
 268   Flag_parsing_c.pretty_print_comment_info := true;
 269
 270   pr2 "pretty print, before comment annotation: --->";
 271   Common.adjust_pp_with_indent (fun () ->
 272   asts +> List.iter (fun ast ->
 273     Pretty_print_c.pp_toplevel_simple ast;
 274   );
 275   );
 276
 277   let _ = Comment_annotater_c.annotate_program toks asts in
 278
 279   Common.adjust_pp_with_indent (fun () ->
 280   pr2 "pretty print, after comment annotation: --->";
 281   asts +> List.iter (fun ast ->
 282     Pretty_print_c.pp_toplevel_simple ast;
 283   );
 284   );
 285
 286
 287   ()
 288
 289
 290 (* ---------------------------------------------------------------------- *)
 291 (* used by generic_makefile now *)
 292 let test_compare_c file1 file2 =
 293   let (correct, diffxs) = Compare_c.compare_default file1 file2 in
 294   let res = Compare_c.compare_result_to_bool correct in
 295   if res
 296   then raise (Common.UnixExit 0)
 297   else raise (Common.UnixExit (-1))
 298
 299
 300 let test_compare_c_hardcoded () =
 301   Compare_c.compare_default
 302     "tests/compare1.c"
 303     "tests/compare2.c"
 304     (*
 305       "tests/equal_modulo1.c"
 306       "tests/equal_modulo2.c"
 307     *)
 308   +> Compare_c.compare_result_to_string
 309   +> pr2
 310
 311
 312
 313 (* ---------------------------------------------------------------------- *)
 314 let test_attributes file =
 315   let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
 316   let ast = Parse_c.program_of_program2 ast2 in
 317
 318   Visitor_c.vk_program { Visitor_c.default_visitor_c with
 319     Visitor_c.kdef = (fun (k, bigf) (defbis, ii) ->
 320       let sattr  = Ast_c.s_of_attr defbis.f_attr in
 321       pr2 (spf "%-30s: %s" (Ast_c.str_of_name (defbis.f_name)) sattr);
 322     );
 323     Visitor_c.kdecl = (fun (k, bigf) decl ->
 324       match decl with
 325       | DeclList (xs, ii) ->
 326           xs +> List.iter (fun (onedecl, iicomma) ->
 327
 328             let sattr  = Ast_c.s_of_attr onedecl.v_attr in
 329             let idname =
 330               match onedecl.v_namei with
 331               | Some (name, ini) -> Ast_c.str_of_name name
 332               | None -> "novar"
 333             in
 334             pr2 (spf "%-30s: %s" idname sattr);
 335           );
 336       | _ -> ()
 337
 338     );
 339   } ast;
 340   ()
 341
 342
 343 let cpp_options () = [
 344   Cpp_ast_c.I "/home/yyzhou/pad/linux/include";
 345 ] ++
 346   Cpp_ast_c.cpp_option_of_cmdline
 347   (!Flag_parsing_c.cpp_i_opts,!Flag_parsing_c.cpp_d_opts)
 348
 349 let test_cpp file =
 350   let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
 351   let dirname = Filename.dirname file in
 352   let ast = Parse_c.program_of_program2 ast2 in
 353   let ast = Cpp_ast_c.cpp_expand_include (cpp_options()) dirname ast in
 354   let _ast = Cpp_ast_c.cpp_ifdef_statementize ast in
 355
 356
 357   ()
 358
 359
 360
 361 (* CONFIG [ch] ? also do for .c ? maybe less needed now that I
 362  * add local_macros.
 363  *)
 364 let extract_macros ~selection dir =
 365   let ext = "h" in
 366   let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in
 367   let macros_and_filename =
 368     fullxs +> List.map (fun file ->
 369       pr2 (spf "processing: %s" file);
 370       let xs = Parse_c.extract_macros file in
 371       file, xs
 372     )
 373   in
 374
 375   let macros =
 376     if selection
 377     then Cpp_analysis_c.extract_dangerous_macros macros_and_filename
 378     else macros_and_filename
 379   in
 380   macros +> List.iter (fun (file, defs) ->
 381     pr ("/* PARSING: " ^ file ^ " */");
 382     defs +> List.iter (fun (s, def) ->
 383       let str = Cpp_token_c.string_of_define_def def in
 384       pr str;
 385     )
 386   );
 387   ()
 388
 389
 390 let test_parse xs =
 391
 392   Flag_parsing_c.filter_msg_define_error := true;
 393   Flag_parsing_c.filter_define_error := true;
 394   Flag_parsing_c.verbose_lexing := false;
 395   Flag_parsing_c.verbose_parsing := false;
 396
 397   let dirname_opt =
 398     match xs with
 399     | [x] when is_directory x -> Some x
 400     | _ -> None
 401   in
 402   dirname_opt +> Common.do_option (fun dir ->
 403
 404     let ext = "h" in
 405     let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in
 406
 407     let macros_and_filename =
 408       fullxs +> List.map (fun file ->
 409         pr2 (spf "processing: %s" file);
 410         let xs = Parse_c.extract_macros file in
 411         file, xs
 412       )
 413     in
 414     let macros =
 415       Cpp_analysis_c.extract_dangerous_macros macros_and_filename
 416     in
 417     macros +> List.iter (fun (file, xs) ->
 418       xs +> List.iter (fun (x, def) ->
 419         let (s, params, body) = def in
 420         let str = Cpp_token_c.string_of_define_def def in
 421         pr str;
 422         (* builtins ? *)
 423         Hashtbl.replace !Parse_c._defs_builtins s (s, params, body);
 424       );
 425     );
 426   );
 427
 428   let ext = "[ch]" in
 429
 430   let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in
 431
 432   let stat_list = ref [] in
 433   Common.check_stack_nbfiles (List.length fullxs);
 434
 435   fullxs +> List.iter (fun file ->
 436     if not (file =~ (".*\\."^ext))
 437     then pr2 ("warning: seems not a ."^ext^" file");
 438
 439     pr2 "";
 440     pr2 ("PARSING: " ^ file);
 441
 442     let (xs, stat) = Parse_c.parse_c_and_cpp file in
 443     xs +> List.iter (fun (ast, (s, toks)) ->
 444       Parse_c.print_commentized toks
 445     );
 446
 447     Common.push2 stat stat_list;
 448   );
 449
 450   if not (null !stat_list)
 451   then begin
 452     Parsing_stat.print_recurring_problematic_tokens !stat_list;
 453     Parsing_stat.print_parsing_stat_list !stat_list;
 454   end;
 455   ()
 456
 457
 458
 459
 460
 461
 462
 463
 464 (* ---------------------------------------------------------------------- *)
 465 let test_xxx a  =
 466   ()
 467
 468 (*
 469   ignore(Parse_c.parse_cpp_define_file "standard.h")
 470   pr2 "pr2";
 471   pr  "pr"
 472
 473   Format.print_newline();
 474   Format.printf "@[<v 5>--@,--@,@[<v 5>--@,--@,@]--@,--@,@]";
 475   Format.print_newline();
 476   Format.printf "@[<v>(---@[<v>(---@[<v>(---@,)@]@,)@]@,)@]"
 477 *)
 478
 479
 480
 481 (*****************************************************************************)
 482 (* Main entry for Arg *)
 483 (*****************************************************************************)
 484
 485 let actions () = [
 486   "--tokens-c", "   <file>",
 487   Common.mk_action_1_arg test_tokens_c;
 488   "--parse-c", "   <file or dir>",
 489   Common.mk_action_n_arg test_parse_c;
 490   "--parse-h", "   <file or dir>",
 491   Common.mk_action_n_arg test_parse_h;
 492   "--parse-ch", "   <file or dir>",
 493   Common.mk_action_n_arg test_parse_ch;
 494   "--parse-i", "   <file or dir>",
 495   Common.mk_action_n_arg test_parse_i;
 496
 497   "--parse", "   <file or dir>",
 498   Common.mk_action_n_arg test_parse;
 499
 500   "--show-flow", "   <file or file:function>",
 501   Common.mk_action_1_arg (local_test_cfg true);
 502   "--control-flow", "   <file or file:function>",
 503   Common.mk_action_1_arg (local_test_cfg true);
 504   "--control-flow-to-file", "   <file or file:function>",
 505   Common.mk_action_1_arg (local_test_cfg false);
 506   "--test-cfg-ifdef", " <file>",
 507   Common.mk_action_1_arg test_cfg_ifdef;
 508   "--parse-unparse", "   <file>",
 509   Common.mk_action_1_arg test_parse_unparse;
 510 (*  "--parse-and-print-sexp", "   <file>",
 511     Common.mk_action_1_arg parse_and_print_sexp;*)
 512   "--type-c", "   <file>",
 513   Common.mk_action_1_arg test_type_c;
 514   "--compare-c", "   <file1> <file2>",
 515   Common.mk_action_2_arg test_compare_c (* result is in unix code *);
 516   "--comment-annotater-c", "   <file>",
 517   Common.mk_action_1_arg test_comment_annotater;
 518
 519   "--compare-c-hardcoded", "  ",
 520   Common.mk_action_0_arg test_compare_c_hardcoded;
 521
 522   "--test-attributes", " <file>",
 523   Common.mk_action_1_arg test_attributes;
 524   "--test-cpp", " <file>",
 525   Common.mk_action_1_arg test_cpp;
 526
 527   "--extract-macros", " <file or dir>",
 528   Common.mk_action_1_arg (extract_macros ~selection:false) ;
 529
 530   "--extract-macros-select", " <file or dir>",
 531   Common.mk_action_1_arg (extract_macros ~selection:true);
 532
 533
 534   "--xxx", "   <file1> <>",
 535   Common.mk_action_n_arg test_xxx;
 536 ]
 537