Fix incorrect integer promotion for bit-fields

src/frontc/cabs2cil.ml

@@ -1359,18 +1359,42 @@ type condExpRes =
   | CENot of condExpRes
 
 (******** CASTS *********)
-let rec integralPromotion (t : typ) : typ = (* c.f. ISO 6.3.1.1 *)
+let rec integralPromotion ?width (t : typ) : typ = (* c.f. ISO 6.3.1.1 *)
+  let int_bits = bitsSizeOf (TInt (IInt, [])) in
   match unrollType t with
     TInt (IBool, a) -> TInt (IInt, a) (* _Bool can only be 0 or 1, irrespective of its size *)
-  | TInt ((IShort|IUShort|IChar|ISChar|IUChar) as ik, a) ->
-      if bitsSizeOf t < bitsSizeOf (TInt (IInt, [])) || isSigned ik then
-	TInt(IInt, a)
-      else
-	TInt(IUInt, a)
-  | TInt _ -> t
-  | TEnum (ei, a) -> integralPromotion (TInt(ei.ekind, a)) (* gcc packed enums can be < int *)
+  | TInt (ik, a) ->
+      (* For a bit-field, the effective width is the bit-field width; for a
+         regular integer, it is the storage size.  A type that fits within
+         int (or has the same width as int and is signed) promotes to int;
+         a same-width unsigned promotes to unsigned int; wider types stay. *)
+      let eff_width = match width with Some w -> w | None -> bitsSizeOf t in
+      if eff_width < int_bits then TInt (IInt, a)
+      else if eff_width = int_bits then
+        if isSigned ik then TInt (IInt, a) else TInt (IUInt, a)
+      else t (* no promotion needed, preserve original type (possibly named) *)
+  | TEnum (ei, a) -> integralPromotion ?width (TInt(ei.ekind, a)) (* gcc packed enums can be < int *)
   | t -> E.s (error "integralPromotion: not expecting %a" d_type t)
 
+(* If the lvalue ends in a bit-field access, return the bit-field width;
+   otherwise return None. Handles nested field accesses (e.g. s.inner.bf)
+   by examining the last field in the offset chain. *)
+let bitfieldWidthOfLval ((_, off) : lval) : int option =
+  let rec lastBitfieldInOffset = function
+    | NoOffset -> None
+    | Field (fi, NoOffset) -> fi.fbitfield
+    | Field (_, sub) -> lastBitfieldInOffset sub
+    | Index (_, sub) -> lastBitfieldInOffset sub
+  in
+  lastBitfieldInOffset off
+
+(* Apply integer promotion considering a possible bit-field restriction.
+   If [e] is a bit-field lvalue, uses its width; otherwise falls back to
+   the regular integralPromotion. *)
+let integralPromotionE (e : exp) (t : typ) : typ =
+  let width = match e with Lval lv -> bitfieldWidthOfLval lv | _ -> None in
+  integralPromotion ?width t
+
 let defaultArgumentPromotion (t : typ) : typ = (* c.f. ISO 6.5.2.2:6 *)
   match unrollType t with
   | TFloat (FFloat, a) -> TFloat (FDouble, a)
