From a8a89b743d7f22120969402642b2375537c67243 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Wed, 21 May 2014 12:54:18 +0000 Subject: [PATCH] sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base to the full view of the parent type when... 2014-05-21 Javier Miranda * 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 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch3.adb | 14 ++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3bd0c7eeb294..9c47f98ad7d0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2014-05-21 Javier Miranda + + * 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 * exp_ch4.adb (Expand_Allocator_Expression.Apply_Accessibility_Check): diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 06f314a27b73..969674a1dd29 100644 --- 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;