Expose issue with multiple anonymous struct.

src/cstubs/cstubs_structs.ml

@@ -78,14 +78,14 @@ let cases fmt list prologue epilogue ~case =
 
 let write_field fmt specs =
   let case = function
-  | `Struct (tag, typedef), fname ->
+  | `Struct (tag, typedef, stamp), fname ->
     let foffset fmt = offsetof fmt (typedef, fname) in
-    puts fmt (Printf.sprintf "  | Struct ({ tag = %S; _} as s'), %S ->" tag fname);
+    puts fmt (Printf.sprintf "  | Struct ({ tag = %S; stamp = %d; _} as s'), %S ->" tag stamp fname);
     printf1 fmt             "    let f = {ftype; fname; foffset = %zu} in \n" foffset;
     puts fmt                "    (s'.fields <- BoxedField f :: s'.fields; f)";
-  | `Union (tag, typedef), fname ->
+  | `Union (tag, typedef, stamp), fname ->
     let foffset fmt = offsetof fmt (typedef, fname) in
-    puts fmt (Printf.sprintf "  | Union ({ utag = %S; _} as s'), %S ->" tag fname);
+    puts fmt (Printf.sprintf "  | Union ({ utag = %S; stamp = %d; _} as s'), %S ->" tag stamp fname);
     printf1 fmt             "    let f = {ftype; fname; foffset = %zu} in \n" foffset;
     puts fmt                "    (s'.ufields <- BoxedField f :: s'.ufields; f)";
   | _ -> raise (Unsupported "Adding a field to non-structured type")
@@ -102,15 +102,15 @@ let write_field fmt specs =
 
 let write_seal fmt specs =
   let case = function
-    | `Struct (tag, typedef) ->
+    | `Struct (tag, typedef, stamp) ->
         let ssize fmt = sizeof fmt typedef
         and salign fmt = alignmentof fmt typedef in
-        puts fmt (Printf.sprintf "  | Struct ({ tag = %S; spec = Incomplete _; _ } as s') ->" tag);
+        puts fmt (Printf.sprintf "  | Struct ({ tag = %S; spec = Incomplete _; stamp = %d; _ } as s') ->" tag stamp);
         printf2 fmt              "    s'.spec <- Complete { size = %zu; align = %zu }\n" ssize salign;
-    | `Union (tag, typedef) ->
+    | `Union (tag, typedef, stamp) ->
         let usize fmt = sizeof fmt typedef
         and ualign fmt = alignmentof fmt typedef in
