diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 45 | ||||
| -rw-r--r-- | gcc/ada/frontend.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/inline.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/opt.adb | 98 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 27 | ||||
| -rw-r--r-- | gcc/ada/par.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 151 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/config_pragma1.adb | 21 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/config_pragma1_pkg.ads | 21 |
12 files changed, 249 insertions, 194 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ae2ab5d..9fe7a3b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,48 @@ +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 diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 48a5d81..1af5587 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 0bda097..81f1e29 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 54f9123..1f12889 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 7e23d1d..fd45984 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 070dd6d..dd6c9b6 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 7fbf7bd..799d66d 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 357fbde..39ed046 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 98c646d..391d1e3 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 2c2f1e3..50cc08f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +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. diff --git a/gcc/testsuite/gnat.dg/config_pragma1.adb b/gcc/testsuite/gnat.dg/config_pragma1.adb new file mode 100644 index 0000000..bae42d2 --- /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 0000000..1715068 --- /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; |