diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2019-07-01 13:37:26 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-01 13:37:26 +0000 |
| commit | f603c9855e36cd7ab706174bddb997b7bb3f2ce2 (patch) | |
| tree | 5c569b0ca4dcecefcfb0993079cd3ebaa6d18c58 | |
| parent | 497ee82ba3b1f9e9154d978022ca51c88e49003e (diff) | |
| download | gcc-f603c9855e36cd7ab706174bddb997b7bb3f2ce2.zip gcc-f603c9855e36cd7ab706174bddb997b7bb3f2ce2.tar.gz gcc-f603c9855e36cd7ab706174bddb997b7bb3f2ce2.tar.bz2 | |
[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 <schonberg@adacore.com>
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
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 10 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/derived_type6.adb | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/derived_type6.ads | 9 |
5 files changed, 37 insertions, 0 deletions
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 <schonberg@adacore.com> + + * 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 <moy@adacore.com> * 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. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0929da1..6b2e983 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2019-07-01 Ed Schonberg <schonberg@adacore.com> + * gnat.dg/derived_type6.adb, gnat.dg/derived_type6.ads: New + testcase. + +2019-07-01 Ed Schonberg <schonberg@adacore.com> + * gnat.dg/weak3.adb, gnat.dg/weak3.ads: New testcase. 2019-07-01 Ed Schonberg <schonberg@adacore.com> diff --git a/gcc/testsuite/gnat.dg/derived_type6.adb b/gcc/testsuite/gnat.dg/derived_type6.adb new file mode 100644 index 0000000..8369d62 --- /dev/null +++ b/gcc/testsuite/gnat.dg/derived_type6.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Derived_Type6 is + procedure Foo is null; +end Derived_Type6; diff --git a/gcc/testsuite/gnat.dg/derived_type6.ads b/gcc/testsuite/gnat.dg/derived_type6.ads new file mode 100644 index 0000000..37728a9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/derived_type6.ads @@ -0,0 +1,9 @@ +with Ada.Strings.Bounded; + +package Derived_Type6 is + package b is new Ada.Strings.Bounded.Generic_Bounded_Length(10); + subtype s1 is b.Bounded_String; + type s2 is new s1; + + procedure Foo; +end Derived_Type6; |