sem_ch8,adb (Analyze_Object_Renaming): Reject ambiguous expressions in an object...

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8,adb (Analyze_Object_Renaming): Reject ambiguous expressions
	in an object renaming declaration when the expected type is an
	anonymous access type.

	* sem_type.adb (Disambiguate): Use anonymousness to resolve a potential
	ambiguity when one interpretation is an anonymous access type and the
	other is a named access type, and the context itself is anonymous

From-SVN: r146404

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 58d9ff68a46fecdb8f7295ae0d0ee13b9ee74b27..56b55438650cf837c810f41600e0d00c725c7630 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -782,25 +782,50 @@ package body Sem_Ch8 is
                Error_Msg_N
                  ("expect anonymous access type in object renaming", N);
             end if;
+
          else
             declare
-               I   : Interp_Index;
-               It  : Interp;
-               Typ : Entity_Id := Empty;
+               I    : Interp_Index;
+               It   : Interp;
+               Typ  : Entity_Id := Empty;
+               Seen : Boolean := False;
 
             begin
                Get_First_Interp (Nam, I, It);
                while Present (It.Typ) loop
-                  if No (Typ) then
-                     if Ekind (It.Typ) = Ekind (T)
-                       and then Covers (T, It.Typ)
+
+                  --  Renaming is ambiguous if more than one candidate
+                  --  interpretation is type-conformant with the context.
+
+                  if Ekind (It.Typ) = Ekind (T) then
+                     if Ekind (T) = E_Anonymous_Access_Subprogram_Type
+                       and then Type_Conformant
+                         (Designated_Type (T), Designated_Type (It.Typ))
+                     then
+                        if not Seen then
+                           Seen := True;
+                        else
+                           Error_Msg_N
+                             ("ambiguous expression in renaming", Nam);
+                        end if;
+
+                     elsif Ekind (T) = E_Anonymous_Access_Type
+                       and then Covers
+                         (Designated_Type (T), Designated_Type (It.Typ))
                      then
+                        if not Seen then
+                           Seen := True;
+                        else
+                           Error_Msg_N
+                             ("ambiguous expression in renaming", Nam);
+                        end if;
+                     end if;
+
+                     if Covers (T, It.Typ) then
                         Typ := It.Typ;
                         Set_Etype (Nam, Typ);
                         Set_Is_Overloaded (Nam, False);
                      end if;
-                  else
-                     Error_Msg_N ("ambiguous expression in renaming", N);
                   end if;
 
                   Get_Next_Interp (I, It);

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index e5f790011c1e972db05e7a0babcd17cab0b53802..6da87733ccd22ac483bd6ec79d2dfb3d09d263d5 100644 (file)
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -1680,6 +1680,37 @@ package body Sem_Type is
       elsif Nkind (N) = N_Range then
          return It1;
 
+      --  Implement AI05-105: A renaming declaration with an access
+      --  definition must resolve to an anonymous access type. This
+      --  is a resolution rule and can be used to disambiguate.
+
+      elsif Nkind (Parent (N)) = N_Object_Renaming_Declaration
+        and then Present (Access_Definition (Parent (N)))
+      then
+         if Ekind (It1.Typ) = E_Anonymous_Access_Type
+           or else Ekind (It1.Typ) = E_Anonymous_Access_Subprogram_Type
+         then
+            if Ekind (It2.Typ) = Ekind (It1.Typ) then
+
+               --  True ambiguity
+
+               return No_Interp;
+            else
+               return It1;
+            end if;
+
+         elsif Ekind (It2.Typ) = E_Anonymous_Access_Type
+           or else Ekind (It2.Typ) = E_Anonymous_Access_Subprogram_Type
+         then
+            return It2;
+
+         else
+
+            --  No legal interpretation.
+
+            return No_Interp;
+         end if;
+
       --  If two user defined-subprograms are visible, it is a true ambiguity,
       --  unless one of them is an entry and the context is a conditional or
       --  timed entry call, or unless we are within an instance and this is