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 <schonb...@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;
