Version 1.0.0-rc17 has been released. Some changes are:
[bpt/coccinelle.git] / parsing_c / test_parsing_c.ml
index fc0e980..633c30d 100644 (file)
@@ -24,6 +24,94 @@ let test_tokens_c file =
   ()
 
 
+(* ---------------------------------------------------------------------- *)
+
+(* 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 =
@@ -138,16 +226,18 @@ let local_test_cfg launchgv file =
   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;
@@ -161,12 +251,16 @@ let local_test_cfg launchgv file =
 *)
               flow
             in
-           let filename = Filename.temp_file "output" ".dot" in
+           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
 
@@ -477,55 +571,57 @@ 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;
-  "-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>",
+  "--show-flow", "   <file or file:function>",
   Common.mk_action_1_arg (local_test_cfg true);
-  "-control_flow", "   <file or file:function>",
+  "--control-flow", "   <file or file:function>",
   Common.mk_action_1_arg (local_test_cfg true);
-  "-control_flow_to_file", "   <file or file:function>",
+  "--control-flow-to-file", "   <file or file:function>",
   Common.mk_action_1_arg (local_test_cfg false);
-  "-test_cfg_ifdef", " <file>",
+  "--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>",
+(*  "--parse-and-print-sexp", "   <file>",
     Common.mk_action_1_arg parse_and_print_sexp;*)
-  "-type_c", "   <file>",
+  "--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;
 ]