From patchwork Mon May 29 08:29:17 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 70221 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 553663889E09 for ; Mon, 29 May 2023 08:34:34 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 553663889E09 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1685349274; bh=wl/FsUuvreZ1Xcq6/3weMPBIwCVF5kK98h2CCFuGvUk=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=ovUgRWNyMZj+yJipaf+KRBJuYOSLDEdLNs8CHjx6jHauQr9gWOe1MrW+gzyLLdmG7 At/x76cDtN8mGnBZ4cgQiQ3TOXpEnDpzehCKKrchJYJqkAhIPQPJressQkDygu11XC gko/jqme0yoMXqRudzlPIZ88B675Va02o96TXHpE= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x330.google.com (mail-wm1-x330.google.com [IPv6:2a00:1450:4864:20::330]) by sourceware.org (Postfix) with ESMTPS id CB6FF384DA4C for ; Mon, 29 May 2023 08:29:20 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org CB6FF384DA4C Received: by mail-wm1-x330.google.com with SMTP id 5b1f17b1804b1-3f6cbdf16d2so18779785e9.2 for ; Mon, 29 May 2023 01:29:20 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1685348959; x=1687940959; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=wl/FsUuvreZ1Xcq6/3weMPBIwCVF5kK98h2CCFuGvUk=; b=Q97+nggOnQsyEge/vyUuVEsgrpNZw/dEU5VdAgl/+2VGl8VarEc0l8Go1xvtFXQNdl 2IL6ZxvIaQGxG6FvA5wRZA/v0lrRzTO50x9OIRr3mdGW5MHVMZ/RyIOgwkYxPXCaEYu8 GPlBVCgtI45DliSRD4VEjP0zcDMJXux8Fa1v0n+vKVZu2LBF5Xf1qqZiCz7gT9qw9Q+p XVePzMZuH8CHYQQzpnz6aXRtBC1aFUhRKX0yb3agx8OcLq2QH0MQ9Dc26ssTf9IftJfG 0ijtAwwST1TcgvTpJIuVNPSbvRa3ptyw0PbAXBxZMZl92EjNOMXd92sBzqsXq931vwH0 1xEA== X-Gm-Message-State: AC+VfDyk0FY9Pj0HbAgDIKM/bixKuIbyGAx6CA6VsrhJDmmpn49vz2cd oR0oI6IxpO6ttnufk/KbJ7X/hlcr/qmYzwYQ2kk2Nw== X-Google-Smtp-Source: ACHHUZ7RKdBT4prUzh3UaVbavwlELZVDLUoGYBtc0MOWVaJZ0XAtuCefxKDSQVu0i9ADhW3W2BqJTA== X-Received: by 2002:a5d:45cf:0:b0:306:30e8:eb34 with SMTP id b15-20020a5d45cf000000b0030630e8eb34mr9134753wrs.48.1685348959371; Mon, 29 May 2023 01:29:19 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id u4-20020adfdd44000000b003063176ef09sm13104964wrm.6.2023.05.29.01.29.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 29 May 2023 01:29:18 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Repair support for user-defined literals in arithmetic operators Date: Mon, 29 May 2023 10:29:17 +0200 Message-Id: <20230529082917.2409948-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" From: Eric Botcazou 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. Tested on x86_64-pc-linux-gnu, committed on master. --- 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 c8bb99b6716..c76f2874957 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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 -- --------- 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 9161218a32b..a31077a5f33 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); @@ -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;