From patchwork Tue Jun 15 10:20:52 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1492110 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4G44LY5Vg0z9sTD for ; Tue, 15 Jun 2021 20:29:25 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 2AFB8399C021 for ; Tue, 15 Jun 2021 10:29:23 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTPS id AD52A384000C for ; Tue, 15 Jun 2021 10:20:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org AD52A384000C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 9D002117B5F; Tue, 15 Jun 2021 06:20:52 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 1yIfJ6zePSi9; Tue, 15 Jun 2021 06:20:52 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 6D5DE117B4C; Tue, 15 Jun 2021 06:20:52 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 6942C1CA; Tue, 15 Jun 2021 06:20:52 -0400 (EDT) Date: Tue, 15 Jun 2021 06:20:52 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Error when passing subprogram'Access to null-defaulted formal subprogram Message-ID: <20210615102052.GA3709@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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: , Cc: Gary Dismukes Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" The compiler issues an error on passing 'Access of a subprogram declared within a generic unit body to an anonymous access-to-subprogram formal of a formal subprogram of the generic that has an "is null" default, when the generic is instantiated and the actual for that formal subprogram is defaulted. This is because such a null formal subprogram default is defined to have convention Intrinsic (a consequence of RM 6.3.1(4 and 8)), and the anonymous access-to-subprogram type formal inherits that convention via Set_Profile_Convention. However, the rule in RM 6.3.1(13.1/5), which was revised by AI12-0207, now specifies that such formal types do not inherit the convention of their associated subprogram, but instead have a convention of Ada, so passing 'Access on calls to the formal subprogram is legal in an instantiation where the formal subprogram's actual defaults to null. This is fixed by suppressing the convention inheritance when a subprogram has convention Intrinsic (as well as when the subprogram has entry convention, as also specified in RM 6.3.1(13.1/5)). Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * freeze.adb (Freeze_Subprogram): Don't propagate conventions Intrinsic or Entry to anonymous access-to-subprogram types associated with subprograms having those conventions. Update related comment. * sem_attr.adb (Resolve_Attribute, Attribute_*Access): Remove special-case warning code for cases where a called subprogram has convention Intrinsic as well as its formal's type (the expected type for the Access attribute), since this case can no longer occur. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -9428,15 +9428,18 @@ package body Freeze is end if; -- Ensure that all anonymous access-to-subprogram types inherit the - -- convention of their related subprogram (RM 6.3.1 13.1/3). This is + -- convention of their related subprogram (RM 6.3.1(13.1/5)). This is -- not done for a defaulted convention Ada because those types also -- default to Ada. Convention Protected must not be propagated when -- the subprogram is an entry because this would be illegal. The only -- way to force convention Protected on these kinds of types is to - -- include keyword "protected" in the access definition. + -- include keyword "protected" in the access definition. Conventions + -- Entry and Intrinsic are also not propagated (specified by AI12-0207). if Convention (E) /= Convention_Ada and then Convention (E) /= Convention_Protected + and then Convention (E) /= Convention_Entry + and then Convention (E) /= Convention_Intrinsic then Set_Profile_Convention (E); end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10887,34 +10887,10 @@ package body Sem_Attr is if Convention (Designated_Type (Btyp)) /= Convention (Entity (P)) then - -- The rule in 6.3.1 (8) deserves a special error - -- message. - - if Convention (Btyp) = Convention_Intrinsic - and then Nkind (Parent (N)) = N_Procedure_Call_Statement - and then Is_Entity_Name (Name (Parent (N))) - and then Inside_A_Generic - then - declare - Subp : constant Entity_Id := - Entity (Name (Parent (N))); - begin - if Convention (Subp) = Convention_Intrinsic then - Error_Msg_FE - ("?subprogram and its formal access " - & "parameters have convention Intrinsic", - Parent (N), Subp); - Error_Msg_N - ("actual cannot be access attribute", N); - end if; - end; - - else - Error_Msg_FE - ("subprogram & has wrong convention", P, Entity (P)); - Error_Msg_Sloc := Sloc (Btyp); - Error_Msg_FE ("\does not match & declared#", P, Btyp); - end if; + Error_Msg_FE + ("subprogram & has wrong convention", P, Entity (P)); + Error_Msg_Sloc := Sloc (Btyp); + Error_Msg_FE ("\does not match & declared#", P, Btyp); if not Is_Itype (Btyp) and then not Has_Convention_Pragma (Btyp)