From patchwork Thu Sep 7 10:09:23 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810950 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461675-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="xPllAa73"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xnx5D0fs1z9t2c for ; Thu, 7 Sep 2017 20:09:35 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=JyGi26xpGuGLLMqUGuA56Wa+yw0ssB8jSNombTEEUoC2CAgWKZ LFUHrxlBn6p9tNu/vyr7TwkjPI5nvKusvrDmUgKnkzcPKun0DkFZh0MR7xwnWO2a NPaaKhZxXCc6tU0x6D8oPtqjfuGNfIL6AweRBcJzYNi4T7zUZ1oO78NII= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=WnQNhKLfvboHSWkom2zfi6P2yOw=; b=xPllAa73pxyLiKBoxWrn u4vRo5YefHItQLH9xq6+QCbBtirQVLRCJDU/R8vQEOqdpp7PbOrtP3WSRKj3gr5l JXxV463xiUMP4g+x9aAb2t1ILjI9ltmj/6lo4LKreI7fui3NAuH2xcQxwaYeJOEn Dk6j8ZYQ4+C7prMv1PoGJkY= Received: (qmail 125003 invoked by alias); 7 Sep 2017 10:09:26 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 124275 invoked by uid 89); 7 Sep 2017 10:09:26 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 07 Sep 2017 10:09:25 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A267F561AA; Thu, 7 Sep 2017 06:09:23 -0400 (EDT) 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 UGkPNbSo0zxm; Thu, 7 Sep 2017 06:09: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 8EF0356179; Thu, 7 Sep 2017 06:09:23 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 8B2404FC; Thu, 7 Sep 2017 06:09:23 -0400 (EDT) Date: Thu, 7 Sep 2017 06:09:23 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [Ada] Adding switch to disable implicit Elaborate_All in task case Message-ID: <20170907100923.GA69520@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch adds switch -gnatd.y to disable the generation of implicit Elaborate_All on a package X when a task body calls a procedure in the same package, and that procedure calls a procedure in another package X. As documented in the GNAT User Guide, when sources cannot be modified, the recommended solution is the use of restriction No_Entry_Calls_In_Elaboration_Code. This switch provides a way to disable the generation of the implicit Elaborate_All when that restriction is not applicable to the sources. The following test now compiles without errors: with Utils; package body Decls is procedure Put_Val (Arg : Decls.My_Int) is begin Utils.Put_Val(Arg); end Put_Val; task body Lib_Task is begin accept Start; Put_Val (2); -- Utils.Put_Val(Arg); end Lib_Task; function Ident (M : My_Int) return My_Int is begin return M; end Ident; end Decls; package Decls is task Lib_Task is entry Start; end Lib_Task; type My_Int is new Integer; function Ident (M : My_Int) return My_Int; end Decls; with Decls; procedure Main is begin Decls.Lib_Task.Start; end; with Text_IO; package body Utils is procedure Put_Val (Arg : Decls.My_Int) is begin Text_IO.Put_Line (Decls.My_Int'Image (Decls.Ident (Arg))); end Put_Val; end Utils; with Decls; package Utils is procedure Put_Val (Arg : Decls.My_Int); end Utils; Command: gnatmake main.adb -gnatd.y Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-07 Javier Miranda * sem_elab.adb (Check_Task_Activation): Adding switch -gnatd.y to allow disabling the generation of implicit pragma Elaborate_All on task bodies. Index: debug.adb =================================================================== --- debug.adb (revision 251834) +++ debug.adb (working copy) @@ -115,7 +115,7 @@ -- d.v -- d.w Do not check for infinite loops -- d.x No exception handlers - -- d.y + -- d.y Disable implicit pragma Elaborate_All on task bodies -- d.z Restore previous support for frontend handling of Inline_Always -- d.A Read/write Aspect_Specifications hash table to tree @@ -603,6 +603,12 @@ -- fully compiled and analyzed, they just get eliminated from the -- code generation step. + -- d.y Disable implicit pragma Elaborate_All on task bodies. When a task + -- body calls a procedure in the same package, and that procedure + -- calls a procedure in another package, the static elaboration + -- machinery adds an implicit Elaborate_All on the other package. This + -- switch disables the addition of the implicit pragma in such cases. + -- -- d.z Restore previous front-end support for Inline_Always. In default -- mode, for targets that use the GCC back end, Inline_Always is -- handled by the back end. Use of this switch restores the previous Index: sem_elab.adb =================================================================== --- sem_elab.adb (revision 251834) +++ sem_elab.adb (working copy) @@ -2961,19 +2961,21 @@ Next_Elmt (Elmt); end loop; - -- For tasks declared in the current unit, trace other calls within - -- the task procedure bodies, which are available. + -- For tasks declared in the current unit, trace other calls within the + -- task procedure bodies, which are available. - In_Task_Activation := True; + if not Debug_Flag_Dot_Y then + In_Task_Activation := True; - Elmt := First_Elmt (Intra_Procs); - while Present (Elmt) loop - Ent := Node (Elmt); - Check_Internal_Call_Continue (N, Ent, Enclosing, Ent); - Next_Elmt (Elmt); - end loop; + Elmt := First_Elmt (Intra_Procs); + while Present (Elmt) loop + Ent := Node (Elmt); + Check_Internal_Call_Continue (N, Ent, Enclosing, Ent); + Next_Elmt (Elmt); + end loop; - In_Task_Activation := False; + In_Task_Activation := False; + end if; end Check_Task_Activation; ------------------------------- Index: sem_elab.ads =================================================================== --- sem_elab.ads (revision 251834) +++ sem_elab.ads (working copy) @@ -71,7 +71,7 @@ -- output a warning. -- For calls to a subprogram in a with'ed unit or a 'Access or variable - -- refernece (SPARK mode case), we require that a pragma Elaborate_All + -- reference (SPARK mode case), we require that a pragma Elaborate_All -- or pragma Elaborate be present, or that the referenced unit have a -- pragma Preelaborate, pragma Pure, or pragma Elaborate_Body. If none -- of these conditions is met, then a warning is generated that a pragma