From 294e7bbb9eb0b1f8d0484e9ddb562a08f7505cab Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 21 Aug 2018 14:46:40 +0000 Subject: [PATCH] [Ada] Fix internal error on extension of record with representation clause This fixes a long-standing issue present for extensions of tagged record types with a representation clause: the clause is correctly inherited for components inherited in the extension but the position and size are not, which fools the logic of Is_Possibly_Unaligned_Object. This can result in an attempt to take the address of a component not aligned on a byte boundary, which is then flagged as an internal error. 2018-08-21 Eric Botcazou gcc/ada/ * exp_util.adb (Is_Possibly_Unaligned_Object): For the case of a selected component inherited in a record extension and subject to a representation clause, retrieve the position and size from the original record component. gcc/testsuite/ * gnat.dg/rep_clause7.adb: New testcase. From-SVN: r263717 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_util.adb | 21 +++++++++++++++++-- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/rep_clause7.adb | 29 +++++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/rep_clause7.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index df4a9dbdf9c..27bb79d5017 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-08-21 Eric Botcazou + + * exp_util.adb (Is_Possibly_Unaligned_Object): For the case of a + selected component inherited in a record extension and subject + to a representation clause, retrieve the position and size from + the original record component. + 2018-08-21 Ed Schonberg * sem_util.ads, sem_util.adb (New_External_Entity): Type of diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 3bed5080ffc..632c879892e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8402,9 +8402,26 @@ package body Exp_Util is declare Align_In_Bits : constant Nat := M * System_Storage_Unit; + Off : Uint; + Siz : Uint; begin - if Component_Bit_Offset (C) mod Align_In_Bits /= 0 - or else Esize (C) mod Align_In_Bits /= 0 + -- For a component inherited in a record extension, the + -- clause is inherited but position and size are not set. + + if Is_Base_Type (Etype (P)) + and then Is_Tagged_Type (Etype (P)) + and then Present (Original_Record_Component (C)) + then + Off := + Component_Bit_Offset (Original_Record_Component (C)); + Siz := Esize (Original_Record_Component (C)); + else + Off := Component_Bit_Offset (C); + Siz := Esize (C); + end if; + + if Off mod Align_In_Bits /= 0 + or else Siz mod Align_In_Bits /= 0 then return True; end if; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5d4bdbd8d19..e0dfb3db38c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-08-21 Eric Botcazou + + * gnat.dg/rep_clause7.adb: New testcase. + 2018-08-21 Ed Schonberg * gnat.dg/task1.adb, gnat.dg/task1.ads, gnat.dg/task1_pkg.adb, diff --git a/gcc/testsuite/gnat.dg/rep_clause7.adb b/gcc/testsuite/gnat.dg/rep_clause7.adb new file mode 100644 index 00000000000..222b8f5c43b --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_clause7.adb @@ -0,0 +1,29 @@ +procedure Rep_Clause7 is + + subtype Msg is String (1 .. 3); + + type Root is tagged record + B : Boolean; + M : Msg; + end record; + for Root use record + B at 0 range 64 .. 64; + M at 0 range 65 .. 88; + end record; + + type Ext is new Root with null record; + + procedure Inner (T : Msg) is + begin + null; + end; + + pragma Warnings (Off); + T1 : Root; + T2 : Ext; + pragma Warnings (On); + +begin + Inner (T1.M); + Inner (T2.M); +end; -- 2.30.2