OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_ch3.adb (Build_Derived_Record_Type): Initialize Parent_Base to the full view of the parent type when... 

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
This commit is contained in:
Javier Miranda 2014-05-21 12:54:18 +00:00 committed by Arnaud Charlet
parent 95bc61b2e3
commit a8a89b743d
2 changed files with 22 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -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):

14
gcc/ada/sem_ch3.adb
View File

@ -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;