From 37915d022449d21fe7bfa7db640a15e77cd3352e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 17 Sep 2019 07:59:16 +0000 Subject: [PATCH] [Ada] Fix wrong value of 'Size for slices of bit-packed arrays 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 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 | 9 +++++++++ gcc/ada/exp_attr.adb | 24 +++++++++++++++++++++--- gcc/ada/exp_ch5.adb | 18 +++++------------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/pack25.adb | 21 +++++++++++++++++++++ 5 files changed, 60 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/pack25.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ecc67e5a376..ee7945cff06 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-09-17 Eric Botcazou + + * 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 * exp_ch5.adb (Expand_Assign_Array_Loop_Or_Bitfield): Add tests diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c7d1647b42e..c5ff9b50c5f 100644 --- a/gcc/ada/exp_attr.adb +++ b/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; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 6ef3fb2c4a5..7c2d6328e70 100644 --- a/gcc/ada/exp_ch5.adb +++ b/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, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f705dc46351..b701f9e29e5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-17 Eric Botcazou + + * gnat.dg/pack25.adb: New testcase. + 2019-09-16 Paolo Carlini * 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 index 00000000000..d1ac22a7035 --- /dev/null +++ b/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 -- 2.30.2