From 7cec010e49d84d5aad737fc040dc693615f81e78 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 14 Jun 2010 15:04:40 +0000 Subject: [PATCH] sem_ch3.adb (Build_Derived_Record_Type): if derived type is an anonymous base generated when... 2010-06-14 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/exp_disp.adb | 9 +++++++-- gcc/ada/sem_ch3.adb | 25 +++++++++++++++++++++++-- 3 files changed, 41 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8f28a3cf1a0..74372c0026c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2010-06-14 Ed Schonberg + + * 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 * 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 b7f31c36c4a..42ef7e06ac9 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 d1a69740379..6e0efe1fd30 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; -- 2.30.2