parsing_c/test_parsing_c.ml

   1 open Common
   2
   3 let score_path = "/home/pad/c-yacfe/tmp"
   4
   5 let tmpfile = "/tmp/output.c"
   6
   7 (*****************************************************************************)
   8 (* Subsystem testing *)
   9 (*****************************************************************************)
  10
  11 let test_tokens_c file =
  12   if not (file =~ ".*\\.c")
  13   then pr2 "warning: seems not a .c file";
  14
  15   Flag_parsing_c.debug_lexer := true;
  16   Flag_parsing_c.verbose_lexing := true;
  17   Flag_parsing_c.verbose_parsing := true;
  18
  19   Parse_c.tokens file +> List.iter (fun x -> pr2_gen x);
  20   ()
  21
  22
  23
  24 (* ---------------------------------------------------------------------- *)
  25 let test_parse_gen xs ext =
  26
  27   Flag_parsing_c.debug_typedef := true;
  28   Flag_parsing_c.debug_cpp := true;
  29   Flag_parsing_c.debug_etdt := false;
  30   Flag_parsing_c.filter_msg := true;
  31
  32   let dirname_opt =
  33     match xs with
  34     | [x] when is_directory x -> Some x
  35     | _ -> None
  36   in
  37
  38   (* old:
  39      let xs = if !Flag.dir then
  40      process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in
  41   *)
  42   let fullxs = Common.files_of_dir_or_files ext xs in
  43
  44   let stat_list = ref [] in
  45   let newscore  = Common.empty_score () in
  46
  47   (*cocci: Common.check_stack_nbfiles (List.length fullxs); *)
  48
  49   fullxs +> List.iter (fun file ->
  50     if not (file =~ (".*\\."^ext))
  51     then pr2 ("warning: seems not a ."^ext^" file");
  52
  53
  54     pr2 "";
  55     pr2 ("PARSING: " ^ file);
  56
  57     let (xs, stat) = Parse_c.parse_print_error_heuristic file in
  58     xs +> List.iter (fun (ast, (s, toks)) ->
  59       Parse_c.print_commentized toks
  60     );
  61
  62     Common.push2 stat stat_list;
  63     let s =
  64       sprintf "bad = %d, timeout = %B"
  65         stat.Parse_c.bad stat.Parse_c.have_timeout
  66     in
  67     if stat.Parse_c.bad = 0 && not stat.Parse_c.have_timeout
  68     then Hashtbl.add newscore file (Common.Ok)
  69     else Hashtbl.add newscore file (Common.Pb s)
  70   );
  71
  72   if not (null !stat_list)
  73   then Parse_c.print_parsing_stat_list !stat_list;
  74
  75   dirname_opt +> Common.do_option (fun dirname ->
  76     pr2 "--------------------------------";
  77     pr2 "regression testing  information";
  78     pr2 "--------------------------------";
  79     let str = Str.global_replace (Str.regexp "/") "__" dirname in
  80     let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in
  81     let ext = if ext = "c" then "" else ext in
  82     Common.regression_testing newscore
  83       (Filename.concat score_path
  84        ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled"))
  85   )
  86
  87
  88 let test_parse_c xs =
  89   test_parse_gen xs "c"
  90 let test_parse_h xs =
  91   test_parse_gen xs "h"
  92 let test_parse_ch xs =
  93   test_parse_gen xs "[ch]"
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106 (* ---------------------------------------------------------------------- *)
 107 (* file can be   "foo.c"  or "foo.c:main" *)
 108 let test_cfg file =
 109
 110   let (file, specific_func) =
 111     if file =~ "\\(.*\\.c\\):\\(.*\\)"
 112     then
 113       let (a,b) = matched2 file in
 114       a, Some b
 115     else
 116       file, None
 117   in
 118
 119   if not (file =~ ".*\\.c")
 120   then pr2 "warning: seems not a .c file";
 121
 122   let (program, _stat) = Parse_c.parse_print_error_heuristic file in
 123
 124   program +> List.iter (fun (e,_) ->
 125     let toprocess =
 126       match specific_func, e with
 127       | None, _ -> true
 128       | Some s, Ast_c.Definition (((funcs, _, _, c),_))  ->
 129           s = funcs
 130       | _, _ -> false
 131     in
 132
 133     if toprocess
 134     then
 135       (* old: Flow_to_ast.test !Flag.show_flow def *)
 136       (try
 137           let flow = Ast_to_flow.ast_to_control_flow e in
 138           flow +> do_option (fun flow ->
 139             Ast_to_flow.deadcode_detection flow;
 140             let flow = Ast_to_flow.annotate_loop_nodes flow in
 141
 142             let flow' =
 143 (*
 144               if !Flag_cocci.show_before_fixed_flow
 145               then flow
 146               else Ctlcocci_integration.fix_flow_ctl flow
 147 *)
 148               flow
 149             in
 150             Ograph_extended.print_ograph_mutable flow' ("/tmp/output.dot") true
 151           )
 152         with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x
 153       )
 154   )
 155
 156
 157
 158
 159 (* ---------------------------------------------------------------------- *)
 160 let test_parse_unparse infile =
 161   if not (infile =~ ".*\\.c")
 162   then pr2 "warning: seems not a .c file";
 163
 164 (* for cocci: to remove one day
 165   let (program2, _stat) = Parse_c.parse_print_error_heuristic infile in
 166   let program2_with_ppmethod =
 167     program2 +> List.map (fun x -> x, Unparse_c2.PPnormal)
 168   in
 169   Unparse_c2.pp_program program2_with_ppmethod tmpfile;
 170   Common.command2 ("cat " ^ tmpfile);
 171   (* if want see diff of space => no -b -B *)
 172   Common.command2 (spf "diff -u -p  %s %s" infile tmpfile);
 173   (* +> Transformation.test_simple_trans1;*)
 174 *)
 175   ()
 176
 177
 178
 179
 180 let test_type_c infile =
 181   if not (infile =~ ".*\\.c")
 182   then pr2 "warning: seems not a .c file";
 183
 184   Flag_parsing_c.pretty_print_type_info := true;
 185
 186   let (program2, _stat) =  Parse_c.parse_print_error_heuristic infile in
 187   let _program2 =
 188     program2
 189     +> Common.unzip
 190     +> (fun (program, infos) ->
 191       Type_annoter_c.annotate_program Type_annoter_c.initial_env true
 192         program +> List.map fst,
 193       infos
 194     )
 195     +> Common.uncurry Common.zip
 196   in
 197 (* for cocci: to remove one day *)
 198   let program2_with_ppmethod =
 199     program2 +> List.map (fun x -> x, Unparse_c2.PPnormal)
 200   in
 201   Unparse_c2.pp_program program2_with_ppmethod tmpfile;
 202   Common.command2 ("cat " ^ tmpfile);
 203   ();;
 204
 205
 206 (* ---------------------------------------------------------------------- *)
 207 (* used by generic_makefile now *)
 208 let test_compare_c file1 file2 =
 209   let (correct, diffxs) = Compare_c.compare_default file1 file2 in
 210   let res = Compare_c.compare_result_to_bool correct in
 211   if res
 212   then raise (Common.UnixExit 0)
 213   else raise (Common.UnixExit (-1))
 214
 215
 216 let test_compare_c_hardcoded () =
 217   Compare_c.compare_default
 218     "tests/compare1.c"
 219     "tests/compare2.c"
 220     (*
 221       "tests/equal_modulo1.c"
 222       "tests/equal_modulo2.c"
 223     *)
 224   +> Compare_c.compare_result_to_string
 225   +> pr2
 226
 227
 228
 229 (* ---------------------------------------------------------------------- *)
 230 let test_xxx a  =
 231   ()
 232
 233 (*
 234   ignore(Parse_c.parse_cpp_define_file "standard.h")
 235   pr2 "pr2";
 236   pr  "pr"
 237
 238   Format.print_newline();
 239   Format.printf "@[<v 5>--@,--@,@[<v 5>--@,--@,@]--@,--@,@]";
 240   Format.print_newline();
 241   Format.printf "@[<v>(---@[<v>(---@[<v>(---@,)@]@,)@]@,)@]"
 242 *)
 243
 244
 245
 246 (*****************************************************************************)
 247 (* Main entry for Arg *)
 248 (*****************************************************************************)
 249
 250 let actions () = [
 251   "-tokens_c", "   <file>",
 252   Common.mk_action_1_arg test_tokens_c;
 253   "-parse_c", "   <file or dir>",
 254   Common.mk_action_n_arg test_parse_c;
 255   "-parse_h", "   <file or dir>",
 256   Common.mk_action_n_arg test_parse_h;
 257   "-parse_ch", "   <file or dir>",
 258   Common.mk_action_n_arg test_parse_ch;
 259
 260   "-show_flow", "   <file or file:function>",
 261   Common.mk_action_1_arg test_cfg;
 262   "-control_flow", "   <file or file:function>",
 263   Common.mk_action_1_arg test_cfg;
 264   "-parse_unparse", "   <file>",
 265   Common.mk_action_1_arg test_parse_unparse;
 266   "-type_c", "   <file>",
 267   Common.mk_action_1_arg test_type_c;
 268   "-compare_c", "   <file1> <file2>",
 269   Common.mk_action_2_arg test_compare_c (* result is in unix code *);
 270
 271   "-compare_c_hardcoded", "  ",
 272   Common.mk_action_0_arg test_compare_c_hardcoded;
 273
 274   "-xxx", "   <file1> <>",
 275   Common.mk_action_n_arg test_xxx;
 276 ]
 277