-        puts fmt (Printf.sprintf "  | Union ({ utag = %S; uspec = None; _ } as s') ->" tag);
+        puts fmt (Printf.sprintf "  | Union ({ utag = %S; uspec = None; stamp = %d; _ } as s') ->" tag stamp);
         printf2 fmt              "    s'.uspec <- Some { size = %zu; align = %zu }\n" usize ualign;
     | `Other -> 
       raise (Unsupported "Sealing a non-structured type")
@@ -255,11 +255,11 @@ let gen_c () =
       open Ctypes_static
       let rec field' : type a s r. string -> s typ -> string -> a typ -> (a, r) field =
         fun structname s fname ftype -> match s with 
-        | Struct { tag } ->
-          fields := (`Struct (tag, structname), fname) :: !fields;
+        | Struct { tag; stamp } ->
+          fields := (`Struct (tag, structname, stamp), fname) :: !fields;
           { ftype; foffset = -1; fname}
-        | Union { utag } ->
-          fields := (`Union (utag, structname), fname) :: !fields;
+        | Union { utag; stamp } ->
+          fields := (`Union (utag, structname, stamp), fname) :: !fields;
           { ftype; foffset = -1; fname}
         | View { ty } -> 
           field' structname ty fname ftype
@@ -269,10 +269,10 @@ let gen_c () =
 
       let rec seal' : type s. string -> s typ -> unit =
         fun structname -> function
-        | Struct { tag } ->
-          structures := `Struct (tag, structname) :: !structures
-        | Union { utag } ->
-          structures := `Union (utag, structname) :: !structures
+        | Struct { tag; stamp } ->
+          structures := `Struct (tag, structname, stamp) :: !structures
+        | Union { utag; stamp } ->
+          structures := `Union (utag, structname, stamp) :: !structures
         | View { ty } ->
            seal' structname ty
         | _ -> raise (Unsupported "Sealing a field to non-structured type")

src/ctypes/ctypes_static.ml

@@ -71,12 +71,14 @@ and ('a, 's) field = {
 }
 and 'a structure_type = {
   tag: string;
+  stamp : int;
   mutable spec: 'a structspec;
   (* fields are in reverse order iff the struct type is incomplete *)
   mutable fields : 'a structure boxed_field list;
 }
 and 'a union_type = {
   utag: string;
+  stamp : int;
   mutable uspec: structured_spec option;
   (* fields are in reverse order iff the union type is incomplete *)
   mutable ufields : 'a union boxed_field list;
@@ -263,10 +265,13 @@ let returning v =
     Returns v
 let static_funptr fn = Funptr fn
 
+let stamp = ref 0
+let new_stamp () = incr stamp; !stamp
+
 let structure tag =
-  Struct { spec = Incomplete { isize = 0 }; tag; fields = [] }
+  Struct { spec = Incomplete { isize = 0 }; tag; stamp = new_stamp (); fields = [] }
 
-let union utag = Union { utag; uspec = None; ufields = [] }
+let union utag = Union { utag; uspec = None; stamp = new_stamp (); ufields = [] }
 
 let offsetof { foffset } = foffset
 let field_type { ftype } = ftype

src/ctypes/ctypes_static.mli

@@ -65,11 +65,13 @@ and ('a, 's) field = {
 }
 and 'a structure_type = {
   tag: string;
+  stamp : int;
   mutable spec: 'a structspec;
   mutable fields : 'a structure boxed_field list;
 }
 and 'a union_type = {
   utag: string;
+  stamp : int;
   mutable uspec: structured_spec option;
   mutable ufields : 'a union boxed_field list;
 }

tests/clib/test_functions.c

@@ -654,11 +654,18 @@ size_t sizeof_s6(void) { return sizeof(s6); }
 size_t alignmentof_s6(void) { return offsetof(struct { char c; s6 x; }, x); }
 size_t offsetof_v1(void) { return offsetof(s6, v1); }
 size_t offsetof_v2(void) { return offsetof(s6, v2); }
+size_t sizeof_s7(void) { return sizeof(s7); }
+size_t alignmentof_s7(void) { return offsetof(struct { char c; s7 x; }, x); }
+size_t offsetof_s7_v1(void) { return offsetof(s7, v1); }
+size_t offsetof_s7_v2(void) { return offsetof(s7, v2); }
+size_t offsetof_s7_v3(void) { return offsetof(s7, v3); }
 
 size_t sizeof_u1(void) { return sizeof(union u1); }
 size_t alignmentof_u1(void) { return offsetof (struct { char c; union u1 x; }, x); }
 size_t sizeof_u2(void) { return sizeof(u2); }
 size_t alignmentof_u2(void) { return offsetof (struct { char c; u2 x; }, x); }
+size_t sizeof_u3(void) { return sizeof(u3); }
+size_t alignmentof_u3(void) { return offsetof (struct { char c; u3 x; }, x); }
 
 bool bool_and(bool l, bool r)
 {

tests/clib/test_functions.h

@@ -180,6 +180,7 @@ struct s3 { int z1; struct s3 *z2; };
 struct s4 { struct s3 z3; struct s3 *z4; };
 struct s5 { int (*w1)(struct s1 *); };
 typedef struct { int v1; float v2; } s6;
+typedef struct { int v1; float v2; int v3; } s7;
 
 size_t sizeof_s1(void);
 size_t alignmentof_s1(void);
@@ -208,16 +209,25 @@ size_t sizeof_s6(void);
 size_t alignmentof_s6(void);
 size_t offsetof_v1(void);
 size_t offsetof_v2(void);
+size_t sizeof_s7(void);
+size_t alignmentof_s7(void);
+size_t offsetof_s7_v1(void);
+size_t offsetof_s7_v2(void);
+size_t offsetof_s7_v3(void);
 
 union u1 { char x1; float x2; double x3; char x4[13]; };
 typedef union { int t1; float t2; } u2;
+typedef union { int t1; float t2; double t3; } u3;
 
 size_t sizeof_u1(void);
 size_t alignmentof_u1(void);
 
 size_t sizeof_u2(void);
 size_t alignmentof_u2(void);
 
+size_t sizeof_u3(void);
+size_t alignmentof_u3(void);
+
 bool bool_and(bool, bool);
 int call_s5(struct s1 *, struct s5 *);
 

tests/test-structs/stubs/types.ml

@@ -49,4 +49,12 @@ struct
   let v1 = field s6 "v1" int
   let v2 = field s6 "v2" float
   let () = seal s6
+
+  (* adding fields through views (typedefs) *)
+  let struct_s7 : [`s7] structure typ = structure ""
+  let s7 = typedef struct_s7 "s7"
+  let s7_v1 = field s7 "v1" int
+  let s7_v2 = field s7 "v2" float
+  let s7_v3 = field s7 "v3" int
+  let () = seal s7
 end

