@@ -7455,6 +7455,8 @@ package body Sem_Ch4 is
then
It := Disambiguate (L, Valid_I, I, Any_Type);
+ -- Note the ambiguity for later, see below
+
if It = No_Interp then
L_Typ := Any_Type;
R_Typ := T;
@@ -7472,6 +7474,12 @@ package body Sem_Ch4 is
Get_Next_Interp (I, It);
end loop;
+ -- Record the operator as an interpretation of the operation if we
+ -- have found a valid pair of types for the two operands. If we have
+ -- found more than one such pair and did not manage to disambiguate
+ -- them, record an "ambiguous" operator as the interpretation, that
+ -- Disambiguate in Sem_Type will specifically recognize.
+
if Present (L_Typ) then
Set_Etype (L, L_Typ);
Set_Etype (R, R_Typ);
@@ -197,10 +197,10 @@ package body Sem_Type is
--------------------
procedure Add_One_Interp
- (N : Node_Id;
- E : Entity_Id;
- T : Entity_Id;
- Opnd_Type : Entity_Id := Empty)
+ (N : Node_Id;
+ E : Entity_Id;
+ T : Entity_Id;
+ Opnd_Typ : Entity_Id := Empty)
is
Vis_Type : Entity_Id;
@@ -308,7 +308,7 @@ package body Sem_Type is
end if;
end loop;
- All_Interp.Table (All_Interp.Last) := (Name, Typ, Abstr_Op);
+ All_Interp.Table (All_Interp.Last) := (Name, Typ, Opnd_Typ, Abstr_Op);
All_Interp.Append (No_Interp);
end Add_Entry;
@@ -369,8 +369,8 @@ package body Sem_Type is
-- it is the type of the operand that is relevant here.
if Ekind (E) = E_Operator then
- if Present (Opnd_Type) then
- Vis_Type := Opnd_Type;
+ if Present (Opnd_Typ) then
+ Vis_Type := Opnd_Typ;
else
Vis_Type := Base_Type (T);
end if;
@@ -663,7 +663,7 @@ package body Sem_Type is
and then not Is_Inherited_Operation (H)
then
All_Interp.Table (All_Interp.Last) :=
- (H, Etype (H), Empty);
+ (H, Etype (H), Empty, Empty);
All_Interp.Append (No_Interp);
goto Next_Homograph;
@@ -1317,6 +1317,12 @@ package body Sem_Type is
-- the generic. Within the instance the actual is represented by a
-- constructed subprogram renaming.
+ function Is_Ambiguous_Boolean_Operator (I : Interp) return Boolean;
+ -- Determine whether I corresponds to an "ambiguous" boolean operator.
+ -- Such an interpretation is used to record the ambiguity of operands
+ -- diagnosed during the analysis of comparison and equality operations.
+ -- See Find_Comparison_Equality_Types in Sem_Ch4 for the rationale.
+
function Matches (Op : Node_Id; Func_Id : Entity_Id) return Boolean;
-- Determine whether function Func_Id is an exact match for binary or
-- unary operator Op.
@@ -1418,6 +1424,17 @@ package body Sem_Type is
or else Is_Wrapper_Package (Scope (S)));
end Is_Actual_Subprogram;
+ -----------------------------------
+ -- Is_Ambiguous_Boolean_Operator --
+ -----------------------------------
+
+ function Is_Ambiguous_Boolean_Operator (I : Interp) return Boolean is
+ begin
+ return Ekind (I.Nam) = E_Operator
+ and then I.Typ = Standard_Boolean
+ and then I.Opnd_Typ = Any_Type;
+ end Is_Ambiguous_Boolean_Operator;
+
-------------
-- Matches --
-------------
@@ -1824,6 +1841,12 @@ package body Sem_Type is
It1 := It;
Nam1 := It.Nam;
+ -- Return immediately if either corresponds to a recorded ambiguity
+
+ if Is_Ambiguous_Boolean_Operator (It1) then
+ return It1;
+ end if;
+
while I /= I2 loop
Get_Next_Interp (I, It);
end loop;
@@ -1831,6 +1854,12 @@ package body Sem_Type is
It2 := It;
Nam2 := It.Nam;
+ -- See above
+
+ if Is_Ambiguous_Boolean_Operator (It2) then
+ return It2;
+ end if;
+
-- Check whether one of the entities is an Ada 2005/2012/2022 and we
-- are operating in an earlier mode, in which case we discard the Ada
-- 2005/2012/2022 entity, so that we get proper Ada 95 overload
@@ -56,22 +56,23 @@ package Sem_Type is
-- identifier, there is a set of possible types corresponding to the types
-- that the overloaded call may return. We keep a 1-to-1 correspondence
-- between interpretations and types: for user-defined subprograms the type
- -- is the declared return type. For operators, the type is determined by
- -- the type of the arguments. If the arguments themselves are overloaded,
- -- we enter the operator name in the names table for each possible result
- -- type. In most cases, arguments are not overloaded and only one
- -- interpretation is present anyway.
+ -- is the declared result type Typ. For operators, the type is determined
+ -- either only by the result type Typ for arithmetic operators or by the
+ -- result type and the type of the operands Opnd_Typ for comparisoon and
+ -- equality operators. If the operands are themselves overloaded, we enter
+ -- the operator name in the names table for each possible result type.
type Interp is record
Nam : Entity_Id;
Typ : Entity_Id;
- Abstract_Op : Entity_Id := Empty;
+ Opnd_Typ : Entity_Id;
+ Abstract_Op : Entity_Id;
end record;
-- Entity Abstract_Op is set to the abstract operation which potentially
-- disables the interpretation in Ada 2005 mode.
- No_Interp : constant Interp := (Empty, Empty, Empty);
+ No_Interp : constant Interp := (Empty, Empty, Empty, Empty);
type Interp_Index is new Int;
@@ -115,10 +116,10 @@ package Sem_Type is
-- error reports.
procedure Add_One_Interp
- (N : Node_Id;
- E : Entity_Id;
- T : Entity_Id;
- Opnd_Type : Entity_Id := Empty);
+ (N : Node_Id;
+ E : Entity_Id;
+ T : Entity_Id;
+ Opnd_Typ : Entity_Id := Empty);
-- Add (E, T) to the list of interpretations of the node being resolved.
-- For calls and operators, i.e. for nodes that have a name field, E is an
-- overloadable entity, and T is its type. For constructs such as indexed
@@ -130,7 +131,7 @@ package Sem_Type is
--
-- For operators, the legality of the operation depends on the visibility
-- of T and its scope. If the operator is an equality or comparison, T is
- -- always Boolean, and we use Opnd_Type, which is a candidate type for one
+ -- always Boolean, and we use Opnd_Typ, which is a candidate type for one
-- of the operands of N, to check visibility.
procedure Get_First_Interp