* [Ada] Fix oversight in latest change to Has_Compatible_Type
@ 2021-11-10 8:58 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-11-10 8:58 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-11-10 8:58 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-10 8:58 [Ada] Fix oversight in latest change to Has_Compatible_Type Pierre-Marie de Rodat
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).