[Ada] Crash on aggregate for limited type in extended return

This patch fixes a compiler abort on an extended return statement whose
expression is an aggregate (to be built in place) for a discriminated
record with a limited component. The build-in-place mechanism creates an
access type and a renaming declaration  through which individual
components are assigned. The renamed object is constrained because it is
limited, and the renaming declaration does not need to create a local
subtype indication for it, which may lead to type mismatches in the
back-end, and is in any case redundant. This patch extends this
optimization to the case of records that are limited only because of a
limitied component, and not because they are explicit declared limited.

2019-07-10  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch8.adb (Check_Constrained_Object): A record that is
	limited because of the presence of a limited component is
	constrained, and no subtype indiciation needs to be created for
	it, just as is the case for declared limited records.

gcc/testsuite/

	* gnat.dg/limited3.adb, gnat.dg/limited3_pkg.adb,
	gnat.dg/limited3_pkg.ads: New testcase.

From-SVN: r273350

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e781181583e505c0d618ddfe7a00ae5b8724bc58..6e9ba85f136bc9781338318f617e5f366d966e87 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch8.adb (Check_Constrained_Object): A record that is
+       limited because of the presence of a limited component is
+       constrained, and no subtype indiciation needs to be created for
+       it, just as is the case for declared limited records.
+
 2019-07-10  Yannick Moy  <moy@adacore.com>
 
        * sem_aux.adb, sem_aux.ads (Is_Protected_Operation): New

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 03b6235dce1efcbe8a41f0591c24f352a5ffd2a4..58abc9c762924f23dac5212003a19f9ef7e4bf0e 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -802,12 +802,17 @@ package body Sem_Ch8 is
                null;
 
             --  If a record is limited its size is invariant. This is the case
-            --  in particular with record types with an access discirminant
+            --  in particular with record types with an access discriminant
             --  that are used in iterators. This is an optimization, but it
             --  also prevents typing anomalies when the prefix is further
-            --  expanded. Limited types with discriminants are included.
-
-            elsif Is_Limited_Record (Typ)
+            --  expanded. This also applies to limited types with access
+            --  discriminants.
+            --  Note that we cannot just use the Is_Limited_Record flag because
+            --  it does not apply to records with limited components, for which
+            --  this syntactic flag is not set, but whose size is also fixed.
+
+            elsif (Is_Record_Type (Typ)
+                and then Is_Limited_Type (Typ))
               or else
                 (Ekind (Typ) = E_Limited_Private_Type
                   and then Has_Discriminants (Typ)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b6588179ade49551b93dd7af34ce9fa7f82d16fe..e2dc5fe38473737e27bd8601fd267c5f8a6941e5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/limited3.adb, gnat.dg/limited3_pkg.adb,
+       gnat.dg/limited3_pkg.ads: New testcase.
+
 2019-07-10  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * gnat.dg/incomplete7.adb, gnat.dg/incomplete7.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/limited3.adb b/gcc/testsuite/gnat.dg/limited3.adb
new file mode 100644 (file)
index 0000000..a0da49d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/limited3.adb
@@ -0,0 +1,11 @@
+--  { dg-do run }
+
+with Limited3_Pkg; use Limited3_Pkg;
+
+procedure Limited3 is
+   R1 : Rec := F (15);
+   R2 : Rec := F (-1);
+   R3 : Var_Rec := FS (20);
+begin
+   null;
+end Limited3;

diff --git a/gcc/testsuite/gnat.dg/limited3_pkg.adb b/gcc/testsuite/gnat.dg/limited3_pkg.adb
new file mode 100644 (file)
index 0000000..71e271d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/limited3_pkg.adb
@@ -0,0 +1,20 @@
+package body Limited3_Pkg is
+   function F (I : Integer) return Rec is
+   begin
+      return (D => False, I => I);
+   end;
+
+   function FS (X : Integer) return Var_Rec is
+   begin
+      return (X, (1..X => '?'), Tag => <>);
+   end FS;
+
+   function F2 (I : Integer) return Rec2 is
+   begin
+      if I > 0 then
+         return (D => False, I => I);
+      else
+         return (D => True, L => new Limited_Rec);
+     end if;
+   end;
+end Limited3_Pkg;

diff --git a/gcc/testsuite/gnat.dg/limited3_pkg.ads b/gcc/testsuite/gnat.dg/limited3_pkg.ads
new file mode 100644 (file)
index 0000000..52f211d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/limited3_pkg.ads
@@ -0,0 +1,30 @@
+package Limited3_Pkg is
+
+   type Limited_Rec is limited
+    null record;
+
+   type Var_Rec (X : Integer) is record
+      Name : String (1 .. X);
+      Tag  : Limited_Rec;
+   end record;
+
+   type Rec (D : Boolean := True) is record
+      case D is
+         when True => L : Limited_Rec;
+         when False => I : Integer;
+      end case;
+   end record;
+
+   function F (I : Integer) return Rec;
+
+   function FS (X : Integer) return Var_Rec;
+
+   type Rec2 (D : Boolean := True) is record
+      case D is
+         when True => L : access Limited_Rec;
+         when False => I : Integer;
+      end case;
+   end record;
+
+   function F2 (I : Integer) return Rec2;
+end Limited3_Pkg;