[Ada] ACATS 4.1L - B452002 - Wrong universal access "=" rules

2020-06-18  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* sem_ch4.adb (Find_Equality_Types.Check_Access_Object_Types):
	New function, used to implement RM 4.5.2 (9.6/2).
	(Find_Equality_Types.Check_Compatible_Profiles): New function,
	used to implement RM 4.5.2(9.7/2).
	(Find_Equality_Types.Reference_Anonymous_Access_Type): New
	function.
	(Find_Equality_Types.Try_One_Interp): Fix handling of anonymous
	access types which was accepting both too much and too little.
	Remove accumulated special and incomplete cases for
	instantiations, replaced by Has_Compatible_Type.
	(Analyze_Overloaded_Selected_Component): Use
	Is_Anonymous_Access_Type instead of Ekind_In.
	* sem_res.adb: Code cleanup and bug fix: use
	Is_Anonymous_Access_Type instead of Ekind_In.  Relax checking of
	anonymous access parameter when universal_access "=" is
	involved.
	* sem_type.adb: Likewise.
	(Find_Unique_Type): Move code from here...
	(Specific_Type): ...to here. Also add missing handling of access
	to class wide types.
	* einfo.ads, einfo.adb (Is_Access_Object_Type): New.

5 files changed, 291 insertions, 99 deletions

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 8280d3b..b482709 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -3644,6 +3644,11 @@ package body Einfo is
    -- Classification Functions --
    ------------------------------
 
+   function Is_Access_Object_Type               (Id : E) return B is
+   begin
+      return Is_Access_Type (Id) and then not Is_Access_Subprogram_Type (Id);
+   end Is_Access_Object_Type;
+
    function Is_Access_Type                      (Id : E) return B is
    begin
       return Ekind (Id) in Access_Kind;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8cf9d2e..32f5593 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2331,6 +2331,9 @@ package Einfo is
 --    Is_Access_Type (synthesized)
 --       Applies to all entities, true for access types and subtypes
 
+--    Is_Access_Object_Type (synthesized)
+--       Applies to all entities, true for access-to-object types and subtypes
+
 --    Is_Activation_Record (Flag305)
 --       Applies to E_In_Parameters generated in Exp_Unst for nested
 --       subprograms, to mark the added formal that carries the activation
@@ -7588,6 +7591,7 @@ package Einfo is
    --  Is_Generic_Type where the Ekind does not provide the needed
    --  information).
 
+   function Is_Access_Object_Type               (Id : E) return B;
    function Is_Access_Type                      (Id : E) return B;
    function Is_Access_Protected_Subprogram_Type (Id : E) return B;
    function Is_Access_Subprogram_Type           (Id : E) return B;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index bc841c0..556f209 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3929,15 +3929,13 @@ package body Sem_Ch4 is
                  and then Is_Visible_Component (Comp, Sel)
                then
 
-                  --  AI05-105:  if the context is an object renaming with
+                  --  AI05-105: if the context is an object renaming with
                   --  an anonymous access type, the expected type of the
                   --  object must be anonymous. This is a name resolution rule.
 
                   if Nkind (Parent (N)) /= N_Object_Renaming_Declaration
                     or else No (Access_Definition (Parent (N)))
-                    or else Ekind (Etype (Comp)) = E_Anonymous_Access_Type
-                    or else
-                      Ekind (Etype (Comp)) = E_Anonymous_Access_Subprogram_Type
+                    or else Is_Anonymous_Access_Type (Etype (Comp))
                   then
                      Set_Entity (Sel, Comp);
                      Set_Etype (Sel, Etype (Comp));
@@ -6542,13 +6540,33 @@ package body Sem_Ch4 is
       Op_Id : Entity_Id;
       N     : Node_Id)
    is
-      Index : Interp_Index;
+      Index : Interp_Index := 0;
       It    : Interp;
       Found : Boolean := False;
       I_F   : Interp_Index;
       T_F   : Entity_Id;
       Scop  : Entity_Id := Empty;
 
