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:
parent
9fc91982f2
commit
7cec010e49
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
Loading…
Reference in New Issue