diff options
author | Ed Schonberg <schonberg@adacore.com> | 2010-06-14 15:04:40 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-14 17:04:40 +0200 |
commit | 7cec010e49d84d5aad737fc040dc693615f81e78 (patch) | |
tree | 2b48b2d75c9ca98f2e6f0d8bf9147ab9126ed6bf | |
parent | 9fc91982f25c892710a0a8a00ab9d69a30481285 (diff) | |
download | gcc-7cec010e49d84d5aad737fc040dc693615f81e78.zip gcc-7cec010e49d84d5aad737fc040dc693615f81e78.tar.gz gcc-7cec010e49d84d5aad737fc040dc693615f81e78.tar.bz2 |
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
-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; |