From 9cc97ad523d17ce6ae643030e5f99fe5acb68bea Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 17 Jul 2018 08:11:28 +0000 Subject: [PATCH] [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. 2018-07-17 Hristian Kirtchev 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. From-SVN: r262794 --- gcc/ada/ChangeLog | 45 ++++++ gcc/ada/frontend.adb | 2 +- gcc/ada/inline.ads | 28 ++-- gcc/ada/opt.adb | 98 ++++++------ gcc/ada/opt.ads | 27 ++-- gcc/ada/par.adb | 26 ++-- gcc/ada/sem.adb | 8 +- gcc/ada/sem_ch10.adb | 12 +- gcc/ada/sem_ch12.adb | 151 ++++++++----------- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gnat.dg/config_pragma1.adb | 21 +++ gcc/testsuite/gnat.dg/config_pragma1_pkg.ads | 21 +++ 12 files changed, 249 insertions(+), 194 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/config_pragma1.adb create mode 100644 gcc/testsuite/gnat.dg/config_pragma1_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ae2ab5dfce6..9fe7a3b69d7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,48 @@ +2018-07-17 Hristian Kirtchev + + * 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 * gcc-interface/decl.c (gnat_to_gnu_entity) : Deal with diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 48a5d814922..1af5587110f 100644 --- a/gcc/ada/frontend.adb +++ b/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 diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index 0bda097d9f6..81f1e299353 100644 --- a/gcc/ada/inline.ads +++ b/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 ( diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 54f9123e975..1f128890bd9 100644 --- a/gcc/ada/opt.adb +++ b/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 -- diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 7e23d1dfb50..fd45984fb9e 100644 --- a/gcc/ada/opt.ads +++ b/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 -- ------------------------ diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 070dd6d89b9..dd6c9b6028d 100644 --- a/gcc/ada/par.adb +++ b/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; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 7fbf7bde1c8..799d66d78ea 100644 --- a/gcc/ada/sem.adb +++ b/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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 357fbde27b1..39ed04681aa 100644 --- a/gcc/ada/sem_ch10.adb +++ b/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; --------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 98c646d9a6b..391d1e3ae7c 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2c2f1e3684b..50cc08f4a95 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-07-17 Hristian Kirtchev + + * gnat.dg/config_pragma1.adb, gnat.dg/config_pragma1_pkg.ads: New testcase. + 2018-07-17 Ed Schonberg * gnat.dg/equal3.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/config_pragma1.adb b/gcc/testsuite/gnat.dg/config_pragma1.adb new file mode 100644 index 00000000000..bae42d298ef --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/config_pragma1_pkg.ads b/gcc/testsuite/gnat.dg/config_pragma1_pkg.ads new file mode 100644 index 00000000000..17150686b9c --- /dev/null +++ b/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; -- 2.30.2