[Ada] Fix internal error on extension of record with representation clause
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 21 Aug 2018 14:46:40 +0000 (14:46 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 21 Aug 2018 14:46:40 +0000 (14:46 +0000)
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  <ebotcazou@adacore.com>

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
gcc/ada/exp_util.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/rep_clause7.adb [new file with mode: 0644]

index df4a9dbdf9c39c1359c90a94e71445617cd59225..27bb79d5017211edb92ab61e56a513a5a1059ae1 100644 (file)
@@ -1,3 +1,10 @@
+2018-08-21  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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  <schonberg@adacore.com>
 
        * sem_util.ads, sem_util.adb (New_External_Entity): Type of
index 3bed5080ffc0002352eddc5fd44879733b7ecc78..632c879892e83e7b8310d5188ba1c1c301033c7d 100644 (file)
@@ -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;
index 5d4bdbd8d1918b4c2616afbca4ae340b4012223f..e0dfb3db38cee07b8daf0da45578de03fc39a994 100644 (file)
@@ -1,3 +1,7 @@
+2018-08-21  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/rep_clause7.adb: New testcase.
+
 2018-08-21  Ed Schonberg  <schonberg@adacore.com>
 
        * 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 (file)
index 0000000..222b8f5
--- /dev/null
@@ -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;