[Ada] Fix wrong value of 'Size for slices of bit-packed arrays

[Ada] Fix wrong value of 'Size for slices of bit-packed arrays

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 1050 bytes --]

This fixes a long-standing issue in the compiler which would return
a wrong value for the Size attribute applied to slices of bit-packed
arrays whose size is not a multiple of the storage unit.

The problem is that the computation was done in the code generator
after the bit-packed array had been internally rewritten into an
array of bytes, so the Size was always rounded up to the next byte.

The computation is now rewritten into the product of the Length and
Compnent_Size attribute of the slices before being sent to the code
generator.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-09-17  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_attr.adb (Expand_Size_Attribute): Chain the special cases
	on the back-end path and rewrite the attribute appled to slices
	of bit-packed arrays into the product of the Length and the
	Compoent_Size attributes of the slices.
	* exp_ch5.adb (Expand_Assign_Array_Bitfield): Use Size attribute
	directly to compute the bitfield's size.

gcc/testsuite/

	* gnat.dg/pack25.adb: New testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3686 bytes --]

--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -7600,18 +7600,36 @@ package body Exp_Attr is
                   New_Occurrence_Of (Get_Actual_Subtype (Pref), Loc),
                 Attribute_Name => Name_Size));
             Analyze_And_Resolve (N, Typ);
-         end if;
 
-         --  If Size applies to a dereference of an access to unconstrained
+         --  If Size is applied to a dereference of an access to unconstrained
          --  packed array, the back end needs to see its unconstrained nominal
          --  type, but also a hint to the actual constrained type.
 
-         if Nkind (Pref) = N_Explicit_Dereference
+         elsif Nkind (Pref) = N_Explicit_Dereference
            and then Is_Array_Type (Ptyp)
            and then not Is_Constrained (Ptyp)
            and then Is_Packed (Ptyp)
          then
             Set_Actual_Designated_Subtype (Pref, Get_Actual_Subtype (Pref));
+
+         --  If Size was applied to a slice of a bit-packed array, we rewrite
+         --  it into the product of Length and Component_Size. We need to do so
+         --  because bit-packed arrays are represented internally as arrays of
+         --  System.Unsigned_Types.Packed_Byte for code generation purposes so
+         --  the size is always rounded up in the back end.
+
+         elsif Nkind (Original_Node (Pref)) = N_Slice
+           and then Is_Bit_Packed_Array (Ptyp)
+         then
+            Rewrite (N,
+              Make_Op_Multiply (Loc,
+                Make_Attribute_Reference (Loc,
+                  Prefix         => Duplicate_Subexpr (Pref, True),
+                  Attribute_Name => Name_Length),
+                Make_Attribute_Reference (Loc,
+                  Prefix         => Duplicate_Subexpr (Pref, True),
+                  Attribute_Name => Name_Component_Size)));
+            Analyze_And_Resolve (N, Typ);
          end if;
 
          return;

--- gcc/ada/exp_ch5.adb
+++ gcc/ada/exp_ch5.adb
@@ -1408,23 +1408,15 @@ package body Exp_Ch5 is
               Expressions => New_List (New_Copy_Tree (Right_Lo))),
           Attribute_Name => Name_Bit);
 
-      --  Compute the Size of the bitfield. ???We can't use Size here, because
-      --  it doesn't work properly for slices of packed arrays, so we compute
-      --  the L'Size as L'Length*L'Component_Size.
-      --
+      --  Compute the Size of the bitfield
+
       --  Note that the length check has already been done, so we can use the
       --  size of either L or R.
 
       Size : constant Node_Id :=
-        Make_Op_Multiply (Loc,
-          Make_Attribute_Reference (Loc,
-            Prefix =>
-              Duplicate_Subexpr (Name (N), True),
-            Attribute_Name => Name_Length),
-          Make_Attribute_Reference (Loc,
-            Prefix =>
-              Duplicate_Subexpr (Name (N), True),
-            Attribute_Name => Name_Component_Size));
+        Make_Attribute_Reference (Loc,
+          Prefix         => Duplicate_Subexpr (Name (N), True),
+          Attribute_Name => Name_Size);
 
    begin
       return Make_Procedure_Call_Statement (Loc,

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/pack25.adb
@@ -0,0 +1,21 @@
+--  { dg-do run }
+procedure Pack25 is
+
+   type Bit is ('0', '1');
+   type Bit_Array is array (Natural range <>) of Bit;
+   pragma Pack (Bit_Array);
+
+   procedure Test (Bits : Bit_Array; Size : Natural) is
+   begin
+      if Bits (0 .. Size - 1)'Size /= Size then
+         raise Program_Error;
+      end if;
+   end;
+
+   A : Bit_Array (0 .. 127) := (others => '1');
+
+begin
+   for X in A'First .. A'Last + 1 loop
+      Test (A, X);
+   end loop;
+end;
\ No newline at end of file