From 81c356975fc26ab5f9306bd9c596ef7232287fcb Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 3 Apr 2020 06:10:22 -0400 Subject: [PATCH] [Ada] ACATS 4.1K - B452001 - No errors detected 2020-06-16 Arnaud Charlet 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 | 5 +++ gcc/ada/sem_ch4.adb | 94 +++++++++++++++++++++----------------------- gcc/ada/sem_type.ads | 2 +- 3 files changed, 50 insertions(+), 51 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index ba83a097f15..f5ad90a4111 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 1d129543473..445122fd91e 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; ----------------------------------- diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads index 36732d382a0..6c6d5eb7fb5 100644 --- a/gcc/ada/sem_type.ads +++ b/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. -- 2.30.2