aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch4.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@adacore.com>2020-04-03 06:10:22 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-16 09:07:13 -0400
commit81c356975fc26ab5f9306bd9c596ef7232287fcb (patch)
treed2d0dbb6868a162bce0b13e3b950be6520258efb /gcc/ada/sem_ch4.adb
parent29b82c7d55c818bd25b98e0f9469cbe6adec0e34 (diff)
downloadgcc-81c356975fc26ab5f9306bd9c596ef7232287fcb.zip
gcc-81c356975fc26ab5f9306bd9c596ef7232287fcb.tar.gz
gcc-81c356975fc26ab5f9306bd9c596ef7232287fcb.tar.bz2
[Ada] ACATS 4.1K - B452001 - No errors detected
2020-06-16 Arnaud Charlet <charlet@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.
Diffstat (limited to 'gcc/ada/sem_ch4.adb')
-rw-r--r--gcc/ada/sem_ch4.adb94
1 files changed, 44 insertions, 50 deletions
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 1d12954..445122f 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/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;
-----------------------------------