From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x435.google.com (mail-wr1-x435.google.com [IPv6:2a00:1450:4864:20::435]) by sourceware.org (Postfix) with ESMTPS id DBDFC385C420 for ; Mon, 12 Sep 2022 08:19:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org DBDFC385C420 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wr1-x435.google.com with SMTP id bq9so14087727wrb.4 for ; Mon, 12 Sep 2022 01:19:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :from:to:cc:subject:date; bh=FbmAYSeUJvje4f4hZw/n8K/OV2A/CjIYJCtejG/T29Y=; b=JKEJRe+WOVAWfRrj5iXUhxwhRBVQ0w+vM4Nj/0HqWXzK2DpHs6bJQh3IXAGqQBmtbW 3MO8XBacPyv4ChLmguTanhDSrJ3c2AyKjmg30Bw8BMWQKpn3JY2LzS7DuzzqjJ6hOlYt CeTg25fzdGkwFlOxJaFRt9lZCwzxb9GYB7LPYknY24CpR+ZIWhI8hIncvret2QpKZ9I+ g10vipAPUhAMfuJy7Wc/fN3mnqoCEbXwadE7uWI0ibGGRCEOhznThsnCU6lTkoamDTBs idYSgQgBOPLTb4+8ajcMwcSY3nFkWL0z0AYlNZvtzELo3DNMwbuexApOtRnkOyGN3FSi qL4g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-disposition:mime-version:message-id:subject:cc:to:from:date :x-gm-message-state:from:to:cc:subject:date; bh=FbmAYSeUJvje4f4hZw/n8K/OV2A/CjIYJCtejG/T29Y=; b=dhubxQ8F3OmkH5Eek+1K+MpnV4ddoUC7Y8AIaZ7JQeqo2QS5M8Dov53mdMH7b7ONZF ycG/GoqS+9yUSN3Ydza9nXwg25BYg5uUipamTOpP9U9yRKxsOjIsJ9dnCZXKViYGb/nk fws/vCLQeTwnr4W0IlyoLsNGvpRAw+fLJ98v8ptk0FFVwiWYnyvYc5P6K1jwtaEMvWQ2 H3K3t43YPIZxO1DbGnV9yGhlAOJIzK4eS8b/CqvkazCtnxoadWSzxOanLmDf+GvcVmmI r0ZMBwBjHshewxX/J6Qs2Rhkb7TSPo/pco1iwRsXO56HRY2Izzf32yaU5JBTsoyotKCN oSpw== X-Gm-Message-State: ACgBeo0C/Ddzz7onzK3bu5kyKuDpDqV7d+g33BjWPOXatUNncZn2yNY3 lKRenR9etzVzYhaAtvUxNUA07R2X4uW3Vg== X-Google-Smtp-Source: AA6agR7+Qx/t1SkPdAPGNd1xlidp2e6PR/jRncUlz8F33gz8e2yfCeI3C38oLQ/8BkJepDO2B1JbpA== X-Received: by 2002:a5d:5a89:0:b0:228:639b:642f with SMTP id bp9-20020a5d5a89000000b00228639b642fmr14100996wrb.503.1662970760683; Mon, 12 Sep 2022 01:19:20 -0700 (PDT) Received: from poulhies-Precision-5550 (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id m12-20020adffe4c000000b0022865038308sm6530953wrs.93.2022.09.12.01.19.19 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Sep 2022 01:19:20 -0700 (PDT) Date: Mon, 12 Sep 2022 10:19:19 +0200 From: Marc =?iso-8859-1?Q?Poulhi=E8s?= To: gcc-patches@gcc.gnu.org Cc: Gary Dismukes Subject: [Ada] Fix issues with compiling ACATS test for user-defined literals Message-ID: <20220912081919.GA1512845@poulhies-Precision-5550> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="rwEMma7ioTxnRzrJ" Content-Disposition: inline X-Spam-Status: No, score=-12.6 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,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 List-Id: --rwEMma7ioTxnRzrJ Content-Type: text/plain; charset=us-ascii Content-Disposition: inline The draft ACATS test (which we developed) for the Ada 2022 feature of user-defined literals has compile-time problems that are fixed with this set of changes. Two of these involve the resolution of named numbers in the context where an implicit literal conversion can occur, and for equality when a literal or named number is an operand. Furthermore, the compiler can hang in some cases when a numeric literal is used in a context where the expected type is a type derived two levels down from a tagged type that specifies a literal aspect. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_res.adb (Resolve_Equality_Op): Add handling for equality ops with user-defined literal operands. * sem_util.ads (Is_User_Defined_Literal): Update spec comment to indicate inclusion of named number cases. * sem_util.adb (Corresponding_Primitive_Op): Rather than following the chain of ancestor subprograms via Alias and Overridden_Operation links, we check for matching profiles between primitive subprograms of the descendant type and the ancestor subprogram (by calling a new nested function Profile_Matches_Ancestor). This prevents the compiler from hanging due to circular linkages via those fields that can occur between inherited and overriding subprograms (which might indicate a latent bug, but one that may be rather delicate to resolve). (Profile_Matches_Ancestor): New nested subprogram to compare the profile of a primitive subprogram with the profile of a candidate ancestor subprogram. (Is_User_Defined_Literal): Also return True in cases where the node N denotes a named number (E_Name_Integer and E_Named_Real). --rwEMma7ioTxnRzrJ Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8876,6 +8876,20 @@ package body Sem_Res is end if; else + + -- For Ada 2022, check for user-defined literals when the type has + -- the appropriate aspect. + + if Has_Applicable_User_Defined_Literal (L, Etype (R)) then + Resolve (L, Etype (R)); + Set_Etype (N, Standard_Boolean); + end if; + + if Has_Applicable_User_Defined_Literal (R, Etype (L)) then + Resolve (R, Etype (L)); + Set_Etype (N, Standard_Boolean); + end if; + -- Deal with other error cases if T = Any_String or else diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7182,7 +7182,51 @@ package body Sem_Util is Typ : constant Entity_Id := Find_Dispatching_Type (Ancestor_Op); Elmt : Elmt_Id; Subp : Entity_Id; - Prim : Entity_Id; + + function Profile_Matches_Ancestor (S : Entity_Id) return Boolean; + -- Returns True if subprogram S has the proper profile for an + -- overriding of Ancestor_Op (that is, corresponding formals either + -- have the same type, or are corresponding controlling formals, + -- and similarly for result types). + + ------------------------------ + -- Profile_Matches_Ancestor -- + ------------------------------ + + function Profile_Matches_Ancestor (S : Entity_Id) return Boolean is + F1 : Entity_Id := First_Formal (Ancestor_Op); + F2 : Entity_Id := First_Formal (S); + + begin + if Ekind (Ancestor_Op) /= Ekind (S) then + return False; + end if; + + -- ??? This should probably account for anonymous access formals, + -- but the parent function (Corresponding_Primitive_Op) is currently + -- only called for user-defined literal functions, which can't have + -- such formals. But if this is ever used in a more general context + -- it should be extended to handle such formals (and result types). + + while Present (F1) and then Present (F2) loop + if Etype (F1) = Etype (F2) + or else Is_Ancestor (Typ, Etype (F2)) + then + Next_Formal (F1); + Next_Formal (F2); + else + return False; + end if; + end loop; + + return No (F1) + and then No (F2) + and then (Etype (Ancestor_Op) = Etype (S) + or else Is_Ancestor (Typ, Etype (S))); + end Profile_Matches_Ancestor; + + -- Start of processing for Corresponding_Primitive_Op + begin pragma Assert (Is_Dispatching_Operation (Ancestor_Op)); pragma Assert (Is_Ancestor (Typ, Descendant_Type) @@ -7193,12 +7237,12 @@ package body Sem_Util is while Present (Elmt) loop Subp := Node (Elmt); - -- For regular primitives we only need to traverse the chain of - -- ancestors when the name matches the name of Ancestor_Op, but - -- for predefined dispatching operations we cannot rely on the - -- name of the primitive to identify a candidate since their name - -- is internally built adding a suffix to the name of the tagged - -- type. + -- For regular primitives we need to check the profile against + -- the ancestor when the name matches the name of Ancestor_Op, + -- but for predefined dispatching operations we cannot rely on + -- the name of the primitive to identify a candidate since their + -- name is internally built by adding a suffix to the name of the + -- tagged type. if Chars (Subp) = Chars (Ancestor_Op) or else Is_Predefined_Dispatching_Operation (Subp) @@ -7214,26 +7258,10 @@ package body Sem_Util is return Alias (Subp); end if; - -- Traverse the chain of ancestors searching for Ancestor_Op. - -- Overridden primitives have attribute Overridden_Operation; - -- inherited primitives have attribute Alias. - - else - Prim := Subp; - - while Present (Overridden_Operation (Prim)) - or else Present (Alias (Prim)) - loop - if Present (Overridden_Operation (Prim)) then - Prim := Overridden_Operation (Prim); - else - Prim := Alias (Prim); - end if; + -- Otherwise, return subprogram when profile matches its ancestor - if Prim = Ancestor_Op then - return Subp; - end if; - end loop; + elsif Profile_Matches_Ancestor (Subp) then + return Subp; end if; end if; @@ -21620,8 +21648,22 @@ package body Sem_Util is N_String_Literal => Aspect_String_Literal); begin - return Nkind (N) in N_Numeric_Or_String_Literal - and then Present (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N)))); + -- Return True when N is either a literal or a named number and the + -- type has the appropriate user-defined literal aspect. + + return (Nkind (N) in N_Numeric_Or_String_Literal + and then Present (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N))))) + or else + (Is_Entity_Name (N) + and then Present (Entity (N)) + and then + ((Ekind (Entity (N)) = E_Named_Integer + and then + Present (Find_Aspect (Typ, Aspect_Integer_Literal))) + or else + (Ekind (Entity (N)) = E_Named_Real + and then + Present (Find_Aspect (Typ, Aspect_Real_Literal))))); end Is_User_Defined_Literal; -------------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2500,7 +2500,9 @@ package Sem_Util is (N : Node_Id; Typ : Entity_Id) return Boolean; pragma Inline (Is_User_Defined_Literal); - -- Determine whether N is a user-defined literal for Typ + -- Determine whether N is a user-defined literal for Typ, including + -- the case where N denotes a named number of the appropriate kind + -- when Typ has an Integer_Literal or Real_Literal aspect. function Is_Validation_Variable_Reference (N : Node_Id) return Boolean; -- Determine whether N denotes a reference to a variable which captures the --rwEMma7ioTxnRzrJ--