This is a test against RM 4.5.2(4.1/4), the rule that ensures that
equality is visible for a membership involving objects. GNAT wasn't
handling this case properly because during the rewrite of membership
tests, the legality rules were bypassed as the rewrite was no longer
treated as if it came from the source code.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-16 Arnaud Charlet <char...@adacore.com>
gcc/ada/
* sem_ch4.adb (Analyze_Membership_Op): Reset entity of equality
nodes for membership tests with singletons.
(Analyze_User_Defined_Binary_Op): Always perform the analysis
since nodes coming from the expander also may refer to non
standard operators as part of membership expansion.
* exp_ch4.adb (Expand_Set_Membership.Make_Cond): Reset entity of
equality node.
* sem_type.ads: Fix typo in comment.--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -12716,6 +12716,11 @@ package body Exp_Ch4 is
Make_Op_Eq (Sloc (Alt),
Left_Opnd => L,
Right_Opnd => R);
+
+ -- We reset the Entity since we do not want to bypass the operator
+ -- resolution.
+
+ Set_Entity (Cond, Empty);
end if;
return Cond;
--- gcc/ada/sem_ch4.adb
+++ gcc/ada/sem_ch4.adb
@@ -2965,6 +2965,8 @@ package body Sem_Ch4 is
end if;
end Analyze_Set_Membership;
+ Op : Node_Id;
+
-- Start of processing for Analyze_Membership_Op
begin
@@ -3011,17 +3013,16 @@ package body Sem_Ch4 is
and then Has_Compatible_Type (R, Etype (L))
then
if Nkind (N) = N_In then
- Rewrite (N,
- Make_Op_Eq (Loc,
- Left_Opnd => L,
- Right_Opnd => R));
+ Op := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R);
else
- Rewrite (N,
- Make_Op_Ne (Loc,
- Left_Opnd => L,
- Right_Opnd => R));
+ Op := Make_Op_Ne (Loc, Left_Opnd => L, Right_Opnd => R);
end if;
+ -- We reset the Entity since we do not want to bypass the operator
+ -- resolution.
+
+ Set_Entity (Op, Empty);
+ Rewrite (N, Op);
Analyze (N);
return;
@@ -5595,54 +5596,47 @@ package body Sem_Ch4 is
procedure Analyze_User_Defined_Binary_Op
(N : Node_Id;
- Op_Id : Entity_Id)
- is
+ Op_Id : Entity_Id) is
begin
- -- Only do analysis if the operator Comes_From_Source, since otherwise
- -- the operator was generated by the expander, and all such operators
- -- always refer to the operators in package Standard.
-
- if Comes_From_Source (N) then
- declare
- F1 : constant Entity_Id := First_Formal (Op_Id);
- F2 : constant Entity_Id := Next_Formal (F1);
-
- begin
- -- Verify that Op_Id is a visible binary function. Note that since
- -- we know Op_Id is overloaded, potentially use visible means use
- -- visible for sure (RM 9.4(11)).
+ declare
+ F1 : constant Entity_Id := First_Formal (Op_Id);
+ F2 : constant Entity_Id := Next_Formal (F1);
- if Ekind (Op_Id) = E_Function
- and then Present (F2)
- and then (Is_Immediately_Visible (Op_Id)
- or else Is_Potentially_Use_Visible (Op_Id))
- and then Has_Compatible_Type (Left_Opnd (N), Etype (F1))
- and then Has_Compatible_Type (Right_Opnd (N), Etype (F2))
- then
- Add_One_Interp (N, Op_Id, Etype (Op_Id));
+ begin
+ -- Verify that Op_Id is a visible binary function. Note that since
+ -- we know Op_Id is overloaded, potentially use visible means use
+ -- visible for sure (RM 9.4(11)).
+
+ if Ekind (Op_Id) = E_Function
+ and then Present (F2)
+ and then (Is_Immediately_Visible (Op_Id)
+ or else Is_Potentially_Use_Visible (Op_Id))
+ and then Has_Compatible_Type (Left_Opnd (N), Etype (F1))
+ and then Has_Compatible_Type (Right_Opnd (N), Etype (F2))
+ then
+ Add_One_Interp (N, Op_Id, Etype (Op_Id));
- -- If the left operand is overloaded, indicate that the current
- -- type is a viable candidate. This is redundant in most cases,
- -- but for equality and comparison operators where the context
- -- does not impose a type on the operands, setting the proper
- -- type is necessary to avoid subsequent ambiguities during
- -- resolution, when both user-defined and predefined operators
- -- may be candidates.
+ -- If the left operand is overloaded, indicate that the current
+ -- type is a viable candidate. This is redundant in most cases,
+ -- but for equality and comparison operators where the context
+ -- does not impose a type on the operands, setting the proper
+ -- type is necessary to avoid subsequent ambiguities during
+ -- resolution, when both user-defined and predefined operators
+ -- may be candidates.
- if Is_Overloaded (Left_Opnd (N)) then
- Set_Etype (Left_Opnd (N), Etype (F1));
- end if;
+ if Is_Overloaded (Left_Opnd (N)) then
+ Set_Etype (Left_Opnd (N), Etype (F1));
+ end if;
- if Debug_Flag_E then
- Write_Str ("user defined operator ");
- Write_Name (Chars (Op_Id));
- Write_Str (" on node ");
- Write_Int (Int (N));
- Write_Eol;
- end if;
+ if Debug_Flag_E then
+ Write_Str ("user defined operator ");
+ Write_Name (Chars (Op_Id));
+ Write_Str (" on node ");
+ Write_Int (Int (N));
+ Write_Eol;
end if;
- end;
- end if;
+ end if;
+ end;
end Analyze_User_Defined_Binary_Op;
-----------------------------------
--- gcc/ada/sem_type.ads
+++ gcc/ada/sem_type.ads
@@ -196,7 +196,7 @@ package Sem_Type is
-- a compatible one.
function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean;
- -- A user-defined function hides a predefined operator if it is matches the
+ -- A user-defined function hides a predefined operator if it matches the
-- signature of the operator, and is declared in an open scope, or in the
-- scope of the result type.