+      function Check_Access_Object_Types
+        (N : Node_Id; Typ : Entity_Id) return Boolean;
+      --  Check for RM 4.5.2 (9.6/2): When both are of access-to-object types,
+      --  the designated types shall be the same or one shall cover the other,
+      --  and if the designated types are elementary or array types, then the
+      --  designated subtypes shall statically match.
+      --  If N is not overloaded, then its unique type must be compatible as
+      --  per above. Otherwise iterate through the interpretations of N looking
+      --  for a compatible one.
+
+      procedure Check_Compatible_Profiles (N : Node_Id; Typ : Entity_Id);
+      --  Check for RM 4.5.2(9.7/2): When both are of access-to-subprogram
+      --  types, the designated profiles shall be subtype conformant.
+
+      function References_Anonymous_Access_Type
+        (N : Node_Id; Typ : Entity_Id) return Boolean;
+      --  Return True either if N is not overloaded and its Etype is an
+      --  anonymous access type or if one of the interpretations of N refers
+      --  to an anonymous access type compatible with Typ.
+
       procedure Try_One_Interp (T1 : Entity_Id);
       --  The context of the equality operator plays no role in resolving the
       --  arguments, so that if there is more than one interpretation of the
@@ -6556,12 +6574,183 @@ package body Sem_Ch4 is
       --  and an error can be emitted now, after trying to disambiguate, i.e.
       --  applying preference rules.
 
+      -------------------------------
+      -- Check_Access_Object_Types --
+      -------------------------------
+
+      function Check_Access_Object_Types
+        (N : Node_Id; Typ : Entity_Id) return Boolean
+      is
+         function Check_Designated_Types (DT1, DT2 : Entity_Id) return Boolean;
+         --  Check RM 4.5.2 (9.6/2) on the given designated types.
+
+         ----------------------------
+         -- Check_Designated_Types --
+         ----------------------------
+
+         function Check_Designated_Types
+           (DT1, DT2 : Entity_Id) return Boolean is
+         begin
+            --  If the designated types are elementary or array types, then
+            --  the designated subtypes shall statically match.
+
+            if Is_Elementary_Type (DT1) or else Is_Array_Type (DT1) then
+               if Base_Type (DT1) /= Base_Type (DT2) then
+                  return False;
+               else
+                  return Subtypes_Statically_Match (DT1, DT2);
+               end if;
+
+            --  Otherwise, the designated types shall be the same or one
+            --  shall cover the other.
+
+            else
+               return DT1 = DT2
+                 or else Covers (DT1, DT2)
+                 or else Covers (DT2, DT1);
+            end if;
+         end Check_Designated_Types;
+
+      --  Start of processing for Check_Access_Object_Types
+
+      begin
+         --  Return immediately with no checks if Typ is not an
+         --  access-to-object type.
+
+         if not Is_Access_Object_Type (Typ) then
+            return True;
+
+         --  Any_Type is compatible with all types in this context, and is used
+         --  in particular for the designated type of a 'null' value.
+
+         elsif Directly_Designated_Type (Typ) = Any_Type
+           or else Nkind (N) = N_Null
+         then
+            return True;
+         end if;
+
+         if not Is_Overloaded (N) then
+            if Is_Access_Object_Type (Etype (N)) then
+               return Check_Designated_Types
+                 (Designated_Type (Typ), Designated_Type (Etype (N)));
+            end if;
+         else
+            declare
+               Typ_Is_Anonymous : constant Boolean :=
+                 Is_Anonymous_Access_Type (Typ);
+
+               I  : Interp_Index;
+               It : Interp;
+
+            begin
+               Get_First_Interp (N, I, It);
+               while Present (It.Typ) loop
+
+                  --  The check on designated types if only relevant when one
+                  --  of the types is anonymous, ignore other (non relevant)
+                  --  types.
+
+                  if (Typ_Is_Anonymous
+                       or else Is_Anonymous_Access_Type (It.Typ))
+                    and then Is_Access_Object_Type (It.Typ)
+                  then
+                     if Check_Designated_Types
+                          (Designated_Type (Typ), Designated_Type (It.Typ))
+                     then
+                        return True;
+                     end if;
+                  end if;
+
+                  Get_Next_Interp (I, It);
+               end loop;
+            end;
+         end if;
+
+         return False;
+      end Check_Access_Object_Types;
+
+      -------------------------------
+      -- Check_Compatible_Profiles --
+      -------------------------------
+
+      procedure Check_Compatible_Profiles (N : Node_Id; Typ : Entity_Id) is
+         I     : Interp_Index;
+         It    : Interp;
+         I1    : Interp_Index := 0;
+         Found : Boolean := False;
+         Tmp   : Entity_Id;
+
+      begin
+         if not Is_Overloaded (N) then
+            Check_Subtype_Conformant
+              (Designated_Type (Etype (N)), Designated_Type (Typ), N);
+         else
+            Get_First_Interp (N, I, It);
+            while Present (It.Typ) loop
+               if Is_Access_Subprogram_Type (It.Typ) then
+                  if not Found then
+                     Found := True;
+                     Tmp   := It.Typ;
+                     I1    := I;
+
+                  else
+                     It := Disambiguate (N, I1, I, Any_Type);
+
+                     if It /= No_Interp then
+                        Tmp := It.Typ;
+                        I1  := I;
+                     else
+                        Found := False;
+                        exit;
+                     end if;
+                  end if;
+               end if;
+
+               Get_Next_Interp (I, It);
+            end loop;
+
+            if Found then
+               Check_Subtype_Conformant
+                 (Designated_Type (Tmp), Designated_Type (Typ), N);
+            end if;
+         end if;
+      end Check_Compatible_Profiles;
+
+      --------------------------------------
+      -- References_Anonymous_Access_Type --
+      --------------------------------------
+
+      function References_Anonymous_Access_Type
+        (N : Node_Id; Typ : Entity_Id) return Boolean
+      is
+         I  : Interp_Index;
+         It : Interp;
+      begin
+         if not Is_Overloaded (N) then
+            return Is_Anonymous_Access_Type (Etype (N));
+         else
+            Get_First_Interp (N, I, It);
+            while Present (It.Typ) loop
+               if Is_Anonymous_Access_Type (It.Typ)
+                 and then (Covers (It.Typ, Typ) or else Covers (Typ, It.Typ))
+               then
+                  return True;
+               end if;
+
+               Get_Next_Interp (I, It);
+            end loop;
+
+            return False;
+         end if;
+      end References_Anonymous_Access_Type;
+
       --------------------
       -- Try_One_Interp --
       --------------------
 
       procedure Try_One_Interp (T1 : Entity_Id) is
