From: Ed Schonberg Date: Wed, 10 Jul 2019 09:02:47 +0000 (+0000) Subject: [Ada] Crash on aggregate for limited type in extended return X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c14dc27e91ccd6bdc86ac0b875892396dc84a985;p=gcc.git [Ada] Crash on aggregate for limited type in extended return 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. 2019-07-10 Ed Schonberg 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. From-SVN: r273350 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e781181583e..6e9ba85f136 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-10 Ed Schonberg + + * 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. + 2019-07-10 Yannick Moy * sem_aux.adb, sem_aux.ads (Is_Protected_Operation): New diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 03b6235dce1..58abc9c7629 100644 --- a/gcc/ada/sem_ch8.adb +++ b/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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b6588179ade..e2dc5fe3847 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-10 Ed Schonberg + + * gnat.dg/limited3.adb, gnat.dg/limited3_pkg.adb, + gnat.dg/limited3_pkg.ads: New testcase. + 2019-07-10 Hristian Kirtchev * gnat.dg/incomplete7.adb, gnat.dg/incomplete7.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/limited3.adb b/gcc/testsuite/gnat.dg/limited3.adb new file mode 100644 index 00000000000..a0da49da157 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/limited3_pkg.adb b/gcc/testsuite/gnat.dg/limited3_pkg.adb new file mode 100644 index 00000000000..71e271d6eb9 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/limited3_pkg.ads b/gcc/testsuite/gnat.dg/limited3_pkg.ads new file mode 100644 index 00000000000..52f211dd9e9 --- /dev/null +++ b/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;