+2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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.
+
2018-07-17 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Deal with
-- 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
-- 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
-- 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 (
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;
-- 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;
-- 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
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;
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 --
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
-- 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 --
------------------------
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 --
--------------------
-- 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
-- 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);
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
-- 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;
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.
-- 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);
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
-- 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
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;
-- 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);
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;
-- 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.
Analyze_Subprogram_Body (N);
Analyze_Proper_Body (N, Empty);
- Restore_Opt_Config_Switches (Opts);
+ Restore_Config_Switches (Opts);
end Analyze_Subprogram_Body_Stub;
---------------------
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;
----------------------------------
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;
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;
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;
-- 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);
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
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
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
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;
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;
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
-- 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;
+2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * gnat.dg/config_pragma1.adb, gnat.dg/config_pragma1_pkg.ads: New testcase.
+
2018-07-17 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/equal3.adb: New testcase.
--- /dev/null
+-- { 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
+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;
projects / thirdparty / gcc.git / commitdiff
