diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c466f7073de5f4d78fd23a6c2da7bd9e7164454d..6985aadd8d7ad8caa045dc5571d991b49c5043a2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2013-01-29 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Analyze_Subtype_Declaration): Inherit
+ Is_Generic_Actual_Type flag in a nested instance.
+ * sem_ch12.adb (Restore_Private_Views): Preserve
+ Is_Generic_Actual_Type flag if actual is a Generic_Actual_Type
+ of an enclosing instance.
+ * sem_util.adb (Corresponding_Generic_Type): Handle generic actual
+ which is an actual of an enclosing instance.
+ * sem_type.adb (Real_Actual): If a generic_actual_type is the
+ formal of an enclosing generic and thus renames the corresponding
+ actual, use the actual of the enclosing instance to resolve
+ spurious ambiguities in instantiations when two formals are
+ instantiated with the same actual.
+
2013-01-29 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document all Ada 2005 and Ada 2012 pragmas as
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 040d6241ca3ef9f83da9a08530c25716adccaea5..85a863ffff3c51a3e77c951b218707fd15962245 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -12677,7 +12677,20 @@ package body Sem_Ch12 is
if Is_Type (E)
and then Nkind (Parent (E)) = N_Subtype_Declaration
then
- Set_Is_Generic_Actual_Type (E, False);
+ -- If the actual for E is itself a generic actual type from
+ -- an enclosing instance, E is still a generic actual type
+ -- outside of the current instance. This matter when resolving
+ -- an overloaded call that may be ambiguous in the enclosing
+ -- instance, when two of its actuals coincide.
+
+ if Is_Entity_Name (Subtype_Indication (Parent (E)))
+ and then Is_Generic_Actual_Type
+ (Entity (Subtype_Indication (Parent (E))))
+ then
+ null;
+ else
+ Set_Is_Generic_Actual_Type (E, False);
+ end if;
-- An unusual case of aliasing: the actual may also be directly
-- visible in the generic, and be private there, while it is fully
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ccbd5117d933817dfdef991551e458517b7259e8..3a5f693384ef862912e05f6e6433db925f47b9b2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4375,9 +4375,16 @@ package body Sem_Ch3 is
-- Some common processing on all types
- Set_Size_Info (Id, T);
+ Set_Size_Info (Id, T);
Set_First_Rep_Item (Id, First_Rep_Item (T));
+ -- If the parent type is a generic actual, so is the subtype. This may
+ -- happen in a nested instance. Why Comes_From_Source test???
+
+ if not Comes_From_Source (N) then
+ Set_Is_Generic_Actual_Type (Id, Is_Generic_Actual_Type (T));
+ end if;
+
T := Etype (Id);
Set_Is_Immediately_Visible (Id, True);
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 41d9a62a9d50b15d2d4f2f1aea3c0a1ab43e4236..5f86561b148c20e1796725841841f022a571b57a 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -750,6 +750,12 @@ package body Sem_Type is
-- removes spurious errors from nested instantiations that involve,
-- among other things, types derived from private types.
+ function Real_Actual (T : Entity_Id) return Entity_Id;
+ -- If an actual in an inner instance is the formal of an enclosing
+ -- generic, the actual in the enclosing instance is the one that can
+ -- create an accidental ambiguity, and the check on compatibily of
+ -- generic actual types must use this enclosing actual.
+
----------------------
-- Full_View_Covers --
----------------------
@@ -765,6 +771,33 @@ package body Sem_Type is
or else Base_Type (Typ2) = Typ1);
end Full_View_Covers;
+ -----------------
+ -- Real_Actual --
+ -----------------
+
+ function Real_Actual (T : Entity_Id) return Entity_Id is
+ Par : constant Node_Id := Parent (T);
+ RA : Entity_Id;
+
+ begin
+ -- Retrieve parent subtype from subtype declaration for actual.
+
+ if Nkind (Par) = N_Subtype_Declaration
+ and then not Comes_From_Source (Par)
+ and then Is_Entity_Name (Subtype_Indication (Par))
+ then
+ RA := Entity (Subtype_Indication (Par));
+
+ if Is_Generic_Actual_Type (RA) then
+ return RA;
+ end if;
+ end if;
+
+ -- Otherwise actual is not the actual of an enclosing instance.
+
+ return T;
+ end Real_Actual;
+
-- Start of processing for Covers
begin
@@ -822,21 +855,34 @@ package body Sem_Type is
-- Generic actuals require special treatment to avoid spurious ambi-
-- guities in an instance, when two formal types are instantiated with
-- the same actual, so that different subprograms end up with the same
- -- signature in the instance.
+ -- signature in the instance. If a generic actual is the actual of an
+ -- enclosing instance, it is that actual that we must compare: generic
+ -- actuals are only incompatible if they appear in the same instance.
if BT1 = BT2
or else BT1 = T2
or else BT2 = T1
then
- if not Is_Generic_Actual_Type (T1) then
+ if not Is_Generic_Actual_Type (T1)
+ or else
+ not Is_Generic_Actual_Type (T2)
+ then
return True;
+
+ -- Both T1 and T2 are generic actual types
+
else
- return (not Is_Generic_Actual_Type (T2)
- or else Is_Itype (T1)
- or else Is_Itype (T2)
- or else Is_Constr_Subt_For_U_Nominal (T1)
- or else Is_Constr_Subt_For_U_Nominal (T2)
- or else Scope (T1) /= Scope (T2));
+ declare
+ RT1 : constant Entity_Id := Real_Actual (T1);
+ RT2 : constant Entity_Id := Real_Actual (T2);
+ begin
+ return RT1 = RT2
+ or else Is_Itype (T1)
+ or else Is_Itype (T2)
+ or else Is_Constr_Subt_For_U_Nominal (T1)
+ or else Is_Constr_Subt_For_U_Nominal (T2)
+ or else Scope (RT1) /= Scope (RT2);
+ end;
end if;
-- Literals are compatible with types in a given "class"
@@ -1267,7 +1313,8 @@ package body Sem_Type is
-- Determine whether a subprogram is an actual in an enclosing instance.
-- An overloading between such a subprogram and one declared outside the
-- instance is resolved in favor of the first, because it resolved in
- -- the generic.
+ -- the generic. Within the instance the eactual is represented by a
+ -- constructed subprogram renaming.
function Matches (Actual, Formal : Node_Id) return Boolean;
-- Look for exact type match in an instance, to remove spurious
@@ -1349,6 +1396,14 @@ package body Sem_Type is
function Is_Actual_Subprogram (S : Entity_Id) return Boolean is
begin
return In_Open_Scopes (Scope (S))
+ and then
+ Nkind (Unit_Declaration_Node (S)) =
+ N_Subprogram_Renaming_Declaration
+
+ -- Why the Comes_From_Source test here???
+
+ and then not Comes_From_Source (Unit_Declaration_Node (S))
+
and then
(Is_Generic_Instance (Scope (S))
or else Is_Wrapper_Package (Scope (S)));
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 907efe4c1e6d23a2304e4a261fa70fd5ef83c7a0..b540169602c18ca56d6432bb1588a0914568b08d 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2538,6 +2538,16 @@ package body Sem_Util is
if not Is_Generic_Actual_Type (T) then
return Any_Type;
+ -- If the actual is the actual of an enclosing instance, resolution
+ -- was correct in the generic.
+
+ elsif Nkind (Parent (T)) = N_Subtype_Declaration
+ and then Is_Entity_Name (Subtype_Indication (Parent (T)))
+ and then
+ Is_Generic_Actual_Type (Entity (Subtype_Indication (Parent (T))))
+ then
+ return Any_Type;
+
else
Inst := Scope (T);