From: Eric Botcazou Date: Tue, 2 Mar 2021 16:58:46 +0000 (+0100) Subject: Fix PR ada/99095 X-Git-Tag: releases/gcc-10.3.0~262 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7297af89ea22c1a1da8609d811e100cf73e574d6;p=thirdparty%2Fgcc.git 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 f083f7c16e76..baba51933ae3 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -810,11 +810,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 000000000000..ded8aa3b4b1e --- /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;