diff options
-rw-r--r-- | cparser/Cutil.ml | 6 | ||||
-rw-r--r-- | cparser/Cutil.mli | 2 | ||||
-rw-r--r-- | cparser/Elab.ml | 49 | ||||
-rw-r--r-- | test/regression/Results/packedstruct1 | 4 | ||||
-rw-r--r-- | test/regression/packedstruct1.c | 15 |
5 files changed, 58 insertions, 18 deletions
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 212303ae..2fc269cc 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -141,6 +141,12 @@ let remove_attributes_type env attr t = let erase_attributes_type env t = change_attributes_type env (fun a -> []) t +(* Is an attribute type-related (true) or variable-related (false)? *) + +let attr_is_type_related = function + | Attr(("packed" | "__packed__"), _) -> true + | _ -> false + (* Type compatibility *) exception Incompat diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli index 54b63040..7e23a723 100644 --- a/cparser/Cutil.mli +++ b/cparser/Cutil.mli @@ -44,6 +44,8 @@ val remove_attributes_type : Env.t -> attributes -> typ -> typ (* Remove the given set of attributes to those of the given type. *) val erase_attributes_type : Env.t -> typ -> typ (* Erase the attributes of the given type. *) +val attr_is_type_related: attribute -> bool +(* Is an attribute type-related (true) or variable-related (false)? *) (* Type compatibility *) val compatible_types : ?noattrs: bool -> Env.t -> typ -> typ -> bool diff --git a/cparser/Elab.ml b/cparser/Elab.ml index 2e0c49fd..0dea8f9c 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -354,6 +354,17 @@ let rec elab_specifier ?(only = false) loc env specifier = let simple ty = (!sto, !inline, add_attributes_type !attr ty, env) in + (* As done in CIL, partition !attr into type-related attributes, + which are returned, and other attributes, which are left in !attr. + The returned type-related attributes are applied to the + struct/union/enum being defined. + The leftover non-type-related attributes will be applied + to the variable being defined. *) + let get_type_attrs () = + let (ta, nta) = List.partition attr_is_type_related !attr in + attr := nta; + ta in + (* Now interpret the list of type specifiers. Much of this code is stolen from CIL. *) match List.stable_sort typespec_order (List.rev !tyspecs) with @@ -413,18 +424,24 @@ let rec elab_specifier ?(only = false) loc env specifier = simple (TNamed(id', [])) | [Cabs.Tstruct(id, optmembers, a)] -> + let a' = + add_attributes (get_type_attrs()) (elab_attributes loc env a) in let (id', env') = - elab_struct_or_union only Struct loc id optmembers a env in + elab_struct_or_union only Struct loc id optmembers a' env in (!sto, !inline, TStruct(id', !attr), env') | [Cabs.Tunion(id, optmembers, a)] -> + let a' = + add_attributes (get_type_attrs()) (elab_attributes loc env a) in let (id', env') = - elab_struct_or_union only Union loc id optmembers a env in + elab_struct_or_union only Union loc id optmembers a' env in (!sto, !inline, TUnion(id', !attr), env') | [Cabs.Tenum(id, optmembers, a)] -> + let a' = + add_attributes (get_type_attrs()) (elab_attributes loc env a) in let (id', env') = - elab_enum loc id optmembers a env in + elab_enum loc id optmembers a' env in (!sto, !inline, TEnum(id', !attr), env') | [Cabs.TtypeofE _] -> @@ -594,10 +611,8 @@ and elab_struct_or_union_info kind loc env members attrs = (* Elaboration of a struct or union *) and elab_struct_or_union only kind loc tag optmembers attrs env = - let attrs' = - elab_attributes loc env attrs in let warn_attrs () = - if attrs' <> [] then + if attrs <> [] then warning loc "attributes over struct/union ignored in this context" in let optbinding = if tag = "" then None else Env.lookup_composite env tag in @@ -616,10 +631,10 @@ and elab_struct_or_union only kind loc tag optmembers attrs env = if ci.ci_kind <> kind then error loc "struct/union mismatch on tag '%s'" tag; (* finishing the definition of an incomplete struct or union *) - let (ci', env') = elab_struct_or_union_info kind loc env members attrs' in + let (ci', env') = elab_struct_or_union_info kind loc env members attrs in (* Emit a global definition for it *) emit_elab (elab_loc loc) - (Gcompositedef(kind, tag', attrs', ci'.ci_members)); + (Gcompositedef(kind, tag', attrs, ci'.ci_members)); (* Replace infos but keep same ident *) (tag', Env.add_composite env' tag' ci') | Some(tag', {ci_sizeof = Some _}), Some _ @@ -630,27 +645,27 @@ and elab_struct_or_union only kind loc tag optmembers attrs env = (* declaration of an incomplete struct or union *) if tag = "" then error loc "anonymous, incomplete struct or union"; - let ci = composite_info_decl env kind attrs' in + let ci = composite_info_decl env kind attrs in (* enter it with a new name *) let (tag', env') = Env.enter_composite env tag ci in (* emit it *) emit_elab (elab_loc loc) - (Gcompositedecl(kind, tag', attrs')); + (Gcompositedecl(kind, tag', attrs)); (tag', env') | _, Some members -> (* definition of a complete struct or union *) - let ci1 = composite_info_decl env kind attrs' in + let ci1 = composite_info_decl env kind attrs in (* enter it, incomplete, with a new name *) let (tag', env') = Env.enter_composite env tag ci1 in (* emit a declaration so that inner structs and unions can refer to it *) emit_elab (elab_loc loc) - (Gcompositedecl(kind, tag', attrs')); + (Gcompositedecl(kind, tag', attrs)); (* elaborate the members *) let (ci2, env'') = - elab_struct_or_union_info kind loc env' members attrs' in + elab_struct_or_union_info kind loc env' members attrs in (* emit a definition *) emit_elab (elab_loc loc) - (Gcompositedef(kind, tag', attrs', ci2.ci_members)); + (Gcompositedef(kind, tag', attrs, ci2.ci_members)); (* Replace infos but keep same ident *) (tag', Env.add_composite env'' tag' ci2) @@ -680,8 +695,6 @@ and elab_enum_item env (s, exp, loc) nextval = (* Elaboration of an enumeration declaration *) and elab_enum loc tag optmembers attrs env = - let attrs' = - elab_attributes loc env attrs in match optmembers with | None -> let (tag', info) = wrap Env.lookup_enum loc env tag in (tag', env) @@ -694,9 +707,9 @@ and elab_enum loc tag optmembers attrs env = let (dcl2, env2) = elab_members env1 nextval1 tl in (dcl1 :: dcl2, env2) in let (dcls, env') = elab_members env 0L members in - let info = { ei_members = dcls; ei_attr = attrs' } in + let info = { ei_members = dcls; ei_attr = attrs } in let (tag', env'') = Env.enter_enum env' tag info in - emit_elab (elab_loc loc) (Genumdef(tag', attrs', dcls)); + emit_elab (elab_loc loc) (Genumdef(tag', attrs, dcls)); (tag', env'') (* Elaboration of a naked type, e.g. in a cast *) diff --git a/test/regression/Results/packedstruct1 b/test/regression/Results/packedstruct1 index 0595cc38..e4bca769 100644 --- a/test/regression/Results/packedstruct1 +++ b/test/regression/Results/packedstruct1 @@ -19,3 +19,7 @@ sizeof(struct s5) = 14 offsetof(x) = 0, offsetof(y) = 2, offsetof(z) = 6 s5 = {x = 123, y = -456, z = 3.14159} +sizeof(struct s6) = 14 +offsetof(x) = 0, offsetof(y) = 2, offsetof(z) = 6 +s62 = {x = 123, y = -456, z = 3.14159} + diff --git a/test/regression/packedstruct1.c b/test/regression/packedstruct1.c index 66c8c9e1..e7b6c1dc 100644 --- a/test/regression/packedstruct1.c +++ b/test/regression/packedstruct1.c @@ -111,6 +111,20 @@ void test5(void) printf("s5 = {x = %d, y = %d, z = %.5f}\n\n", s5.x, s5.y, s5.z); } +/* Yet another, with packed attribute after the struct decl */ + +struct s6 { unsigned short x; int y; double z; } __attribute((packed)) const s61; + +void test6(void) +{ + struct s6 s62; + printf("sizeof(struct s6) = %d\n", sizeof(struct s6)); + printf("offsetof(x) = %d, offsetof(y) = %d, offsetof(z) = %d\n", + offsetof(s6,x), offsetof(s6,y), offsetof(s6,z)); + s62.x = 123; s62.y = -456; s62.z = 3.14159; + printf("s62 = {x = %d, y = %d, z = %.5f}\n\n", s62.x, s62.y, s62.z); +} + /* Test harness */ @@ -121,5 +135,6 @@ int main(int argc, char ** argv) test3(); test4(); test5(); + test6(); return 0; } |