From 98089fdf4880b46a57aafa96ea00578e396bb58b Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Mon, 30 Dec 2013 14:01:44 +0000
Subject: Elab.ml: more warnings. Cutil.ml: fix sizeof calculation of structs.

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2391 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 cparser/Cutil.ml |  9 +++++++--
 cparser/Elab.ml  | 13 +++++++++----
 2 files changed, 16 insertions(+), 6 deletions(-)

(limited to 'cparser')

diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index ea4a905..302c1cf 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -397,9 +397,14 @@ let sizeof_union env members =
 
 let sizeof_struct env members =
   let rec sizeof_rec ofs = function
-  | [] | [ { fld_typ = TArray(_, None, _) } ] ->
-      (* C99: ty[] allowed as last field *)
+  | [] ->
       Some ofs
+  | [ { fld_typ = TArray(_, None, _) } as m ] ->
+      (* C99: ty[] allowed as last field *)
+      begin match alignof env m.fld_typ with
+      | Some a -> Some (align ofs a)
+      | None -> None
+      end
   | m :: rem as ml ->
       if m.fld_bitfield = None then begin
         match alignof env m.fld_typ, sizeof env m.fld_typ with
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index 46dbdb7..566ba4f 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -635,6 +635,9 @@ and elab_struct_or_union_info kind loc env members attrs =
         error loc "member '%s' has incomplete type" fld.fld_name;
       check_incomplete rem in
   check_incomplete m;
+  (* Warn for empty structs or unions *)
+  if m = [] then
+    warning loc "empty %s" (if kind = Struct then "struct" else "union");
   (composite_info_def env' kind attrs m, env')
 
 and elab_struct_or_union only kind loc tag optmembers attrs env =
@@ -928,25 +931,25 @@ let elab_expr loc env a =
   | UNARY(PLUS, a1) ->
       let b1 = elab a1 in
       if not (is_arith_type env b1.etyp) then
-        error "argument of unary '+' is not an arithmetic type";
+        err "argument of unary '+' is not an arithmetic type";
       { edesc = EUnop(Oplus, b1); etyp = unary_conversion env b1.etyp }
 
   | UNARY(MINUS, a1) ->
       let b1 = elab a1 in
       if not (is_arith_type env b1.etyp) then
-        error "argument of unary '-' is not an arithmetic type";
+        err "argument of unary '-' is not an arithmetic type";
       { edesc = EUnop(Ominus, b1); etyp = unary_conversion env b1.etyp }
 
   | UNARY(BNOT, a1) ->
       let b1 = elab a1 in
       if not (is_integer_type env b1.etyp) then
-        error "argument of '~' is not an integer type";
+        err "argument of '~' is not an integer type";
       { edesc = EUnop(Onot, b1); etyp = unary_conversion env b1.etyp }
 
   | UNARY(NOT, a1) ->
       let b1 = elab a1 in
       if not (is_scalar_type env b1.etyp) then
-        error "argument of '!' is not a scalar type";
+        err "argument of '!' is not a scalar type";
       { edesc = EUnop(Olognot, b1); etyp = TInt(IInt, []) }
 
   | UNARY(ADDROF, a1) ->
@@ -1023,6 +1026,8 @@ let elab_expr loc env a =
                 err "mismatch between pointer types in binary '-'";
               if not (pointer_arithmetic_ok env ty1) then
                 err "illegal pointer arithmetic in binary '-'";
+              if sizeof env ty1 = Some 0 then
+                err "subtraction between two pointers to zero-sized objects";
               (TPtr(ty1, []), TInt(ptrdiff_t_ikind, []))
           | _, _ -> error "type error in binary '-'"
         end in
-- 
cgit v1.2.3