Fix PR ada/99095

This is a regression present on the mainline and 10 branch, where we fail
to make the bounds explicit for the return value of a function returning
an unconstrained array of a limited record type.

gcc/ada/
	PR ada/99095
	* sem_ch8.adb (Check_Constrained_Object): Restrict again the special
	optimization for limited types to non-array types except in the case
	of an extended return statement.
gcc/testsuite/
	* gnat.dg/limited5.adb: New test.

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 4689ae4ba18411038ffe1419605cf8d35770eb13..efff7145337b3f4b04a3cf6c0d456e1ae4bee537 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -830,11 +830,19 @@ package body Sem_Ch8 is
             --  that are used in iterators. This is an optimization, but it
             --  also prevents typing anomalies when the prefix is further
             --  expanded.
+
             --  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_Limited_Type (Typ) then
+            --  Note also that we need to build the constrained subtype for an
+            --  array in order to make the bounds explicit in most cases, but
+            --  not if the object comes from an extended return statement, as
+            --  this would create dangling references to them later on.
+
+            elsif Is_Limited_Type (Typ)
+              and then (not Is_Array_Type (Typ) or else Is_Return_Object (Id))
+            then
                null;
 
             else

diff --git a/gcc/testsuite/gnat.dg/limited5.adb b/gcc/testsuite/gnat.dg/limited5.adb
new file mode 100644 (file)
index 0000000..ded8aa3
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/limited5.adb
@@ -0,0 +1,17 @@
+--  { dg-do compile }
+
+procedure Limited5 is
+
+   type Command       is limited null record;
+   type Command_Array is array (Positive range <>) of Command;
+      
+   function To_Commands return Command_Array is
+   begin
+      return Result : Command_Array (1 .. 2);
+   end To_Commands;
+   
+   The_Commands : aliased Command_Array := To_Commands;
+
+begin
+   null;
+end;