* [Ada] Suppression of elaboration-related warnings
@ 2018-05-23 10:31 Pierre-Marie de Rodat
0 siblings, 0 replies; 3+ messages in thread
From: Pierre-Marie de Rodat @ 2018-05-23 10:31 UTC (permalink / raw)
To: gcc-patches; +Cc: Hristian Kirtchev
[-- Attachment #1: Type: text/plain, Size: 314 bytes --]
This patch updates the documentation section on suppressing elaboration
warnings. No change in behavior, no need for a test.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-23 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* sem_elab.adb: Update the section on suppressing elaboration warnings.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1819 bytes --]
--- gcc/ada/sem_elab.adb
+++ gcc/ada/sem_elab.adb
@@ -394,33 +394,38 @@ package body Sem_Elab is
-- suppressed.
--
-- In addition to switch -gnatwL, pragma Warnings may be used to suppress
- -- elaboration-related warnings by wrapping a construct in the following
- -- manner:
+ -- elaboration-related warnings when used in the following manner:
--
-- pragma Warnings ("L");
- -- <construct>
- -- pragma Warnings ("l");
+ -- <scenario-or-target>
+ --
+ -- <target>
+ -- pragma Warnings (Off, target);
+ --
+ -- pragma Warnings (Off);
+ -- <scenario-or-target>
--
-- * To suppress elaboration warnings for '[Unrestricted_]Access of
-- entries, operators, and subprograms, either:
--
- -- - Wrap the entry, operator, or subprogram, or
- -- - Wrap the attribute, or
+ -- - Suppress the entry, operator, or subprogram, or
+ -- - Suppress the attribute, or
-- - Use switch -gnatw.f
--
-- * To suppress elaboration warnings for calls to entries, operators,
-- and subprograms, either:
--
- -- - Wrap the entry, operator, or subprogram, or
- -- - Wrap the call
+ -- - Suppress the entry, operator, or subprogram, or
+ -- - Suppress the call
--
- -- * To suppress elaboration warnings for instantiations, wrap the
+ -- * To suppress elaboration warnings for instantiations, suppress the
-- instantiation.
--
-- * To suppress elaboration warnings for task activations, either:
--
- -- - Wrap the task object, or
- -- - Wrap the task type
+ -- - Suppress the task object, or
+ -- - Suppress the task type, or
+ -- - Suppress the activation call
--------------
-- Switches --
^ permalink raw reply [flat|nested] 3+ messages in thread
* [Ada] Suppression of elaboration-related warnings
@ 2018-05-23 10:32 Pierre-Marie de Rodat
0 siblings, 0 replies; 3+ messages in thread
From: Pierre-Marie de Rodat @ 2018-05-23 10:32 UTC (permalink / raw)
To: gcc-patches; +Cc: Hristian Kirtchev
[-- Attachment #1: Type: text/plain, Size: 5024 bytes --]
This patch changes the behavior of elaboration-related warnings as follows:
* If a scenario or a target has [elaboration] warnings suppressed, then
any further elaboration-related warnings along the paths rooted at the
scenario are also suppressed.
* Elaboration-related warnings related to task activation can now be
suppressed when either the task object, task type, or the activation
call have [elaboration] warnings suppressed.
* Elaboration-related warnings related to calls can now be suppressed when
either the target or the call have [elaboration] warnings suppressed.
* Elaboration-related warnings related to instantiations can now be
suppressed when the instantiation has [elaboration] warnings suppressed.
The patch also cleans up the way the state of the Processing phase is updated
with each new node along a path. It is now preferable to update the state in
routines
Process_Conditional_ABE_Activation_Impl
Process_Conditional_ABE_Call
Process_Conditional_ABE_Instantiation
rather than within their language-specific versions.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-23 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* einfo.adb: Flag304 is now Is_Elaboration_Warnings_OK_Id.
(Is_Elaboration_Warnings_OK_Id): New routine.
(Set_Is_Elaboration_Warnings_OK_Id): New routine.
(Write_Entity_Flags): Output Flag304.
* einfo.ads: Add new attribute Is_Elaboration_Warnings_OK_Id along with
occurrences in entities.
(Is_Elaboration_Warnings_OK_Id): New routine along with pragma Inline.
(Set_Is_Elaboration_Warnings_OK_Id): New routine along with pragma
Inline.
* sem_attr.adb (Analyze_Access_Attribute): Capture the state of
elaboration warnings.
* sem_ch3.adb (Analyze_Object_Declaration): Capture the state of
elaboration warnings.
* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Capture the
state of elaboration warnings.
(Analyze_Subprogram_Body_Helper): Capture the state of elaboration
warnings.
(Analyze_Subprogram_Declaration): Capture the state of elaboration
warnings.
* sem_ch9.adb (Analyze_Entry_Declaration): Capture the state of
elaboration warnings.
(Analyze_Single_Task_Declaration): Capture the state of elaboration
warnings.
(Analyze_Task_Type_Declaration): Capture the state of elaboration
warnings.
* sem_ch12.adb (Analyze_Generic_Package_Declaration): Capture the state
of elaboration warnings.
(Analyze_Generic_Subprogram_Declaration): Capture the state of
elaboration warnings.
* sem_elab.adb: Add a section on suppressing elaboration warnings.
Type Processing_Attributes includes component Suppress_Warnings
intended to suppress any elaboration warnings along a path in the
graph. Update Initial_State to include a value for this component.
Types Target_Attributes and Task_Attriutes include component
Elab_Warnings_OK to indicate whether the target or task has elaboration
warnings enabled. component Elab_Warnings_OK.
(Build_Access_Marker): Propagate attribute
Is_Elaboration_Warnings_OK_Node from the attribute to the generated
call marker.
(Extract_Instantiation_Attributes): Set the value for Elab_Warnings_OK.
(Extract_Target_Attributes): Set the value for Elab_Warnings_OK.
(Extract_Task_Attributes): Set the value for Elab_Warnings_OK.
(Process_Conditional_ABE_Access): Suppress futher elaboration warnings
when already in this mode or when the attribute or target have warnings
suppressed.
(Process_Conditional_ABE_Activation_Impl): Do not emit any diagnostics
if warnings are suppressed.
(Process_Conditional_ABE_Call): Suppress further elaboration warnings
when already in this mode, or the target or call have warnings
suppressed.
(Process_Conditional_ABE_Call_Ada): Do not emit any diagnostics if
warnings are suppressed.
(Process_Conditional_ABE_Call_SPARK): Do not emit any diagnostics if
warnings are suppressed.
(Process_Conditional_ABE_Instantiation): Suppress further elaboration
warnings when already in this mode or when the instantiation has
warnings suppressed.
(Process_Conditional_ABE_Instantiation_Ada): Do not emit any
diagnostics if warnings are suppressed.
(Process_Conditional_ABE_Variable_Assignment_Ada): Use the more
specific Is_Elaboration_Warnings_OK_Id rather than Warnings_Off.
(Process_Conditional_ABE_Variable_Assignment_SPARK): Use the more
specific Is_Elaboration_Warnings_OK_Id rather than Warnings_Off.
(Process_Task_Object): Suppress further elaboration warnings when
already in this mode, or when the object, activation call, or task type
have warnings suppressed. Update the processing state to indicate that
the path goes through a task body.
* sinfo.adb (Is_Elaboration_Warnings_OK_Node): Accept attribute
references.
(Set_Is_Elaboration_Warnings_OK_Node): Accept attribute references.
* sinfo.ads: Attribute Is_Elaboration_Warnings_OK_Node now applies to
attribute references.
gcc/testsuite/
* gnat.dg/elab4.adb, gnat.dg/elab4_pkg.adb, gnat.dg/elab4_pkg.ads: New
testcase.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 37384 bytes --]
--- gcc/ada/einfo.adb
+++ gcc/ada/einfo.adb
@@ -627,8 +627,8 @@ package body Einfo is
-- Ignore_SPARK_Mode_Pragmas Flag301
-- Is_Initial_Condition_Procedure Flag302
-- Suppress_Elaboration_Warnings Flag303
+ -- Is_Elaboration_Warnings_OK_Id Flag304
- -- (unused) Flag304
-- (unused) Flag305
-- (unused) Flag306
-- (unused) Flag307
@@ -2262,6 +2262,17 @@ package body Einfo is
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));
+ return Flag304 (Id);
+ end Is_Elaboration_Warnings_OK_Id;
+
function Is_Eliminated (Id : E) return B is
begin
return Flag124 (Id);
@@ -5476,6 +5487,17 @@ package body Einfo is
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));
+ Set_Flag304 (Id, V);
+ end Set_Is_Elaboration_Warnings_OK_Id;
+
procedure Set_Is_Eliminated (Id : E; V : B := True) is
begin
Set_Flag124 (Id, V);
@@ -9685,6 +9707,7 @@ package body Einfo is
W ("Is_Dispatch_Table_Entity", Flag234 (Id));
W ("Is_Dispatching_Operation", Flag6 (Id));
W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id));
+ W ("Is_Elaboration_Warnings_OK_Id", Flag304 (Id));
W ("Is_Eliminated", Flag124 (Id));
W ("Is_Entry_Formal", Flag52 (Id));
W ("Is_Exception_Handler", Flag286 (Id));
--- gcc/ada/einfo.ads
+++ gcc/ada/einfo.ads
@@ -2522,6 +2522,10 @@ package Einfo is
-- checks. Such targets are allowed to generate run-time conditional ABE
-- checks or guaranteed ABE failures.
+-- 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.
-- Either Is_Composite_Type or Is_Elementary_Type (but not both) is true
@@ -5949,6 +5953,7 @@ package Einfo is
-- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85)
-- Is_Elaboration_Checks_OK_Id (Flag148) (constants only)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304) (constants only)
-- Is_Eliminated (Flag124)
-- Is_Finalized_Transient (Flag252)
-- Is_Ignored_Transient (Flag295)
@@ -6026,6 +6031,7 @@ package Einfo is
-- Has_Expanded_Contract (Flag240)
-- Ignore_SPARK_Mode_Pragmas (Flag301)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Entry_Wrapper (Flag297)
-- Needs_No_Actuals (Flag22)
-- Sec_Stack_Needed_For_Return (Flag167)
@@ -6166,6 +6172,7 @@ package Einfo is
-- Is_Discrim_SO_Function (Flag176)
-- Is_Discriminant_Check_Function (Flag264)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Eliminated (Flag124)
-- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only)
-- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only)
@@ -6316,6 +6323,7 @@ package Einfo is
-- Has_Nested_Subprogram (Flag282)
-- Ignore_SPARK_Mode_Pragmas (Flag301)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Intrinsic_Subprogram (Flag64)
-- Is_Machine_Code_Subprogram (Flag137)
-- Is_Primitive (Flag218)
@@ -6383,6 +6391,7 @@ package Einfo is
-- In_Package_Body (Flag48)
-- In_Use (Flag8)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Instantiated (Flag126)
-- Is_Private_Descendant (Flag53)
-- Is_Visible_Lib_Unit (Flag116)
@@ -6486,6 +6495,7 @@ package Einfo is
-- Is_Constructor (Flag76)
-- Is_DIC_Procedure (Flag132) (non-generic case only)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Eliminated (Flag124)
-- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only)
-- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only)
@@ -6697,6 +6707,7 @@ package Einfo is
-- Has_Storage_Size_Clause (Flag23) (base type only)
-- Ignore_SPARK_Mode_Pragmas (Flag301)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- SPARK_Aux_Pragma_Inherited (Flag266)
-- First_Component (synth)
-- First_Component_Or_Discriminant (synth)
@@ -6745,6 +6756,7 @@ package Einfo is
-- Has_Volatile_Components (Flag87)
-- Is_Atomic (Flag85)
-- Is_Elaboration_Checks_OK_Id (Flag148)
+ -- Is_Elaboration_Warnings_OK_Id (Flag304)
-- Is_Eliminated (Flag124)
-- Is_Finalized_Transient (Flag252)
-- Is_Ignored_Transient (Flag295)
@@ -7264,6 +7276,7 @@ package Einfo is
function Is_Dispatch_Table_Entity (Id : E) return B;
function Is_Dispatching_Operation (Id : E) return B;
function Is_Elaboration_Checks_OK_Id (Id : E) return B;
+ function Is_Elaboration_Warnings_OK_Id (Id : E) return B;
function Is_Eliminated (Id : E) return B;
function Is_Entry_Formal (Id : E) return B;
function Is_Entry_Wrapper (Id : E) return B;
@@ -7959,6 +7972,7 @@ package Einfo is
procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True);
procedure Set_Is_Dispatching_Operation (Id : E; V : B := True);
procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True);
+ procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True);
procedure Set_Is_Eliminated (Id : E; V : B := True);
procedure Set_Is_Entry_Formal (Id : E; V : B := True);
procedure Set_Is_Entry_Wrapper (Id : E; V : B := True);
@@ -8787,6 +8801,7 @@ package Einfo is
pragma Inline (Is_Dispatch_Table_Entity);
pragma Inline (Is_Dispatching_Operation);
pragma Inline (Is_Elaboration_Checks_OK_Id);
+ pragma Inline (Is_Elaboration_Warnings_OK_Id);
pragma Inline (Is_Elementary_Type);
pragma Inline (Is_Eliminated);
pragma Inline (Is_Entry);
@@ -9303,6 +9318,7 @@ package Einfo is
pragma Inline (Set_Is_Dispatch_Table_Entity);
pragma Inline (Set_Is_Dispatching_Operation);
pragma Inline (Set_Is_Elaboration_Checks_OK_Id);
+ pragma Inline (Set_Is_Elaboration_Warnings_OK_Id);
pragma Inline (Set_Is_Eliminated);
pragma Inline (Set_Is_Entry_Formal);
pragma Inline (Set_Is_Entry_Wrapper);
--- gcc/ada/sem_attr.adb
+++ gcc/ada/sem_attr.adb
@@ -813,9 +813,10 @@ package body Sem_Attr is
-- analysis, resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => N,
- Checks => True,
- Modes => True);
+ (N_Id => N,
+ Checks => True,
+ Modes => True,
+ Warnings => True);
-- Save the scenario for later examination by the ABE Processing
-- phase.
--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -3564,8 +3564,9 @@ package body Sem_Ch12 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Id,
- Checks => True);
+ (N_Id => Id,
+ Checks => True,
+ Warnings => True);
-- Analyze aspects now, so that generated pragmas appear in the
-- declarations before building and analyzing the generic copy.
@@ -3738,8 +3739,9 @@ package body Sem_Ch12 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Id,
- Checks => True);
+ (N_Id => Id,
+ Checks => True,
+ Warnings => True);
Formals := Parameter_Specifications (Spec);
--- gcc/ada/sem_ch3.adb
+++ gcc/ada/sem_ch3.adb
@@ -4758,8 +4758,9 @@ package body Sem_Ch3 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Id,
- Checks => True);
+ (N_Id => Id,
+ Checks => True,
+ Warnings => True);
-- Initialize alignment and size and capture alignment setting
--- gcc/ada/sem_ch6.adb
+++ gcc/ada/sem_ch6.adb
@@ -236,8 +236,9 @@ package body Sem_Ch6 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Subp_Id,
- Checks => True);
+ (N_Id => Subp_Id,
+ Checks => True,
+ Warnings => True);
Set_Is_Abstract_Subprogram (Subp_Id);
New_Overloaded_Entity (Subp_Id);
@@ -4148,6 +4149,17 @@ package body Sem_Ch6 is
end if;
end if;
+ -- Preserve relevant elaboration-related attributes of the context which
+ -- are no longer available or very expensive to recompute once analysis,
+ -- resolution, and expansion are over.
+
+ if No (Spec_Id) then
+ Mark_Elaboration_Attributes
+ (N_Id => Body_Id,
+ Checks => True,
+ Warnings => True);
+ end if;
+
-- If this is the proper body of a stub, we must verify that the stub
-- conforms to the body, and to the previous spec if one was present.
-- We know already that the body conforms to that spec. This test is
@@ -4785,8 +4797,9 @@ package body Sem_Ch6 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Designator,
- Checks => True);
+ (N_Id => Designator,
+ Checks => True,
+ Warnings => True);
if Debug_Flag_C then
Write_Str ("==> subprogram spec ");
--- gcc/ada/sem_ch9.adb
+++ gcc/ada/sem_ch9.adb
@@ -1662,8 +1662,9 @@ package body Sem_Ch9 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Def_Id,
- Checks => True);
+ (N_Id => Def_Id,
+ Checks => True,
+ Warnings => True);
-- Process formals
@@ -2866,8 +2867,9 @@ package body Sem_Ch9 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => Obj_Id,
- Checks => True);
+ (N_Id => Obj_Id,
+ Checks => True,
+ Warnings => True);
-- Instead of calling Analyze on the new node, call the proper analysis
-- procedure directly. Otherwise the node would be expanded twice, with
@@ -3137,8 +3139,9 @@ package body Sem_Ch9 is
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => T,
- Checks => True);
+ (N_Id => T,
+ Checks => True,
+ Warnings => True);
Push_Scope (T);
--- gcc/ada/sem_elab.adb
+++ gcc/ada/sem_elab.adb
@@ -372,6 +372,56 @@ package body Sem_Elab is
-- The diagnostics of the ABE mechanism depend on accurate source locations
-- to determine the spacial relation of nodes.
+ -----------------------------------------
+ -- Suppression of elaboration warnings --
+ -----------------------------------------
+
+ -- Elaboration warnings along multiple traversal paths rooted at a scenario
+ -- are suppressed when the scenario has elaboration warnings suppressed.
+ --
+ -- Root scenario
+ -- |
+ -- +-- Child scenario 1
+ -- | |
+ -- | +-- Grandchild scenario 1
+ -- | |
+ -- | +-- Grandchild scenario N
+ -- |
+ -- +-- Child scenario N
+ --
+ -- If the root scenario has elaboration warnings suppressed, then all its
+ -- child, grandchild, etc. scenarios will have their elaboration warnings
+ -- suppressed.
+ --
+ -- In addition to switch -gnatwL, pragma Warnings may be used to suppress
+ -- elaboration-related warnings by wrapping a construct in the following
+ -- manner:
+ --
+ -- pragma Warnings ("L");
+ -- <construct>
+ -- pragma Warnings ("l");
+ --
+ -- * To suppress elaboration warnings for '[Unrestricted_]Access of
+ -- entries, operators, and subprograms, either:
+ --
+ -- - Wrap the entry, operator, or subprogram, or
+ -- - Wrap the attribute, or
+ -- - Use switch -gnatw.f
+ --
+ -- * To suppress elaboration warnings for calls to entries, operators,
+ -- and subprograms, either:
+ --
+ -- - Wrap the entry, operator, or subprogram, or
+ -- - Wrap the call
+ --
+ -- * To suppress elaboration warnings for instantiations, wrap the
+ -- instantiation.
+ --
+ -- * To suppress elaboration warnings for task activations, either:
+ --
+ -- - Wrap the task object, or
+ -- - Wrap the task type
+
--------------
-- Switches --
--------------
@@ -718,6 +768,10 @@ package body Sem_Elab is
-- This flag is set when the Processing phase must not generate any
-- implicit Elaborate[_All] pragmas.
+ Suppress_Warnings : Boolean;
+ -- This flag is set when the Processing phase must not emit any warnings
+ -- on elaboration problems.
+
Within_Initial_Condition : Boolean;
-- This flag is set when the Processing phase is currently examining a
-- scenario which was reached from an initial condition procedure.
@@ -737,6 +791,7 @@ package body Sem_Elab is
Initial_State : constant Processing_Attributes :=
(Suppress_Implicit_Pragmas => False,
+ Suppress_Warnings => False,
Within_Initial_Condition => False,
Within_Instance => False,
Within_Partial_Finalization => False,
@@ -749,6 +804,9 @@ package body Sem_Elab is
Elab_Checks_OK : Boolean;
-- This flag is set when the target has elaboration checks enabled
+ Elab_Warnings_OK : Boolean;
+ -- This flag is set when the target has elaboration warnings enabled
+
From_Source : Boolean;
-- This flag is set when the target comes from source
@@ -831,6 +889,9 @@ package body Sem_Elab is
Elab_Checks_OK : Boolean;
-- This flag is set when the task type has elaboration checks enabled
+ Elab_Warnings_OK : Boolean;
+ -- This flag is set when the task type has elaboration warnings enabled
+
Ghost_Mode_Ignore : Boolean;
-- This flag is set when the task type appears in a region subject to
-- pragma Ghost with policy ignore, or starts one such region.
@@ -4090,6 +4151,7 @@ package body Sem_Elab is
Attrs.Body_Barf := Body_Barf;
Attrs.Body_Decl := Body_Decl;
Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Id (Target_Id);
+ Attrs.Elab_Warnings_OK := Is_Elaboration_Warnings_OK_Id (Target_Id);
Attrs.From_Source := Comes_From_Source (Target_Id);
Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Entity (Target_Id);
Attrs.SPARK_Mode_On :=
@@ -4140,6 +4202,7 @@ package body Sem_Elab is
Attrs.Body_Decl := Body_Decl;
Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Id (Task_Typ);
+ Attrs.Elab_Warnings_OK := Is_Elaboration_Warnings_OK_Id (Task_Typ);
Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Entity (Task_Typ);
Attrs.SPARK_Mode_On :=
Present (Prag) and then Get_SPARK_Mode_From_Annotation (Prag) = On;
@@ -8392,8 +8455,8 @@ package body Sem_Elab is
-- component.
procedure Process_Task_Objects (List : List_Id);
- -- Perform ABE checks and diagnostics for all task objects found in
- -- the list List.
+ -- Perform ABE checks and diagnostics for all task objects found in the
+ -- list List.
-------------------------
-- Process_Task_Object --
@@ -8405,30 +8468,54 @@ package body Sem_Elab is
Comp_Id : Entity_Id;
Task_Attrs : Task_Attributes;
+ New_State : Processing_Attributes := State;
+ -- Each step of the Processing phase constitutes a new state
+
begin
if Is_Task_Type (Typ) then
Extract_Task_Attributes
(Typ => Base_Typ,
Attrs => Task_Attrs);
+ -- Warnings are suppressed when a prior scenario is already in
+ -- that mode, or when the object, activation call, or task type
+ -- have warnings suppressed. Update the state of the Processing
+ -- phase to reflect this.
+
+ New_State.Suppress_Warnings :=
+ New_State.Suppress_Warnings
+ or else not Is_Elaboration_Warnings_OK_Id (Obj_Id)
+ or else not Call_Attrs.Elab_Warnings_OK
+ or else not Task_Attrs.Elab_Warnings_OK;
+
+ -- Update the state of the Processing phase to indicate that any
+ -- further traversal is now within a task body.
+
+ New_State.Within_Task_Body := True;
+
Process_Single_Activation
(Call => Call,
Call_Attrs => Call_Attrs,
Obj_Id => Obj_Id,
Task_Attrs => Task_Attrs,
- State => State);
+ State => New_State);
-- Examine the component type when the object is an array
elsif Is_Array_Type (Typ) and then Has_Task (Base_Typ) then
- Process_Task_Object (Obj_Id, Component_Type (Typ));
+ Process_Task_Object
+ (Obj_Id => Obj_Id,
+ Typ => Component_Type (Typ));
-- Examine individual component types when the object is a record
elsif Is_Record_Type (Typ) and then Has_Task (Base_Typ) then
Comp_Id := First_Component (Typ);
while Present (Comp_Id) loop
- Process_Task_Object (Obj_Id, Etype (Comp_Id));
+ Process_Task_Object
+ (Obj_Id => Obj_Id,
+ Typ => Etype (Comp_Id));
+
Next_Component (Comp_Id);
end loop;
end if;
@@ -8454,7 +8541,9 @@ package body Sem_Elab is
Item_Typ := Etype (Item_Id);
if Has_Task (Item_Typ) then
- Process_Task_Object (Item_Id, Item_Typ);
+ Process_Task_Object
+ (Obj_Id => Item_Id,
+ Typ => Item_Typ);
end if;
end if;
@@ -8558,6 +8647,8 @@ package body Sem_Elab is
(Marker, False);
Set_Is_Elaboration_Checks_OK_Node
(Marker, Is_Elaboration_Checks_OK_Node (Attr));
+ Set_Is_Elaboration_Warnings_OK_Node
+ (Marker, Is_Elaboration_Warnings_OK_Node (Attr));
Set_Is_Source_Call
(Marker, Comes_From_Source (Attr));
Set_Is_SPARK_Mode_On_Node
@@ -8578,6 +8669,9 @@ package body Sem_Elab is
Target_Attrs : Target_Attributes;
+ New_State : Processing_Attributes := State;
+ -- Each step of the Processing phase constitutes a new state
+
-- Start of processing for Process_Conditional_ABE_Access
begin
@@ -8593,6 +8687,21 @@ package body Sem_Elab is
(Target_Id => Target_Id,
Attrs => Target_Attrs);
+ -- Warnings are suppressed when a prior scenario is already in that
+ -- mode, or when the attribute or the target have warnings suppressed.
+ -- Update the state of the Processing phase to reflect this.
+
+ New_State.Suppress_Warnings :=
+ New_State.Suppress_Warnings
+ or else not Is_Elaboration_Warnings_OK_Node (Attr)
+ or else not Target_Attrs.Elab_Warnings_OK;
+
+ -- Do not emit any ABE diagnostics when the current or previous scenario
+ -- in this traversal has suppressed elaboration warnings.
+
+ if New_State.Suppress_Warnings then
+ null;
+
-- Both the attribute and the corresponding body are in the same unit.
-- The corresponding body must appear prior to the root scenario which
-- started the recursive search. If this is not the case, then there is
@@ -8600,7 +8709,7 @@ package body Sem_Elab is
-- Emit a warning only when switch -gnatw.f (warnings on suspucious
-- 'Access) is in effect.
- if Warn_On_Elab_Access
+ elsif Warn_On_Elab_Access
and then Present (Target_Attrs.Body_Decl)
and then In_Extended_Main_Code_Unit (Target_Attrs.Body_Decl)
and then Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl)
@@ -8620,7 +8729,7 @@ package body Sem_Elab is
if Debug_Flag_Dot_O then
Process_Conditional_ABE
(N => Build_Access_Marker (Target_Id),
- State => State);
+ State => New_State);
-- Otherwise ensure that the unit with the corresponding body is
-- elaborated prior to the main unit.
@@ -8630,7 +8739,7 @@ package body Sem_Elab is
(N => Attr,
Unit_Id => Target_Attrs.Unit_Id,
Prag_Nam => Name_Elaborate_All,
- State => State);
+ State => New_State);
end if;
end Process_Conditional_ABE_Access;
@@ -8785,11 +8894,17 @@ package body Sem_Elab is
if Earlier_In_Extended_Unit (Root, Task_Attrs.Body_Decl) then
+ -- Do not emit any ABE diagnostics when a previous scenario in
+ -- this traversal has suppressed elaboration warnings.
+
+ if State.Suppress_Warnings then
+ null;
+
-- Do not emit any ABE diagnostics when the activation occurs in
-- a partial finalization context because this leads to confusing
-- noise.
- if State.Within_Partial_Finalization then
+ elsif State.Within_Partial_Finalization then
null;
-- ABE diagnostics are emitted only in the static model because
@@ -8797,9 +8912,7 @@ package body Sem_Elab is
-- this order diagnostics appear jumbled and result in unwanted
-- noise.
- elsif Static_Elaboration_Checks
- and then Call_Attrs.Elab_Warnings_OK
- then
+ elsif Static_Elaboration_Checks then
Error_Msg_Sloc := Sloc (Call);
Error_Msg_N
("??task & will be activated # before elaboration of its "
@@ -8869,11 +8982,6 @@ package body Sem_Elab is
Id => Task_Attrs.Unit_Id);
end if;
- -- Update the state of the Processing phase to indicate that any further
- -- traversal is now within a task body.
-
- New_State.Within_Task_Body := True;
-
-- Both the activation call and task type are subject to SPARK_Mode
-- On, this triggers the SPARK rules for task activation. Compared to
-- calls and instantiations, task activation in SPARK does not require
@@ -9085,6 +9193,15 @@ package body Sem_Elab is
return;
end if;
+ -- Warnings are suppressed when a prior scenario is already in that
+ -- mode, or the call or target have warnings suppressed. Update the
+ -- state of the Processing phase to reflect this.
+
+ New_State.Suppress_Warnings :=
+ New_State.Suppress_Warnings
+ or else not Call_Attrs.Elab_Warnings_OK
+ or else not Target_Attrs.Elab_Warnings_OK;
+
-- The call occurs in an initial condition context when a prior scenario
-- is already in that mode, or when the target is an Initial_Condition
-- procedure. Update the state of the Processing phase to reflect this.
@@ -9221,11 +9338,17 @@ package body Sem_Elab is
if Earlier_In_Extended_Unit (Root, Target_Attrs.Body_Decl) then
+ -- Do not emit any ABE diagnostics when a previous scenario in
+ -- this traversal has suppressed elaboration warnings.
+
+ if State.Suppress_Warnings then
+ null;
+
-- Do not emit any ABE diagnostics when the call occurs in a
-- partial finalization context because this leads to confusing
-- noise.
- if State.Within_Partial_Finalization then
+ elsif State.Within_Partial_Finalization then
null;
-- ABE diagnostics are emitted only in the static model because
@@ -9233,9 +9356,7 @@ package body Sem_Elab is
-- this order diagnostics appear jumbled and result in unwanted
-- noise.
- elsif Static_Elaboration_Checks
- and then Call_Attrs.Elab_Warnings_OK
- then
+ elsif Static_Elaboration_Checks then
Error_Msg_NE
("??cannot call & before body seen", Call, Target_Id);
Error_Msg_N ("\Program_Error may be raised at run time", Call);
@@ -9408,11 +9529,17 @@ package body Sem_Elab is
if Earlier_In_Extended_Unit (Call, Target_Attrs.Body_Decl) then
+ -- Do not emit any ABE diagnostics when a previous scenario in
+ -- this traversal has suppressed elaboration warnings.
+
+ if State.Suppress_Warnings then
+ null;
+
-- Do not emit any ABE diagnostics when the call occurs in an
-- initial condition context because this leads to incorrect
-- diagnostics.
- if State.Within_Initial_Condition then
+ elsif State.Within_Initial_Condition then
null;
-- Do not emit any ABE diagnostics when the call occurs in a
@@ -9515,6 +9642,9 @@ package body Sem_Elab is
SPARK_Rules_On : Boolean;
-- This flag is set when the SPARK rules are in effect
+ New_State : Processing_Attributes := State;
+ -- Each step of the Processing phase constitutes a new state
+
begin
Extract_Instantiation_Attributes
(Exp_Inst => Exp_Inst,
@@ -9579,15 +9709,23 @@ package body Sem_Elab is
elsif Is_Up_Level_Target (Gen_Attrs.Spec_Decl) then
return;
+ end if;
+
+ -- Warnings are suppressed when a prior scenario is already in that
+ -- mode, or when the instantiation has warnings suppressed. Update
+ -- the state of the processing phase to reflect this.
+
+ New_State.Suppress_Warnings :=
+ New_State.Suppress_Warnings or else not Inst_Attrs.Elab_Warnings_OK;
-- The SPARK rules are in effect
- elsif SPARK_Rules_On then
+ if SPARK_Rules_On then
Process_Conditional_ABE_Instantiation_SPARK
(Inst => Inst,
Gen_Id => Gen_Id,
Gen_Attrs => Gen_Attrs,
- State => State);
+ State => New_State);
-- Otherwise the Ada rules are in effect, or SPARK code is allowed to
-- violate the SPARK rules.
@@ -9599,7 +9737,7 @@ package body Sem_Elab is
Inst_Attrs => Inst_Attrs,
Gen_Id => Gen_Id,
Gen_Attrs => Gen_Attrs,
- State => State);
+ State => New_State);
end if;
end Process_Conditional_ABE_Instantiation;
@@ -9624,11 +9762,11 @@ package body Sem_Elab is
-- the generic have active elaboration checks and both are not ignored
-- Ghost constructs.
+ Root : constant Node_Id := Root_Scenario;
+
New_State : Processing_Attributes := State;
-- Each step of the Processing phase constitutes a new state
- Root : constant Node_Id := Root_Scenario;
-
begin
-- Nothing to do when the instantiation is ABE-safe
--
@@ -9685,11 +9823,17 @@ package body Sem_Elab is
if Earlier_In_Extended_Unit (Root, Gen_Attrs.Body_Decl) then
+ -- Do not emit any ABE diagnostics when a previous scenario in
+ -- this traversal has suppressed elaboration warnings.
+
+ if State.Suppress_Warnings then
+ null;
+
-- Do not emit any ABE diagnostics when the instantiation occurs
-- in partial finalization context because this leads to unwanted
-- noise.
- if State.Within_Partial_Finalization then
+ elsif State.Within_Partial_Finalization then
null;
-- ABE diagnostics are emitted only in the static model because
@@ -9697,9 +9841,7 @@ package body Sem_Elab is
-- this order diagnostics appear jumbled and result in unwanted
-- noise.
- elsif Static_Elaboration_Checks
- and then Inst_Attrs.Elab_Warnings_OK
- then
+ elsif Static_Elaboration_Checks then
Error_Msg_NE
("??cannot instantiate & before body seen", Inst, Gen_Id);
Error_Msg_N ("\Program_Error may be raised at run time", Inst);
@@ -9899,7 +10041,7 @@ package body Sem_Elab is
-- spec without a pragma Elaborate_Body is initialized by elaboration
-- code within the corresponding body.
- if not Warnings_Off (Var_Id)
+ if Is_Elaboration_Warnings_OK_Id (Var_Id)
and then not Is_Initialized (Var_Decl)
and then not Has_Pragma_Elaborate_Body (Spec_Id)
then
@@ -9940,7 +10082,8 @@ package body Sem_Elab is
-- without pragma Elaborate_Body is further modified by elaboration code
-- within the corresponding body.
- if Is_Initialized (Var_Decl)
+ if Is_Elaboration_Warnings_OK_Id (Var_Id)
+ and then Is_Initialized (Var_Decl)
and then not Has_Pragma_Elaborate_Body (Spec_Id)
then
Error_Msg_NE
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -18399,12 +18399,13 @@ package body Sem_Util is
Elaboration_Checks_OK
(Target_Id => Id,
Context_Id => Scope (Id)));
+ end if;
- -- Entities do not need to capture their enclosing level. The Ghost
- -- and SPARK modes in effect are already marked during analysis.
+ -- Mark the status of elaboration warnings in effect. Do not reset
+ -- the status in case the entity is reanalyzed with warnings off.
- else
- null;
+ if Warnings and then not Is_Elaboration_Warnings_OK_Id (Id) then
+ Set_Is_Elaboration_Warnings_OK_Id (Id, Elab_Warnings);
end if;
end Mark_Elaboration_Attributes_Id;
--- gcc/ada/sinfo.adb
+++ gcc/ada/sinfo.adb
@@ -1929,6 +1929,7 @@ package body Sinfo is
(N : Node_Id) return Boolean is
begin
pragma Assert (False
+ or else NT (N).Nkind = N_Attribute_Reference
or else NT (N).Nkind = N_Call_Marker
or else NT (N).Nkind = N_Entry_Call_Statement
or else NT (N).Nkind = N_Function_Call
@@ -5392,6 +5393,7 @@ package body Sinfo is
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
+ or else NT (N).Nkind = N_Attribute_Reference
or else NT (N).Nkind = N_Call_Marker
or else NT (N).Nkind = N_Entry_Call_Statement
or else NT (N).Nkind = N_Function_Call
--- gcc/ada/sinfo.ads
+++ gcc/ada/sinfo.ads
@@ -1758,6 +1758,7 @@ package Sinfo is
-- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Present in the following nodes:
--
+ -- attribute reference
-- call marker
-- entry call statement
-- function call
@@ -4064,6 +4065,7 @@ package Sinfo is
-- Associated_Node (Node4-Sem)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Header_Size_Added (Flag11-Sem)
-- Redundant_Use (Flag13-Sem)
-- Must_Be_Byte_Aligned (Flag14-Sem)
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab4.adb
@@ -0,0 +1,5 @@
+-- { dg-do link }
+
+with Elab4_Pkg;
+
+procedure Elab4 is begin null; end Elab4;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab4_pkg.adb
@@ -0,0 +1,99 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Elab4_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;
+
+ -----------------------------------------------------------
+ -- 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_3 return Boolean is
+ pragma Warnings ("L");
+ package Inst is new Suppressed_Generic;
+ pragma Warnings ("l");
+ begin
+ return True;
+ end Elaborator_3;
+
+ Elab_3 : constant Boolean := Elaborator_3;
+
+ -------------------------------------------------------------
+ -- 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_4 return Boolean is
+ pragma Warnings ("L");
+ T : Suppressed_Task;
+ pragma Warnings ("l");
+ begin
+ return True;
+ end Elaborator_4;
+
+ Elab_4 : constant Boolean := Elaborator_4;
+
+ 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 Elab4_Pkg;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/elab4_pkg.ads
@@ -0,0 +1,41 @@
+package Elab4_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;
+
+ procedure Suppressed_Call_1;
+
+ pragma Warnings ("L");
+ procedure Suppressed_Call_2;
+ pragma Warnings ("l");
+
+ -----------------------------------------------------------
+ -- Instantiation to call, instantiation, task activation --
+ -----------------------------------------------------------
+
+ function Elaborator_3 return Boolean;
+
+ generic
+ package Suppressed_Generic is
+ procedure Force_Body;
+ end Suppressed_Generic;
+
+ -------------------------------------------------------------
+ -- Task activation to call, instantiation, task activation --
+ -------------------------------------------------------------
+
+ function Elaborator_4 return Boolean;
+ task type Suppressed_Task;
+end Elab4_Pkg;
^ permalink raw reply [flat|nested] 3+ messages in thread
* [Ada] Suppression of elaboration-related warnings
@ 2018-05-23 10:31 Pierre-Marie de Rodat
0 siblings, 0 replies; 3+ messages in thread
From: Pierre-Marie de Rodat @ 2018-05-23 10:31 UTC (permalink / raw)
To: gcc-patches; +Cc: Hristian Kirtchev
[-- Attachment #1: Type: text/plain, Size: 947 bytes --]
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 <kirtchev@adacore.com>
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 12579 bytes --]
--- 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;
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2018-05-23 10:31 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-05-23 10:31 [Ada] Suppression of elaboration-related warnings Pierre-Marie de Rodat
-- strict thread matches above, loose matches on Subject: below --
2018-05-23 10:32 Pierre-Marie de Rodat
2018-05-23 10:31 Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).