@@ -256,8 +256,8 @@ package body Sem_Ch4 is
-- type is not directly visible. The routine uses this type to emit a more
-- informative message.
- function Has_Possible_Literal_Aspects (N : Node_Id) return Boolean;
- -- Ada_2022: if an operand is a literal it may be subject to an
+ function Has_Possible_User_Defined_Literal (N : Node_Id) return Boolean;
+ -- Ada 2022: if an operand is a literal, it may be subject to an
-- implicit conversion to a type for which a user-defined literal
-- function exists. During the first pass of type resolution we do
-- not know the context imposed on the literal, so we assume that
@@ -7572,19 +7572,11 @@ package body Sem_Ch4 is
if Etype (N) = Any_Type then
declare
- L : Node_Id;
- R : Node_Id;
- Op_Id : Entity_Id := Empty;
+ L : constant Node_Id :=
+ (if Nkind (N) in N_Binary_Op then Left_Opnd (N) else Empty);
+ R : constant Node_Id := Right_Opnd (N);
begin
- R := Right_Opnd (N);
-
- if Nkind (N) in N_Binary_Op then
- L := Left_Opnd (N);
- else
- L := Empty;
- end if;
-
-- If either operand has no type, then don't complain further,
-- since this simply means that we have a propagated error.
@@ -7665,9 +7657,10 @@ package body Sem_Ch4 is
then
return;
- elsif Present (Entity (N))
- and then Has_Possible_Literal_Aspects (N)
- then
+ -- The handling of user-defined literals is deferred to the second
+ -- pass of resolution.
+
+ elsif Has_Possible_User_Defined_Literal (N) then
return;
-- If we have a logical operator, one of whose operands is
@@ -7882,117 +7875,19 @@ package body Sem_Ch4 is
end if;
end if;
- -- If we fall through then just give general message. Note that in
- -- the following messages, if the operand is overloaded we choose
- -- an arbitrary type to complain about, but that is probably more
- -- useful than not giving a type at all.
-
- if Nkind (N) in N_Unary_Op then
- Error_Msg_Node_2 := Etype (R);
- Error_Msg_N ("operator& not defined for}", N);
- return;
-
- else
- if Nkind (N) in N_Binary_Op then
- if not Is_Overloaded (L)
- and then not Is_Overloaded (R)
- and then Base_Type (Etype (L)) = Base_Type (Etype (R))
- then
- Error_Msg_Node_2 := First_Subtype (Etype (R));
- Error_Msg_N ("there is no applicable operator& for}", N);
-
- else
- -- Another attempt to find a fix: one of the candidate
- -- interpretations may not be use-visible. This has
- -- already been checked for predefined operators, so
- -- we examine only user-defined functions.
-
- Op_Id := Get_Name_Entity_Id (Chars (N));
-
- while Present (Op_Id) loop
- if Ekind (Op_Id) /= E_Operator
- and then Is_Overloadable (Op_Id)
- then
- if not Is_Immediately_Visible (Op_Id)
- and then not In_Use (Scope (Op_Id))
- and then not Is_Abstract_Subprogram (Op_Id)
- and then not Is_Hidden (Op_Id)
- and then Ekind (Scope (Op_Id)) = E_Package
- and then
- Has_Compatible_Type
- (L, Etype (First_Formal (Op_Id)))
- and then Present
- (Next_Formal (First_Formal (Op_Id)))
- and then
- Has_Compatible_Type
- (R,
- Etype (Next_Formal (First_Formal (Op_Id))))
- then
- Error_Msg_N
- ("no legal interpretation for operator&", N);
- Error_Msg_NE
- ("\use clause on& would make operation legal",
- N, Scope (Op_Id));
- exit;
- end if;
- end if;
-
- Op_Id := Homonym (Op_Id);
- end loop;
-
- if No (Op_Id) then
- Error_Msg_N ("invalid operand types for operator&", N);
-
- if Nkind (N) /= N_Op_Concat then
- Error_Msg_NE ("\left operand has}!", N, Etype (L));
- Error_Msg_NE ("\right operand has}!", N, Etype (R));
-
- -- For multiplication and division operators with
- -- a fixed-point operand and an integer operand,
- -- indicate that the integer operand should be of
- -- type Integer.
-
- if Nkind (N) in N_Op_Multiply | N_Op_Divide
- and then Is_Fixed_Point_Type (Etype (L))
- and then Is_Integer_Type (Etype (R))
- then
- Error_Msg_N
- ("\convert right operand to `Integer`", N);
-
- elsif Nkind (N) = N_Op_Multiply
- and then Is_Fixed_Point_Type (Etype (R))
- and then Is_Integer_Type (Etype (L))
- then
- Error_Msg_N
- ("\convert left operand to `Integer`", N);
- end if;
-
- -- For concatenation operators it is more difficult to
- -- determine which is the wrong operand. It is worth
- -- flagging explicitly an access type, for those who
- -- might think that a dereference happens here.
-
- elsif Is_Access_Type (Etype (L)) then
- Error_Msg_N ("\left operand is access type", N);
+ -- If we fall through then just give general message
- elsif Is_Access_Type (Etype (R)) then
- Error_Msg_N ("\right operand is access type", N);
- end if;
- end if;
- end if;
- end if;
- end if;
+ Unresolved_Operator (N);
end;
end if;
end Operator_Check;
- ----------------------------------
- -- Has_Possible_Literal_Aspects --
- ----------------------------------
+ ---------------------------------------
+ -- Has_Possible_User_Defined_Literal --
+ ---------------------------------------
- function Has_Possible_Literal_Aspects (N : Node_Id) return Boolean is
+ function Has_Possible_User_Defined_Literal (N : Node_Id) return Boolean is
R : constant Node_Id := Right_Opnd (N);
- L : Node_Id := Empty;
procedure Check_Literal_Opnd (Opnd : Node_Id);
-- If an operand is a literal to which an aspect may apply,
@@ -8006,25 +7901,20 @@ package body Sem_Ch4 is
begin
if Nkind (Opnd) in N_Numeric_Or_String_Literal
or else (Is_Entity_Name (Opnd)
- and then Present (Entity (Opnd))
- and then Is_Named_Number (Entity (Opnd)))
+ and then Present (Entity (Opnd))
+ and then Is_Named_Number (Entity (Opnd)))
then
Add_One_Interp (N, Etype (Opnd), Etype (Opnd));
end if;
end Check_Literal_Opnd;
- -- Start of processing for Has_Possible_Literal_Aspects
+ -- Start of processing for Has_Possible_User_Defined_Literal
begin
if Ada_Version < Ada_2022 then
return False;
end if;
- if Nkind (N) in N_Binary_Op then
- L := Left_Opnd (N);
- else
- L := Empty;
- end if;
Check_Literal_Opnd (R);
-- Check left operand only if right one did not provide a
@@ -8040,14 +7930,12 @@ package body Sem_Ch4 is
-- determine whether a user-defined literal may apply to
-- either or both.
- if Present (L)
- and then Etype (N) = Any_Type
- then
- Check_Literal_Opnd (L);
+ if Nkind (N) in N_Binary_Op and then Etype (N) = Any_Type then
+ Check_Literal_Opnd (Left_Opnd (N));
end if;
return Etype (N) /= Any_Type;
- end Has_Possible_Literal_Aspects;
+ end Has_Possible_User_Defined_Literal;
-----------------------------------------------
-- Nondispatching_Call_To_Abstract_Operation --
@@ -10673,6 +10561,106 @@ package body Sem_Ch4 is
end if;
end Try_Object_Operation;
+ -------------------------
+ -- Unresolved_Operator --
+ -------------------------
+
+ procedure Unresolved_Operator (N : Node_Id) is
+ L : constant Node_Id :=
+ (if Nkind (N) in N_Binary_Op then Left_Opnd (N) else Empty);
+ R : constant Node_Id := Right_Opnd (N);
+
+ Op_Id : Entity_Id;
+
+ begin
+ -- Note that in the following messages, if the operand is overloaded we
+ -- choose an arbitrary type to complain about, but that is probably more
+ -- useful than not giving a type at all.
+
+ if Nkind (N) in N_Unary_Op then
+ Error_Msg_Node_2 := Etype (R);
+ Error_Msg_N ("operator& not defined for}", N);
+
+ elsif Nkind (N) in N_Binary_Op then
+ if not Is_Overloaded (L)
+ and then not Is_Overloaded (R)
+ and then Base_Type (Etype (L)) = Base_Type (Etype (R))
+ then
+ Error_Msg_Node_2 := First_Subtype (Etype (R));
+ Error_Msg_N ("there is no applicable operator& for}", N);
+
+ else
+ -- Another attempt to find a fix: one of the candidate
+ -- interpretations may not be use-visible. This has
+ -- already been checked for predefined operators, so
+ -- we examine only user-defined functions.
+
+ Op_Id := Get_Name_Entity_Id (Chars (N));
+
+ while Present (Op_Id) loop
+ if Ekind (Op_Id) /= E_Operator
+ and then Is_Overloadable (Op_Id)
+ and then not Is_Immediately_Visible (Op_Id)
+ and then not In_Use (Scope (Op_Id))
+ and then not Is_Abstract_Subprogram (Op_Id)
+ and then not Is_Hidden (Op_Id)
+ and then Ekind (Scope (Op_Id)) = E_Package
+ and then Has_Compatible_Type (L, Etype (First_Formal (Op_Id)))
+ and then Present (Next_Formal (First_Formal (Op_Id)))
+ and then
+ Has_Compatible_Type
+ (R, Etype (Next_Formal (First_Formal (Op_Id))))
+ then
+ Error_Msg_N ("no legal interpretation for operator&", N);
+ Error_Msg_NE ("\use clause on& would make operation legal",
+ N, Scope (Op_Id));
+ exit;
+ end if;
+
+ Op_Id := Homonym (Op_Id);
+ end loop;
+
+ if No (Op_Id) then
+ Error_Msg_N ("invalid operand types for operator&", N);
+
+ if Nkind (N) /= N_Op_Concat then
+ Error_Msg_NE ("\left operand has}!", N, Etype (L));
+ Error_Msg_NE ("\right operand has}!", N, Etype (R));
+
+ -- For multiplication and division operators with
+ -- a fixed-point operand and an integer operand,
+ -- indicate that the integer operand should be of
+ -- type Integer.
+
+ if Nkind (N) in N_Op_Multiply | N_Op_Divide
+ and then Is_Fixed_Point_Type (Etype (L))
+ and then Is_Integer_Type (Etype (R))
+ then
+ Error_Msg_N ("\convert right operand to `Integer`", N);
+
+ elsif Nkind (N) = N_Op_Multiply
+ and then Is_Fixed_Point_Type (Etype (R))
+ and then Is_Integer_Type (Etype (L))
+ then
+ Error_Msg_N ("\convert left operand to `Integer`", N);
+ end if;
+
+ -- For concatenation operators it is more difficult to
+ -- determine which is the wrong operand. It is worth
+ -- flagging explicitly an access type, for those who
+ -- might think that a dereference happens here.
+
+ elsif Is_Access_Type (Etype (L)) then
+ Error_Msg_N ("\left operand is access type", N);
+
+ elsif Is_Access_Type (Etype (R)) then
+ Error_Msg_N ("\right operand is access type", N);
+ end if;
+ end if;
+ end if;
+ end if;
+ end Unresolved_Operator;
+
---------
-- wpo --
---------
@@ -88,4 +88,7 @@ package Sem_Ch4 is
-- of a non-tagged type is allowed as if Extensions_Allowed returned True.
-- This is used to issue better error messages.
+ procedure Unresolved_Operator (N : Node_Id);
+ -- Give an error for an unresolved operator
+
end Sem_Ch4;
@@ -2483,10 +2483,17 @@ package body Sem_Res is
Expr_Type := Etype (Parent (N));
-- If not overloaded, then we know the type, and all that needs doing
- -- is to check that this type is compatible with the context.
+ -- is to check that this type is compatible with the context. But note
+ -- that we may have an operator with no interpretation in Ada 2022 for
+ -- the case of possible user-defined literals as operands.
elsif not Is_Overloaded (N) then
- Found := Covers (Typ, Etype (N));
+ if Nkind (N) in N_Op and then No (Entity (N)) then
+ pragma Assert (Ada_Version >= Ada_2022);
+ Found := False;
+ else
+ Found := Covers (Typ, Etype (N));
+ end if;
Expr_Type := Etype (N);
-- In the overloaded case, we must select the interpretation that
@@ -3058,8 +3065,7 @@ package body Sem_Res is
-- literal aspect, rewrite node as a call to the corresponding
-- function, which plays the role of an implicit conversion.
- if Nkind (N) in
- N_Numeric_Or_String_Literal | N_Identifier
+ if Nkind (N) in N_Numeric_Or_String_Literal | N_Identifier
and then Has_Applicable_User_Defined_Literal (N, Typ)
then
Analyze_And_Resolve (N, Typ);
@@ -3169,13 +3175,15 @@ package body Sem_Res is
(First (Component_Associations (N))));
end if;
- -- For an operator with no interpretation, check whether
- -- one of its operands may be a user-defined literal.
+ -- For an operator with no interpretation, check whether one of
+ -- its operands may be a user-defined literal.
- elsif Nkind (N) in N_Op
- and then Try_User_Defined_Literal (N, Typ)
- then
- return;
+ elsif Nkind (N) in N_Op and then No (Entity (N)) then
+ if Try_User_Defined_Literal (N, Typ) then
+ return;
+ else
+ Unresolved_Operator (N);
+ end if;
else
Wrong_Type (N, Typ);
@@ -13306,22 +13314,22 @@ package body Sem_Res is
Typ : Entity_Id) return Boolean
is
begin
- if Nkind (N) in N_Op_Add | N_Op_Divide | N_Op_Mod | N_Op_Multiply
- | N_Op_Rem | N_Op_Subtract
+ if Nkind (N) in N_Op_Add
+ | N_Op_Divide
+ | N_Op_Mod
+ | N_Op_Multiply
+ | N_Op_Rem
+ | N_Op_Subtract
then
-
- -- Both operands must have the same type as the context.
+ -- Both operands must have the same type as the context
-- (ignoring for now fixed-point and exponentiation ops).
if Has_Applicable_User_Defined_Literal (Right_Opnd (N), Typ) then
Resolve (Left_Opnd (N), Typ);
Analyze_And_Resolve (N, Typ);
return True;
- end if;
- if
- Has_Applicable_User_Defined_Literal (Left_Opnd (N), Typ)
- then
+ elsif Has_Applicable_User_Defined_Literal (Left_Opnd (N), Typ) then
Resolve (Right_Opnd (N), Typ);
Analyze_And_Resolve (N, Typ);
return True;
@@ -13331,7 +13339,7 @@ package body Sem_Res is
end if;
elsif Nkind (N) in N_Binary_Op then
- -- For other operators the context does not impose a type on
+ -- For other binary operators the context does not impose a type on
-- the operands, but their types must match.
if Nkind (Left_Opnd (N))
@@ -13351,18 +13359,20 @@ package body Sem_Res is
then
Analyze_And_Resolve (N, Typ);
return True;
+
else
return False;
end if;
elsif Nkind (N) in N_Unary_Op
- and then
- Has_Applicable_User_Defined_Literal (Right_Opnd (N), Typ)
+ and then Has_Applicable_User_Defined_Literal (Right_Opnd (N), Typ)
then
Analyze_And_Resolve (N, Typ);
return True;
- else -- Other operators
+ else
+ -- Other operators
+
return False;
end if;
end Try_User_Defined_Literal;