diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 25 |
3 files changed, 41 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8f28a3c..74372c0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index b7f31c3..42ef7e0 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d1a6974..6e0efe1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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; |