This patch modifies the elaboration warnings produced by the ABE mechanism to
depend on the status of flag Elab_Warnings. The flag is enabled by compilation
switch -gnatwl. This change allows for selective suppression of warnings, as
well as total suppression.
In order to preserve the behaviour of the ABE mmechanism with respect ot the
legacy ABE mechanism, elaboration warnings are now on by default.
-------------
-- Sources --
-------------
-- selective_2.ads
package Selective_2 is
Var : Integer;
generic
procedure Gen;
procedure Proc;
task type Tsk is
entry E;
end Tsk;
package Direct is
procedure Force_Body;
end Direct;
end Selective_2;
-- selective_2.adb
package body Selective_2 is
function Elaborator return Boolean is
pragma Warnings (Off);
procedure Inst is new Gen; -- OK
T : Tsk; -- OK
pragma Warnings (On);
begin
Proc; -- Warn
return True;
end Elaborator;
package body Direct is
procedure Force_Body is begin null; end Force_Body;
pragma Warnings (Off);
procedure Inst is new Gen; -- OK
T : Tsk; -- OK
pragma Warnings (On);
begin
Proc; -- Warn
end Direct;
Indirect : constant Boolean := Elaborator;
procedure Gen is begin null; end Gen;
procedure Proc is begin null; end Proc;
task body Tsk is
begin
accept E;
end Tsk;
pragma Warnings (Off);
begin
Var := 1; -- OK
end Selective_2;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c selective_2.adb
selective_2.adb:8:07: warning: cannot call "Proc" before body seen
selective_2.adb:8:07: warning: Program_Error may be raised at run time
selective_2.adb:8:07: warning: body of unit "Selective_2" elaborated
selective_2.adb:8:07: warning: function "Elaborator" called at line 22
selective_2.adb:8:07: warning: procedure "Proc" called at line 8
selective_2.adb:19:07: warning: cannot call "Proc" before body seen
selective_2.adb:19:07: warning: Program_Error will be raised at run time
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-11-16 Hristian Kirtchev <kirtc...@adacore.com>
* opt.ads: Elaboration warnings are now on by default. Add a comment
explaining why this is needed.
* sem_ch9.adb (Analyze_Requeue): Preserve the status of elaboration
warnings.
* sem_ch12.adb (Analyze_Package_Instantiation): Preserve the status of
elaboration warnings.
(Analyze_Subprogram_Instantiation): Preserve the status of elaboration
warnings.
* sem_elab.adb: Update the structure of Call_Attributes and
Instantiation_Attributes.
(Build_Call_Marker): Propagate the status of elaboration warnings from
the call to the marker.
(Extract_Call_Attributes): Extract the status of elaboration warnings.
(Extract_Instantiation_Attributes): Extract the status of elaboration
warnings.
(Process_Conditional_ABE_Activation_Impl): Elaboration diagnostics are
now dependent on the status of elaboration warnings.
(Process_Conditional_ABE_Call_Ada): Elaboration diagnostics are now
dependent on the status of elaboration warnings.
(Process_Conditional_ABE_Instantiation_Ada): Elaboration diagnostics
are now dependent on the status of elaboration warnings.
(Process_Guaranteed_ABE_Activation_Impl): Remove pragma Unreferenced
for formal Call_Attrs. Elaboration diagnostics are now dependent on the
status of elaboration warnings.
(Process_Guaranteed_ABE_Call): Elaboration diagnostics are now
dependent on the status of elaboration warnings.
(Process_Guaranteed_ABE_Instantiation): Elaboration diagnostics are now
dependent on the status of elaboration warnings.
* sem_prag.adb (Analyze_Pragma): Remove the unjustified warning
concerning pragma Elaborate.
* sem_res.adb (Resolve_Call): Preserve the status of elaboration
warnings.
(Resolve_Entry_Call): Propagate flag Is_Elaboration_Warnings_OK_Node
from the procedure call to the entry call.
* sem_util.adb (Mark_Elaboration_Attributes): Add formal parameter
Warnings.
(Mark_Elaboration_Attributes_Node): Preserve the status of elaboration
warnings
* sem_util.ads (Mark_Elaboration_Attributes): Add formal parameter
Warnings. Update the comment on usage.
* sinfo.adb (Is_Dispatching_Call): Update to use Flag6.
(Is_Elaboration_Warnings_OK_Node): New routine.
(Set_Is_Dispatching_Call): Update to use Flag6.
(Set_Is_Elaboration_Warnings_OK_Node): New routine.
* sinfo.ads: Attribute Is_Dispatching_Call now uses Flag6. Add new
attribute Is_Elaboration_Warnings_OK_Node along with occurrences
in nodes.
(Is_Elaboration_Warnings_OK_Node): New routine along with pragma
Inline.
(Set_Is_Elaboration_Warnings_OK_Node): New routine along with pragma
Inline.
* doc/gnat_ugn/elaboration_order_handling_in_gnat.rst: Update various
sections to indicate how to suppress elaboration warnings. Document
switches -gnatwl and -gnatwL.
* gnat_ugn.texi: Regenerate.
Index: doc/gnat_ugn/elaboration_order_handling_in_gnat.rst
===================================================================
--- doc/gnat_ugn/elaboration_order_handling_in_gnat.rst (revision 254818)
+++ doc/gnat_ugn/elaboration_order_handling_in_gnat.rst (revision 254819)
@@ -690,8 +690,8 @@
Note that GNAT emits warnings rather than hard errors whenever it encounters an
elaboration problem. This is because the elaboration model in effect may be too
conservative, or a particular scenario may not be elaborated or executed due to
-data and control flow. The warnings can be suppressed with compiler switch
-:switch:`-gnatws`.
+data and control flow. The warnings can be suppressed selectively with ``pragma
+Warnigns (Off)`` or globally with compiler switch :switch:`-gnatwL`.
.. _Dynamic_Elaboration_Model_in_GNAT:
@@ -764,8 +764,8 @@
The static model performs extensive diagnostics on scenarios which elaborate
or execute internal targets. The warnings resulting from these diagnostics
- are enabled by default, but can be suppressed using compiler switch
- :switch:`-gnatws`.
+ are enabled by default, but can be suppressed selectively with ``pragma
+ Warnings (Off)`` or globally with compiler switch :switch:`-gnatwL`.
::
@@ -1648,6 +1648,47 @@
In the example above, the elaboration of declaration ``Ptr`` is assigned
``Func'Access`` before the body of ``Func`` has been elaborated.
+.. index:: -gnatwl (gnat)
+
+:switch:`-gnatwl`
+ Turn on warnings for elaboration problems
+
+ When this switch is in effect, GNAT emits diagnostics in the form of warnings
+ concerning various elaboration problems. The warnings are enabled by default.
+ The switch is provided in case all warnings are suppressed, but elaboration
+ warnings are still desired.
+
+:switch:`-gnatwL`
+ Turn off warnings for elaboration problems
+
+ When this switch is in effect, GNAT no longer emits any diagnostics in the
+ form of warnings. Selective suppression of elaboration problems is possible
+ using ``pragma Warnings (Off)``.
+
+ ::
+
+ 1. package body Selective_Suppression is
+ 2. function ABE return Integer;
+ 3.
+ 4. Val_1 : constant Integer := ABE;
+ |
+ >>> warning: cannot call "ABE" before body seen
+ >>> warning: Program_Error will be raised at run time
+
+ 5.
+ 6. pragma Warnings (Off);
+ 7. Val_2 : constant Integer := ABE;
+ 8. pragma Warnings (On);
+ 9.
+ 10. function ABE return Integer is
+ 11. begin
+ 12. ...
+ 13. end ABE;
+ 14. end Selective_Suppression;
+
+ Note that suppressing elaboration warnings does not eliminate run-time
+ checks. The example above will still fail at runtime with an ABE.
+
.. _Summary_of_Procedures_for_Elaboration_Control:
Summary of Procedures for Elaboration Control
Index: gnat_ugn.texi
===================================================================
--- gnat_ugn.texi (revision 254818)
+++ gnat_ugn.texi (revision 254819)
@@ -21,7 +21,7 @@
@copying
@quotation
-GNAT User's Guide for Native Platforms , Nov 09, 2017
+GNAT User's Guide for Native Platforms , Nov 16, 2017
AdaCore
@@ -27897,8 +27897,8 @@
Note that GNAT emits warnings rather than hard errors whenever it encounters an
elaboration problem. This is because the elaboration model in effect may be too
conservative, or a particular scenario may not be elaborated or executed due to
-data and control flow. The warnings can be suppressed with compiler switch
-@code{-gnatws}.
+data and control flow. The warnings can be suppressed selectively with
@code{pragma
+Warnigns (Off)} or globally with compiler switch @code{-gnatwL}.
@node Dynamic Elaboration Model in GNAT,Static Elaboration Model in
GNAT,Common Elaboration-model Traits,Elaboration Order Handling in GNAT
@anchor{gnat_ugn/elaboration_order_handling_in_gnat
dynamic-elaboration-model-in-gnat}@anchor{23e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat
id8}@anchor{23f}
@@ -27975,8 +27975,8 @@
The static model performs extensive diagnostics on scenarios which elaborate
or execute internal targets. The warnings resulting from these diagnostics
-are enabled by default, but can be suppressed using compiler switch
-@code{-gnatws}.
+are enabled by default, but can be suppressed selectively with @code{pragma
+Warnings (Off)} or globally with compiler switch @code{-gnatwL}.
@example
1. package body Static_Model is
@@ -28959,6 +28959,53 @@
@code{Func'Access} before the body of @code{Func} has been elaborated.
@end table
+@geindex -gnatwl (gnat)
+
+
+@table @asis
+
+@item @code{-gnatwl}
+
+Turn on warnings for elaboration problems
+
+When this switch is in effect, GNAT emits diagnostics in the form of warnings
+concerning various elaboration problems. The warnings are enabled by default.
+The switch is provided in case all warnings are suppressed, but elaboration
+warnings are still desired.
+
+@item @code{-gnatwL}
+
+Turn off warnings for elaboration problems
+
+When this switch is in effect, GNAT no longer emits any diagnostics in the
+form of warnings. Selective suppression of elaboration problems is possible
+using @code{pragma Warnings (Off)}.
+
+@example
+ 1. package body Selective_Suppression is
+ 2. function ABE return Integer;
+ 3.
+ 4. Val_1 : constant Integer := ABE;
+ |
+ >>> warning: cannot call "ABE" before body seen
+ >>> warning: Program_Error will be raised at run time
+
+ 5.
+ 6. pragma Warnings (Off);
+ 7. Val_2 : constant Integer := ABE;
+ 8. pragma Warnings (On);
+ 9.
+10. function ABE return Integer is
+11. begin
+12. ...
+13. end ABE;
+14. end Selective_Suppression;
+@end example
+
+Note that suppressing elaboration warnings does not eliminate run-time
+checks. The example above will still fail at runtime with an ABE.
+@end table
+
@node Summary of Procedures for Elaboration Control,Inspecting the Chosen
Elaboration Order,Elaboration-related Compiler Switches,Elaboration Order
Handling in GNAT
@anchor{gnat_ugn/elaboration_order_handling_in_gnat
summary-of-procedures-for-elaboration-control}@anchor{24e}@anchor{gnat_ugn/elaboration_order_handling_in_gnat
id16}@anchor{24f}
@section Summary of Procedures for Elaboration Control
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 254818)
+++ sem_prag.adb (revision 254819)
@@ -15021,24 +15021,6 @@
Next (Arg);
end loop Outer;
-
- -- Give a warning if operating in static mode with one of the
- -- gnatwl/-gnatwE (elaboration warnings enabled) switches set.
-
- if Elab_Warnings
- and not Dynamic_Elaboration_Checks
-
- -- pragma Elaborate not allowed in SPARK mode anyway. We
- -- already complained about it, no point in generating any
- -- further complaint.
-
- and SPARK_Mode /= On
- then
- Error_Msg_N
- ("?l?use of pragma Elaborate may not be safe", N);
- Error_Msg_N
- ("?l?use pragma Elaborate_All instead if possible", N);
- end if;
end Elaborate;
-------------------
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 254818)
+++ sem_ch12.adb (revision 254819)
@@ -3943,10 +3943,11 @@
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => N,
- Checks => True,
- Level => True,
- Modes => True);
+ (N_Id => N,
+ Checks => True,
+ Level => True,
+ Modes => True,
+ Warnings => True);
Check_SPARK_05_Restriction ("generic is not allowed", N);
@@ -5393,10 +5394,11 @@
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => N,
- Checks => True,
- Level => True,
- Modes => True);
+ (N_Id => N,
+ Checks => True,
+ Level => True,
+ Modes => True,
+ Warnings => True);
Check_SPARK_05_Restriction ("generic is not allowed", N);
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 254818)
+++ sem_util.adb (revision 254819)
@@ -17827,10 +17827,11 @@
---------------------------------
procedure Mark_Elaboration_Attributes
- (N_Id : Node_Or_Entity_Id;
- Checks : Boolean := False;
- Level : Boolean := False;
- Modes : Boolean := False)
+ (N_Id : Node_Or_Entity_Id;
+ Checks : Boolean := False;
+ Level : Boolean := False;
+ Modes : Boolean := False;
+ Warnings : Boolean := False)
is
function Elaboration_Checks_OK
(Target_Id : Entity_Id;
@@ -18013,6 +18014,13 @@
Set_Is_SPARK_Mode_On_Node (N);
end if;
end if;
+
+ -- Mark the status of elaboration warnings in effect. Do not reset
+ -- the status in case the node is reanalyzed with warnings off.
+
+ if Warnings and then not Is_Elaboration_Warnings_OK_Node (N) then
+ Set_Is_Elaboration_Warnings_OK_Node (N, Elab_Warnings);
+ end if;
end Mark_Elaboration_Attributes_Node;
-- Start of processing for Mark_Elaboration_Attributes
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 254818)
+++ sem_util.ads (revision 254819)
@@ -2087,16 +2087,19 @@
-- cleaned up during resolution.
procedure Mark_Elaboration_Attributes
- (N_Id : Node_Or_Entity_Id;
- Checks : Boolean := False;
- Level : Boolean := False;
- Modes : Boolean := False);
+ (N_Id : Node_Or_Entity_Id;
+ Checks : Boolean := False;
+ Level : Boolean := False;
+ Modes : Boolean := False;
+ Warnings : Boolean := False);
-- Preserve relevant elaboration-related properties of the context in
- -- arbitrary entity or node N_Id. When flag Checks is set, the routine
- -- saves the status of Elaboration_Check. When flag Level is set, the
- -- routine captures the declaration level of N_Id if applicable. When
- -- flag Modes is set, the routine saves the Ghost and SPARK modes in
- -- effect if applicable.
+ -- arbitrary entity or node N_Id. The flags control the properties as
+ -- follows:
+ --
+ -- Checks - Save the status of Elaboration_Check
+ -- Level - Save the declaration level of N_Id (if appicable)
+ -- Modes - Save the Ghost and SPARK modes in effect (if applicable)
+ -- Warnings - Save the status of Elab_Warnings
function Matching_Static_Array_Bounds
(L_Typ : Node_Id;
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 254818)
+++ sem_res.adb (revision 254819)
@@ -5830,9 +5830,10 @@
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => N,
- Checks => True,
- Modes => True);
+ (N_Id => N,
+ Checks => True,
+ Modes => True,
+ Warnings => True);
-- The context imposes a unique interpretation with type Typ on a
-- procedure or function call. Find the entity of the subprogram that
@@ -7833,6 +7834,9 @@
Set_Is_Elaboration_Checks_OK_Node
(Entry_Call, Is_Elaboration_Checks_OK_Node (N));
+ Set_Is_Elaboration_Warnings_OK_Node
+ (Entry_Call, Is_Elaboration_Warnings_OK_Node (N));
+
Set_Is_SPARK_Mode_On_Node
(Entry_Call, Is_SPARK_Mode_On_Node (N));
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 254818)
+++ sinfo.adb (revision 254819)
@@ -1886,7 +1886,7 @@
begin
pragma Assert (False
or else NT (N).Nkind = N_Call_Marker);
- return Flag3 (N);
+ return Flag6 (N);
end Is_Dispatching_Call;
function Is_Dynamic_Coextension
@@ -1933,6 +1933,21 @@
return Flag9 (N);
end Is_Elaboration_Code;
+ function Is_Elaboration_Warnings_OK_Node
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ 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
+ or else NT (N).Nkind = N_Function_Instantiation
+ or else NT (N).Nkind = N_Package_Instantiation
+ or else NT (N).Nkind = N_Procedure_Call_Statement
+ or else NT (N).Nkind = N_Procedure_Instantiation
+ or else NT (N).Nkind = N_Requeue_Statement);
+ return Flag3 (N);
+ end Is_Elaboration_Warnings_OK_Node;
+
function Is_Elsif
(N : Node_Id) return Boolean is
begin
@@ -5322,7 +5337,7 @@
begin
pragma Assert (False
or else NT (N).Nkind = N_Call_Marker);
- Set_Flag3 (N, Val);
+ Set_Flag6 (N, Val);
end Set_Is_Dispatching_Call;
procedure Set_Is_Dynamic_Coextension
@@ -5369,6 +5384,21 @@
Set_Flag9 (N, Val);
end Set_Is_Elaboration_Code;
+ procedure Set_Is_Elaboration_Warnings_OK_Node
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ 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
+ or else NT (N).Nkind = N_Function_Instantiation
+ or else NT (N).Nkind = N_Package_Instantiation
+ or else NT (N).Nkind = N_Procedure_Call_Statement
+ or else NT (N).Nkind = N_Procedure_Instantiation
+ or else NT (N).Nkind = N_Requeue_Statement);
+ Set_Flag3 (N, Val);
+ end Set_Is_Elaboration_Warnings_OK_Node;
+
procedure Set_Is_Elsif
(N : Node_Id; Val : Boolean := True) is
begin
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 254818)
+++ sinfo.ads (revision 254819)
@@ -1709,7 +1709,7 @@
-- If this flag is set, the aspect or policy is not analyzed for semantic
-- correctness, so any expressions etc will not be marked as analyzed.
- -- Is_Dispatching_Call (Flag3-Sem)
+ -- Is_Dispatching_Call (Flag6-Sem)
-- Present in call marker nodes. Set when the related call which prompted
-- the creation of the marker is dispatching.
@@ -1724,12 +1724,23 @@
-- a use clause is "used" in the current source.
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
- -- Present in nodes which represent an elaboration scenario. Those are
- -- assignment statement, attribute reference, call marker, entry call
- -- statement, expanded name, function call, identifier, instantiation,
- -- procedure call statement, and requeue statement nodes. Set when the
- -- node appears within a context which allows for the generation of
- -- run-time ABE checks. This flag detemines whether the ABE Processing
+ -- Present in the following nodes:
+ --
+ -- assignment statement
+ -- attribute reference
+ -- call marker
+ -- entry call statement
+ -- expanded name
+ -- function call
+ -- function instantiation
+ -- identifier
+ -- package instantiation
+ -- procedure call statement
+ -- procedure instantiation
+ -- requeue statement
+ --
+ -- Set when the node appears within a context which allows the generation
+ -- of run-time ABE checks. This flag detemines whether the ABE Processing
-- phase generates conditional ABE checks and guaranteed ABE failures.
-- Is_Elaboration_Code (Flag9-Sem)
@@ -1737,6 +1748,22 @@
-- the elaboration flag of a package or subprogram when the corresponding
-- body is successfully elaborated.
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
+ -- Present in the following nodes:
+ --
+ -- call marker
+ -- entry call statement
+ -- function call
+ -- function instantiation
+ -- package instantiation
+ -- procedure call statement
+ -- procedure instantiation
+ -- requeue statement
+ --
+ -- Set when the node appears within a context where elaboration warnings
+ -- are enabled. This flag determines whether the ABE processing phase
+ -- generates diagnostics on various elaboration issues.
+
-- Is_Entry_Barrier_Function (Flag8-Sem)
-- This flag is set on N_Subprogram_Declaration and N_Subprogram_Body
-- nodes which emulate the barrier function of a protected entry body.
@@ -5487,6 +5514,7 @@
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- plus fields for expression
@@ -5517,6 +5545,7 @@
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Is_Expanded_Build_In_Place_Call (Flag11-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- No_Side_Effect_Removal (Flag17-Sem)
@@ -6230,6 +6259,7 @@
-- First_Named_Actual (Node4-Sem)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
------------------------------
-- 9.5.4 Requeue Statement --
@@ -6247,6 +6277,7 @@
-- Abort_Present (Flag15)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
--------------------------
-- 9.6 Delay Statement --
@@ -7044,6 +7075,7 @@
-- Instance_Spec (Node5-Sem)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Is_Declaration_Level_Node (Flag5-Sem)
-- Is_Known_Guaranteed_ABE (Flag18-Sem)
@@ -7057,6 +7089,7 @@
-- Instance_Spec (Node5-Sem)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Is_Declaration_Level_Node (Flag5-Sem)
-- Must_Override (Flag14) set if overriding indicator present
-- Must_Not_Override (Flag15) set if not_overriding indicator present
@@ -7072,6 +7105,7 @@
-- Instance_Spec (Node5-Sem)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Is_Declaration_Level_Node (Flag5-Sem)
-- Must_Override (Flag14) set if overriding indicator present
-- Must_Not_Override (Flag15) set if not_overriding indicator present
@@ -7827,9 +7861,10 @@
-- Target (Node1-Sem)
-- Is_Elaboration_Checks_OK_Node (Flag1-Sem)
-- Is_SPARK_Mode_On_Node (Flag2-Sem)
- -- Is_Dispatching_Call (Flag3-Sem)
+ -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem)
-- Is_Source_Call (Flag4-Sem)
-- Is_Declaration_Level_Node (Flag5-Sem)
+ -- Is_Dispatching_Call (Flag6-Sem)
-- Is_Known_Guaranteed_ABE (Flag18-Sem)
------------------------
@@ -9699,7 +9734,7 @@
(N : Node_Id) return Boolean; -- Flag15
function Is_Dispatching_Call
- (N : Node_Id) return Boolean; -- Flag3
+ (N : Node_Id) return Boolean; -- Flag6
function Is_Dynamic_Coextension
(N : Node_Id) return Boolean; -- Flag18
@@ -9713,6 +9748,9 @@
function Is_Elaboration_Code
(N : Node_Id) return Boolean; -- Flag9
+ function Is_Elaboration_Warnings_OK_Node
+ (N : Node_Id) return Boolean; -- Flag3
+
function Is_Elsif
(N : Node_Id) return Boolean; -- Flag13
@@ -10794,7 +10832,7 @@
(N : Node_Id; Val : Boolean := True); -- Flag15
procedure Set_Is_Dispatching_Call
- (N : Node_Id; Val : Boolean := True); -- Flag3
+ (N : Node_Id; Val : Boolean := True); -- Flag6
procedure Set_Is_Dynamic_Coextension
(N : Node_Id; Val : Boolean := True); -- Flag18
@@ -10808,6 +10846,9 @@
procedure Set_Is_Elaboration_Code
(N : Node_Id; Val : Boolean := True); -- Flag9
+ procedure Set_Is_Elaboration_Warnings_OK_Node
+ (N : Node_Id; Val : Boolean := True); -- Flag3
+
procedure Set_Is_Elsif
(N : Node_Id; Val : Boolean := True); -- Flag13
@@ -13340,6 +13381,7 @@
pragma Inline (Is_Effective_Use_Clause);
pragma Inline (Is_Elaboration_Checks_OK_Node);
pragma Inline (Is_Elaboration_Code);
+ pragma Inline (Is_Elaboration_Warnings_OK_Node);
pragma Inline (Is_Elsif);
pragma Inline (Is_Entry_Barrier_Function);
pragma Inline (Is_Expanded_Build_In_Place_Call);
@@ -13700,6 +13742,7 @@
pragma Inline (Set_Is_Effective_Use_Clause);
pragma Inline (Set_Is_Elaboration_Checks_OK_Node);
pragma Inline (Set_Is_Elaboration_Code);
+ pragma Inline (Set_Is_Elaboration_Warnings_OK_Node);
pragma Inline (Set_Is_Elsif);
pragma Inline (Set_Is_Entry_Barrier_Function);
pragma Inline (Set_Is_Expanded_Build_In_Place_Call);
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb (revision 254818)
+++ sem_ch9.adb (revision 254819)
@@ -2295,9 +2295,10 @@
-- resolution, and expansion are over.
Mark_Elaboration_Attributes
- (N_Id => N,
- Checks => True,
- Modes => True);
+ (N_Id => N,
+ Checks => True,
+ Modes => True,
+ Warnings => True);
Tasking_Used := True;
Check_SPARK_05_Restriction ("requeue statement is not allowed", N);
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 254818)
+++ sem_elab.adb (revision 254819)
@@ -444,15 +444,6 @@
--
-- The complimentary switch for -gnatel.
--
- -- -gnatwl turn on warnings for elaboration problems
- --
- -- The ABE mechanism produces warnings on detected ABEs along with
- -- traceback showing the graph of the ABE.
- --
- -- -gnatwL turn off warnings for elaboration problems
- --
- -- The complimentary switch for -gnatwl.
- --
-- -gnatw.f turn on warnings for suspicious Subp'Access
--
-- The ABE mechanism treats '[Unrestricted_]Access of an entry,
@@ -462,6 +453,15 @@
-- -gnatw.F turn off warnings for suspicious Subp'Access
--
-- The complimentary switch for -gnatw.f.
+ --
+ -- -gnatwl turn on warnings for elaboration problems
+ --
+ -- The ABE mechanism produces warnings on detected ABEs along with
+ -- traceback showing the graph of the ABE.
+ --
+ -- -gnatwL turn off warnings for elaboration problems
+ --
+ -- The complimentary switch for -gnatwl.
---------------------------
-- Adding a new scenario --
@@ -567,6 +567,9 @@
Elab_Checks_OK : Boolean;
-- This flag is set when the call has elaboration checks enabled
+ Elab_Warnings_OK : Boolean;
+ -- This flag is set when the call has elaboration warnings elabled
+
From_Source : Boolean;
-- This flag is set when the call comes from source
@@ -622,6 +625,10 @@
-- This flag is set when the instantiation has elaboration checks
-- enabled.
+ Elab_Warnings_OK : Boolean;
+ -- This flag is set when the instantiation has elaboration warnings
+ -- enabled.
+
Ghost_Mode_Ignore : Boolean;
-- This flag is set when the instantiation appears in a region subject
-- to pragma Ghost with policy ignore, or starts one such region.
@@ -1519,7 +1526,7 @@
In_Partial_Fin : Boolean;
In_Task_Body : Boolean);
-- Perform common conditional ABE checks and diagnostics for call Call
- -- which activates task Obj_Id ignoring the Ada or SPARK rules. CAll_Attrs
+ -- which activates task Obj_Id ignoring the Ada or SPARK rules. Call_Attrs
-- are the attributes of the activation call. Task_Attrs are the attributes
-- of the task type. The flags should be set when the processing was
-- initiated as follows:
@@ -1657,11 +1664,11 @@
In_Partial_Fin : Boolean;
In_Task_Body : Boolean);
-- Perform common guaranteed ABE checks and diagnostics for call Call which
- -- activates task Obj_Id ignoring the Ada or SPARK rules. Task_Attrs are
- -- the attributes of the task type. The following parameters are provided
- -- for compatibility and are unused.
+ -- activates task Obj_Id ignoring the Ada or SPARK rules. Call_Attrs are
+ -- the attributes of the activation call. Task_Attrs are the attributes of
+ -- the task type. The following parameters are provided for compatibility
+ -- and are not used.
--
- -- Call_Attrs
-- In_Init_Cond
-- In_Partial_Fin
-- In_Task_Body
@@ -2057,13 +2064,16 @@
-- Inherit the attributes of the original call
- Set_Target (Marker, Target_Id);
- Set_Is_Elaboration_Checks_OK_Node (Marker, Call_Attrs.Elab_Checks_OK);
- Set_Is_Declaration_Level_Node (Marker, Call_Attrs.In_Declarations);
- Set_Is_Dispatching_Call (Marker, Call_Attrs.Is_Dispatching);
- Set_Is_Ignored_Ghost_Node (Marker, Call_Attrs.Ghost_Mode_Ignore);
- Set_Is_Source_Call (Marker, Call_Attrs.From_Source);
- Set_Is_SPARK_Mode_On_Node (Marker, Call_Attrs.SPARK_Mode_On);
+ Set_Target (Marker, Target_Id);
+ Set_Is_Declaration_Level_Node (Marker, Call_Attrs.In_Declarations);
+ Set_Is_Dispatching_Call (Marker, Call_Attrs.Is_Dispatching);
+ Set_Is_Elaboration_Checks_OK_Node
+ (Marker, Call_Attrs.Elab_Checks_OK);
+ Set_Is_Elaboration_Warnings_OK_Node
+ (Marker, Call_Attrs.Elab_Warnings_OK);
+ Set_Is_Ignored_Ghost_Node (Marker, Call_Attrs.Ghost_Mode_Ignore);
+ Set_Is_Source_Call (Marker, Call_Attrs.From_Source);
+ Set_Is_SPARK_Mode_On_Node (Marker, Call_Attrs.SPARK_Mode_On);
-- The marker is inserted prior to the original call. This placement has
-- several desirable effects:
@@ -3567,6 +3577,7 @@
-- Set all attributes
Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Node (Call);
+ Attrs.Elab_Warnings_OK := Is_Elaboration_Warnings_OK_Node (Call);
Attrs.From_Source := From_Source;
Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Node (Call);
Attrs.In_Declarations := In_Declarations;
@@ -3653,8 +3664,8 @@
Attrs : out Instantiation_Attributes)
is
begin
- Inst := Original_Node (Exp_Inst);
- Inst_Id := Defining_Entity (Inst);
+ Inst := Original_Node (Exp_Inst);
+ Inst_Id := Defining_Entity (Inst);
-- Traverse a possible chain of renamings to obtain the original generic
-- being instantiatied.
@@ -3664,6 +3675,7 @@
-- Set all attributes
Attrs.Elab_Checks_OK := Is_Elaboration_Checks_OK_Node (Inst);
+ Attrs.Elab_Warnings_OK := Is_Elaboration_Warnings_OK_Node (Inst);
Attrs.Ghost_Mode_Ignore := Is_Ignored_Ghost_Node (Inst);
Attrs.In_Declarations := Is_Declaration_Level_Node (Inst);
Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Inst);
@@ -8679,7 +8691,9 @@
-- this order diagnostics appear jumbled and result in unwanted
-- noise.
- elsif Static_Elaboration_Checks then
+ elsif Static_Elaboration_Checks
+ and then Call_Attrs.Elab_Warnings_OK
+ then
Error_Msg_Sloc := Sloc (Call);
Error_Msg_N
("??task & will be activated # before elaboration of its "
@@ -9068,7 +9082,9 @@
-- this order diagnostics appear jumbled and result in unwanted
-- noise.
- elsif Static_Elaboration_Checks then
+ elsif Static_Elaboration_Checks
+ and then Call_Attrs.Elab_Warnings_OK
+ then
Error_Msg_NE
("??cannot call & before body seen", Call, Target_Id);
Error_Msg_N ("\Program_Error may be raised at run time", Call);
@@ -9500,7 +9516,9 @@
-- this order diagnostics appear jumbled and result in unwanted
-- noise.
- elsif Static_Elaboration_Checks then
+ elsif Static_Elaboration_Checks
+ and then Inst_Attrs.Elab_Warnings_OK
+ then
Error_Msg_NE
("??cannot instantiate & before body seen", Inst, Gen_Id);
Error_Msg_N ("\Program_Error may be raised at run time", Inst);
@@ -9668,10 +9686,6 @@
and then not Is_Initialized (Var_Decl)
and then not Has_Pragma_Elaborate_Body (Spec_Id)
then
- -- Generate an implicit Elaborate_Body in the spec
-
- Set_Elaborate_Body_Desirable (Spec_Id);
-
Error_Msg_NE
("??variable & can be accessed by clients before this "
& "initialization", Asmt, Var_Id);
@@ -9681,6 +9695,10 @@
& "initialization", Asmt, Spec_Id);
Output_Active_Scenarios (Asmt);
+
+ -- Generate an implicit Elaborate_Body in the spec
+
+ Set_Elaborate_Body_Desirable (Spec_Id);
end if;
end Process_Conditional_ABE_Variable_Assignment_Ada;
@@ -9905,7 +9923,6 @@
In_Partial_Fin : Boolean;
In_Task_Body : Boolean)
is
- pragma Unreferenced (Call_Attrs);
pragma Unreferenced (In_Init_Cond);
pragma Unreferenced (In_Partial_Fin);
pragma Unreferenced (In_Task_Body);
@@ -10017,11 +10034,13 @@
Target_Decl => Task_Attrs.Task_Decl,
Target_Body => Task_Attrs.Body_Decl)
then
- Error_Msg_Sloc := Sloc (Call);
- Error_Msg_N
- ("??task & will be activated # before elaboration of its body",
- Obj_Id);
- Error_Msg_N ("\Program_Error will be raised at run time", Obj_Id);
+ if Call_Attrs.Elab_Warnings_OK then
+ Error_Msg_Sloc := Sloc (Call);
+ Error_Msg_N
+ ("??task & will be activated # before elaboration of its body",
+ Obj_Id);
+ Error_Msg_N ("\Program_Error will be raised at run time", Obj_Id);
+ end if;
-- Mark the activation call as a guaranteed ABE
@@ -10130,8 +10149,10 @@
Target_Decl => Target_Attrs.Spec_Decl,
Target_Body => Target_Attrs.Body_Decl)
then
- Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id);
- Error_Msg_N ("\Program_Error will be raised at run time", Call);
+ if Call_Attrs.Elab_Warnings_OK then
+ Error_Msg_NE ("??cannot call & before body seen", Call, Target_Id);
+ Error_Msg_N ("\Program_Error will be raised at run time", Call);
+ end if;
-- Mark the call as a guarnateed ABE
@@ -10253,9 +10274,11 @@
Target_Decl => Gen_Attrs.Spec_Decl,
Target_Body => Gen_Attrs.Body_Decl)
then
- Error_Msg_NE
- ("??cannot instantiate & before body seen", Inst, Gen_Id);
- Error_Msg_N ("\Program_Error will be raised at run time", Inst);
+ if Inst_Attrs.Elab_Warnings_OK then
+ Error_Msg_NE
+ ("??cannot instantiate & before body seen", Inst, Gen_Id);
+ Error_Msg_N ("\Program_Error will be raised at run time", Inst);
+ end if;
-- Mark the instantiation as a guarantee ABE. This automatically
-- suppresses the instantiation of the generic body.
Index: opt.ads
===================================================================
--- opt.ads (revision 254818)
+++ opt.ads (revision 254819)
@@ -553,9 +553,13 @@
-- GNAT
-- Set to True to output info messages for static elabmodel (-gnatel)
- Elab_Warnings : Boolean := False;
+ Elab_Warnings : Boolean := True;
-- GNAT
- -- Set to True to generate elaboration warnings (-gnatwl)
+ -- Set to True to generate elaboration warnings (-gnatwl). The warnings are
+ -- enabled by default because they carry the same importance as errors. The
+ -- compiler cannot emit actual errors because elaboration diagnostics need
+ -- dataflow analysis, which is not available. This behavior parallels that
+ -- of the old ABE mechanism.
Error_Msg_Line_Length : Nat := 0;
-- GNAT
