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

[Pierre-Marie de Rodat <derodat at adacore dot com>]

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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

--- gcc/ada/sem_ch8.adb
+++ 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)

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;