X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/4dfbc1c2559051afaa06fbd7f7be19276d24bf44..abad11c5570b7b9bbae5ff92b3050cf68fe3fd14:/parsing_c/type_annoter_c.ml

diff --git a/parsing_c/type_annoter_c.ml b/parsing_c/type_annoter_c.ml
index 010f2ab..d4fd615 100644
--- a/parsing_c/type_annoter_c.ml
+++ b/parsing_c/type_annoter_c.ml
@@ -164,6 +164,19 @@ type namedef =
   (* cppext: *)
   | Macro        of string * (define_kind * define_val)
 
+let print_scoped_env e =
+  List.iter
+    (function e ->
+      List.iter
+	(function
+	    VarOrFunc(s,_) -> Printf.printf "%s " s
+	  | EnumConstant(s,_) -> Printf.printf "%s " s
+	  | TypeDef(s,t) -> Printf.printf "%s" s
+	  | StructUnionNameDef(s,_) -> Printf.printf "%s " s
+	  | Macro(s,_) -> Printf.printf "%s " s)
+	e;
+      Printf.printf "\n")
+    e
 
 (* Because have nested scope, have nested list, hence the list list.
  *
@@ -189,10 +202,10 @@ let initial_env = ref [
 
   (*
    VarOrFunc("malloc",
-            (Lib.al_type(Parse_c.type_of_string "void* (*)(int size)"),
+            (Lib.al_type(Parse_c.type_of_string "void* ( * )(int size)"),
 	    Ast_c.NotLocalVar));
    VarOrFunc("free",
-            (Lib.al_type(Parse_c.type_of_string "void (*)(void *ptr)"),
+            (Lib.al_type(Parse_c.type_of_string "void ( * )(void *ptr)"),
 	    Ast_c.NotLocalVar));
   *)
   ]
@@ -334,6 +347,7 @@ let rec find_final_type ty env =
 
 (* ------------------------------------------------------------ *)
 let rec type_unfold_one_step ty env =
+  let rec loop seen ty env =
 
   match Ast_c.unwrap_typeC ty with
   | NoType        -> ty
@@ -365,7 +379,9 @@ let rec type_unfold_one_step ty env =
       (try
           if !typedef_debug then pr2 "type_unfold_one_step: lookup_typedef";
           let (t', env') = lookup_typedef s env in
-          type_unfold_one_step t' env'
+	  if List.mem s seen (* avoid pb with recursive typedefs *)
+	  then type_unfold_one_step t' env'
+          else loop (s::seen) t' env
        with Not_found ->
           ty
       )
@@ -374,7 +390,8 @@ let rec type_unfold_one_step ty env =
   | TypeOfExpr e ->
       pr2_once ("Type_annoter: not handling typeof");
       ty
-  | TypeOfType t -> type_unfold_one_step t env
+  | TypeOfType t -> type_unfold_one_step t env in
+  loop [] ty env
 
 
 
@@ -391,60 +408,68 @@ let rec type_unfold_one_step ty env =
  * for most tasks.
  *)
 let rec typedef_fix ty env =
-  match Ast_c.unwrap_typeC ty with
-  | NoType  ->
-      ty
-  | BaseType x  ->
-      ty
-  | Pointer t ->
-      Pointer (typedef_fix t env)  +> Ast_c.rewrap_typeC ty
-  | Array (e, t) ->
-      Array (e, typedef_fix t env) +> Ast_c.rewrap_typeC ty
-  | StructUnion (su, sopt, fields) ->
+  let rec loop seen ty env =
+    match Ast_c.unwrap_typeC ty with
+    | NoType  ->
+	ty
+    | BaseType x  ->
+	ty
+    | Pointer t ->
+	Pointer (typedef_fix t env)  +> Ast_c.rewrap_typeC ty
+    | Array (e, t) ->
+	Array (e, typedef_fix t env) +> Ast_c.rewrap_typeC ty
+    | StructUnion (su, sopt, fields) ->
       (* normalize, fold.
-       * todo? but what if correspond to a nested struct def ?
-       *)
-      Type_c.structdef_to_struct_name ty
-  | FunctionType ft ->
-      (FunctionType ft) (* todo ? *) +> Ast_c.rewrap_typeC ty
-  | Enum  (s, enumt) ->
-      (Enum  (s, enumt)) (* todo? *) +> Ast_c.rewrap_typeC ty
-  | EnumName s ->
-      (EnumName s) (* todo? *) +> Ast_c.rewrap_typeC ty
-
+	 * todo? but what if correspond to a nested struct def ?
+      *)
+	Type_c.structdef_to_struct_name ty
+    | FunctionType ft ->
+	(FunctionType ft) (* todo ? *) +> Ast_c.rewrap_typeC ty
+    | Enum  (s, enumt) ->
+	(Enum  (s, enumt)) (* todo? *) +> Ast_c.rewrap_typeC ty
+    | EnumName s ->
+	(EnumName s) (* todo? *) +> Ast_c.rewrap_typeC ty
+	  
   (* we prefer StructUnionName to StructUnion when it comes to typed metavar *)
-  | StructUnionName (su, s) -> ty
-
+    | StructUnionName (su, s) ->
+	ty
+	  
   (* keep the typename but complete with more information *)
-  | TypeName (name, typ) ->
-      let s = Ast_c.str_of_name name in
-      (match typ with
-      | Some _ ->
-          pr2 ("typedef value already there:" ^ s);
-          ty
-      | None ->
-        (try
-          if !typedef_debug then pr2 "typedef_fix: lookup_typedef";
-          let (t', env') = lookup_typedef s env in
-
+    | TypeName (name, typ) ->
+	let s = Ast_c.str_of_name name in
+	(match typ with
+	| Some _ ->
+            pr2 ("typedef value already there:" ^ s);
+            ty
+	| None ->
+            (try
+              if !typedef_debug then pr2 "typedef_fix: lookup_typedef";
+              let (t', env') = lookup_typedef s env in
+	      
           (* bugfix: termination bug if use env instead of env' below, because
-           * can have some weird mutually recursive typedef which
-           * each new type alias search for its mutual def.
-           *)
-          TypeName (name, Some (typedef_fix t' env')) +> Ast_c.rewrap_typeC ty
-        with Not_found ->
-          ty
-      ))
+             * can have some weird mutually recursive typedef which
+             * each new type alias search for its mutual def.
+	     * seen is an attempt to do better.
+          *)
+	      let fixed =
+		if List.mem s seen
+		then loop (s::seen) t' env
+		else typedef_fix t' env' in
+	      TypeName (name, Some fixed) +>
+	      Ast_c.rewrap_typeC ty
+            with Not_found ->
+              ty))
 
   (* remove paren for better matching with typed metavar. kind of iso again *)
