From patchwork Fri Sep 15 14:20:32 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: 140456 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:612c:172:b0:3f2:4152:657d with SMTP id h50csp1083740vqi; Fri, 15 Sep 2023 07:21:54 -0700 (PDT) X-Google-Smtp-Source: AGHT+IG7kEuuVcdwA/URWGvBraWYWgwMF4NmEwm2x3qBsWuUt9UkRnQjDJ/WJL1KAT2CighxGVXa X-Received: by 2002:adf:f34f:0:b0:317:e1fb:d57b with SMTP id e15-20020adff34f000000b00317e1fbd57bmr1492797wrp.56.1694787714489; Fri, 15 Sep 2023 07:21:54 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1694787714; cv=none; d=google.com; s=arc-20160816; b=ah3g7lyJFVV668VpDFLfNu0wvJalveOSGaO4fdk6NW9Cqk+2EAVN7bmPscrTrpiTWt WsvihSuAYD7DUnMC7KI0DMa6QzTHl5ifw6ubYMWR879K7aR7CQaD4zadZE3gkUB4wzLa PuSQnoBUBqsQBWpTi+6EdSWQT6+YULTxOaXdXivUOjlrGVg4uBc5UXIWhq16QNCB0MOA 7U3g/aj5B8DFTrKugkCiISyYBDAse1Bsm6jyQeQTFyY8bbNy8y/V6e5WwWThX0hwYcH6 i2AFmyo9KLT3UxzjMMWYnUuZIKqQhporZ6Z0nlFGyl6gt5iowo84ET+vsW0jdW4cEAGf MY/A== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence :content-transfer-encoding:mime-version:message-id:date:subject:cc :to:dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=KS625Rx5IwAFlezw/Di6Y2532bBHtIgpZ8fKdUKo1h0=; fh=xMTG+Z2BAn45iekV7HxLGBKXrsSIb8vOWtd2ivRmbts=; b=oiKrsnTqqcOlN/c37y6hebp9xO+MVb7w0q59OiwtIyhWDjlGXJmzJb7Hh837x3LN7p p6/tXoDnDA4YOm5TqvDOC06DN4nlCZY5uaFbEGAHdGU7pP3Ore5PcnKZqacHdDobPXMC fxICbG34xMApEtryxyEhB3uvy6Z7ulIJLMR+mY5Fs05BmQAJB3YfoDYyFjgPBkGzHCWK PW74zS4GA4w+a/8FeP8MyvvRhWpIKI5F55PqqGaJVXfKqsey1oktYXVEKoPULgxRXYKl XlxvU/PfsWrqQ1QpUheG+bsEt9PF0ehxrpZAHb5sQZXvYFdNfRzv35c2J+sXoG92ASis jvGw== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=cCfZRpIW; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id p10-20020aa7d30a000000b0052c90d81109si3289898edq.293.2023.09.15.07.21.54 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 15 Sep 2023 07:21:54 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=cCfZRpIW; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 809FF38555A9 for ; Fri, 15 Sep 2023 14:21:39 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 809FF38555A9 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1694787699; bh=KS625Rx5IwAFlezw/Di6Y2532bBHtIgpZ8fKdUKo1h0=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=cCfZRpIWek2LrE28yK4g6iAkzYtilkSLTESPQ2OpDiwR1vYoKaJjo4wfj4BubJhpk GH/vIACF0TDrUQ2mnRzOuHb4JW4cZeH1zUTD4mob9HMEtTxVODIPr3V9bqa9DwF7ts MsHkZPtVy3UE9CWy8ae80rCrYzLfmWFGI9I8xOTU= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42d.google.com (mail-wr1-x42d.google.com [IPv6:2a00:1450:4864:20::42d]) by sourceware.org (Postfix) with ESMTPS id 547573858D1E for ; Fri, 15 Sep 2023 14:20:51 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 547573858D1E Received: by mail-wr1-x42d.google.com with SMTP id ffacd0b85a97d-31dca134c83so2178332f8f.3 for ; Fri, 15 Sep 2023 07:20:51 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1694787650; x=1695392450; 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=KS625Rx5IwAFlezw/Di6Y2532bBHtIgpZ8fKdUKo1h0=; b=gLEhz3gL8SWA4XEHcN4QNdjutDESF+yXIQBrnJeIhlQbCIP8nwdBfxNkdq5p0UpilA pHs/tCE7EmSGbKPcVZm8LZpU/EI3ciCRtta97bjtXJu2zjVn94ihYzQY0cc6uV97X7Xa yZjQRrOvnLh5AnrX3E6sqxyVERAJxcXCPXewjx7F5kKfZTOKnVo1ddyt4cmlivZLu+pj cx7YlqDkzsy0aEu+M+uvn1XyTZz86ZClsI6wJf/yWaBuge+Nk3Cox29HZiu0Wfyyas4X gp1FrrsQb6bkh3tHYexNWKDWMFNHkXW9wtzLGs+LiRfUbUTaikPZzN/zQ6CjM3pp/73m iihg== X-Gm-Message-State: AOJu0Yxl7dspp4qx8KJlL3C7GfxAuC5X5JduFs9s/Bjbmfhq47UkjsLq JDzc6E+eaf9/sfrMcvTEbAtl0bsqkUoeuUVbPp+KGw== X-Received: by 2002:a5d:46cf:0:b0:31f:918a:ca9d with SMTP id g15-20020a5d46cf000000b0031f918aca9dmr1380472wrs.13.1694787649868; Fri, 15 Sep 2023 07:20:49 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:a63c:a2c3:ab34:f429]) by smtp.gmail.com with ESMTPSA id v15-20020adff68f000000b0031433443265sm4555980wrp.53.2023.09.15.07.20.49 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 15 Sep 2023 07:20:49 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [COMMITTED] ada: Crash on creation of extra formals on type extension Date: Fri, 15 Sep 2023 16:20:32 +0200 Message-Id: <20230915142032.2100558-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 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.30 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+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1777113722266737051 X-GMAIL-MSGID: 1777113722266737051 From: Javier Miranda Revert previous patch and fix the pending issue. gcc/ada/ * accessibility.ads (Needs_Result_Accessibility_Extra_Formal): Removed. * accessibility.adb (Needs_Result_Accessibility_Level_Param): Removed. (Needs_Result_Accessibility_Extra_Formal): Removed. (Needs_Result_Accessibility_Level): Revert previous patch. * sem_ch6.adb (Parent_Subprogram): Handle function overriding an enumeration literal. (Create_Extra_Formals): Ensure that the parent subprogram has all its extra formals. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 54 ++------------------------------------- gcc/ada/accessibility.ads | 9 ------- gcc/ada/sem_ch6.adb | 27 ++++++++++++++++---- 3 files changed, 24 insertions(+), 66 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 6b4ec5b9d24..bc897d1ef18 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -56,16 +56,6 @@ with Tbuild; use Tbuild; package body Accessibility is - function Needs_Result_Accessibility_Level_Param - (Func_Id : Entity_Id; - Func_Typ : Entity_Id) return Boolean; - -- Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and - -- Needs_Result_Accessibility_Level_Param. Return True if the function - -- needs an implicit parameter to identify the accessibility level of - -- the function result "determined by the point of call". Func_Typ is - -- the function return type; this function returns False if Func_Typ is - -- Empty. - --------------------------- -- Accessibility_Message -- --------------------------- @@ -1902,34 +1892,6 @@ package body Accessibility is and then Is_Explicitly_Aliased (Entity (Prefix (Exp))); end Is_Special_Aliased_Formal_Access; - --------------------------------------------- - -- Needs_Result_Accessibility_Extra_Formal -- - --------------------------------------------- - - function Needs_Result_Accessibility_Extra_Formal - (Func_Id : Entity_Id) return Boolean - is - Func_Typ : Entity_Id; - - begin - if Present (Underlying_Type (Etype (Func_Id))) then - Func_Typ := Underlying_Type (Etype (Func_Id)); - - -- Case of a function returning a private type which is not completed - -- yet. The support for this case is required because this function is - -- called to create the extra formals of dispatching primitives, and - -- they may be frozen before we see the full-view of their returned - -- private type. - - else - -- Temporarily restore previous behavior - -- Func_Typ := Etype (Func_Id); - Func_Typ := Empty; - end if; - - return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ); - end Needs_Result_Accessibility_Extra_Formal; - -------------------------------------- -- Needs_Result_Accessibility_Level -- -------------------------------------- @@ -1939,18 +1901,6 @@ package body Accessibility is is Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); - begin - return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ); - end Needs_Result_Accessibility_Level; - - -------------------------------------------- - -- Needs_Result_Accessibility_Level_Param -- - -------------------------------------------- - - function Needs_Result_Accessibility_Level_Param - (Func_Id : Entity_Id; - Func_Typ : Entity_Id) return Boolean - is function Has_Unconstrained_Access_Discriminant_Component (Comp_Typ : Entity_Id) return Boolean; -- Returns True if any component of the type has an unconstrained access @@ -2002,7 +1952,7 @@ package body Accessibility is -- Flag used to temporarily disable a "True" result for tagged types. -- See comments further below for details. - -- Start of processing for Needs_Result_Accessibility_Level_Param + -- Start of processing for Needs_Result_Accessibility_Level begin -- False if completion unavailable, which can happen when we are @@ -2078,7 +2028,7 @@ package body Accessibility is else return False; end if; - end Needs_Result_Accessibility_Level_Param; + end Needs_Result_Accessibility_Level; ------------------------------------------ -- Prefix_With_Safe_Accessibility_Level -- diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads index 731fea125f4..000e9b6e1e4 100644 --- a/gcc/ada/accessibility.ads +++ b/gcc/ada/accessibility.ads @@ -197,15 +197,6 @@ package Accessibility is -- prefix is an aliased formal of Scop and that Scop returns an anonymous -- access type. See RM 3.10.2 for more details. - function Needs_Result_Accessibility_Extra_Formal - (Func_Id : Entity_Id) return Boolean; - -- Ada 2012 (AI05-0234): Return True if the function needs an implicit - -- parameter to identify the accessibility level of the function result. - -- If the type of the function result is a private type and its completion - -- is unavailable, which can happen when we are analyzing an abstract - -- subprogram, determines its result using the returned private type. This - -- function is used by Create_Extra_Formals. - function Needs_Result_Accessibility_Level (Func_Id : Entity_Id) return Boolean; -- Ada 2012 (AI05-0234): Return True if the function needs an implicit diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 612a9e97221..a0dad86149f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8766,7 +8766,12 @@ package body Sem_Ch6 is Ovr_Alias : Entity_Id; begin - if Present (Ovr_E) then + if Present (Ovr_E) + and then Ekind (Ovr_E) = E_Enumeration_Literal + then + Ovr_E := Empty; + + elsif Present (Ovr_E) then Ovr_Alias := Ultimate_Alias (Ovr_E); -- There is no real overridden subprogram if there is a mutual @@ -8992,6 +8997,18 @@ package body Sem_Ch6 is -- for extra formals. if Present (Parent_Subp) then + + -- Ensure that the parent subprogram has all its extra formals. + -- Required because its return type may have been a private or + -- an incomplete type, and the extra formals were not added. We + -- protect this call against the weird cases where the parent subp + -- renames this primitive (documented in the body of the local + -- function Parent_Subprogram). + + if Ultimate_Alias (Parent_Subp) /= Ref_E then + Create_Extra_Formals (Parent_Subp); + end if; + Parent_Formal := First_Formal (Parent_Subp); -- For concurrent types, the controlling argument of a dispatching @@ -9140,13 +9157,13 @@ package body Sem_Ch6 is begin Ada_Version := Ada_2022; - if Needs_Result_Accessibility_Extra_Formal (Ref_E) + if Needs_Result_Accessibility_Level (Ref_E) or else (Present (Parent_Subp) - and then Needs_Result_Accessibility_Extra_Formal (Parent_Subp)) + and then Needs_Result_Accessibility_Level (Parent_Subp)) or else (Present (Alias_Subp) - and then Needs_Result_Accessibility_Extra_Formal (Alias_Subp)) + and then Needs_Result_Accessibility_Level (Alias_Subp)) then Set_Extra_Accessibility_Of_Result (E, Add_Extra_Formal (E, Standard_Natural, E, "L")); @@ -9695,7 +9712,7 @@ package body Sem_Ch6 is -- Check attribute Extra_Accessibility_Of_Result if Ekind (E) in E_Function | E_Subprogram_Type - and then Needs_Result_Accessibility_Extra_Formal (E) + and then Needs_Result_Accessibility_Level (E) and then No (Extra_Accessibility_Of_Result (E)) then return False;