From patchwork Wed May 23 10:31:12 2018 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: 918944 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-478250-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ZE+DJGrx"; 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 40rTN02xBVz9s15 for ; Wed, 23 May 2018 20:32:00 +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=fJMf/0JoI62jshpTOyg2btLCM8adZAMXRBYvuMPgbySzE6J5Q4 u/301Ml8zV743G5UzkWi3T+wcLuP5NUpXw+HkEBV6OOCjt4XW1xzfJC/IBqiS00X VwIK/vtVWtDTJVBXC4C4lOw5xXa6ETdKcQCbOOupZP/gnLcp9C03Mpzxs= 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=ey92so1YIMiHX/xMdU1qRMXsEl4=; b=ZE+DJGrxqPVgxeKn5+eH 7PZ8K1z6L3rFJomjCLpTWeDa9Xxajr07nqCqoPPenl2HVfLfDnJXDjcY7HDgOZHe fLq3zT2QJscc2v30xI7C+HL32ruPMLeAs9BYuG/I8vdqhsXn4qkb2aeWLjtpFyoX jrNFzXyIiQtFAxYpinPhC9M= Received: (qmail 81541 invoked by alias); 23 May 2018 10:31:18 -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 81390 invoked by uid 89); 23 May 2018 10:31:17 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.2 required=5.0 tests=AWL, 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; Wed, 23 May 2018 10:31:14 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B3517117D15; Wed, 23 May 2018 06:31:12 -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 V9ssYQNJxgtd; Wed, 23 May 2018 06:31:12 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id A12EA117D0B; Wed, 23 May 2018 06:31:12 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id A00364B2; Wed, 23 May 2018 06:31:12 -0400 (EDT) Date: Wed, 23 May 2018 06:31:12 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Suppression of elaboration-related warnings Message-ID: <20180523103112.GA9320@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This patch modifies the effects of pragma Warnings (Off, ...) to suppress elaboration warnings related to an entity. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-05-23 Hristian Kirtchev gcc/ada/ * einfo.adb (Is_Elaboration_Checks_OK_Id): Use predicate Is_Elaboration_Target. (Is_Elaboration_Target): New routine. (Is_Elaboration_Warnings_OK_Id): Use predicate Is_Elaboration_Target. (Set_Is_Elaboration_Checks_OK_Id): Use predicate Is_Elaboration_Target. (Set_Is_Elaboration_Warnings_OK_Id): Use predicate Is_Elaboration_Target. * einfo.ads: Add new synthesized attribute Is_Elaboration_Target along with occurrences in nodes. (Is_Elaboration_Target): New routine. * sem_prag.adb (Analyze_Pragma): Suppress elaboration warnings when an elaboration target is subject to pragma Warnings (Off, ...). gcc/testsuite/ * gnat.dg/elab5.adb, gnat.dg/elab5_pkg.adb, gnat.dg/elab5_pkg.ads: New testcase. --- gcc/ada/einfo.adb +++ gcc/ada/einfo.adb @@ -2253,23 +2253,13 @@ package body Einfo is function Is_Elaboration_Checks_OK_Id (Id : E) return B is begin - pragma Assert - (Ekind_In (Id, E_Constant, E_Variable) - or else Is_Entry (Id) - or else Is_Generic_Unit (Id) - or else Is_Subprogram (Id) - or else Is_Task_Type (Id)); + pragma Assert (Is_Elaboration_Target (Id)); return Flag148 (Id); end Is_Elaboration_Checks_OK_Id; function Is_Elaboration_Warnings_OK_Id (Id : E) return B is begin - pragma Assert - (Ekind_In (Id, E_Constant, E_Variable, E_Void) - or else Is_Entry (Id) - or else Is_Generic_Unit (Id) - or else Is_Subprogram (Id) - or else Is_Task_Type (Id)); + pragma Assert (Is_Elaboration_Target (Id) or else Ekind (Id) = E_Void); return Flag304 (Id); end Is_Elaboration_Warnings_OK_Id; @@ -5478,23 +5468,13 @@ package body Einfo is procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is begin - pragma Assert - (Ekind_In (Id, E_Constant, E_Variable) - or else Is_Entry (Id) - or else Is_Generic_Unit (Id) - or else Is_Subprogram (Id) - or else Is_Task_Type (Id)); + pragma Assert (Is_Elaboration_Target (Id)); Set_Flag148 (Id, V); end Set_Is_Elaboration_Checks_OK_Id; procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True) is begin - pragma Assert - (Ekind_In (Id, E_Constant, E_Variable) - or else Is_Entry (Id) - or else Is_Generic_Unit (Id) - or else Is_Subprogram (Id) - or else Is_Task_Type (Id)); + pragma Assert (Is_Elaboration_Target (Id)); Set_Flag304 (Id, V); end Set_Is_Elaboration_Warnings_OK_Id; @@ -8112,6 +8092,20 @@ package body Einfo is and then Is_Entity_Attribute_Name (Attribute_Name (N))); end Is_Entity_Name; + --------------------------- + -- Is_Elaboration_Target -- + --------------------------- + + function Is_Elaboration_Target (Id : Entity_Id) return Boolean is + begin + return + Ekind_In (Id, E_Constant, E_Variable) + or else Is_Entry (Id) + or else Is_Generic_Unit (Id) + or else Is_Subprogram (Id) + or else Is_Task_Type (Id); + end Is_Elaboration_Target; + ----------------------- -- Is_External_State -- ----------------------- --- gcc/ada/einfo.ads +++ gcc/ada/einfo.ads @@ -2522,12 +2522,16 @@ package Einfo is -- checks. Such targets are allowed to generate run-time conditional ABE -- checks or guaranteed ABE failures. +-- Is_Elaboration_Target (synthesized) +-- Applies to all entities, True only for elaboration targets (see the +-- terminology in Sem_Elab). + -- Is_Elaboration_Warnings_OK_Id (Flag304) -- Defined in elaboration targets (see terminology in Sem_Elab). Set when -- the target appears in a region with elaboration warnings enabled. -- Is_Elementary_Type (synthesized) --- Applies to all entities, true for all elementary types and subtypes. +-- Applies to all entities, True for all elementary types and subtypes. -- Either Is_Composite_Type or Is_Elementary_Type (but not both) is true -- of any type. @@ -5971,6 +5975,7 @@ package Einfo is -- Address_Clause (synth) -- Alignment_Clause (synth) -- Is_Atomic_Or_VFA (synth) + -- Is_Elaboration_Target (synth) -- Size_Clause (synth) -- E_Decimal_Fixed_Point_Type @@ -6041,6 +6046,7 @@ package Einfo is -- Entry_Index_Type (synth) -- First_Formal (synth) -- First_Formal_With_Extras (synth) + -- Is_Elaboration_Target (synth) -- Last_Formal (synth) -- Number_Formals (synth) -- Scope_Depth (synth) @@ -6202,6 +6208,7 @@ package Einfo is -- Address_Clause (synth) -- First_Formal (synth) -- First_Formal_With_Extras (synth) + -- Is_Elaboration_Target (synth) -- Last_Formal (synth) -- Number_Formals (synth) -- Scope_Depth (synth) @@ -6329,6 +6336,7 @@ package Einfo is -- Is_Primitive (Flag218) -- Is_Pure (Flag44) -- SPARK_Pragma_Inherited (Flag265) + -- Is_Elaboration_Target (synth) -- Aren't there more flags and fields? seems like this list should be -- more similar to the E_Function list, which is much longer ??? @@ -6401,6 +6409,7 @@ package Einfo is -- Static_Elaboration_Desired (Flag77) (non-generic case only) -- Has_Non_Null_Abstract_State (synth) -- Has_Null_Abstract_State (synth) + -- Is_Elaboration_Target (synth) -- Is_Wrapper_Package (synth) (non-generic case only) -- Scope_Depth (synth) @@ -6525,6 +6534,7 @@ package Einfo is -- Address_Clause (synth) -- First_Formal (synth) -- First_Formal_With_Extras (synth) + -- Is_Elaboration_Target (synth) -- Is_Finalizer (synth) -- Last_Formal (synth) -- Number_Formals (synth) @@ -6712,6 +6722,7 @@ package Einfo is -- First_Component (synth) -- First_Component_Or_Discriminant (synth) -- Has_Entries (synth) + -- Is_Elaboration_Target (synth) -- Number_Entries (synth) -- Scope_Depth (synth) -- (plus type attributes) @@ -6777,6 +6788,7 @@ package Einfo is -- Address_Clause (synth) -- Alignment_Clause (synth) -- Is_Atomic_Or_VFA (synth) + -- Is_Elaboration_Target (synth) -- Size_Clause (synth) -- E_Void @@ -7595,6 +7607,7 @@ package Einfo is function Is_Controlled (Id : E) return B; function Is_Discriminal (Id : E) return B; function Is_Dynamic_Scope (Id : E) return B; + function Is_Elaboration_Target (Id : E) return B; function Is_External_State (Id : E) return B; function Is_Finalizer (Id : E) return B; function Is_Null_State (Id : E) return B; --- gcc/ada/sem_prag.adb +++ gcc/ada/sem_prag.adb @@ -24696,6 +24696,13 @@ package body Sem_Prag is (E, (Chars (Get_Pragma_Arg (Arg1)) = Name_Off)); + -- Suppress elaboration warnings if the entity + -- denotes an elaboration target. + + if Is_Elaboration_Target (E) then + Set_Is_Elaboration_Warnings_OK_Id (E, False); + end if; + -- For OFF case, make entry in warnings off -- pragma table for later processing. But we do -- not do that within an instance, since these --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/elab5.adb @@ -0,0 +1,5 @@ +-- { dg-do link } + +with Elab5_Pkg; + +procedure Elab5 is begin null; end Elab5; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/elab5_pkg.adb @@ -0,0 +1,123 @@ +with Ada.Text_IO; use Ada.Text_IO; + +package body Elab5_Pkg is + + -------------------------------------------------- + -- Call to call, instantiation, task activation -- + -------------------------------------------------- + + procedure Suppressed_Call_1 is + package Inst is new ABE_Gen; + T : ABE_Task; + begin + ABE_Call; + end Suppressed_Call_1; + + function Elaborator_1 return Boolean is + begin + pragma Warnings ("L"); + Suppressed_Call_1; + pragma Warnings ("l"); + return True; + end Elaborator_1; + + Elab_1 : constant Boolean := Elaborator_1; + + procedure Suppressed_Call_2 is + package Inst is new ABE_Gen; + T : ABE_Task; + begin + ABE_Call; + end Suppressed_Call_2; + + function Elaborator_2 return Boolean is + begin + Suppressed_Call_2; + return True; + end Elaborator_2; + + Elab_2 : constant Boolean := Elaborator_2; + + procedure Suppressed_Call_3 is + package Inst is new ABE_Gen; + T : ABE_Task; + begin + ABE_Call; + end Suppressed_Call_3; + + function Elaborator_3 return Boolean is + begin + Suppressed_Call_3; + return True; + end Elaborator_3; + + Elab_3 : constant Boolean := Elaborator_3; + + ----------------------------------------------------------- + -- Instantiation to call, instantiation, task activation -- + ----------------------------------------------------------- + + package body Suppressed_Generic is + procedure Force_Body is begin null; end Force_Body; + package Inst is new ABE_Gen; + T : ABE_Task; + begin + ABE_Call; + end Suppressed_Generic; + + function Elaborator_4 return Boolean is + pragma Warnings ("L"); + package Inst is new Suppressed_Generic; + pragma Warnings ("l"); + begin + return True; + end Elaborator_4; + + Elab_4 : constant Boolean := Elaborator_4; + + ------------------------------------------------------------- + -- Task activation to call, instantiation, task activation -- + ------------------------------------------------------------- + + task body Suppressed_Task is + package Inst is new ABE_Gen; + T : ABE_Task; + begin + ABE_Call; + end Suppressed_Task; + + function Elaborator_5 return Boolean is + pragma Warnings ("L"); + T : Suppressed_Task; + pragma Warnings ("l"); + begin + return True; + end Elaborator_5; + + Elab_5 : constant Boolean := Elaborator_5; + + function Elaborator_6 return Boolean is + T : Suppressed_Task; + pragma Warnings (Off, T); + begin + return True; + end Elaborator_6; + + Elab_6 : constant Boolean := Elaborator_6; + + procedure ABE_Call is + begin + Put_Line ("ABE_Call"); + end ABE_Call; + + package body ABE_Gen is + procedure Force_Body is begin null; end Force_Body; + begin + Put_Line ("ABE_Gen"); + end ABE_Gen; + + task body ABE_Task is + begin + Put_Line ("ABE_Task"); + end ABE_Task; +end Elab5_Pkg; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/elab5_pkg.ads @@ -0,0 +1,47 @@ +package Elab5_Pkg is + procedure ABE_Call; + + generic + package ABE_Gen is + procedure Force_Body; + end ABE_Gen; + + task type ABE_Task; + + -------------------------------------------------- + -- Call to call, instantiation, task activation -- + -------------------------------------------------- + + function Elaborator_1 return Boolean; + function Elaborator_2 return Boolean; + function Elaborator_3 return Boolean; + + procedure Suppressed_Call_1; + + pragma Warnings ("L"); + procedure Suppressed_Call_2; + pragma Warnings ("l"); + + procedure Suppressed_Call_3; + pragma Warnings (Off, Suppressed_Call_3); + + ----------------------------------------------------------- + -- Instantiation to call, instantiation, task activation -- + ----------------------------------------------------------- + + function Elaborator_4 return Boolean; + + generic + package Suppressed_Generic is + procedure Force_Body; + end Suppressed_Generic; + + ------------------------------------------------------------- + -- Task activation to call, instantiation, task activation -- + ------------------------------------------------------------- + + function Elaborator_5 return Boolean; + function Elaborator_6 return Boolean; + + task type Suppressed_Task; +end Elab5_Pkg;