[Ada] Fix oversight in latest change to Has_Compatible_Type

[Ada] Fix oversight in latest change to Has_Compatible_Type

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 699 bytes --]

Adding manual calls to Covers in the callers overlooks the overloaded case,
so this follow-up change adds back the reversed calls to Has_Compatible_Type
but guard them with a boolean flag set to true for comparison operators.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_type.ads (Has_Compatible_Type): Add For_Comparison parameter.
	* sem_type.adb (Has_Compatible_Type): Put back the reversed calls
	to Covers guarded with For_Comparison.
	* sem_ch4.adb (Analyze_Membership_Op) <Try_One_Interp>: Remove new
	reversed call to Covers and set For_Comparison to true instead.
	(Find_Comparison_Types) <Try_One_Interp>: Likewise
	(Find_Equality_Types) <Try_One_Interp>: Likewise.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3945 bytes --]

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