From 47e818992372c1480b1052b64728a33d758637cf Mon Sep 17 00:00:00 2001
From: Bernhard Schommer <bernhardschommer@gmail.com>
Date: Fri, 20 Jan 2017 14:44:59 +0100
Subject: Simplified version.

The problem was that sub structs are were not correctly aligned.
The new version is much simpler and uses the sizeof_struct to
calculate the individual offsets and add them up to get correct
offest.
Bug 20765
---
 cparser/Cutil.ml | 51 ++++++++++++++++++---------------------------------
 cparser/Elab.ml  | 18 ++++++++----------
 2 files changed, 26 insertions(+), 43 deletions(-)

(limited to 'cparser')

diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 66ea19e4..30f7294b 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -535,40 +535,25 @@ let sizeof_struct env members =
 
 (* Compute the offset of a struct member *)
 let offsetof env ty fields =
-  let align_field ofs ty =
-    let a =  match alignof env ty with
-      | Some a -> a
-      | None -> assert false in
-    align ofs a in
-  let rec offsetof_rec ofs field rest = function
-    | [] -> ofs
-    | m :: rem as ml ->
-      if m.fld_name = field.fld_name then begin
-        match rest with
-        | [] -> align_field ofs field.fld_typ
-        | _ -> lookup_field ofs field.fld_typ rest
-      end else if m.fld_bitfield = None then begin
-        match alignof env m.fld_typ, sizeof env m.fld_typ with
-        | Some a, Some s -> offsetof_rec (align ofs a + s) field rest rem
-        | _, _ -> assert false (* should never happen *)
-      end else begin
-        let (s, a, ml') = pack_bitfields ml in
-        let ofs = align ofs a + s in
-        offsetof_rec ofs field rest ml'
-      end
-  and lookup_field ofs ty = function
-    | [] -> align_field ofs ty
-    | fld::rest ->
-      begin match unroll env ty with
-        | TStruct (id,_) ->
-          let str = Env.find_struct env id in
-          offsetof_rec ofs fld rest str.ci_members
-        | TUnion (id,_) ->
-          lookup_field ofs fld.fld_typ rest
-        | _ -> assert false
-      end
+  let rec sub acc name = function
+    | [] -> List.rev acc
+    | m::rem -> if m.fld_name = name then
+        List.rev acc
+      else
+        sub (m::acc) name rem in
+  let offset (ofs,ty) field =
+    match unroll env ty with
+    | TStruct (id,_) ->
+      let str = Env.find_struct env id in
+      let pre = sub [] field.fld_name str.ci_members in
+      begin match sizeof_struct env pre ,alignof env field.fld_typ with
+      | Some s, Some a ->
+        (ofs + align s a),field.fld_typ
+      | _ -> assert false end
+    | _ -> ofs,field.fld_typ
   in
-  lookup_field 0  ty (List.rev fields)
+  let fields = List.rev fields in
+  fst (List.fold_left offset (0,ty) fields)
 
 (* Simplified version to compute offsets on structs without bitfields *)
 let struct_layout env members =
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index afdf3969..6256bf1f 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -1646,16 +1646,14 @@ let elab_expr vararg loc env a =
     let (ty,env) = elab_type loc env spec dcl in
     if  Cutil.incomplete_type env ty then
       error "offsetof of incomplete type %a" (print_typ env) ty;
-    let offset =
-      match unroll env ty with
-      | TStruct(id,_)
-      | TUnion (id,_)->
-        let fld = (wrap Env.find_struct_member loc env (id,mem)) in
-        if List.exists (fun fld -> fld.fld_bitfield <> None) fld then
-          error "cannot compute the offset of bitfield '%s" mem;
-        Cutil.offsetof env ty fld
-      | _ ->
-        error "request offsetof for member '%s' in something not a structure" mem in
+      let fld = match unroll env ty with
+        | TStruct(id,_) ->(wrap Env.find_struct_member loc env (id,mem))
+        | TUnion (id,_)->(wrap Env.find_union_member loc env (id,mem))
+        | _ ->
+          error "request offsetof for member '%s' in something not a structure" mem in
+      if List.exists (fun fld -> fld.fld_bitfield <> None) fld then
+        error "cannot compute the offset of bitfield '%s" mem;
+    let offset = Cutil.offsetof env ty fld in
     let offsetof_const = EConst (CInt(Int64.of_int offset,size_t_ikind (),"")) in
     { edesc = offsetof_const; etyp = TInt(size_t_ikind(), []) },env
 
-- 
cgit