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

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ba83a09..f5ad90a 100644 (file)
--- 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 1d12954..445122f 100644 (file)
--- 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 36732d3..6c6d5eb 100644 (file)
--- 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.