From patchwork Tue Jan 9 10:07:46 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 186307 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7300:2411:b0:101:2151:f287 with SMTP id m17csp11633dyi; Tue, 9 Jan 2024 02:08:44 -0800 (PST) X-Google-Smtp-Source: AGHT+IEG461/XrxugUOtHwjHhr/EKvYNqA/1vBpbXOB28TBVfLX9KI1WA3Sh3FehwOmeO21CoV+X X-Received: by 2002:a05:620a:c91:b0:783:4c4:5e27 with SMTP id q17-20020a05620a0c9100b0078304c45e27mr486037qki.15.1704794923811; Tue, 09 Jan 2024 02:08:43 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1704794923; cv=pass; d=google.com; s=arc-20160816; b=QrsJwTcIeryB1AN54GxQR1MpWsy5YwJpO25GKY7S40EGjyI26aWbrTGiMyL5Q5S3+L XWuVm8Ar7PBiMrTk4vxgftE06Om5hbA9Gqwj0L4lDWYS96KVLZhn6ttyL2hv2Y89wJXM Rq09+fJ4ATIvQj7RKussRMOSole79uaL8KfsB3/WKMwsA4+Qte7k19IgDJ51muQTamLB 0qTAQz6pQhEDyuNEKhga1Q0GOmmfLcrLSx+84J+o6P5UJq5iEPfyL6utA+Jxd181jB9n LD7mT56t/BuWgoYebcy7yiVDWjLr5c+76AiqOJTopdlV6GyyEnrX10VDEcklhU0+Peeo El3A== ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:content-transfer-encoding :mime-version:message-id:date:subject:to:from:dkim-signature :arc-filter:dmarc-filter:delivered-to; bh=T2G7gQpAlcE98LJcHWtHEOvRIMIb4P8jkMevJXUTYU8=; fh=hPrbWPhweUx4V0GV9uXJqbyAzg2ABmTz7kczrAQqMmM=; b=WBa895mNrYGj4HuF2+4uykSMGpZL7kJcaYoJQUwwEybAwiT9MuzSe6K5D3K5QvilqL C1ghhOLlUPDP1tEvZR4gsbmUSgaw+Xt4KeXtu7BYBxHJi5d7YhT7dFMr+yOhKK3qb1On X8gvPtrq7DYe1UkLIF1sghnzkiq3JG6WjGhJ40n14oRHyO+f9SrmNXLMwjtJQzDA87Vm 9wes2BKT1JSzwfR+GgMSuAPTQmREJZj3UrwxuZIBl6O1pM7TWAw/yn9lcvWIli6AzS2s nQgI3Dfh8+EzqINMbBnrZX3+ru1StYV1ju6dCSJP8Zev6vyQ/Wa40fVqY1hfmattreXb 04yA== ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@adacore.com header.s=google header.b=f0IIt35q; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=QUARANTINE sp=QUARANTINE dis=NONE) header.from=adacore.com Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id vv11-20020a05620a562b00b007831f561328si1669726qkn.218.2024.01.09.02.08.43 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 09 Jan 2024 02:08:43 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@adacore.com header.s=google header.b=f0IIt35q; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=QUARANTINE sp=QUARANTINE dis=NONE) header.from=adacore.com Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7C682385800E for ; Tue, 9 Jan 2024 10:08:43 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32b.google.com (mail-wm1-x32b.google.com [IPv6:2a00:1450:4864:20::32b]) by sourceware.org (Postfix) with ESMTPS id 5406B385802A for ; Tue, 9 Jan 2024 10:07:49 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 5406B385802A Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 5406B385802A Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::32b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704794872; cv=none; b=oRHsPS9UBgJc7R0OzLaOc4OyiaAQPD+S4jGb7a3a4G1ZlscmmrrF6oRyE/k2xMvlVqP+EEpbfDLIQ/CSHfrB7SI79dK4AigQ5wCEd998AXRwhPWUhjblM4wayJWciXQQwpbNJyAWOKBZoc9/tsAIYyRClnQ0F008bFtNFwX8eOc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1704794872; c=relaxed/simple; bh=+D1IrzrwG9B7mt8NRmQYGsAlCBAHwSt2x0EYEQcXuMg=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=d0nKMk4C+fUEAWAKypzAPm0wKFRTvxHoQtv8DThdD954+AHBEG8SN8OFB6d8lA1xtt5bnp6xxu0CGdEMRRBkxc2OgwvQ0TpuUhzBWKIQ1b9vXqGUITdfDQXKgMrmg9/UekPXFDPAZGSzuUrG+J+lnTvh/+76+xxFNZB1EqkJK2E= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x32b.google.com with SMTP id 5b1f17b1804b1-40e43e489e4so27784575e9.1 for ; Tue, 09 Jan 2024 02:07:49 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1704794868; x=1705399668; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:subject:to :from:from:to:cc:subject:date:message-id:reply-to; bh=T2G7gQpAlcE98LJcHWtHEOvRIMIb4P8jkMevJXUTYU8=; b=f0IIt35qFQwEmECC4drvdqhx1xSoShAKNssM6uX6etDFs4eNxeBaYEdWyrTs06XGD5 vJHZz+k0Qb+ltdQG51V0+2I66t+XHP10cYWvRUQLgnux0DwG8nJ2r7tASkdoX5RNt+as HaWeAfLBazmabneGNS8oECjtDLmWDCtqLiqbKTOz5E6hIHBAWfMEq2iUgm9fEC++qTkS 3nJ5D2pCwaMV3/J2dzFz8glHpFMA6uNnwmo86lmh8F9PPJ8KiycNaUbFQVX/5V1gnIBe K2XYozhTTTHvsMk5+QOJGrvN2tWwirdmCAaEEeuEUGVOb3NtS6nsr8PopUC+okVJuDii 7mfg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1704794868; x=1705399668; h=content-transfer-encoding:mime-version:message-id:date:subject:to :from:x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=T2G7gQpAlcE98LJcHWtHEOvRIMIb4P8jkMevJXUTYU8=; b=kEzzO+sSSc88YozsZiPTR9iu1YX2ANRFpjBn68k5J7Y9qU8aAl0LpTAekwWNO8MhDh T3RBQV6sakpc2F6HXWcXIZ/km9/6j4gERxvD5uURbnsNAZuW2PH7+TbEys4/BAFm0AFD PqiwhUOKnvQdA5CVXaZiinLe0uA8V1ZQKPtH0PYBX1CwYkT9kSEZf3e1Xp5ud1reYyPV jiVhc7JuizpOndMo4Q8NyphrpRRtBMdjuz5/u3Z/CGewzy54vaj/JvQ0lkpIvz8CCUPK T/Jp8RAN9kWOEx7uUT/pXJp3LaJ1rMs/2i/MfF04TZIC50gHhEd6AU1Oyklf57VJrBNo psUg== X-Gm-Message-State: AOJu0YxMryaoNN2/RyWqwBQH2sYsljqM04cik0ozWaOtMuEP5ykklBAh 86op0/6N2U0K/SBZIOJdAefmbj8LPeTqc8bZ+pnWT8whNw== X-Received: by 2002:a1c:6a07:0:b0:40e:519a:5adb with SMTP id f7-20020a1c6a07000000b0040e519a5adbmr235673wmc.164.1704794867832; Tue, 09 Jan 2024 02:07:47 -0800 (PST) Received: from fomalhaut.localnet ([2a01:e0a:8d5:d990:e654:e8ff:fe8f:2ce6]) by smtp.gmail.com with ESMTPSA id jg28-20020a05600ca01c00b0040e45518c1csm2890950wmb.18.2024.01.09.02.07.47 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 09 Jan 2024 02:07:47 -0800 (PST) From: Eric Botcazou X-Google-Original-From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix PR ada/112781 (2/2) Date: Tue, 09 Jan 2024 11:07:46 +0100 Message-ID: <2180612.Icojqenx9y@fomalhaut> MIME-Version: 1.0 X-Spam-Status: No, score=-10.4 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1787607042128887084 X-GMAIL-MSGID: 1787607042128887084 The problem occurs when this function call is the expression of a return in a function returning the limited interface; in this peculiar case, there is a mismatch between the callee, which has BIP formals but is not a BIP call, and the caller, which is a BIP function, that is spotted by an assertion. This is fixed by restoring the semantics of Is_Build_In_Place_Function_Call, which returns again true only for calls to BIP functions, introducing the Is_Function_Call_With_BIP_Formals predicate, which also returns true for calls to functions with BIP formals that are not BIP functions, and moving down the assertion in Expand_Simple_Function_Return. Tested on SPARC64/Linux, applied on the mainline and 13 branch. 2024-01-09 Eric Botcazou PR ada/112781 * exp_ch6.ads (Is_Build_In_Place_Function): Adjust description. * exp_ch6.adb (Is_True_Build_In_Place_Function_Call): Delete. (Is_Function_Call_With_BIP_Formals): New predicate. (Is_Build_In_Place_Function_Call): Restore original semantics. (Expand_Call_Helper): Adjust conditions guarding the calls to Add_Dummy_Build_In_Place_Actuals to above renaming. (Expand_N_Extended_Return_Statement): Adjust to above renaming. (Expand_Simple_Function_Return): Likewise. Move the assertion to after the transformation into an extended return statement. (Make_Build_In_Place_Call_In_Allocator): Remove unreachable code. (Make_Build_In_Place_Call_In_Assignment): Likewise. 2024-01-09 Eric Botcazou * gnat.dg/bip_prim_func2.adb: New test. * gnat.dg/bip_prim_func2_pkg.ads, gnat.dg/bip_prim_func2_pkg.adb: New helper package. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8e4c9035b22..939d3be57c3 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -316,11 +316,10 @@ package body Exp_Ch6 is -- Insert the Post_Call list previously produced by routine Expand_Actuals -- or Expand_Call_Helper into the tree. - function Is_True_Build_In_Place_Function_Call (N : Node_Id) return Boolean; + function Is_Function_Call_With_BIP_Formals (N : Node_Id) return Boolean; -- Ada 2005 (AI-318-02): Returns True if N denotes a call to a function - -- that requires handling as a build-in-place call; returns False for - -- non-BIP function calls and also for calls to functions with inherited - -- BIP formals that do not require BIP formals. For example: + -- that requires handling as a build-in-place call, that is, BIP function + -- calls and calls to functions with inherited BIP formals. For example: -- -- type Iface is limited interface; -- function Get_Object return Iface; @@ -330,15 +329,14 @@ package body Exp_Ch6 is -- type T1 is new Root1 and Iface with ... -- function Get_Object return T1; -- -- This primitive requires the BIP formals, and the evaluation of - -- -- Is_True_Build_In_Place_Function_Call returns True. + -- -- Is_Build_In_Place_Function_Call returns True. -- -- type Root2 is tagged record ... -- type T2 is new Root2 and Iface with ... -- function Get_Object return T2; -- -- This primitive inherits the BIP formals of the interface primitive -- -- but, given that T2 is not a limited type, it does not require such - -- -- formals; therefore Is_True_Build_In_Place_Function_Call returns - -- -- False. + -- -- formals; therefore Is_Build_In_Place_Function_Call returns False. procedure Replace_Renaming_Declaration_Id (New_Decl : Node_Id; @@ -4906,8 +4904,8 @@ package body Exp_Ch6 is -- inherited the BIP extra actuals but does not require them. if Nkind (Call_Node) = N_Function_Call - and then Is_Build_In_Place_Function_Call (Call_Node) - and then not Is_True_Build_In_Place_Function_Call (Call_Node) + and then Is_Function_Call_With_BIP_Formals (Call_Node) + and then not Is_Build_In_Place_Function_Call (Call_Node) then Add_Dummy_Build_In_Place_Actuals (Subp, Num_Added_Extra_Actuals => Num_Extra_Actuals); @@ -4918,8 +4916,8 @@ package body Exp_Ch6 is -- inherited the BIP extra actuals but does not require them. elsif Nkind (Call_Node) = N_Function_Call - and then Is_Build_In_Place_Function_Call (Call_Node) - and then not Is_True_Build_In_Place_Function_Call (Call_Node) + and then Is_Function_Call_With_BIP_Formals (Call_Node) + and then not Is_Build_In_Place_Function_Call (Call_Node) then Add_Dummy_Build_In_Place_Actuals (Subp); end if; @@ -5614,7 +5612,7 @@ package body Exp_Ch6 is pragma Assert (Ekind (Current_Subprogram) = E_Function); pragma Assert (Is_Build_In_Place_Function (Current_Subprogram) = - Is_True_Build_In_Place_Function_Call (Exp)); + Is_Build_In_Place_Function_Call (Exp)); null; end if; @@ -6803,17 +6801,6 @@ package body Exp_Ch6 is end if; end if; - -- Assert that if F says "return G(...);" - -- then F and G are both b-i-p, or neither b-i-p. - - if Nkind (Exp) = N_Function_Call then - pragma Assert (Ekind (Scope_Id) = E_Function); - pragma Assert - (Is_Build_In_Place_Function (Scope_Id) = - Is_True_Build_In_Place_Function_Call (Exp)); - null; - end if; - -- For the case of a simple return that does not come from an -- extended return, in the case of build-in-place, we rewrite -- "return ;" to be: @@ -6833,7 +6820,7 @@ package body Exp_Ch6 is pragma Assert (Comes_From_Extended_Return_Statement (N) - or else not Is_True_Build_In_Place_Function_Call (Exp) + or else not Is_Build_In_Place_Function_Call (Exp) or else Has_BIP_Formals (Scope_Id)); if not Comes_From_Extended_Return_Statement (N) @@ -6868,6 +6855,17 @@ package body Exp_Ch6 is end; end if; + -- Assert that if F says "return G(...);" + -- then F and G are both b-i-p, or neither b-i-p. + + if Nkind (Exp) = N_Function_Call then + pragma Assert (Ekind (Scope_Id) = E_Function); + pragma Assert + (Is_Build_In_Place_Function (Scope_Id) = + Is_Build_In_Place_Function_Call (Exp)); + null; + end if; + -- Here we have a simple return statement that is part of the expansion -- of an extended return statement (either written by the user, or -- generated by the above code). @@ -8155,64 +8153,90 @@ package body Exp_Ch6 is raise Program_Error; end if; - if Is_Build_In_Place_Function (Function_Id) then - return True; - - -- True also if the function has BIP Formals - - else - declare - Kind : constant Entity_Kind := Ekind (Function_Id); - - begin - if (Kind in E_Function | E_Generic_Function - or else (Kind = E_Subprogram_Type - and then - Etype (Function_Id) /= Standard_Void_Type)) - and then Has_BIP_Formals (Function_Id) - then - -- So we can stop here in the debugger - return True; - else - return False; - end if; - end; - end if; + declare + Result : constant Boolean := Is_Build_In_Place_Function (Function_Id); + -- So we can stop here in the debugger + begin + return Result; + end; end Is_Build_In_Place_Function_Call; - ------------------------------------------ - -- Is_True_Build_In_Place_Function_Call -- - ------------------------------------------ + --------------------------------------- + -- Is_Function_Call_With_BIP_Formals -- + --------------------------------------- - function Is_True_Build_In_Place_Function_Call (N : Node_Id) return Boolean - is - Exp_Node : Node_Id; + function Is_Function_Call_With_BIP_Formals (N : Node_Id) return Boolean is + Exp_Node : constant Node_Id := Unqual_Conv (N); Function_Id : Entity_Id; begin - -- No action needed if we know that this is not a BIP function call + -- Return False if the expander is currently inactive, since awareness + -- of build-in-place treatment is only relevant during expansion. Note + -- that Is_Build_In_Place_Function, which is called as part of this + -- function, is also conditioned this way, but we need to check here as + -- well to avoid blowing up on processing protected calls when expansion + -- is disabled (such as with -gnatc) since those would trip over the + -- raise of Program_Error below. + + -- In SPARK mode, build-in-place calls are not expanded, so that we + -- may end up with a call that is neither resolved to an entity, nor + -- an indirect call. - if not Is_Build_In_Place_Function_Call (N) then + if not Expander_Active or else Nkind (Exp_Node) /= N_Function_Call then return False; end if; - Exp_Node := Unqual_Conv (N); - if Is_Entity_Name (Name (Exp_Node)) then Function_Id := Entity (Name (Exp_Node)); + -- In the case of an explicitly dereferenced call, use the subprogram + -- type generated for the dereference. + elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then Function_Id := Etype (Name (Exp_Node)); + -- This may be a call to a protected function. + elsif Nkind (Name (Exp_Node)) = N_Selected_Component then + -- The selector in question might not have been analyzed due to a + -- previous error, so analyze it here to output the appropriate + -- error message instead of crashing when attempting to fetch its + -- entity. + + if not Analyzed (Selector_Name (Name (Exp_Node))) then + Analyze (Selector_Name (Name (Exp_Node))); + end if; + Function_Id := Etype (Entity (Selector_Name (Name (Exp_Node)))); else raise Program_Error; end if; - return Is_Build_In_Place_Function (Function_Id); - end Is_True_Build_In_Place_Function_Call; + if Is_Build_In_Place_Function (Function_Id) then + return True; + + -- True also if the function has BIP Formals + + else + declare + Kind : constant Entity_Kind := Ekind (Function_Id); + + begin + if (Kind in E_Function | E_Generic_Function + or else (Kind = E_Subprogram_Type + and then + Etype (Function_Id) /= Standard_Void_Type)) + and then Has_BIP_Formals (Function_Id) + then + -- So we can stop here in the debugger + return True; + else + return False; + end if; + end; + end if; + end Is_Function_Call_With_BIP_Formals; ----------------------------------- -- Is_Build_In_Place_Result_Type -- @@ -8368,14 +8392,6 @@ package body Exp_Ch6 is Func_Call := Expression (Func_Call); end if; - -- No action needed if the called function inherited the BIP extra - -- formals but it is not a true BIP function. - - if not Is_True_Build_In_Place_Function_Call (Func_Call) then - pragma Assert (Is_Expanded_Build_In_Place_Call (Func_Call)); - return; - end if; - -- Mark the call as processed as a build-in-place call pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call)); @@ -8781,14 +8797,6 @@ package body Exp_Ch6 is Result_Subt : Entity_Id; begin - -- No action needed if the called function inherited the BIP extra - -- formals but it is not a true BIP function. - - if not Is_True_Build_In_Place_Function_Call (Func_Call) then - pragma Assert (Is_Expanded_Build_In_Place_Call (Func_Call)); - return; - end if; - -- Mark the call as processed as a build-in-place call pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call)); diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 7b762073377..f3502b542df 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -159,8 +159,7 @@ package Exp_Ch6 is function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean; -- Ada 2005 (AI-318-02): Returns True if N denotes a call to a function -- that requires handling as a build-in-place call (possibly qualified or - -- converted); that is, BIP function calls, and calls to functions with - -- inherited BIP formals. + -- converted). function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean; -- Ada 2005 (AI-318-02): Returns True if functions returning the type use