mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-22 19:11:18 +08:00
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.
This commit is contained in:
parent
f8e4d7a659
commit
168b75ff54
gcc
@ -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
|
||||
|
17
gcc/testsuite/gnat.dg/limited5.adb
Normal file
17
gcc/testsuite/gnat.dg/limited5.adb
Normal file
@ -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;
|
Loading…
x
Reference in New Issue
Block a user