sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base to the full view...

2014-05-21  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base
	to the full view of the parent type when processing a derived type
	which is the full view of a private type not defined in a generic
	unit which is derived from a private type with discriminants
	whose full view is a non-tagged record type.

From-SVN: r210699

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3bd0c7eeb29455bb64c9002537858c591cb1f7bc..9c47f98ad7d0dd1bc2e973fdf075d16bc5697334 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2014-05-21  Javier Miranda  <miranda@adacore.com>
+
+       * sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base
+       to the full view of the parent type when processing a derived type
+       which is the full view of a private type not defined in a generic
+       unit which is derived from a private type with discriminants
+       whose full view is a non-tagged record type.
+
 2014-05-21  Javier Miranda  <miranda@adacore.com>
 
        * exp_ch4.adb (Expand_Allocator_Expression.Apply_Accessibility_Check):

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 06f314a27b735f61c5e798cb53ce852fa1827f24..969674a1dd294d337094671ebc73c7c1d7cd5613 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -7453,6 +7453,20 @@ package body Sem_Ch3 is
         and then Has_Discriminants (Parent_Type)
       then
          Parent_Base := Base_Type (Full_View (Parent_Type));
+
+      --  Handle a derived type which is the full view of a private type not
+      --  defined in a generic unit which is derived from a private type with
+      --  discriminants whose full view is a non-tagged record type.
+
+      elsif not Inside_A_Generic
+        and then Ekind (Parent_Type) = E_Private_Type
+        and then Has_Discriminants (Parent_Type)
+        and then Present (Full_View (Parent_Type))
+        and then Is_Record_Type (Full_View (Parent_Type))
+        and then not Is_Tagged_Type (Full_View (Parent_Type))
+        and then Has_Private_Declaration (Derived_Type)
+      then
+         Parent_Base := Base_Type (Full_View (Parent_Type));
       else
          Parent_Base := Base_Type (Parent_Type);
       end if;