[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 738be6128a65adc8aaec8f2d3fba8baa1da2423c..adb86222a5831aaac3b3aaacb17f39ad742f6829 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 b86e7cce4b697d9557190d32de16a33c0fb2fcfe..e32d5478c99ebcca98a1a99bd62866564bdf28a1 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 e1f16789a78746efc17a9df940e870b6e0e0dfcd..d50b7b2097f15a236f688ae1a21d91167d34ecbc 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;