sem_ch3.adb (Analyze_Subtype_Declaration): Inherit Is_Generic_Actual_Type flag in a nested instance.

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.

From-SVN: r195538

5 files changed, 111 insertions, 11 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c466f70..6985aad 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 040d624..85a863f 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 ccbd511..3a5f693 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 41d9a62..5f86561 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
@@ -1350,6 +1397,14 @@ package body Sem_Type 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)));
       end Is_Actual_Subprogram;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 907efe4..b540169 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);