From 7fb62ca1b7a7db0177e956b2d9f35d46789cfe70 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Thu, 16 Nov 2017 13:17:19 +0000 Subject: [PATCH] opt.ads: Elaboration warnings are now on by default. 2017-11-16 Hristian Kirtchev * 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. From-SVN: r254819 --- gcc/ada/ChangeLog | 58 ++++++++++ .../elaboration_order_handling_in_gnat.rst | 49 +++++++- gcc/ada/gnat_ugn.texi | 57 +++++++++- gcc/ada/opt.ads | 8 +- gcc/ada/sem_ch12.adb | 18 +-- gcc/ada/sem_ch9.adb | 7 +- gcc/ada/sem_elab.adb | 105 +++++++++++------- gcc/ada/sem_prag.adb | 18 --- gcc/ada/sem_res.adb | 10 +- gcc/ada/sem_util.adb | 16 ++- gcc/ada/sem_util.ads | 21 ++-- gcc/ada/sinfo.adb | 34 +++++- gcc/ada/sinfo.ads | 63 +++++++++-- 13 files changed, 355 insertions(+), 109 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1f3cf290cd5..26457f12c17 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,61 @@ +2017-11-16 Hristian Kirtchev + + * 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. + 2017-11-16 Sylvain Dailler * sem_util.adb (Get_Enum_Lit_From_Pos): Add a condition for Pos diff --git a/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst index c45d3fcdbee..57acf53879c 100644 --- a/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst @@ -690,8 +690,8 @@ dispatching calls and a particular kind of ABE referred to as *guaranteed ABE*. 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 @@ run-time checks based on the nature of the target. 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 @@ the elaboration order chosen by the binder. 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 diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 05fdf4c84d0..43ef24596d4 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -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 @@ three models: 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 @@ run-time checks based on the nature of the target. 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 @@ In the example above, the elaboration of declaration @code{Ptr} is assigned @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 diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 94ed9533ac2..86a5c35ddce 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -553,9 +553,13 @@ package Opt is -- 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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 23f9ca7c223..afa58f43bae 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3943,10 +3943,11 @@ package body Sem_Ch12 is -- 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 @@ package body Sem_Ch12 is -- 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); diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 766742297fa..e1631357f1c 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2295,9 +2295,10 @@ package body Sem_Ch9 is -- 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); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 1f854945bd4..b34523f31f2 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -444,15 +444,6 @@ package body Sem_Elab is -- -- 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 @@ package body Sem_Elab is -- -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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is -- 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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is & "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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is 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. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 219ccf53474..17ce6ac3b62 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -15021,24 +15021,6 @@ package body Sem_Prag is 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; ------------------- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 84f19a7a8ed..434879386b4 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5830,9 +5830,10 @@ package body Sem_Res is -- 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 @@ package body Sem_Res is 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)); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 576a7596180..f58211328ed 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -17827,10 +17827,11 @@ package body Sem_Util is --------------------------------- 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 @@ package body Sem_Util is 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 diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index a12b2608503..c2d67f8e94d 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2087,16 +2087,19 @@ package Sem_Util is -- 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; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 06f62c5a922..afb3ece1fb4 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1886,7 +1886,7 @@ package body Sinfo is 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 @@ package body Sinfo is 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 @@ package body Sinfo is 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 @@ package body Sinfo is 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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index f14d2d15cb3..278b456e9d1 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1709,7 +1709,7 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is -- 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 @@ package Sinfo is (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 @@ package Sinfo is 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 @@ package Sinfo is (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 @@ package Sinfo is 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 @@ package Sinfo is 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 @@ package Sinfo is 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); -- 2.30.2