tests/test-structs/test_structs.ml

@@ -470,6 +470,11 @@ struct
   let alignmentof_s6 = retrieve_size "alignmentof_s6"
   let offsetof_v1 = retrieve_size "offsetof_v1"
   let offsetof_v2 = retrieve_size "offsetof_v2"
+  let sizeof_s7 = retrieve_size "sizeof_s7"
+  let alignmentof_s7 = retrieve_size "alignmentof_s7"
+  let offsetof_s7_v1 = retrieve_size "offsetof_s7_v1"
+  let offsetof_s7_v2 = retrieve_size "offsetof_s7_v2"
+  let offsetof_s7_v3 = retrieve_size "offsetof_s7_v3"
 
   (*
     Test that struct layout retrieved from C correctly accounts for missing
@@ -542,6 +547,7 @@ struct
   (* Test that we can retrieve information for structs without tags that are
      identified through typedefs, e.g.
          typedef struct { int x; float y; } t;
+     Test also we get info for correct anonymous struct.
    *)
   let test_tagless_structs _ =
     begin
@@ -556,6 +562,21 @@ struct
 
       assert_equal offsetof_v2
         (offsetof M.v2);
+
+      assert_equal sizeof_s7
+        (sizeof M.s7);
+
+      assert_equal alignmentof_s7
+        (alignment M.s7);
+
+      assert_equal offsetof_s7_v1
+        (offsetof M.s7_v1);
+
+      assert_equal offsetof_s7_v2
+        (offsetof M.s7_v2);
+
+      assert_equal offsetof_s7_v3
+        (offsetof M.s7_v3);
     end
 
 

tests/test-unions/stubs/types.ml

@@ -17,9 +17,17 @@ struct
   let () = seal u1
 
   (* adding fields through views (typedefs) *)
-  let union_u2 : [`s7] union typ = union ""
+  let union_u2 : [`u2] union typ = union ""
   let u2 = typedef union_u2 "u2"
   let t1 = field u2 "t1" int
   let t2 = field u2 "t2" float
   let () = seal u2
+
+  (* adding fields through views (typedefs) *)
+  let union_u3 : [`u3] union typ = union ""
+  let u3 = typedef union_u3 "u3"
+  let u3_t1 = field u3 "t1" int
+  let u3_t2 = field u3 "t2" float
+  let u3_t3 = field u3 "t3" double
+  let () = seal u3
 end

tests/test-unions/test_unions.ml

@@ -167,6 +167,9 @@ struct
   let sizeof_u2 = retrieve_size "sizeof_u2"
   let alignmentof_u2 = retrieve_size "alignmentof_u2"
 
+  let sizeof_u3 = retrieve_size "sizeof_u3"
+  let alignmentof_u3 = retrieve_size "alignmentof_u3"
+
   (*
     Test that union layout retrieved from C correctly accounts for missing
     fields.
@@ -192,6 +195,12 @@ struct
 
       assert_equal alignmentof_u2
         (alignment M.u2);
+
+      assert_equal sizeof_u3
+        (sizeof M.u3);
+
+      assert_equal alignmentof_u3
+        (alignment M.u3);
     end
 end