Elab:

- bad error recovery on bitfield with 'long long' type
- check for redefinition of function parameters
Bitfields:
- when assigning to a bitfield, cast the RHS to "unsigned int"
  (it matters if the RHS is long long).


git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2339 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

2 files changed, 34 insertions, 29 deletions

diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml
index 937a61f..d09c1fe 100644
--- a/cparser/Bitfields.ml
+++ b/cparser/Bitfields.ml
@@ -183,15 +183,13 @@ let bitfield_extract bf carrier =
     {edesc = EBinop(Oshl, carrier, left_shift_count bf, TInt(IUInt, []));
      etyp = carrier.etyp} in
   let ty = TInt((if bf.bf_signed then IInt else IUInt), []) in
-  let e2 =
-    {edesc = ECast(ty, e1); etyp = ty} in
+  let e2 = ecast ty e1 in
   let e3 =
     {edesc = EBinop(Oshr, e2, right_shift_count bf, e2.etyp);
      etyp = ty} in
-  if bf.bf_signed_res = bf.bf_signed then e3 else begin
-    let ty' = TInt((if bf.bf_signed_res then IInt else IUInt), []) in
-    {edesc = ECast(ty', e3); etyp = ty'}
-  end
+  if bf.bf_signed_res = bf.bf_signed
+  then e3
+  else ecast (TInt((if bf.bf_signed_res then IInt else IUInt), [])) e3
 
 (* Assign a bitfield within a carrier *)
 
@@ -208,8 +206,10 @@ unsigned int bitfield_insert(unsigned int x, int ofs, int sz, unsigned int y)
 let bitfield_assign bf carrier newval =
   let msk = insertion_mask bf in
   let notmsk = {edesc = EUnop(Onot, msk); etyp = msk.etyp} in
+  let newval_casted =
+    ecast (TInt(IUInt,[])) newval in
   let newval_shifted =
-    {edesc = EBinop(Oshl, newval, intconst (Int64.of_int bf.bf_pos) IUInt,
+    {edesc = EBinop(Oshl, newval_casted, intconst (Int64.of_int bf.bf_pos) IUInt,
                     TInt(IUInt,[]));
      etyp = TInt(IUInt,[])} in
   let newval_masked =
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index 0dea8f9..4cbda39 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -510,6 +510,8 @@ and elab_parameter env (spec, name) =
   if sto <> Storage_default && sto <> Storage_register then
     error (loc_of_name name)
       "'extern' or 'static' storage not supported for function parameter";
+  if redef Env.lookup_ident env id <> None then
+    error (loc_of_name name) "redefinition of parameter '%s'" id;
   (* replace array and function types by pointer types *)
   let ty1 = argument_conversion env1 ty in
   let (id', env2) = Env.enter_ident env1 id sto ty1 in
@@ -565,28 +567,31 @@ and elab_field_group loc env (spec, fieldlist) =
             | TInt(ik, _) -> ik
             | TEnum(_, _) -> enum_ikind
             | _ -> ILongLong (* trigger next error message *) in
-          if integer_rank ik > integer_rank IInt then
-              error loc
-                "the type of '%s' must be an integer type \
-                 no bigger than 'int'" id;
-          match Ceval.integer_expr env' (!elab_expr_f loc env sz) with
-          | Some n ->
-              if n < 0L then begin
-                error loc "bit size of '%s' (%Ld) is negative" id n;
-                None
-              end else
-              if n > Int64.of_int(sizeof_ikind ik * 8) then begin
-                error loc "bit size of '%s' (%Ld) exceeds its type" id n;
-                None
-              end else
-              if n = 0L && id <> "" then begin
-                error loc "member '%s' has zero size" id;
+          if integer_rank ik > integer_rank IInt then begin
+            error loc
+              "the type of bitfield '%s' must be an integer type \
+               no bigger than 'int'" id;
+            None
+          end else begin
+            match Ceval.integer_expr env' (!elab_expr_f loc env sz) with
+            | Some n ->
+                if n < 0L then begin
+                  error loc "bit size of '%s' (%Ld) is negative" id n;
+                  None
+                end else
+                if n > Int64.of_int(sizeof_ikind ik * 8) then begin
+                  error loc "bit size of '%s' (%Ld) exceeds its type" id n;
+                  None
+                end else
+                if n = 0L && id <> "" then begin
+                  error loc "member '%s' has zero size" id;
+                  None
+                end else
+                  Some(Int64.to_int n)
+            | None ->
+                error loc "bit size of '%s' is not a compile-time constant" id;
                 None
-              end else
-                Some(Int64.to_int n)
-          | None ->
-              error loc "bit size of '%s' is not a compile-time constant" id;
-              None in
+          end in
     { fld_name = id; fld_typ = ty; fld_bitfield = optbitsize' } 
   in
   (List.map2 elab_bitfield fieldlist names, env')
@@ -1460,7 +1465,7 @@ let enter_typedef loc env (s, sto, ty) =
   if sto <> Storage_default then
     error loc "Non-default storage on 'typedef' definition";
   if redef Env.lookup_typedef env s <> None then
-    error loc "Redefinition of typedef '%s'" s;
+    error loc "redefinition of typedef '%s'" s;
   let (id, env') =
     Env.enter_typedef env s ty in
   emit_elab (elab_loc loc) (Gtypedef(id, ty));