diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3113,7 +3113,7 @@ package body Sem_Ch4 is procedure Try_One_Interp (T1 : Entity_Id) is begin - if Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then + if Has_Compatible_Type (R, T1, For_Comparison => True) then if Found and then Base_Type (T1) /= Base_Type (T_F) then @@ -6607,8 +6607,7 @@ package body Sem_Ch4 is end if; if Valid_Comparison_Arg (T1) - and then (Has_Compatible_Type (R, T1) - or else Covers (Etype (R), T1)) + and then Has_Compatible_Type (R, T1, For_Comparison => True) then if Found and then Base_Type (T1) /= Base_Type (T_F) then It := Disambiguate (L, I_F, Index, Any_Type); @@ -7105,8 +7104,8 @@ package body Sem_Ch4 is if T1 /= Standard_Void_Type and then (Universal_Access - or else Has_Compatible_Type (R, T1) - or else Covers (Etype (R), T1)) + or else + Has_Compatible_Type (R, T1, For_Comparison => True)) and then ((not Is_Limited_Type (T1) diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2438,8 +2438,9 @@ package body Sem_Type is ------------------------- function Has_Compatible_Type - (N : Node_Id; - Typ : Entity_Id) return Boolean + (N : Node_Id; + Typ : Entity_Id; + For_Comparison : Boolean := False) return Boolean is I : Interp_Index; It : Interp; @@ -2479,6 +2480,12 @@ package body Sem_Type is or else (Nkind (N) = N_String_Literal and then Present (Find_Aspect (Typ, Aspect_String_Literal))) + + or else + (For_Comparison + and then not Is_Tagged_Type (Typ) + and then Ekind (Typ) /= E_Anonymous_Access_Type + and then Covers (Etype (N), Typ)) then return True; end if; @@ -2503,6 +2510,11 @@ package body Sem_Type is and then Covers (Typ, Corresponding_Record_Type (Etype (It.Typ)))) + or else + (For_Comparison + and then not Is_Tagged_Type (Typ) + and then Ekind (Typ) /= E_Anonymous_Access_Type + and then Covers (It.Typ, Typ)) then return True; end if; diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads --- a/gcc/ada/sem_type.ads +++ b/gcc/ada/sem_type.ads @@ -186,11 +186,17 @@ package Sem_Type is -- right operand, which has one interpretation compatible with that of L. -- Return the type intersection of the two. - function Has_Compatible_Type (N : Node_Id; Typ : Entity_Id) return Boolean; + function Has_Compatible_Type + (N : Node_Id; + Typ : Entity_Id; + For_Comparison : Boolean := False) return Boolean; -- Verify that some interpretation of the node N has a type compatible with -- Typ. If N is not overloaded, then its unique type must be compatible -- with Typ. Otherwise iterate through the interpretations of N looking for - -- a compatible one. + -- a compatible one. If For_Comparison is true, the function is invoked for + -- a comparison (or equality) operator and also needs to verify the reverse + -- compatibility, because the implementation of type resolution for these + -- operators is not fully symmetrical. function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean; -- A user-defined function hides a predefined operator if it matches the