This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Configuration state not observed for instance bodies
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Hristian Kirtchev <kirtchev at adacore dot com>
- Date: Tue, 17 Jul 2018 04:24:36 -0400
- Subject: [Ada] Configuration state not observed for instance bodies
This patch ensures that the processing of instantiated and inlined bodies uses
the proper configuration context available at the point of the instantiation or
inlining.
Previously configuration pragmas which appear prior to the context items of a
unit would lose their effect when a body is instantiated or inlined.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* frontend.adb (Frontend): Update the call to Register_Config_Switches.
* inline.ads: Add new component Config_Switches to record
Pending_Body_Info which captures the configuration state of the pending
body. Remove components Version, Version_Pragma, SPARK_Mode, and
SPARK_Mode_Pragma from record Pending_Body_Info because they are
already captured in component Config_Switches.
* opt.adb (Register_Opt_Config_Switches): Rename to
Register_Config_Switches.
(Restore_Opt_Config_Switches): Rename to Restore_Config_Switches.
(Save_Opt_Config_Switches): Rename to Save_Config_Switches. This
routine is now a function, and returns the saved configuration state as
an aggregate to avoid missing an attribute.
(Set_Opt_Config_Switches): Rename to Set_Config_Switches.
* opt.ads (Register_Opt_Config_Switches): Rename to
Register_Config_Switches.
(Restore_Opt_Config_Switches): Rename to Restore_Config_Switches.
(Save_Opt_Config_Switches): Rename to Save_Config_Switches. This
routine is now a function.
(Set_Opt_Config_Switches): Rename to Set_Config_Switches.
* par.adb (Par): Update the calls to configuration switch-related
subprograms.
* sem.adb (Semantics): Update the calls to configuration switch-related
subprograms.
* sem_ch10.adb (Analyze_Package_Body_Stub): Update the calls to
configuration switch-related subprograms.
(Analyze_Protected_Body_Stub): Update the calls to configuration
switch-related subprograms.
(Analyze_Subprogram_Body_Stub): Update calls to configuration
switch-related subprograms.
* sem_ch12.adb (Add_Pending_Instantiation): Update the capture of
pending instantiation attributes.
(Inline_Instance_Body): Update the capture of pending instantiation
attributes. It is no longer needed to explicitly manipulate the SPARK
mode.
(Instantiate_Package_Body): Update the restoration of the context
attributes.
(Instantiate_Subprogram_Body): Update the restoration of context
attributes.
(Load_Parent_Of_Generic): Update the capture of pending instantiation
attributes.
(Set_Instance_Env): Update the way relevant configuration attributes
are saved and restored.
gcc/testsuite/
* gnat.dg/config_pragma1.adb, gnat.dg/config_pragma1_pkg.ads: New testcase.
--- gcc/ada/frontend.adb
+++ gcc/ada/frontend.adb
@@ -303,7 +303,7 @@ begin
-- capture the values of the configuration switches (see Opt for further
-- details).
- Opt.Register_Opt_Config_Switches;
+ Register_Config_Switches;
-- Check for file which contains No_Body pragma
--- gcc/ada/inline.ads
+++ gcc/ada/inline.ads
@@ -63,21 +63,24 @@ package Inline is
-- See full description in body of Sem_Ch12 for more details
type Pending_Body_Info is record
- Inst_Node : Node_Id;
- -- Node for instantiation that requires the body
-
Act_Decl : Node_Id;
-- Declaration for package or subprogram spec for instantiation
- Expander_Status : Boolean;
- -- If the body is instantiated only for semantic checking, expansion
- -- must be inhibited.
+ Config_Switches : Config_Switches_Type;
+ -- Capture the values of configuration switches
Current_Sem_Unit : Unit_Number_Type;
-- The semantic unit within which the instantiation is found. Must be
-- restored when compiling the body, to insure that internal entities
-- use the same counter and are unique over spec and body.
+ Expander_Status : Boolean;
+ -- If the body is instantiated only for semantic checking, expansion
+ -- must be inhibited.
+
+ Inst_Node : Node_Id;
+ -- Node for instantiation that requires the body
+
Scope_Suppress : Suppress_Record;
Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
-- Save suppress information at the point of instantiation. Used to
@@ -93,21 +96,8 @@ package Inline is
-- This means we have to capture this information from the current scope
-- at the point of instantiation.
- Version : Ada_Version_Type;
- -- The body must be compiled with the same language version as the
- -- spec. The version may be set by a configuration pragma in a separate
- -- file or in the current file, and may differ from body to body.
-
- Version_Pragma : Node_Id;
- -- This is linked with the Version value
-
Warnings : Warning_Record;
-- Capture values of warning flags
-
- SPARK_Mode : SPARK_Mode_Type;
- SPARK_Mode_Pragma : Node_Id;
- -- SPARK_Mode for an instance is the one applicable at the point of
- -- instantiation. SPARK_Mode_Pragma is the related active pragma.
end record;
package Pending_Instantiations is new Table.Table (
--- gcc/ada/opt.adb
+++ gcc/ada/opt.adb
@@ -80,11 +80,11 @@ package body Opt is
return Exception_Mechanism = Back_End_ZCX;
end ZCX_Exceptions;
- ----------------------------------
- -- Register_Opt_Config_Switches --
- ----------------------------------
+ ------------------------------
+ -- Register_Config_Switches --
+ ------------------------------
- procedure Register_Opt_Config_Switches is
+ procedure Register_Config_Switches is
begin
Ada_Version_Config := Ada_Version;
Ada_Version_Pragma_Config := Ada_Version_Pragma;
@@ -118,13 +118,13 @@ package body Opt is
-- but that's not a local setting.
Optimize_Alignment_Local := False;
- end Register_Opt_Config_Switches;
+ end Register_Config_Switches;
- ---------------------------------
- -- Restore_Opt_Config_Switches --
- ---------------------------------
+ -----------------------------
+ -- Restore_Config_Switches --
+ -----------------------------
- procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
+ procedure Restore_Config_Switches (Save : Config_Switches_Type) is
begin
Ada_Version := Save.Ada_Version;
Ada_Version_Pragma := Save.Ada_Version_Pragma;
@@ -160,48 +160,50 @@ package body Opt is
-- Normalize_Scalars then it forces that value for all with'ed units.
Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
- end Restore_Opt_Config_Switches;
+ end Restore_Config_Switches;
- ------------------------------
- -- Save_Opt_Config_Switches --
- ------------------------------
+ --------------------------
+ -- Save_Config_Switches --
+ --------------------------
- procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
+ function Save_Config_Switches return Config_Switches_Type is
begin
- Save.Ada_Version := Ada_Version;
- Save.Ada_Version_Pragma := Ada_Version_Pragma;
- Save.Ada_Version_Explicit := Ada_Version_Explicit;
- Save.Assertions_Enabled := Assertions_Enabled;
- Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values;
- Save.Check_Float_Overflow := Check_Float_Overflow;
- Save.Check_Policy_List := Check_Policy_List;
- Save.Default_Pool := Default_Pool;
- Save.Default_SSO := Default_SSO;
- Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
- Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
- Save.Extensions_Allowed := Extensions_Allowed;
- Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
- Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
- Save.Fast_Math := Fast_Math;
- Save.Initialize_Scalars := Initialize_Scalars;
- Save.No_Component_Reordering := No_Component_Reordering;
- Save.Optimize_Alignment := Optimize_Alignment;
- Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
- Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
- Save.Polling_Required := Polling_Required;
- Save.Prefix_Exception_Messages := Prefix_Exception_Messages;
- Save.SPARK_Mode := SPARK_Mode;
- Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma;
- Save.Uneval_Old := Uneval_Old;
- Save.Use_VADS_Size := Use_VADS_Size;
- Save.Warnings_As_Errors_Count := Warnings_As_Errors_Count;
- end Save_Opt_Config_Switches;
+ return
+ (Ada_Version => Ada_Version,
+ Ada_Version_Pragma => Ada_Version_Pragma,
+ Ada_Version_Explicit => Ada_Version_Explicit,
+ Assertions_Enabled => Assertions_Enabled,
+ Assume_No_Invalid_Values => Assume_No_Invalid_Values,
+ Check_Float_Overflow => Check_Float_Overflow,
+ Check_Policy_List => Check_Policy_List,
+ Default_Pool => Default_Pool,
+ Default_SSO => Default_SSO,
+ Dynamic_Elaboration_Checks => Dynamic_Elaboration_Checks,
+ Exception_Locations_Suppressed => Exception_Locations_Suppressed,
+ Extensions_Allowed => Extensions_Allowed,
+ External_Name_Exp_Casing => External_Name_Exp_Casing,
+ External_Name_Imp_Casing => External_Name_Imp_Casing,
+ Fast_Math => Fast_Math,
+ Initialize_Scalars => Initialize_Scalars,
+ No_Component_Reordering => No_Component_Reordering,
+ Normalize_Scalars => Normalize_Scalars,
+ Optimize_Alignment => Optimize_Alignment,
+ Optimize_Alignment_Local => Optimize_Alignment_Local,
+ Persistent_BSS_Mode => Persistent_BSS_Mode,
+ Polling_Required => Polling_Required,
+ Prefix_Exception_Messages => Prefix_Exception_Messages,
+ SPARK_Mode => SPARK_Mode,
+ SPARK_Mode_Pragma => SPARK_Mode_Pragma,
+ Uneval_Old => Uneval_Old,
+ Use_VADS_Size => Use_VADS_Size,
+ Warnings_As_Errors_Count => Warnings_As_Errors_Count);
+ end Save_Config_Switches;
- -----------------------------
- -- Set_Opt_Config_Switches --
- -----------------------------
+ -------------------------
+ -- Set_Config_Switches --
+ -------------------------
- procedure Set_Opt_Config_Switches
+ procedure Set_Config_Switches
(Internal_Unit : Boolean;
Main_Unit : Boolean)
is
@@ -244,12 +246,14 @@ package body Opt is
Check_Policy_List := Check_Policy_List_Config;
SPARK_Mode := SPARK_Mode_Config;
SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config;
+
else
if GNAT_Mode_Config then
Assertions_Enabled := Assertions_Enabled_Config;
else
Assertions_Enabled := False;
end if;
+
Assume_No_Invalid_Values := False;
Check_Policy_List := Empty;
SPARK_Mode := None;
@@ -299,7 +303,7 @@ package body Opt is
Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
Fast_Math := Fast_Math_Config;
Polling_Required := Polling_Required_Config;
- end Set_Opt_Config_Switches;
+ end Set_Config_Switches;
---------------
-- Tree_Read --
--- gcc/ada/opt.ads
+++ gcc/ada/opt.ads
@@ -2148,11 +2148,20 @@ package Opt is
type Config_Switches_Type is private;
-- Type used to save values of the switches set from Config values
- procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type);
- -- This procedure saves the current values of the switches which are
- -- initialized from the above Config values.
+ procedure Register_Config_Switches;
+ -- This procedure is called after processing the gnat.adc file and other
+ -- configuration pragma files to record the values of the Config switches,
+ -- as possibly modified by the use of command line switches and pragmas
+ -- appearing in these files.
+
+ procedure Restore_Config_Switches (Save : Config_Switches_Type);
+ -- This procedure restores a set of switch values previously saved by a
+ -- call to Save_Config_Switches.
+
+ function Save_Config_Switches return Config_Switches_Type;
+ -- Return the current state of all configuration-related attributes
- procedure Set_Opt_Config_Switches
+ procedure Set_Config_Switches
(Internal_Unit : Boolean;
Main_Unit : Boolean);
-- This procedure sets the switches to the appropriate initial values. The
@@ -2164,16 +2173,6 @@ package Opt is
-- internal unit is the main unit, in which case we use the command line
-- settings.
- procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type);
- -- This procedure restores a set of switch values previously saved by a
- -- call to Save_Opt_Config_Switches (Save).
-
- procedure Register_Opt_Config_Switches;
- -- This procedure is called after processing the gnat.adc file and other
- -- configuration pragma files to record the values of the Config switches,
- -- as possibly modified by the use of command line switches and pragmas
- -- appearing in these files.
-
------------------------
-- Other Global Flags --
------------------------
--- gcc/ada/par.adb
+++ gcc/ada/par.adb
@@ -57,22 +57,22 @@ with Tbuild; use Tbuild;
function Par (Configuration_Pragmas : Boolean) return List_Id is
+ Inside_Record_Definition : Boolean := False;
+ -- True within a record definition. Used to control warning for
+ -- redefinition of standard entities (not issued for field names).
+
+ Loop_Block_Count : Nat := 0;
+ -- Counter used for constructing loop/block names (see the routine
+ -- Par.Ch5.Get_Loop_Block_Name).
+
Num_Library_Units : Natural := 0;
-- Count number of units parsed (relevant only in syntax check only mode,
-- since in semantics check mode only a single unit is permitted anyway).
- Save_Config_Switches : Config_Switches_Type;
+ Save_Config_Attrs : Config_Switches_Type;
-- Variable used to save values of config switches while we parse the
-- new unit, to be restored on exit for proper recursive behavior.
- Loop_Block_Count : Nat := 0;
- -- Counter used for constructing loop/block names (see the routine
- -- Par.Ch5.Get_Loop_Block_Name).
-
- Inside_Record_Definition : Boolean := False;
- -- True within a record definition. Used to control warning for
- -- redefinition of standard entities (not issued for field names).
-
--------------------
-- Error Recovery --
--------------------
@@ -1517,7 +1517,7 @@ begin
-- Normal case of compilation unit
else
- Save_Opt_Config_Switches (Save_Config_Switches);
+ Save_Config_Attrs := Save_Config_Switches;
-- The following loop runs more than once in syntax check mode
-- where we allow multiple compilation units in the same file
@@ -1525,7 +1525,7 @@ begin
-- we get to the unit we want.
for Ucount in Pos loop
- Set_Opt_Config_Switches
+ Set_Config_Switches
(Is_Internal_Unit (Current_Source_Unit),
Main_Unit => Current_Source_Unit = Main_Unit);
@@ -1661,7 +1661,7 @@ begin
end if;
- Restore_Opt_Config_Switches (Save_Config_Switches);
+ Restore_Config_Switches (Save_Config_Attrs);
end loop;
-- Now that we have completely parsed the source file, we can complete
@@ -1690,7 +1690,7 @@ begin
-- Restore settings of switches saved on entry
- Restore_Opt_Config_Switches (Save_Config_Switches);
+ Restore_Config_Switches (Save_Config_Attrs);
Set_Comes_From_Source_Default (False);
end if;
--- gcc/ada/sem.adb
+++ gcc/ada/sem.adb
@@ -1438,7 +1438,7 @@ package body Sem is
In_Extended_Main_Source_Unit (Comp_Unit);
-- Determine if unit is in extended main source unit
- Save_Config_Switches : Config_Switches_Type;
+ Save_Config_Attrs : Config_Switches_Type;
-- Variable used to save values of config switches while we analyze the
-- new unit, to be restored on exit for proper recursive behavior.
@@ -1518,8 +1518,8 @@ package body Sem is
-- Save current config switches and reset then appropriately
- Save_Opt_Config_Switches (Save_Config_Switches);
- Set_Opt_Config_Switches
+ Save_Config_Attrs := Save_Config_Switches;
+ Set_Config_Switches
(Is_Internal_Unit (Current_Sem_Unit),
Is_Main_Unit_Or_Main_Unit_Spec);
@@ -1602,7 +1602,7 @@ package body Sem is
Outer_Generic_Scope := S_Outer_Gen_Scope;
Style_Check := S_Style_Check;
- Restore_Opt_Config_Switches (Save_Config_Switches);
+ Restore_Config_Switches (Save_Config_Attrs);
-- Deal with restore of restrictions
--- gcc/ada/sem_ch10.adb
+++ gcc/ada/sem_ch10.adb
@@ -1624,7 +1624,7 @@ package body Sem_Ch10 is
-- Retain and restore the configuration options of the enclosing
-- context as the proper body may introduce a set of its own.
- Save_Opt_Config_Switches (Opts);
+ Opts := Save_Config_Switches;
-- Indicate that the body of the package exists. If we are doing
-- only semantic analysis, the stub stands for the body. If we are
@@ -1644,7 +1644,7 @@ package body Sem_Ch10 is
Generate_Reference (Nam, Id, 'b');
Analyze_Proper_Body (N, Nam);
- Restore_Opt_Config_Switches (Opts);
+ Restore_Config_Switches (Opts);
end if;
end Analyze_Package_Body_Stub;
@@ -1985,7 +1985,7 @@ package body Sem_Ch10 is
-- Retain and restore the configuration options of the enclosing
-- context as the proper body may introduce a set of its own.
- Save_Opt_Config_Switches (Opts);
+ Opts := Save_Config_Switches;
Set_Scope (Id, Current_Scope);
Set_Ekind (Id, E_Protected_Body);
@@ -2000,7 +2000,7 @@ package body Sem_Ch10 is
Generate_Reference (Nam, Id, 'b');
Analyze_Proper_Body (N, Etype (Nam));
- Restore_Opt_Config_Switches (Opts);
+ Restore_Config_Switches (Opts);
end if;
end Analyze_Protected_Body_Stub;
@@ -2045,7 +2045,7 @@ package body Sem_Ch10 is
-- Retain and restore the configuration options of the enclosing context
-- as the proper body may introduce a set of its own.
- Save_Opt_Config_Switches (Opts);
+ Opts := Save_Config_Switches;
-- Treat stub as a body, which checks conformance if there is a previous
-- declaration, or else introduces entity and its signature.
@@ -2053,7 +2053,7 @@ package body Sem_Ch10 is
Analyze_Subprogram_Body (N);
Analyze_Proper_Body (N, Empty);
- Restore_Opt_Config_Switches (Opts);
+ Restore_Config_Switches (Opts);
end Analyze_Subprogram_Body_Stub;
---------------------
--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -1031,23 +1031,18 @@ package body Sem_Ch12 is
procedure Add_Pending_Instantiation (Inst : Node_Id; Act_Decl : Node_Id) is
begin
-
- -- Add to the instantiation node and the corresponding unit declaration
- -- the current values of global flags to be used when analyzing the
- -- instance body.
+ -- Capture the body of the generic instantiation along with its context
+ -- for later processing by Instantiate_Bodies.
Pending_Instantiations.Append
- ((Inst_Node => Inst,
- Act_Decl => Act_Decl,
- Expander_Status => Expander_Active,
+ ((Act_Decl => Act_Decl,
+ Config_Switches => Save_Config_Switches,
Current_Sem_Unit => Current_Sem_Unit,
- Scope_Suppress => Scope_Suppress,
+ Expander_Status => Expander_Active,
+ Inst_Node => Inst,
Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
- Version => Ada_Version,
- Version_Pragma => Ada_Version_Pragma,
- Warnings => Save_Warnings,
- SPARK_Mode => SPARK_Mode,
- SPARK_Mode_Pragma => SPARK_Mode_Pragma));
+ Scope_Suppress => Scope_Suppress,
+ Warnings => Save_Warnings));
end Add_Pending_Instantiation;
----------------------------------
@@ -4782,17 +4777,13 @@ package body Sem_Ch12 is
Gen_Unit : Entity_Id;
Act_Decl : Node_Id)
is
+ Config_Attrs : constant Config_Switches_Type := Save_Config_Switches;
+
Curr_Comp : constant Node_Id := Cunit (Current_Sem_Unit);
Curr_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
Gen_Comp : constant Entity_Id :=
Cunit_Entity (Get_Source_Unit (Gen_Unit));
- Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
- Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
- -- Save the SPARK mode-related data to restore on exit. Removing
- -- enclosing scopes to provide a clean environment for analysis of
- -- the inlined body will eliminate any previously set SPARK_Mode.
-
Scope_Stack_Depth : constant Pos :=
Scope_Stack.Last - Scope_Stack.First + 1;
@@ -4934,25 +4925,25 @@ package body Sem_Ch12 is
pragma Assert (Num_Inner < Num_Scopes);
- -- The inlined package body must be analyzed with the SPARK_Mode of
- -- the enclosing context, otherwise the body may cause bogus errors
- -- if a configuration SPARK_Mode pragma in in effect.
-
Push_Scope (Standard_Standard);
Scope_Stack.Table (Scope_Stack.Last).Is_Active_Stack_Base := True;
+
+ -- The inlined package body is analyzed with the configuration state
+ -- of the context prior to the scope manipulations performed above.
+
+ -- ??? shouldn't this also use the warning state of the context prior
+ -- to the scope manipulations?
+
Instantiate_Package_Body
(Body_Info =>
- ((Inst_Node => N,
- Act_Decl => Act_Decl,
- Expander_Status => Expander_Active,
+ ((Act_Decl => Act_Decl,
+ Config_Switches => Config_Attrs,
Current_Sem_Unit => Current_Sem_Unit,
- Scope_Suppress => Scope_Suppress,
+ Expander_Status => Expander_Active,
+ Inst_Node => N,
Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
- Version => Ada_Version,
- Version_Pragma => Ada_Version_Pragma,
- Warnings => Save_Warnings,
- SPARK_Mode => Saved_SM,
- SPARK_Mode_Pragma => Saved_SMP)),
+ Scope_Suppress => Scope_Suppress,
+ Warnings => Save_Warnings)),
Inlined_Body => True);
Pop_Scope;
@@ -5059,17 +5050,14 @@ package body Sem_Ch12 is
else
Instantiate_Package_Body
(Body_Info =>
- ((Inst_Node => N,
- Act_Decl => Act_Decl,
- Expander_Status => Expander_Active,
+ ((Act_Decl => Act_Decl,
+ Config_Switches => Save_Config_Switches,
Current_Sem_Unit => Current_Sem_Unit,
- Scope_Suppress => Scope_Suppress,
+ Expander_Status => Expander_Active,
+ Inst_Node => N,
Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
- Version => Ada_Version,
- Version_Pragma => Ada_Version_Pragma,
- Warnings => Save_Warnings,
- SPARK_Mode => SPARK_Mode,
- SPARK_Mode_Pragma => SPARK_Mode_Pragma)),
+ Scope_Suppress => Scope_Suppress,
+ Warnings => Save_Warnings)),
Inlined_Body => True);
end if;
end Inline_Instance_Body;
@@ -8994,7 +8982,7 @@ package body Sem_Ch12 is
-- Save configuration switches. These may be reset if the unit is a
-- predefined unit, and the current mode is not Ada 2005.
- Save_Opt_Config_Switches (Saved.Switches);
+ Saved.Switches := Save_Config_Switches;
Instance_Envs.Append (Saved);
@@ -11334,13 +11322,9 @@ package body Sem_Ch12 is
Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top;
Scope_Suppress := Body_Info.Scope_Suppress;
- Opt.Ada_Version := Body_Info.Version;
- Opt.Ada_Version_Pragma := Body_Info.Version_Pragma;
- Restore_Warnings (Body_Info.Warnings);
-
- -- Install the SPARK mode which applies to the package body
- Install_SPARK_Mode (Body_Info.SPARK_Mode, Body_Info.SPARK_Mode_Pragma);
+ Restore_Config_Switches (Body_Info.Config_Switches);
+ Restore_Warnings (Body_Info.Warnings);
if No (Gen_Body_Id) then
@@ -11694,15 +11678,9 @@ package body Sem_Ch12 is
Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top;
Scope_Suppress := Body_Info.Scope_Suppress;
- Opt.Ada_Version := Body_Info.Version;
- Opt.Ada_Version_Pragma := Body_Info.Version_Pragma;
- Restore_Warnings (Body_Info.Warnings);
- -- Install the SPARK mode which applies to the subprogram body from the
- -- instantiation context. This may be refined further if an explicit
- -- SPARK_Mode pragma applies to the generic body.
-
- Install_SPARK_Mode (Body_Info.SPARK_Mode, Body_Info.SPARK_Mode_Pragma);
+ Restore_Config_Switches (Body_Info.Config_Switches);
+ Restore_Warnings (Body_Info.Warnings);
if No (Gen_Body_Id) then
@@ -13735,20 +13713,17 @@ package body Sem_Ch12 is
Decl := First_Elmt (Previous_Instances);
while Present (Decl) loop
Info :=
- (Inst_Node => Node (Decl),
- Act_Decl =>
+ (Act_Decl =>
Instance_Spec (Node (Decl)),
- Expander_Status => Exp_Status,
+ Config_Switches => Save_Config_Switches,
Current_Sem_Unit =>
Get_Code_Unit (Sloc (Node (Decl))),
- Scope_Suppress => Scope_Suppress,
+ Expander_Status => Exp_Status,
+ Inst_Node => Node (Decl),
Local_Suppress_Stack_Top =>
Local_Suppress_Stack_Top,
- Version => Ada_Version,
- Version_Pragma => Ada_Version_Pragma,
- Warnings => Save_Warnings,
- SPARK_Mode => SPARK_Mode,
- SPARK_Mode_Pragma => SPARK_Mode_Pragma);
+ Scope_Suppress => Scope_Suppress,
+ Warnings => Save_Warnings);
-- Package instance
@@ -13798,18 +13773,15 @@ package body Sem_Ch12 is
Instantiate_Package_Body
(Body_Info =>
- ((Inst_Node => Inst_Node,
- Act_Decl => True_Parent,
+ ((Act_Decl => True_Parent,
+ Config_Switches => Save_Config_Switches,
+ Current_Sem_Unit =>
+ Get_Code_Unit (Sloc (Inst_Node)),
Expander_Status => Exp_Status,
- Current_Sem_Unit => Get_Code_Unit
- (Sloc (Inst_Node)),
- Scope_Suppress => Scope_Suppress,
+ Inst_Node => Inst_Node,
Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
- Version => Ada_Version,
- Version_Pragma => Ada_Version_Pragma,
- Warnings => Save_Warnings,
- SPARK_Mode => SPARK_Mode,
- SPARK_Mode_Pragma => SPARK_Mode_Pragma)),
+ Scope_Suppress => Scope_Suppress,
+ Warnings => Save_Warnings)),
Body_Optional => Body_Optional);
end;
end if;
@@ -14405,7 +14377,7 @@ package body Sem_Ch12 is
Parent_Unit_Visible := Saved.Parent_Unit_Visible;
Instance_Parent_Unit := Saved.Instance_Parent_Unit;
- Restore_Opt_Config_Switches (Saved.Switches);
+ Restore_Config_Switches (Saved.Switches);
Instance_Envs.Decrement_Last;
end Restore_Env;
@@ -15980,11 +15952,10 @@ package body Sem_Ch12 is
Act_Unit : Entity_Id)
is
Saved_AE : constant Boolean := Assertions_Enabled;
+ Saved_CPL : constant Node_Id := Check_Policy_List;
+ Saved_DEC : constant Boolean := Dynamic_Elaboration_Checks;
Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
- -- Save the SPARK mode-related data because utilizing the configuration
- -- values of pragmas and switches will eliminate any previously set
- -- SPARK_Mode.
begin
-- Regardless of the current mode, predefined units are analyzed in the
@@ -15993,20 +15964,20 @@ package body Sem_Ch12 is
-- These are always analyzed in the current mode.
if In_Internal_Unit (Gen_Unit) then
- Set_Opt_Config_Switches (True, Current_Sem_Unit = Main_Unit);
- -- In Ada2012 we may want to enable assertions in an instance of a
- -- predefined unit, in which case we need to preserve the current
- -- setting for the Assertions_Enabled flag. This will become more
- -- critical when pre/postconditions are added to predefined units,
- -- as is already the case for some numeric libraries.
+ -- The following call resets all configuration attributes to default
+ -- or the xxx_Config versions of the attributes when the current sem
+ -- unit is the main unit. At the same time, internal units must also
+ -- inherit certain configuration attributes from their context. It
+ -- is unclear what these two sets are.
- if Ada_Version >= Ada_2012 then
- Assertions_Enabled := Saved_AE;
- end if;
+ Set_Config_Switches (True, Current_Sem_Unit = Main_Unit);
+
+ -- Reinstall relevant configuration attributes of the context
- -- Reinstall the SPARK_Mode which was in effect at the point of
- -- instantiation.
+ Assertions_Enabled := Saved_AE;
+ Check_Policy_List := Saved_CPL;
+ Dynamic_Elaboration_Checks := Saved_DEC;
Install_SPARK_Mode (Saved_SM, Saved_SMP);
end if;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/config_pragma1.adb
@@ -0,0 +1,21 @@
+-- { dg-do run }
+-- { dg-options "-gnata" }
+
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+with Config_Pragma1_Pkg; use Config_Pragma1_Pkg;
+
+procedure Config_Pragma1 is
+ Target : String10;
+
+begin
+ for I in Positive10 loop
+ Move
+ (Source => Positive10'Image(I),
+ Target => Target);
+
+ FHM.Include
+ (Container => FHMM,
+ Key => Target,
+ New_Item => I);
+ end loop;
+end Config_Pragma1;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/config_pragma1_pkg.ads
@@ -0,0 +1,21 @@
+pragma Assertion_Policy (Ignore);
+
+with Ada.Containers; use Ada.Containers;
+with Ada.Containers.Formal_Hashed_Maps;
+with Ada.Strings; use Ada.Strings;
+with Ada.Strings.Hash;
+
+package Config_Pragma1_Pkg is
+ subtype Positive10 is Positive range 1 .. 1000;
+ subtype String10 is String (Positive10);
+
+ package FHM is new Formal_Hashed_Maps
+ (Key_Type => String10,
+ Element_Type => Positive10,
+ Hash => Hash,
+ Equivalent_Keys => "=");
+
+ FHMM : FHM.Map
+ (Capacity => 1_000_000,
+ Modulus => FHM.Default_Modulus (Count_Type (1_000_000)));
+end Config_Pragma1_Pkg;