@@ -4008,7 +4032,7 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
     | A.UNARY(A.MINUS, e) ->
         let (se, e', t) = doExp asconst e (AExp None) in
         if isIntegralType t then
-          let tres = integralPromotion t in
+          let tres = integralPromotionE e' t in
           let e'' = UnOp(Neg, makeCastT ~kind:IntegerPromotion ~e:e' ~oldt:t ~newt:tres, tres) in
           finishExp se e'' tres
         else
@@ -4020,7 +4044,7 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
     | A.UNARY(A.BNOT, e) ->
         let (se, e', t) = doExp asconst e (AExp None) in
         if isIntegralType t then
-          let tres = integralPromotion t in
+          let tres = integralPromotionE e' t in
           let e'' = UnOp(BNot, makeCastT ~kind:IntegerPromotion ~e:e' ~oldt:t ~newt:tres, tres) in
           finishExp se e'' tres
         else
@@ -4029,7 +4053,7 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
     | A.UNARY(A.PLUS, e) ->
         let (se, e', t) = doExp asconst e (AExp None) in
         if isIntegralType t then
-          let tres = integralPromotion t in
+          let tres = integralPromotionE e' t in
           let e'' = makeCastT ~kind:IntegerPromotion ~e:e' ~oldt:t ~newt:tres in
           finishExp se e'' tres
         else
@@ -4472,7 +4496,12 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
                           -- gcc manual *)
                       (sa :: ss, a' :: args')
                     else
-                      let promoted_type = defaultArgumentPromotion at in
+                      (* For bit-field arguments, apply bit-field-aware promotion
+                         to get the correct effective type before default arg promotion. *)
+                      let eff_at = match a' with
+                        | Lval lv -> (match bitfieldWidthOfLval lv with Some w -> integralPromotion ~width:w at | None -> at)
+                        | _ -> at in
+                      let promoted_type = defaultArgumentPromotion eff_at in
                       let _, a'' = castTo ~kind:DefaultArgumentPromotion at promoted_type a' in
                       (sa :: ss, a'' :: args')
               in
@@ -5043,8 +5072,15 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
           | _ -> true
           | exception (Failure _) -> false
         in
-        let (_, _, e_typ) = doExp false e (AExp None) in (* doExp with AExp handles array and function types for "lvalue conversions" (AType would not!) *)
+        let (_, e_expr, e_typ) = doExp false e (AExp None) in (* doExp with AExp handles array and function types for "lvalue conversions" (AType would not!) *)
         let e_typ = removeOuterQualifierAttributes e_typ in (* removeOuterQualifierAttributes handles qualifiers for "lvalue conversions" *)
+        (* ISO 6.5.1.1: if the controlling expression is a bit-field lvalue,
+           integer promotions are applied and the type after promotion is used
+           for association matching. For non-bit-field expressions, the type
+           is NOT subject to integer promotions here. *)
+        let e_typ = match e_expr with
+          | Lval lv -> (match bitfieldWidthOfLval lv with Some w -> integralPromotion ~width:w e_typ | None -> e_typ)
+          | _ -> e_typ in
         let al_compatible = List.filter (fun ((ast, adt), _) -> typ_compatible e_typ (doOnlyType ast adt)) al_nondefault in
 
         (* TODO: error when multiple compatible associations or defaults even when unused? *)
@@ -5070,21 +5106,27 @@ and doExp (asconst: bool)   (* This expression is used as a constant *)
 (* bop is always the arithmetic version. Change it to the appropriate pointer
    version if necessary *)
 and doBinOp (bop: binop) (e1: exp) (t1: typ) (e2: exp) (t2: typ) : typ * exp =
+  (* For bit-field lvalue expressions, the integer promotion (ISO 6.3.1.1)
+     must account for the bit-field width, not just the base type.
+     pt1/pt2 are the effectively-promoted types used for arithmetic; the
+     original t1/t2 are still used as oldt in casts. *)
+  let pt1 = match e1 with Lval lv -> (match bitfieldWidthOfLval lv with Some w -> integralPromotion ~width:w t1 | None -> t1) | _ -> t1 in
+  let pt2 = match e2 with Lval lv -> (match bitfieldWidthOfLval lv with Some w -> integralPromotion ~width:w t2 | None -> t2) | _ -> t2 in
   let doArithmetic () =
-    let tres = arithmeticConversion t1 t2 in
+    let tres = arithmeticConversion pt1 pt2 in
     (* Keep the operator since it is arithmetic *)
     tres,
     optConstFoldBinOp false bop (makeCastT ~kind:ArithmeticConversion ~e:e1 ~oldt:t1 ~newt:tres) (makeCastT ~kind:ArithmeticConversion ~e:e2 ~oldt:t2 ~newt:tres) tres
   in
   let doArithmeticComp () =
-    let tres = arithmeticConversion t1 t2 in
+    let tres = arithmeticConversion pt1 pt2 in
     (* Keep the operator since it is arithmetic *)
     intType,
     optConstFoldBinOp false bop
       (makeCastT ~kind:ArithmeticConversion ~e:e1 ~oldt:t1 ~newt:tres) (makeCastT ~kind:ArithmeticConversion ~e:e2 ~oldt:t2 ~newt:tres) intType
   in
   let doIntegralArithmetic () =
-    let tres = unrollType (arithmeticConversion t1 t2) in
+    let tres = unrollType (arithmeticConversion pt1 pt2) in
     match tres with
       TInt _ ->
         tres,
@@ -5105,8 +5147,8 @@ and doBinOp (bop: binop) (e1: exp) (t1: typ) (e2: exp) (t2: typ) : typ * exp =
   | (Mod|BAnd|BOr|BXor) -> doIntegralArithmetic ()
   | (Shiftlt|Shiftrt) -> (* ISO 6.5.7. Only integral promotions. The result
                             has the same type as the left hand side *)
-      let t1' = integralPromotion t1 in
-      let t2' = integralPromotion t2 in
+      let t1' = integralPromotion pt1 in
+      let t2' = integralPromotion pt2 in
       t1',
       optConstFoldBinOp false bop (makeCastT ~kind:IntegerPromotion ~e:e1 ~oldt:t1 ~newt:t1') (makeCastT ~kind:IntegerPromotion ~e:e2 ~oldt:t2 ~newt:t2') t1'
 
@@ -5118,15 +5160,15 @@ and doBinOp (bop: binop) (e1: exp) (t1: typ) (e2: exp) (t2: typ) : typ * exp =
   | PlusA when isPointerType t1 && isIntegralType t2 ->
       t1,
       optConstFoldBinOp false PlusPI e1
-        (makeCastT ~kind:IntegerPromotion ~e:e2 ~oldt:t2 ~newt:(integralPromotion t2)) t1
+        (makeCastT ~kind:IntegerPromotion ~e:e2 ~oldt:t2 ~newt:(integralPromotion pt2)) t1
   | PlusA when isIntegralType t1 && isPointerType t2 ->
       t2,
       optConstFoldBinOp false PlusPI e2
-        (makeCastT ~kind:IntegerPromotion ~e:e1 ~oldt:t1 ~newt:(integralPromotion t1)) t2
+        (makeCastT ~kind:IntegerPromotion ~e:e1 ~oldt:t1 ~newt:(integralPromotion pt1)) t2
   | MinusA when isPointerType t1 && isIntegralType t2 ->
       t1,
       optConstFoldBinOp false MinusPI e1
-        (makeCastT ~kind:IntegerPromotion ~e:e2 ~oldt:t2 ~newt:(integralPromotion t2)) t1
+        (makeCastT ~kind:IntegerPromotion ~e:e2 ~oldt:t2 ~newt:(integralPromotion pt2)) t1
   | MinusA when isPointerType t1 && isPointerType t2 ->
       let commontype = t1 in
       !ptrdiffType,
@@ -6940,7 +6982,7 @@ and doStatement (s : A.statement) : chunk =
         let (se, e', et) = doExp false e (AExp None) in
         if not (Cil.isIntegralType et) then
           E.s (error "Switch on a non-integer expression.");
-        let et' = integralPromotion et in
+        let et' = integralPromotionE e' et in
         let e' = makeCastT ~kind:IntegerPromotion ~e:e' ~oldt:et ~newt:et' in
         enter_break_env ();
         let s' = doStatement s in

src/frontc/cabs2cil.mli

@@ -126,8 +126,9 @@ val convStandaloneExp: genv:(string, envdata * Cil.location) Hashtbl.t -> env:(s
 
 val currentFunctionFDEC: Cil.fundec ref
 
-(** c.f. ISO 6.3.1.1 *)
-val integralPromotion: Cil.typ -> Cil.typ
+(** c.f. ISO 6.3.1.1.  When [~width] is supplied (bit-field width in bits),
+    the promotion accounts for the narrower representable range. *)
+val integralPromotion: ?width:int -> Cil.typ -> Cil.typ
 
 (** c.f. ISO 6.3.1.8 *)
 val arithmeticConversion: Cil.typ -> Cil.typ -> Cil.typ

test/small1/bitfield4.c

@@ -0,0 +1,43 @@
+#include "testharness.h"
+
+/* Test that integer promotions for bit-fields correctly account for the
+   bit-field width (c.f. ISO 6.3.1.1).
+   A bit-field whose values fit in int shall be promoted to int,
+   regardless of the declared base type. */
+
+struct X {
+  long x : 7;   /* signed 7-bit: range fits in int -> promote to int */
+} sx;
+
+struct UX {
+  unsigned long y : 7;  /* unsigned 7-bit: range [0,127] fits in int -> promote to int */
+} usx;
+
+int main() {
+  /* _Generic selects based on type after integer promotion (ISO 6.5.1.1).
+     For long : 7 bit-field, the promoted type should be int. */
+  int r1 = _Generic(sx.x + 0, int : 1, default : -1);
+  if (r1 != 1) E(1);
+
+  /* Unary + also triggers integer promotion */
+  int r2 = _Generic(+sx.x, int : 1, default : -1);
+  if (r2 != 1) E(2);
+
+  /* Unary - also triggers integer promotion */
+  int r3 = _Generic(-sx.x, int : 1, default : -1);
+  if (r3 != 1) E(3);
+
+  /* Unary ~ also triggers integer promotion */
+  int r4 = _Generic(~sx.x, int : 1, default : -1);
+  if (r4 != 1) E(4);
+
+  /* unsigned long : 7 should also promote to int (7-bit range [0,127] fits) */
+  int r5 = _Generic(usx.y + 0, int : 1, default : -1);
+  if (r5 != 1) E(5);
+
+  /* Direct bit-field access as _Generic controlling expression */
+  int r6 = _Generic(sx.x, int : 1, default : -1);
+  if (r6 != 1) E(6);
+
+  SUCCESS;
+}

test/testcil.pl

@@ -232,6 +232,7 @@ sub addToGroup {
 addTest("test/packed2 _GNUCC=1");
 addTest("test/bitfield");
 addTest("testrun/bitfield3");
+addTest("testrunc11/bitfield4");
 
 addTest("testrun/bitfield2");
 addTest("testrun/call2 ");