[Ada] Fix wrong value of 'Size for slices of bit-packed arrays
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 17 Sep 2019 07:59:16 +0000 (07:59 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 17 Sep 2019 07:59:16 +0000 (07:59 +0000)
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.

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.

From-SVN: r275769

gcc/ada/ChangeLog
gcc/ada/exp_attr.adb
gcc/ada/exp_ch5.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/pack25.adb [new file with mode: 0644]

index ecc67e5a376420ac89ee236c5b8d052b84c66999..ee7945cff06158cf73276b97378b451c075b5cd9 100644 (file)
@@ -1,3 +1,12 @@
+2019-09-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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.
+
 2019-09-17  Bob Duff  <duff@adacore.com>
 
        * exp_ch5.adb (Expand_Assign_Array_Loop_Or_Bitfield): Add tests
index c7d1647b42e554bd8b8b23f948f2b7c201af659a..c5ff9b50c5fbeb3edaec0754683d986a066cada0 100644 (file)
@@ -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;
index 6ef3fb2c4a53250887502be96e22e6ea28cc60ea..7c2d6328e70c7f157565f604b8a424c641877220 100644 (file)
@@ -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,
index f705dc463512098465fd06b90230a7435b10e917..b701f9e29e5e49a1c708478598cfd09e8d13d316 100644 (file)
@@ -1,3 +1,7 @@
+2019-09-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/pack25.adb: New testcase.
+
 2019-09-16  Paolo Carlini  <paolo.carlini@oracle.com>
 
        * g++.dg/ext/int128-6.C: New.
diff --git a/gcc/testsuite/gnat.dg/pack25.adb b/gcc/testsuite/gnat.dg/pack25.adb
new file mode 100644 (file)
index 0000000..d1ac22a
--- /dev/null
@@ -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