-         Bas : Entity_Id;
+         Universal_Access : Boolean;
+         Bas              : Entity_Id;
 
       begin
          --  Perform a sanity check in case of previous errors
@@ -6581,6 +6770,9 @@ package body Sem_Ch4 is
          --  In Ada 2005, the equality operator for anonymous access types
          --  is declared in Standard, and preference rules apply to it.
 
+         Universal_Access := Is_Anonymous_Access_Type (T1)
+           or else References_Anonymous_Access_Type (R, T1);
+
          if Present (Scop) then
 
             --  Note that we avoid returning if we are currently within a
@@ -6601,48 +6793,28 @@ package body Sem_Ch4 is
             then
                null;
 
-            elsif Ekind (T1) = E_Anonymous_Access_Type
-              and then Scop = Standard_Standard
-            then
-               null;
+            elsif Scop /= Standard_Standard or else not Universal_Access then
 
-            else
                --  The scope does not contain an operator for the type
 
                return;
             end if;
 
          --  If we have infix notation, the operator must be usable. Within
-         --  an instance, if the type is already established we know it is
-         --  correct. If an operand is universal it is compatible with any
-         --  numeric type.
+         --  an instance, the type may have been immediately visible if the
+         --  types are compatible.
 
          elsif In_Open_Scopes (Scope (Bas))
            or else Is_Potentially_Use_Visible (Bas)
            or else In_Use (Bas)
            or else (In_Use (Scope (Bas)) and then not Is_Hidden (Bas))
-
-            --  In an instance, the type may have been immediately visible.
-            --  Either the types are compatible, or one operand is universal
-            --  (numeric or null).
-
            or else
              ((In_Instance or else In_Inlined_Body)
-                and then
-                  (First_Subtype (T1) = First_Subtype (Etype (R))
-                    or else Nkind (R) = N_Null
-                    or else
-                      (Is_Numeric_Type (T1)
-                        and then Is_Universal_Numeric_Type (Etype (R)))))
-
-           --  In Ada 2005, the equality on anonymous access types is declared
-           --  in Standard, and is always visible.
-
-           or else Ekind (T1) = E_Anonymous_Access_Type
+                and then Has_Compatible_Type (R, T1))
          then
             null;
 