-  | ParenType t ->
-      typedef_fix t env
-  | TypeOfExpr e ->
-      pr2_once ("Type_annoter: not handling typeof");
-      ty
+    | ParenType t ->
+	typedef_fix t env
+    | TypeOfExpr e ->
+	pr2_once ("Type_annoter: not handling typeof");
+	ty
 
-  | TypeOfType t ->
-      typedef_fix t env
+    | TypeOfType t ->
+	typedef_fix t env in
+  loop [] ty env
 
 
 (*****************************************************************************)
@@ -516,7 +541,6 @@ let add_in_scope namedef =
   let (current, older) = Common.uncons !_scoped_env in
   _scoped_env := (namedef::current)::older
 
-
 (* ------------------------------------------------------------ *)
 
 (* sort of hackish... *)
@@ -740,8 +764,7 @@ let annotater_expr_visitor_subpart = (fun (k,bigf) expr ->
     | Ident (ident) ->
         let s = Ast_c.str_of_name ident in
         (match lookup_opt_env lookup_var s with
-        | Some ((typ,local),_nextenv) ->
-            make_info_fix (typ,local)
+        | Some ((typ,local),_nextenv) -> make_info_fix (typ,local)
         | None  ->
             (match lookup_opt_env lookup_macro s with
             | Some ((defkind, defval), _nextenv) ->
@@ -811,12 +834,10 @@ let annotater_expr_visitor_subpart = (fun (k,bigf) expr ->
           make_info_def_fix ft
         )
 
-
     (* -------------------------------------------------- *)
     (* fields *)
     | RecordAccess  (e, namefld)
     | RecordPtAccess (e, namefld) as x ->
-
         let fld = Ast_c.str_of_name namefld in
 
         k expr; (* recurse to set the types-ref of sub expressions *)
@@ -831,7 +852,7 @@ let annotater_expr_visitor_subpart = (fun (k,bigf) expr ->
                 | Pointer (t) -> Some t
                 | _ -> None
                 )
-            | _ -> raise Impossible
+            | _ -> raise (Impossible 159)
 
           in
           (match topt with
@@ -1072,9 +1093,20 @@ let rec visit_toplevel ~just_add_in_env ~depth elem =
 
 
 	    let local =
-	      match local with
-	      | Ast_c.NotLocalDecl -> Ast_c.NotLocalVar
-	      |	Ast_c.LocalDecl -> Ast_c.LocalVar (Ast_c.info_of_type t)
+	      match (sto,local) with
+	      | (_,Ast_c.NotLocalDecl) -> Ast_c.NotLocalVar
+	      |	((Ast_c.Sto Ast_c.Static, _), Ast_c.LocalDecl) ->
+		  (match Ast_c.info_of_type t with
+		    (* if there is no info about the type it must not be
+		       present, so we don't know what the variable is *)
+		    None -> Ast_c.NotLocalVar
+		  | Some ii -> Ast_c.StaticLocalVar ii)
+	      |	(_,Ast_c.LocalDecl) ->
+		  (match Ast_c.info_of_type t with
+		    (* if there is no info about the type it must not be
+		       present, so we don't know what the variable is *)
+		    None -> Ast_c.NotLocalVar
+		  | Some ii -> Ast_c.LocalVar ii)
             in
             var +> Common.do_option (fun (name, iniopt) ->
               let s = Ast_c.str_of_name name in
@@ -1100,7 +1132,7 @@ let rec visit_toplevel ~just_add_in_env ~depth elem =
                   end
             );
           );
-      | MacroDecl _ ->
+      | MacroDecl _ | MacroDeclInit _ ->
           if need_annotate_body
           then k d
       );
@@ -1169,7 +1201,7 @@ let rec visit_toplevel ~just_add_in_env ~depth elem =
                *)
             | iifunc1::iifunc2::ibrace1::ibrace2::ifakestart::isto ->
                 iifunc1, iifunc2
-            | _ -> raise Impossible
+            | _ -> raise (Impossible 160)
           in
           let funcs = Ast_c.str_of_name name in
 
@@ -1187,7 +1219,14 @@ let rec visit_toplevel ~just_add_in_env ~depth elem =
                     match nameopt with
                     | Some name ->
                         let s = Ast_c.str_of_name name in
-		        let local = Ast_c.LocalVar (Ast_c.info_of_type t) in
+		        let local =
+			  (match Ast_c.info_of_type t with
+			    (* if there is no info about the type it must
+			       not be present, so we don't know what the
+			       variable is *)
+			    None -> Ast_c.NotLocalVar
+			  | Some ii -> Ast_c.LocalVar ii)
+			in
 		        add_binding (VarOrFunc (s,(Lib.al_type t,local))) true
                     | None ->
                     pr2 "no type, certainly because Void type ?"