From patchwork Tue Sep 5 11:08:18 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: 137508 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:ab0a:0:b0:3f2:4152:657d with SMTP id m10csp1608483vqo; Tue, 5 Sep 2023 04:15:52 -0700 (PDT) X-Google-Smtp-Source: AGHT+IGyCbj++4cnK12LrvmuGLeRRO1/f6xEOUdgicIrZg1kAhvCsWubYS/OU9YVycRUziWVTO5/ X-Received: by 2002:a2e:a17a:0:b0:2bb:a28b:58e1 with SMTP id u26-20020a2ea17a000000b002bba28b58e1mr9688299ljl.41.1693912552669; Tue, 05 Sep 2023 04:15:52 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1693912552; cv=none; d=google.com; s=arc-20160816; b=wH6nMT+x+ijHeHgLALCtDZm7pj2jlLfhL8cpUUZmZYTQJzGbk4eqipTp+LIHGG/Qiy f43wwSlO+y6I6cIen2ey9tttg4EtHwTuUNDLEVqIYRd3cPAeSoNY9LNxEiep0AWm6KkG PZCVoZcB6uLQajhvAbPAiF4TjUKmKWBNLrbxI7Q68QoeYbBrzRJxZ5Zf4AvxVBX2cEfZ tCXq6wSVDtYuIhJnp728UEGBk9pUSImOXSP4Q3eQ8kCGX0OJlleRMHuBnJIJyX4SFYMM Dt/lZGx8j9bg1MnWzUM1pYipaP55bYbCbKb+5U/tRv4D0toPzEm2UiYqLIRe6mikPrad E8tw== 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=57pEKQPVO+EHsNwyQA8/cQkjXzkbch7R0Ycr0v9NunQ=; fh=xMTG+Z2BAn45iekV7HxLGBKXrsSIb8vOWtd2ivRmbts=; b=Dv3W+wY6q1F+l1jJfucGQ9zt/c77HxbKaeyvoWdp2cZBbA/t7LK2AiadhxRKr7j2yO 7m1aTape9LlG83wIicqIoMa01EWeYWzPBUCsu2Sm92tMScv4e6B8SRJ4g7hwzvSueGtJ A7uevyAVxWYFILW5pMyPShWDarsL8Cw5To+rfI07QIQiqgI3rA4oC0EUIw4zYS7tzZYg 7mTX6+ToMmgjWFCKpJ/dmYgzxz5XWosKlJrm0xu1fLY69FI46xw27EU7wDKFSrKkldp2 TI59tezFAdUMU1MGGX/zFqew/bOtjhP/pmWUrM7Ui7NkuoNU6C4o89uDxI+reTk+rBJy OOJw== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=Mn7M16Ue; 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 p12-20020a170906838c00b009a633e2f3f8si4137456ejx.43.2023.09.05.04.15.52 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 05 Sep 2023 04:15:52 -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=Mn7M16Ue; 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 488D8393BA60 for ; Tue, 5 Sep 2023 11:11:00 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 488D8393BA60 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1693912260; bh=57pEKQPVO+EHsNwyQA8/cQkjXzkbch7R0Ycr0v9NunQ=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=Mn7M16UeFVpZVXKHIiOq0e1rXe8Zf/pDeJgq+7+LHuTkh8dA20ydf+4fzAICp0Lzu 7kytrCpZR2DDrFxSbZvu6wmCDqQw9IqDm7b33oI07V/xsFQIcRC/m3r7TkrNeT7VYg iagvzTpUbXM3sVcZTrBkH4wwcZ0d2i38pktEjXJg= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 381A03854822 for ; Tue, 5 Sep 2023 11:08:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 381A03854822 Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-31dcd553fecso1973244f8f.2 for ; Tue, 05 Sep 2023 04:08:21 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1693912100; x=1694516900; 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=57pEKQPVO+EHsNwyQA8/cQkjXzkbch7R0Ycr0v9NunQ=; b=ddWwtjE3iLH9cZuA6ILJp/Sn3h2ZLiNrKg2YLNavFF1/vPw9xC6MyVok8NsrzaHtp3 6/jnJFUrJfGm/+NKr/9fvg0OXgJaHDelwt0mMdJuFrS+scFjAlMQ9ki3cKdRFwn3ufxv Tucf0XFArjTkBSFNzOvt0mQmJnj5Xti05vTRMc8w0l3mUkbdKfjqispOWQ3nKlcprd4w jP3nsnemBTj84nN8J3/eOe8JsoEOQB7bGtwEdUXzulMKItllUdzTsLqG2ONW2SYc7PCj H9jbbhOwr4x6pBwVaBrjTA7lrk/ClC9iDiEtjnh3ElF4TpiqYMznA3/+0IekjPW0O+TL 4iVg== X-Gm-Message-State: AOJu0YxG7vtoJedNf0ABzJTBc4NDbvseu+Yn2HupepzT4mMrHEDHltz+ bmxqz3MAtF/H2aD01xdCjztP87o7yYsbRZpW5SdDwg== X-Received: by 2002:a5d:6041:0:b0:31c:762b:ceb3 with SMTP id j1-20020a5d6041000000b0031c762bceb3mr8987570wrt.48.1693912099971; Tue, 05 Sep 2023 04:08:19 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:20fc:79e4:455c:1075]) by smtp.gmail.com with ESMTPSA id c18-20020adfed92000000b003143c6e09ccsm17361909wro.16.2023.09.05.04.08.19 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 05 Sep 2023 04:08:19 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [COMMITTED] ada: Crash on creation of extra formals on type extension Date: Tue, 5 Sep 2023 13:08:18 +0200 Message-Id: <20230905110818.562990-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: 1776196048910998672 X-GMAIL-MSGID: 1776196048910998672 From: Javier Miranda The compiler blows up processing an overriding dispatching function of a derived tagged type that returns a private tagged type that has an access type discriminant. gcc/ada/ * accessibility.ads (Needs_Result_Accessibility_Extra_Formal): New subprogram. * accessibility.adb (Needs_Result_Accessibility_Level_Param): New subprogram. (Needs_Result_Accessibility_Extra_Formal): New subprogram, temporarily keep the previous behavior of the frontend. * sem_ch6.adb (Create_Extra_Formals): Replace occurrences of function Needs_Result_Accessibility_Level_Param by calls to function Needs_Result_Accessibility_Extra_Formal. (Extra_Formals_OK): Ditto. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 54 +++++++++++++++++++++++++++++++++++++-- gcc/ada/accessibility.ads | 12 ++++++++- gcc/ada/sem_ch6.adb | 8 +++--- 3 files changed, 67 insertions(+), 7 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index bc897d1ef18..6b4ec5b9d24 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -56,6 +56,16 @@ 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 -- --------------------------- @@ -1892,6 +1902,34 @@ 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 -- -------------------------------------- @@ -1901,6 +1939,18 @@ 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 @@ -1952,7 +2002,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 + -- Start of processing for Needs_Result_Accessibility_Level_Param begin -- False if completion unavailable, which can happen when we are @@ -2028,7 +2078,7 @@ package body Accessibility is else return False; end if; - end Needs_Result_Accessibility_Level; + end Needs_Result_Accessibility_Level_Param; ------------------------------------------ -- Prefix_With_Safe_Accessibility_Level -- diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads index e30c90ab6a7..731fea125f4 100644 --- a/gcc/ada/accessibility.ads +++ b/gcc/ada/accessibility.ads @@ -197,11 +197,21 @@ 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 -- parameter to identify the accessibility level of the function result - -- "determined by the point of call". + -- "determined by the point of call". Return False if the type of the + -- function result is a private type and its completion is unavailable. function Subprogram_Access_Level (Subp : Entity_Id) return Uint; -- Return the accessibility level of the view denoted by Subp diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 53011f465a8..297371a2c16 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9139,13 +9139,13 @@ package body Sem_Ch6 is begin Ada_Version := Ada_2022; - if Needs_Result_Accessibility_Level (Ref_E) + if Needs_Result_Accessibility_Extra_Formal (Ref_E) or else (Present (Parent_Subp) - and then Needs_Result_Accessibility_Level (Parent_Subp)) + and then Needs_Result_Accessibility_Extra_Formal (Parent_Subp)) or else (Present (Alias_Subp) - and then Needs_Result_Accessibility_Level (Alias_Subp)) + and then Needs_Result_Accessibility_Extra_Formal (Alias_Subp)) then Set_Extra_Accessibility_Of_Result (E, Add_Extra_Formal (E, Standard_Natural, E, "L")); @@ -9694,7 +9694,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_Level (E) + and then Needs_Result_Accessibility_Extra_Formal (E) and then No (Extra_Accessibility_Of_Result (E)) then return False;