-         else
+         elsif not Universal_Access then
             --  Save candidate type for subsequent error message, if any
 
             if not Is_Limited_Type (T1) then
@@ -6655,9 +6827,7 @@ package body Sem_Ch4 is
          --  Ada 2005 (AI-230): Keep restriction imposed by Ada 83 and 95:
          --  Do not allow anonymous access types in equality operators.
 
-         if Ada_Version < Ada_2005
-           and then Ekind (T1) = E_Anonymous_Access_Type
-         then
+         if Ada_Version < Ada_2005 and then Universal_Access then
             return;
          end if;
 
@@ -6675,9 +6845,10 @@ package body Sem_Ch4 is
          --  because that indicates the potential rewriting case where the
          --  interpretation to consider is actually "=" and the node may be
          --  about to be rewritten by Analyze_Equality_Op.
+         --  Finally, also check for RM 4.5.2 (9.6/2).
 
          if T1 /= Standard_Void_Type
-           and then Has_Compatible_Type (R, T1)
+           and then (Universal_Access or else Has_Compatible_Type (R, T1))
 
            and then
              ((not Is_Limited_Type (T1)
@@ -6692,7 +6863,18 @@ package body Sem_Ch4 is
              (Nkind (N) /= N_Op_Ne
                or else not Is_Tagged_Type (T1)
                or else Chars (Op_Id) = Name_Op_Eq)
+
+           and then (not Universal_Access
+                      or else Check_Access_Object_Types (R, T1))
          then
+            if Universal_Access
+              and then Is_Access_Subprogram_Type (T1)
+              and then Nkind (L) /= N_Null
+              and then Nkind (R) /= N_Null
+            then
+               Check_Compatible_Profiles (R, T1);
+            end if;
+
             if Found
               and then Base_Type (T1) /= Base_Type (T_F)
             then
@@ -6724,11 +6906,6 @@ package body Sem_Ch4 is
             if Etype (N) = Any_Type then
                Found := False;
             end if;
-
-         elsif Scop = Standard_Standard
-           and then Ekind (T1) = E_Anonymous_Access_Type
-         then
-            Found := True;
          end if;
       end Try_One_Interp;
 
@@ -6763,7 +6940,6 @@ package body Sem_Ch4 is
 
       if not Is_Overloaded (L) then
          Try_One_Interp (Etype (L));
-
       else
          Get_First_Interp (L, Index, It);
          while Present (It.Typ) loop
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0a6d61f..e6b4e6c 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -1547,8 +1547,8 @@ package body Sem_Res is
             null;
 
          elsif Nam_In (Op_Name, Name_Op_Multiply, Name_Op_Divide)
-           and then Is_Fixed_Point_Type (Etype (Left_Opnd  (Op_Node)))
-           and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node)))
+           and then Is_Fixed_Point_Type (Etype (Act1))
+           and then Is_Fixed_Point_Type (Etype (Act2))
          then
             if Pack /= Standard_Standard then
                Error := True;
@@ -1559,7 +1559,8 @@ package body Sem_Res is
 
          elsif Ada_Version >= Ada_2005
            and then Nam_In (Op_Name, Name_Op_Eq, Name_Op_Ne)
-           and then Ekind (Etype (Act1)) = E_Anonymous_Access_Type
+           and then (Is_Anonymous_Access_Type (Etype (Act1))
+                      or else Is_Anonymous_Access_Type (Etype (Act2)))
          then
             null;
 
@@ -8470,10 +8471,8 @@ package body Sem_Res is
          --  Why no similar processing for case expressions???
 
          elsif Ada_Version >= Ada_2012
-           and then Ekind_In (Etype (L), E_Anonymous_Access_Type,
-                                         E_Anonymous_Access_Subprogram_Type)
-           and then Ekind_In (Etype (R), E_Anonymous_Access_Type,
-                                         E_Anonymous_Access_Subprogram_Type)
+           and then Is_Anonymous_Access_Type (Etype (L))
+           and then Is_Anonymous_Access_Type (Etype (R))
          then
             Check_If_Expression (L);
             Check_If_Expression (R);
