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

sem_ch3.adb (Build_Derived_Record_Type): if derived type is an anonymous base generated when... 

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): if derived type is an
	anonymous base generated when the parent is a constrained discriminated
	type, propagate interface list to first subtype because it may appear
	in a current instance within the extension part of the derived type
	declaration, and its own subtype declaration has not been elaborated
	yet.
	* exp_disp.adb (Build_Interface_Thunk): Use base type of formal to
	determine whether it has the controlling type.

From-SVN: r160748
This commit is contained in:
Ed Schonberg 2010-06-14 15:04:40 +00:00 committed by Arnaud Charlet
parent 9fc91982f2
commit 7cec010e49
3 changed files with 41 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): if derived type is an
anonymous base generated when the parent is a constrained discriminated
type, propagate interface list to first subtype because it may appear
in a current instance within the extension part of the derived type
declaration, and its own subtype declaration has not been elaborated
yet.
* exp_disp.adb (Build_Interface_Thunk): Use base type of formal to
determine whether it has the controlling type.
2010-06-14 Jerome Lambourg <lambourg@adacore.com>
* exp_ch11.adb (Expand_N_Raise_Statement): Make sure that the explicit

9
gcc/ada/exp_disp.adb
View File

@ -1528,14 +1528,19 @@ package body Exp_Disp is
Formal := First (Formals);
while Present (Formal) loop
-- Handle concurrent types
-- Handle concurrent types.
if Ekind (Target_Formal) = E_In_Parameter
and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type
then
Ftyp := Directly_Designated_Type (Etype (Target_Formal));
else
Ftyp := Etype (Target_Formal);
-- if the parent is a constrained discriminated type. the
-- primitive operation will have been defined on a first subtype.
-- for proper matching with controlling type, use base type.
Ftyp := Base_Type (Etype (Target_Formal));
end if;
if Is_Concurrent_Type (Ftyp) then

25
gcc/ada/sem_ch3.adb
View File

@ -3750,10 +3750,10 @@ package body Sem_Ch3 is
if Present (Generic_Parent_Type (N))
and then
(Nkind
(Parent (Generic_Parent_Type (N))) /= N_Formal_Type_Declaration
(Parent (Generic_Parent_Type (N))) /= N_Formal_Type_Declaration
or else Nkind
(Formal_Type_Definition (Parent (Generic_Parent_Type (N))))
/= N_Formal_Private_Type_Definition)
/= N_Formal_Private_Type_Definition)
then
if Is_Tagged_Type (Id) then
@ -7356,6 +7356,27 @@ package body Sem_Ch3 is
Exclude_Parents => True);
Set_Interfaces (Derived_Type, Ifaces_List);
-- If the derived type is the anonymous type created for
-- a declaration whose parent has a constraint, propagate
-- the interface list to the source type. This must be done
-- prior to the completion of the analysis of the source type
-- because the components in the extension may contain current
-- instances whose legality depends on some ancestor.
if Is_Itype (Derived_Type) then
declare
Def : constant Node_Id :=
Associated_Node_For_Itype (Derived_Type);
begin
if Present (Def)
and then Nkind (Def) = N_Full_Type_Declaration
then
Set_Interfaces
(Defining_Identifier (Def), Ifaces_List);
end if;
end;
end if;
end;
end if;