From f603c9855e36cd7ab706174bddb997b7bb3f2ce2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 1 Jul 2019 13:37:26 +0000 Subject: [Ada] Spurious error private subtype derivation This patch fixes a spurious error on a derived type declaration whose subtype indication is a subtype of a private type whose full view is a constrained discriminated type. 2019-07-01 Ed Schonberg gcc/ada/ * sem_ch3.adb (Build_Derived_Record_Type): If the parent type is declared as a subtype of a private type with an inherited discriminant constraint, its generated full base appears as a record subtype, so we need to retrieve its oen base type so that the inherited constraint can be applied to it. gcc/testsuite/ * gnat.dg/derived_type6.adb, gnat.dg/derived_type6.ads: New testcase. From-SVN: r272879 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch3.adb | 10 ++++++++++ 2 files changed, 18 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dffdc95..38bd1d7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-07-01 Ed Schonberg + + * sem_ch3.adb (Build_Derived_Record_Type): If the parent type is + declared as a subtype of a private type with an inherited + discriminant constraint, its generated full base appears as a + record subtype, so we need to retrieve its oen base type so that + the inherited constraint can be applied to it. + 2019-07-01 Yannick Moy * sem_spark.adb: Completely rework the algorithm for ownership diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index bc5e73d..9fff6b6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8582,6 +8582,16 @@ package body Sem_Ch3 is Parent_Base := Base_Type (Parent_Type); end if; + -- If the parent type is declared as a subtype of another private + -- type with inherited discriminants, its generated base type is + -- itself a record subtype. To further inherit the constraint we + -- need to use its own base to have an unconstrained type on which + -- to apply the inherited constraint. + + if Ekind (Parent_Base) = E_Record_Subtype then + Parent_Base := Base_Type (Parent_Base); + end if; + -- AI05-0115: if this is a derivation from a private type in some -- other scope that may lead to invisible components for the derived -- type, mark it accordingly. -- cgit v1.1