From: Hristian Kirtchev Date: Wed, 23 May 2018 10:22:25 +0000 (+0000) Subject: [Ada] Suppression of elaboration-related warnings X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=48688534182cf02b7a99416b4459d6514512fc13;p=gcc.git [Ada] Suppression of elaboration-related warnings This patch modifies the effects of pragma Warnings (Off, ...) to suppress elaboration warnings related to an entity. 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. From-SVN: r260580 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d5679e23fe8..cfe3b82cc66 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2018-05-23 Hristian Kirtchev + + * 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, ...). + 2018-05-23 Eric Botcazou * repinfo.adb (List_Type_Info): Remove obsolete stuff. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 47d4f25f6ff..6d5c7eace85 100644 --- a/gcc/ada/einfo.adb +++ b/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 -- ----------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 5fc30714f4d..7f8f0e21272 100644 --- a/gcc/ada/einfo.ads +++ b/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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e25873b7165..b864bb8f621 100644 --- a/gcc/ada/sem_prag.adb +++ b/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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fc786e32c72..d92394bb33a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-05-23 Hristian Kirtchev + + * gnat.dg/elab5.adb, gnat.dg/elab5_pkg.adb, gnat.dg/elab5_pkg.ads: New + testcase. + 2018-05-23 Hristian Kirtchev * gnat.dg/elab4.adb, gnat.dg/elab4_pkg.adb, gnat.dg/elab4_pkg.ads: New diff --git a/gcc/testsuite/gnat.dg/elab5.adb b/gcc/testsuite/gnat.dg/elab5.adb new file mode 100644 index 00000000000..598a2f19fb7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab5.adb @@ -0,0 +1,5 @@ +-- { dg-do link } + +with Elab5_Pkg; + +procedure Elab5 is begin null; end Elab5; diff --git a/gcc/testsuite/gnat.dg/elab5_pkg.adb b/gcc/testsuite/gnat.dg/elab5_pkg.adb new file mode 100644 index 00000000000..5a21fd7a25b --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/elab5_pkg.ads b/gcc/testsuite/gnat.dg/elab5_pkg.ads new file mode 100644 index 00000000000..78da6e68e94 --- /dev/null +++ b/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;