[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dffdc95f4e3e725625d2873e7f4f545e707076e8..38bd1d7ca2e21f50189050c7ab66065bfa28e7a8 100644 (file)
--- 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 bc5e73d93086e80a9cb4d03924e22beb80a5fab3..9fff6b6c9664cdacbfc7adbb74b953cb8c952fba 100644 (file)
--- 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 0929da1ff0340330b6577aed7c6de782879661ce..6b2e98326fed4557746a3c5c9a622fb9a43acbdf 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/derived_type6.adb b/gcc/testsuite/gnat.dg/derived_type6.adb
new file mode 100644 (file)
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 (file)
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;