public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <derodat@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Eric Botcazou <ebotcazou@adacore.com>
Subject: [Ada] Fix oversight in latest change to Has_Compatible_Type
Date: Wed, 10 Nov 2021 08:58:33 +0000	[thread overview]
Message-ID: <20211110085833.GA2811085@adacore.com> (raw)

[-- 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



                 reply	other threads:[~2021-11-10  8:58 UTC|newest]

Thread overview: [no followups] expand[flat|nested]  mbox.gz  Atom feed

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20211110085833.GA2811085@adacore.com \
    --to=derodat@adacore.com \
    --cc=ebotcazou@adacore.com \
    --cc=gcc-patches@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).