From patchwork Fri May 7 09:38:23 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: 1475422 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@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 4Fc54L07lZz9sj5 for ; Fri, 7 May 2021 19:38:58 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 890683939C3D; Fri, 7 May 2021 09:38:30 +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 [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id BAE6138930FA for ; Fri, 7 May 2021 09:38:25 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org BAE6138930FA Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 3AB395635A; Fri, 7 May 2021 05:38:23 -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 6TVOW2ES-0lV; Fri, 7 May 2021 05:38:23 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 2815256358; Fri, 7 May 2021 05:38:23 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 27465FA; Fri, 7 May 2021 05:38:23 -0400 (EDT) Date: Fri, 7 May 2021 05:38:23 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Crash on imported object with deep initialization and No_Aborts Message-ID: <20210507093823.GA140643@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.5 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: Ed Schonberg Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Compiler aborts on an object declaration without an expression, when the type of the object includes controlled components and thus requires deep initialization, there are various restrictions in effect that prevent Abort statements, and there is a later Import pragma that applies to the object being declared. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_util.adb (Remove_Init_Call): If a simple initialization call is present, and the next statement is an initialization block (that contains a call to a Deep_ Initialize routine), remove the block as well, and insert the first initialization call in it, in case it is needed for later relocation. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -11382,6 +11382,26 @@ package body Exp_Util is end if; if Present (Init_Call) then + -- If restrictions have forbidden Aborts, the initialization call + -- for objects that require deep initialization has not been wrapped + -- into the following block (see Exp_Ch3, Default_Initialize_Object) + -- so if present remove it as well, and include the IP call in it, + -- in the rare case the caller may need to simply displace the + -- initialization, as is done for a later address specification. + + if Nkind (Next (Init_Call)) = N_Block_Statement + and then Is_Initialization_Block (Next (Init_Call)) + then + declare + IP_Call : constant Node_Id := Init_Call; + begin + Init_Call := Next (IP_Call); + Remove (IP_Call); + Prepend (IP_Call, + Statements (Handled_Statement_Sequence (Init_Call))); + end; + end if; + Remove (Init_Call); end if;