From 168b75ff54b4e70650b8709816edff13f93e737a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 2 Mar 2021 17:58:46 +0100 Subject: [PATCH] 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. --- gcc/ada/sem_ch8.adb | 10 +++++++++- gcc/testsuite/gnat.dg/limited5.adb | 17 +++++++++++++++++ 2 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/limited5.adb diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 4689ae4ba18..efff7145337 100644 --- 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 index 00000000000..ded8aa3b4b1 --- /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;