public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7867] ada: Repair support for user-defined literals in arithmetic operators
@ 2023-09-27 8:25 Eric Botcazou
0 siblings, 0 replies; only message in thread
From: Eric Botcazou @ 2023-09-27 8:25 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:5cc34c3a390e8d2654a19506d10a55be232e7525
commit r13-7867-g5cc34c3a390e8d2654a19506d10a55be232e7525
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon Apr 3 17:11:11 2023 +0200
ada: Repair support for user-defined literals in arithmetic operators
It was partially broken to fix a regression in error reporting, because the
fix was applied to the first pass of resolution instead of the second pass,
as needs to be done for user-defined literals.
gcc/ada/
* sem_ch4.ads (Unresolved_Operator): New procedure.
* sem_ch4.adb (Has_Possible_Literal_Aspects): Rename into...
(Has_Possible_User_Defined_Literal): ...this. Tidy up.
(Operator_Check): Accept again unresolved operators if they have a
possible user-defined literal as operand. Factor out the handling
of the general error message into...
(Unresolved_Operator): ...this new procedure.
* sem_res.adb (Resolve): Be prepared for unresolved operators on
entry in Ada 2022 or later. If they are still unresolved on exit,
call Unresolved_Operator to give the error message.
(Try_User_Defined_Literal): Tidy up.
Diff:
---
gcc/ada/sem_ch4.adb | 254 +++++++++++++++++++++++++---------------------------
gcc/ada/sem_ch4.ads | 3 +
gcc/ada/sem_res.adb | 54 ++++++-----
3 files changed, 156 insertions(+), 155 deletions(-)
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 153a63586ca..8525565d883 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -255,8 +255,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
@@ -7519,19 +7519,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.
@@ -7612,9 +7604,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
@@ -7829,117 +7822,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,
@@ -7953,25 +7848,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
@@ -7987,14 +7877,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 --
@@ -10620,6 +10508,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 --
---------
diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads
index a0e20694f67..6f266a72577 100644
--- a/gcc/ada/sem_ch4.ads
+++ b/gcc/ada/sem_ch4.ads
@@ -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;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f6634da42a7..b819deb8c39 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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);
@@ -13201,22 +13209,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;
@@ -13226,7 +13234,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))
@@ -13246,18 +13254,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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-09-27 8:25 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-09-27 8:25 [gcc r13-7867] ada: Repair support for user-defined literals in arithmetic operators Eric Botcazou
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).