@@ -13327,13 +13326,14 @@ package body Sem_Res is
                      return False;
 
                   --  Implicit conversions aren't allowed for anonymous access
-                  --  parameters. The "not Is_Local_Anonymous_Access_Type" test
-                  --  is done to exclude anonymous access results.
+                  --  parameters. We exclude anonymous access results as well
+                  --  as universal_access "=".
 
                   elsif not Is_Local_Anonymous_Access (Opnd_Type)
                     and then Nkind_In (Associated_Node_For_Itype (Opnd_Type),
                                        N_Function_Specification,
                                        N_Procedure_Specification)
+                    and then not Nkind_In (Parent (N), N_Op_Eq, N_Op_Ne)
                   then
                      Conversion_Error_N
                        ("implicit conversion of anonymous access parameter "
@@ -13355,7 +13355,7 @@ package body Sem_Res is
                   --  implicit conversion is disallowed (by RM12-8.6(27.1/3)).
 
                   elsif Type_Access_Level (Opnd_Type) >
-                        Deepest_Type_Access_Level (Target_Type)
+                    Deepest_Type_Access_Level (Target_Type)
                   then
                      Conversion_Error_N
                        ("implicit conversion of anonymous access value "
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index a224418..d975edc 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -376,7 +376,7 @@ package body Sem_Type is
            or else Nkind (N) = N_Expanded_Name
            or else (Nkind (N) in N_Op and then E = Entity (N))
            or else (In_Instance or else In_Inlined_Body)
-           or else Ekind (Vis_Type) = E_Anonymous_Access_Type
+           or else Is_Anonymous_Access_Type (Vis_Type)
          then
             null;
 
@@ -1242,8 +1242,8 @@ package body Sem_Type is
       --                                   Formal_Obj => Actual_Obj);
 
       elsif Ada_Version >= Ada_2005
-        and then Ekind (T1) = E_Anonymous_Access_Type
-        and then Ekind (T2) = E_Anonymous_Access_Type
+        and then Is_Anonymous_Access_Type (T1)
+        and then Is_Anonymous_Access_Type (T2)
         and then Is_Generic_Type (Directly_Designated_Type (T1))
         and then Get_Instance_Of (Directly_Designated_Type (T1)) =
                                                Directly_Designated_Type (T2)
@@ -1888,9 +1888,7 @@ package body Sem_Type is
       elsif Nkind (Parent (N)) = N_Object_Renaming_Declaration
         and then Present (Access_Definition (Parent (N)))
       then
-         if Ekind_In (It1.Typ, E_Anonymous_Access_Type,
-                               E_Anonymous_Access_Subprogram_Type)
-         then
+         if Is_Anonymous_Access_Type (It1.Typ) then
             if Ekind (It2.Typ) = Ekind (It1.Typ) then
 
                --  True ambiguity
@@ -1901,9 +1899,7 @@ package body Sem_Type is
                return It1;
             end if;
 
-         elsif Ekind_In (It2.Typ, E_Anonymous_Access_Type,
-                                  E_Anonymous_Access_Subprogram_Type)
-         then
+         elsif Is_Anonymous_Access_Type (It2.Typ) then
             return It2;
 
          --  No legal interpretation
@@ -2121,7 +2117,7 @@ package body Sem_Type is
             elsif Nam_In (Chars (Nam1), Name_Op_Eq, Name_Op_Ne)
               and then Ada_Version >= Ada_2005
               and then Etype (User_Subp) = Standard_Boolean
-              and then Ekind (Operand_Type) = E_Anonymous_Access_Type
+              and then Is_Anonymous_Access_Type (Operand_Type)
               and then
                 In_Same_Declaration_List
                   (Designated_Type (Operand_Type),
@@ -2252,35 +2248,6 @@ package body Sem_Type is
       elsif T = Universal_Fixed then
          return Etype (R);
 
-      --  Ada 2005 (AI-230): Support the following operators:
-
-      --    function "="  (L, R : universal_access) return Boolean;
-      --    function "/=" (L, R : universal_access) return Boolean;
-
-      --  Pool specific access types (E_Access_Type) are not covered by these
-      --  operators because of the legality rule of 4.5.2(9.2): "The operands
-      --  of the equality operators for universal_access shall be convertible
-      --  to one another (see 4.6)". For example, considering the type decla-
-      --  ration "type P is access Integer" and an anonymous access to Integer,
-      --  P is convertible to "access Integer" by 4.6 (24.11-24.15), but there
-      --  is no rule in 4.6 that allows "access Integer" to be converted to P.
-      --  Note that this does not preclude one operand to be a pool-specific
-      --  access type, as a previous version of this code enforced.
-
-      elsif Ada_Version >= Ada_2005
-        and then Ekind_In (Etype (L), E_Anonymous_Access_Type,
-                                      E_Anonymous_Access_Subprogram_Type)
-        and then Is_Access_Type (Etype (R))
-      then
-         return Etype (L);
-
-      elsif Ada_Version >= Ada_2005
-        and then Ekind_In (Etype (R), E_Anonymous_Access_Type,
-                                      E_Anonymous_Access_Subprogram_Type)
-        and then Is_Access_Type (Etype (L))
-      then
-         return Etype (R);
-
       --  If one operand is a raise_expression, use type of other operand
 
       elsif Nkind (L) = N_Raise_Expression then
@@ -3438,6 +3405,24 @@ package body Sem_Type is
       then
          return T2;
 
+      elsif Is_Access_Type (T1)
+        and then Is_Access_Type (T2)
+        and then Is_Class_Wide_Type (Designated_Type (T1))
+        and then not Is_Class_Wide_Type (Designated_Type (T2))
+        and then
+          Is_Ancestor (Root_Type (Designated_Type (T1)), Designated_Type (T2))
+      then
+         return T1;
+
+      elsif Is_Access_Type (T1)
+        and then Is_Access_Type (T2)
+        and then Is_Class_Wide_Type (Designated_Type (T2))
+        and then not Is_Class_Wide_Type (Designated_Type (T1))
+        and then
+          Is_Ancestor (Root_Type (Designated_Type (T2)), Designated_Type (T1))
+      then
+         return T2;
+
       elsif Ekind_In (B1, E_Access_Subprogram_Type,
                           E_Access_Protected_Subprogram_Type)
         and then Ekind (Designated_Type (B1)) /= E_Subprogram_Type
@@ -3452,25 +3437,47 @@ package body Sem_Type is
       then
          return T1;
 
-      elsif Ekind_In (T1, E_Allocator_Type,
-                          E_Access_Attribute_Type,
-                          E_Anonymous_Access_Type)
+      elsif Ekind_In (T1, E_Allocator_Type, E_Access_Attribute_Type)
         and then Is_Access_Type (T2)
       then
          return T2;
 
-      elsif Ekind_In (T2, E_Allocator_Type,
-                          E_Access_Attribute_Type,
-                          E_Anonymous_Access_Type)
+      elsif Ekind_In (T2, E_Allocator_Type, E_Access_Attribute_Type)
         and then Is_Access_Type (T1)
       then
          return T1;
 
-      --  If none of the above cases applies, types are not compatible
+      --  Ada 2005 (AI-230): Support the following operators:
 
-      else
-         return Any_Type;
+      --    function "="  (L, R : universal_access) return Boolean;
+      --    function "/=" (L, R : universal_access) return Boolean;
+
+      --  Pool-specific access types (E_Access_Type) are not covered by these
+      --  operators because of the legality rule of 4.5.2(9.2): "The operands
+      --  of the equality operators for universal_access shall be convertible
+      --  to one another (see 4.6)". For example, considering the type decla-
+      --  ration "type P is access Integer" and an anonymous access to Integer,
+      --  P is convertible to "access Integer" by 4.6 (24.11-24.15), but there
+      --  is no rule in 4.6 that allows "access Integer" to be converted to P.
+      --  Note that this does not preclude one operand to be a pool-specific
+      --  access type, as a previous version of this code enforced.
+
+      elsif Ada_Version >= Ada_2005 then
+         if Is_Anonymous_Access_Type (T1)
+           and then Is_Access_Type (T2)
+         then
+            return T1;
+
+         elsif Is_Anonymous_Access_Type (T2)
+           and then Is_Access_Type (T1)
+         then
+            return T2;
+         end if;
       end if;
+
+      --  If none of the above cases applies, types are not compatible
+
+      return Any_Type;
    end Specific_Type;
 
    ---------------------