aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2010-06-14 15:04:40 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2010-06-14 17:04:40 +0200
commit7cec010e49d84d5aad737fc040dc693615f81e78 (patch)
tree2b48b2d75c9ca98f2e6f0d8bf9147ab9126ed6bf
parent9fc91982f25c892710a0a8a00ab9d69a30481285 (diff)
downloadgcc-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/ChangeLog11
-rw-r--r--gcc/ada/exp_disp.adb9
-rw-r--r--gcc/ada/sem_ch3.adb25
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;