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,
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-09 Ed Schonberg <schonb...@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.--- gcc/ada/sem_res.adb
+++ 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);
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;
