[Ada] Wrong resolution of equality operator with overloaded operand

This patch fixes a code generation error on an equality operation one of
whose operands is an overloaded call, and several equality operators are
visible. The resolution would succes but in some cases the wrong entity
was lwfton the equality node, leading to expansion with the wrong
interpretation.  If the equality operation is the operand of a negation,
the resolution of the negation must make direct use of the equality
resolution,

2019-07-09  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_res.adb (Resolve_Equality_Op): If the node was overloaded,
	set properly the entity to which the node has been resolved. The
	original entity is the first one found during analysis, and is
	not necessarily the resolved one.
	(Resolve_Op_Not): If the argument of negation is an overloaded
	equality operation, call its resolution directly given that the
	context type does not participate in overload resolution.

gcc/testsuite/

	* gnat.dg/equal7.adb, gnat.dg/equal7_pkg.adb,
	gnat.dg/equal7_pkg.ads: New testcase.

From-SVN: r273281

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 738be61..adb8622 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Resolve_Equality_Op): If the node was overloaded,
+       set properly the entity to which the node has been resolved. The
+       original entity is the first one found during analysis, and is
+       not necessarily the resolved one.
+       (Resolve_Op_Not): If the argument of negation is an overloaded
+       equality operation, call its resolution directly given that the
+       context type does not participate in overload resolution.
+
 2019-07-09  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * bindo.adb: Remove with and use clauses for Debug.  Add with

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index b86e7cc..e32d547 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8437,6 +8437,45 @@ package body Sem_Res is
             Explain_Redundancy (Original_Node (R));
          end if;
 
+         --  If the equality is overloaded and the operands have resolved
+         --  properly, set the proper equality operator on the node. The
+         --  current setting is the first one found during analysis, which
+         --  is not necessarily the one to which the node has resolved.
+
+         if Is_Overloaded (N) then
+            declare
+               I  : Interp_Index;
+               It : Interp;
+            begin
+               Get_First_Interp (N, I, It);
+
+               --  If the equality is user-defined, the type of the operands
+               --  matches that of the formals. For a predefined operqtor,
+               --  it is the scope that matters, given that the predefined
+               --  equality has Any_Type formals. In either case the result
+               --  type (most often Booleam) must match the context .
+
+               while Present (It.Typ) loop
+                  if Etype (It.Nam) = Typ
+                    and then
+                     (Etype (First_Entity (It.Nam)) = Etype (L)
+                       or else Scope (It.Nam) = Scope (T))
+                  then
+                     Set_Entity (N, It.Nam);
+
+                     Set_Is_Overloaded (N, False);
+                     exit;
+                  end if;
+
+                  Get_Next_Interp (I, It);
+               end loop;
+
+               if Present (Alias (Entity (N))) then
+                  Set_Entity (N, Alias (Entity (N)));
+               end if;
+            end;
+         end if;
+
          Check_Unset_Reference (L);
          Check_Unset_Reference (R);
          Generate_Operator_Reference (N, T);
@@ -10034,9 +10073,36 @@ package body Sem_Res is
          end if;
 
          --  Complete resolution and evaluation of NOT
+         --  If argument is an equality and expected type is boolean, that
+         --  expected type has no effect on resolution, and there are
+         --  special rules for resolution of Eq, Neq in the presence of
+         --  overloaded operands, so we directly call its resolution routines.
+
+         declare
+            Opnd : constant Node_Id := Right_Opnd (N);
+         begin
+            if B_Typ = Standard_Boolean
+              and then Nkind_In (Opnd, N_Op_Eq, N_Op_Ne)
+              and then Is_Overloaded (Opnd)
+            then
+               Resolve_Equality_Op (Opnd, B_Typ);
+               if Ekind (Entity (Opnd)) = E_Function then
+                  Rewrite_Operator_As_Call (Opnd, Entity (Opnd));
+               end if;
+
+               if not Inside_A_Generic or else Is_Entity_Name (Opnd) then
+                  Freeze_Expression (Opnd);
+               end if;
+
+               Expand (Opnd);
+
+            else
+               Resolve (Opnd, B_Typ);
+            end if;
+
+            Check_Unset_Reference (Opnd);
+         end;
 
-         Resolve (Right_Opnd (N), B_Typ);
-         Check_Unset_Reference (Right_Opnd (N));
          Set_Etype (N, B_Typ);
          Generate_Operator_Reference (N, B_Typ);
          Eval_Op_Not (N);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e1f1678..d50b7b2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/equal7.adb, gnat.dg/equal7_pkg.adb,
+       gnat.dg/equal7_pkg.ads: New testcase.
+
 2019-07-09  Javier Miranda  <miranda@adacore.com>
 
        * gnat.dg/range_check3.adb, gnat.dg/range_check3_pkg.adb,

diff --git a/gcc/testsuite/gnat.dg/equal7.adb b/gcc/testsuite/gnat.dg/equal7.adb
new file mode 100644 (file)
index 0000000..2b27842
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal7.adb
@@ -0,0 +1,15 @@
+--  { dg-do run }
+
+with Equal7_Pkg; use Equal7_Pkg;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+procedure Equal7 is
+   X : constant Integer := 42;
+
+begin
+   if F (X) /= "" & ASCII.LF then
+       null;
+   end if;
+   if not (F (X) = "" & ASCII.LF) then
+       null;
+   end if;
+end;

diff --git a/gcc/testsuite/gnat.dg/equal7_pkg.adb b/gcc/testsuite/gnat.dg/equal7_pkg.adb
new file mode 100644 (file)
index 0000000..171343f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal7_pkg.adb
@@ -0,0 +1,14 @@
+package body Equal7_Pkg is
+
+   function F (X : Integer) return String is
+   begin
+      return To_String (F (X));
+   end F;
+
+   function F (X : Integer) return Unbounded_String is
+      Result : Unbounded_String;
+   begin
+      Append (Result, "hello" & X'Img);
+      return Result;
+   end;
+end;

diff --git a/gcc/testsuite/gnat.dg/equal7_pkg.ads b/gcc/testsuite/gnat.dg/equal7_pkg.ads
new file mode 100644 (file)
index 0000000..8fd601c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/equal7_pkg.ads
@@ -0,0 +1,16 @@
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Finalization;      use Ada.Finalization;
+package Equal7_Pkg is
+
+   type Editor_Location is abstract new Controlled with null record;
+   Nil_Editor_Location : constant Editor_Location'Class;
+
+   function F (X : Integer) return Unbounded_String;
+   function F (X : Integer) return String;
+
+private
+   type Dummy_Editor_Location is new Editor_Location with null record;
+
+   Nil_Editor_Location : constant Editor_Location'Class :=
+     Dummy_Editor_Location'(Controlled with null record);
+end;