From 9caf55e370f2346d393e141b8fb4c4e59afc32c9 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 6 Sep 2017 10:29:47 +0000 Subject: [PATCH] frontend.adb (Frontend): Skip -gnatec=gnat.adc switch, because we've already read gnat.adc by default. 2017-09-06 Bob Duff * frontend.adb (Frontend): Skip -gnatec=gnat.adc switch, because we've already read gnat.adc by default. 2017-09-06 Bob Duff * exp_ch5.adb (Get_Default_Iterator): Replace "Assert(False)" with "return Iter", because if an iterable type is derived from a noniterable one, then we won't find an overriding or inherited default iterator. From-SVN: r251774 --- gcc/ada/ChangeLog | 12 ++ gcc/ada/exp_ch5.adb | 22 +-- gcc/ada/frontend.adb | 396 ++++++++++++++++++++++--------------------- 3 files changed, 223 insertions(+), 207 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f7ec8616684..19d518ed906 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2017-09-06 Bob Duff + + * frontend.adb (Frontend): Skip -gnatec=gnat.adc + switch, because we've already read gnat.adc by default. + +2017-09-06 Bob Duff + + * exp_ch5.adb (Get_Default_Iterator): Replace + "Assert(False)" with "return Iter", because if an iterable + type is derived from a noniterable one, then we won't find an + overriding or inherited default iterator. + 2017-09-06 Yannick Moy * sem_warn.adb (Warn_On_Suspicious_Index): Improve warning when the diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c30307415fa..63cc4592967 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3934,9 +3934,9 @@ package body Exp_Ch5 is function Get_Default_Iterator (T : Entity_Id) return Entity_Id; - -- If the container is a derived type, the aspect holds the parent - -- operation. The required one is a primitive of the derived type - -- and is either inherited or overridden. Also sets Container_Arg. + -- Return the default iterator for a specific type. If the type is + -- derived, we return the inherited or overridden one if + -- appropriate. -------------------------- -- Get_Default_Iterator -- @@ -3953,11 +3953,11 @@ package body Exp_Ch5 is begin Container_Arg := New_Copy_Tree (Container); - -- A previous version of GNAT allowed indexing aspects to - -- be redefined on derived container types, while the - -- default iterator was inherited from the parent type. - -- This non-standard extension is preserved temporarily for - -- use by the modelling project under debug flag d.X. + -- A previous version of GNAT allowed indexing aspects to be + -- redefined on derived container types, while the default + -- iterator was inherited from the parent type. This + -- nonstandard extension is preserved for use by the + -- modelling project under debug flag -gnatd.X. if Debug_Flag_Dot_XX then if Base_Type (Etype (Container)) /= @@ -3995,9 +3995,11 @@ package body Exp_Ch5 is Next_Elmt (Prim); end loop; - -- Default iterator must exist + -- If we didn't find it, then our parent type is not + -- iterable, so we return the Default_Iterator aspect of + -- this type. - pragma Assert (False); + return Iter; -- Otherwise not a derived type diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 612f55484fb..461c04bcc73 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -68,9 +68,6 @@ with Tbuild; use Tbuild; with Types; use Types; procedure Frontend is - Config_Pragmas : List_Id; - -- Gather configuration pragmas - begin -- Carry out package initializations. These are initializations which might -- logically be performed at elaboration time, were it not for the fact @@ -136,6 +133,12 @@ begin -- Read and process configuration pragma files if present declare + Config_Pragmas : List_Id := Empty_List; + -- Gather configuration pragmas + + Gnat_Adc : constant File_Name_Type := Name_Find ("gnat.adc"); + Dot_Gnat_Adc : constant File_Name_Type := Name_Find ("./gnat.adc"); + Save_Style_Check : constant Boolean := Opt.Style_Check; -- Save style check mode so it can be restored later @@ -144,8 +147,6 @@ begin Prag : Node_Id; - Temp_File : Boolean; - begin -- We always analyze config files with style checks off, since we -- don't want a miscellaneous gnat.adc that is around to discombobulate @@ -162,9 +163,7 @@ begin -- First deal with gnat.adc file if Opt.Config_File then - Name_Buffer (1 .. 8) := "gnat.adc"; - Name_Len := 8; - Source_gnat_adc := Load_Config_File (Name_Enter); + Source_gnat_adc := Load_Config_File (Gnat_Adc); -- Case of gnat.adc file present @@ -175,20 +174,11 @@ begin Initialize_Scanner (No_Unit, Source_gnat_adc); Config_Pragmas := Par (Configuration_Pragmas => True); - -- We unconditionally add a compilation dependency for gnat.adc - -- so that if it changes, we force a recompilation. This is a - -- fairly recent (2014-03-28) change. + -- We add a compilation dependency for gnat.adc so that if it + -- changes, we force a recompilation. Prepcomp.Add_Dependency (Source_gnat_adc); - - -- Case of no gnat.adc file present - - else - Config_Pragmas := Empty_List; end if; - - else - Config_Pragmas := Empty_List; end if; -- Now deal with specified config pragmas files if there are any @@ -198,42 +188,50 @@ begin -- Loop through config pragmas files for Index in Opt.Config_File_Names'Range loop - - -- See if extension is .TMP/.tmp indicating a temporary config - -- file (which we ignore from the dependency point of view). - - Name_Len := Config_File_Names (Index)'Length; - Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all; - Temp_File := - Name_Len > 4 - and then - (Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP" + declare + Len : constant Natural := Config_File_Names (Index)'Length; + Str : constant String (1 .. Len) := + Config_File_Names (Index).all; + Config_Name : constant File_Name_Type := Name_Find (Str); + Temp_File : constant Boolean := Len > 4 + and then + (Str (Len - 3 .. Len) = ".TMP" or else - Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp"); + Str (Len - 3 .. Len) = ".tmp"); + -- Extension indicating a temporary config file? - -- Load the file, error if we did not find it + begin + -- Skip it if it's the default name, already loaded above. + -- Otherwise, we get confusing warning messages about + -- seeing the same thing twice. - Source_Config_File := Load_Config_File (Name_Enter); + if Config_Name /= Gnat_Adc + and then Config_Name /= Dot_Gnat_Adc + then + -- Load the file, error if we did not find it - if Source_Config_File = No_Source_File then - Osint.Fail - ("cannot find configuration pragmas file " - & Config_File_Names (Index).all); + Source_Config_File := Load_Config_File (Config_Name); - -- If we did find the file, and it is not a temporary file, then - -- we unconditionally add a compilation dependency for it so - -- that if it changes, we force a recompilation. This is a - -- fairly recent (2014-03-28) change. + if Source_Config_File = No_Source_File then + Osint.Fail + ("cannot find configuration pragmas file " + & Config_File_Names (Index).all); - elsif not Temp_File then - Prepcomp.Add_Dependency (Source_Config_File); - end if; + -- If we did find the file, and it is not a temporary file, + -- then we add a compilation dependency for it so that if it + -- changes, we force a recompilation. + + elsif not Temp_File then + Prepcomp.Add_Dependency (Source_Config_File); + end if; - -- Parse the config pragmas file, and accumulate results + -- Parse the config pragmas file, and accumulate results - Initialize_Scanner (No_Unit, Source_Config_File); - Append_List_To - (Config_Pragmas, Par (Configuration_Pragmas => True)); + Initialize_Scanner (No_Unit, Source_Config_File); + Append_List_To + (Config_Pragmas, Par (Configuration_Pragmas => True)); + end if; + end; end loop; end if; @@ -260,208 +258,212 @@ begin -- Capture any modifications to suppress options from config pragmas Opt.Suppress_Options := Scope_Suppress; - end; - - -- If a target dependency info file has been read through switch -gnateT=, - -- add it to the dependencies. - - if Target_Dependent_Info_Read_Name /= null then - declare - Index : Source_File_Index; - begin - Name_Len := 0; - Add_Str_To_Name_Buffer (Target_Dependent_Info_Read_Name.all); - Index := Load_Config_File (Name_Enter); - Prepcomp.Add_Dependency (Index); - end; - end if; - -- This is where we can capture the value of the compilation unit specific - -- restrictions that have been set by the config pragma files (or from - -- Targparm), for later restoration when processing e.g. subunits. + -- If a target dependency info file has been read through switch + -- -gnateT=, add it to the dependencies. + + if Target_Dependent_Info_Read_Name /= null then + declare + Index : Source_File_Index; + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (Target_Dependent_Info_Read_Name.all); + Index := Load_Config_File (Name_Enter); + Prepcomp.Add_Dependency (Index); + end; + end if; - Save_Config_Cunit_Boolean_Restrictions; + -- This is where we can capture the value of the compilation unit + -- specific restrictions that have been set by the config pragma + -- files (or from Targparm), for later restoration when processing + -- e.g. subunits. - -- If there was a -gnatem switch, initialize the mappings of unit names to - -- file names and of file names to path names from the mapping file. + Save_Config_Cunit_Boolean_Restrictions; - if Mapping_File_Name /= null then - Fmap.Initialize (Mapping_File_Name.all); - end if; + -- If there was a -gnatem switch, initialize the mappings of unit names + -- to file names and of file names to path names from the mapping file. - -- Adjust Optimize_Alignment mode from debug switches if necessary + if Mapping_File_Name /= null then + Fmap.Initialize (Mapping_File_Name.all); + end if; - if Debug_Flag_Dot_SS then - Optimize_Alignment := 'S'; - elsif Debug_Flag_Dot_TT then - Optimize_Alignment := 'T'; - end if; + -- Adjust Optimize_Alignment mode from debug switches if necessary - -- We have now processed the command line switches, and the configuration - -- pragma files, so this is the point at which we want to capture the - -- values of the configuration switches (see Opt for further details). + if Debug_Flag_Dot_SS then + Optimize_Alignment := 'S'; + elsif Debug_Flag_Dot_TT then + Optimize_Alignment := 'T'; + end if; - Opt.Register_Opt_Config_Switches; + -- We have now processed the command line switches, and the + -- configuration pragma files, so this is the point at which we want to + -- capture the values of the configuration switches (see Opt for further + -- details). - -- Check for file which contains No_Body pragma + Opt.Register_Opt_Config_Switches; - if Source_File_Is_No_Body (Source_Index (Main_Unit)) then - Change_Main_Unit_To_Spec; - end if; + -- Check for file which contains No_Body pragma - -- Initialize the scanner. Note that we do this after the call to - -- Create_Standard, which uses the scanner in its processing of - -- floating-point bounds. - - Initialize_Scanner (Main_Unit, Source_Index (Main_Unit)); + if Source_File_Is_No_Body (Source_Index (Main_Unit)) then + Change_Main_Unit_To_Spec; + end if; - -- Here we call the parser to parse the compilation unit (or units in - -- the check syntax mode, but in that case we won't go on to the - -- semantics in any case). + -- Initialize the scanner. Note that we do this after the call to + -- Create_Standard, which uses the scanner in its processing of + -- floating-point bounds. - Discard_List (Par (Configuration_Pragmas => False)); - Parsing_Main_Extended_Source := False; + Initialize_Scanner (Main_Unit, Source_Index (Main_Unit)); - -- The main unit is now loaded, and subunits of it can be loaded, - -- without reporting spurious loading circularities. + -- Here we call the parser to parse the compilation unit (or units in + -- the check syntax mode, but in that case we won't go on to the + -- semantics in any case). - Set_Loading (Main_Unit, False); + Discard_List (Par (Configuration_Pragmas => False)); + Parsing_Main_Extended_Source := False; - -- Now that the main unit is installed, we can complete the analysis - -- of the pragmas in gnat.adc and the configuration file, that require - -- a context for their semantic processing. + -- The main unit is now loaded, and subunits of it can be loaded, + -- without reporting spurious loading circularities. - if Config_Pragmas /= Error_List - and then Operating_Mode /= Check_Syntax + Set_Loading (Main_Unit, False); - -- Do not attempt to process deferred configuration pragmas if the main - -- unit failed to load, to avoid cascaded inconsistencies that can lead - -- to a compiler crash. + -- Now that the main unit is installed, we can complete the analysis + -- of the pragmas in gnat.adc and the configuration file, that require + -- a context for their semantic processing. - and then Fatal_Error (Main_Unit) /= Error_Detected - then - -- Pragmas that require some semantic activity, such as Interrupt_State, - -- cannot be processed until the main unit is installed, because they - -- require a compilation unit on which to attach with_clauses, etc. So - -- analyze them now. + if Config_Pragmas /= Error_List + and then Operating_Mode /= Check_Syntax - declare - Prag : Node_Id; + -- Do not attempt to process deferred configuration pragmas if the + -- main unit failed to load, to avoid cascaded inconsistencies that + -- can lead to a compiler crash. - begin - Prag := First (Config_Pragmas); - while Present (Prag) loop + and then Fatal_Error (Main_Unit) /= Error_Detected + then + -- Pragmas that require some semantic activity, such as + -- Interrupt_State, cannot be processed until the main unit is + -- installed, because they require a compilation unit on which to + -- attach with_clauses, etc. So analyze them now. + + declare + Prag : Node_Id; + + begin + Prag := First (Config_Pragmas); + while Present (Prag) loop + + -- Guard against the case where a configuration pragma may be + -- split into multiple pragmas and the original rewritten as a + -- null statement. + + if Nkind (Prag) = N_Pragma + and then Delay_Config_Pragma_Analyze (Prag) + then + Analyze_Pragma (Prag); + end if; + + Next (Prag); + end loop; + end; + end if; - -- Guard against the case where a configuration pragma may be - -- split into multiple pragmas and the original rewritten as a - -- null statement. + -- If we have restriction No_Exception_Propagation, and we did not have + -- an explicit switch turning off Warn_On_Non_Local_Exception, then turn + -- on this warning by default if we have encountered an exception + -- handler. - if Nkind (Prag) = N_Pragma - and then Delay_Config_Pragma_Analyze (Prag) - then - Analyze_Pragma (Prag); - end if; + if Restriction_Check_Required (No_Exception_Propagation) + and then not No_Warn_On_Non_Local_Exception + and then Exception_Handler_Encountered + then + Warn_On_Non_Local_Exception := True; + end if; - Next (Prag); - end loop; - end; - end if; + -- Now on to the semantics. Skip if in syntax only mode - -- If we have restriction No_Exception_Propagation, and we did not have an - -- explicit switch turning off Warn_On_Non_Local_Exception, then turn on - -- this warning by default if we have encountered an exception handler. + if Operating_Mode /= Check_Syntax then - if Restriction_Check_Required (No_Exception_Propagation) - and then not No_Warn_On_Non_Local_Exception - and then Exception_Handler_Encountered - then - Warn_On_Non_Local_Exception := True; - end if; + -- Install the configuration pragmas in the tree - -- Now on to the semantics. Skip if in syntax only mode + Set_Config_Pragmas + (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas); - if Operating_Mode /= Check_Syntax then + -- Following steps are skipped if we had a fatal error during parsing - -- Install the configuration pragmas in the tree + if Fatal_Error (Main_Unit) /= Error_Detected then - Set_Config_Pragmas (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas); + -- Reset Operating_Mode to Check_Semantics for subunits. We cannot + -- actually generate code for subunits, so we suppress expansion. + -- This also corrects certain problems that occur if we try to + -- incorporate subunits at a lower level. - -- Following steps are skipped if we had a fatal error during parsing + if Operating_Mode = Generate_Code + and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit + then + Operating_Mode := Check_Semantics; + end if; - if Fatal_Error (Main_Unit) /= Error_Detected then + -- Analyze (and possibly expand) main unit - -- Reset Operating_Mode to Check_Semantics for subunits. We cannot - -- actually generate code for subunits, so we suppress expansion. - -- This also corrects certain problems that occur if we try to - -- incorporate subunits at a lower level. + Scope_Suppress := Suppress_Options; + Semantics (Cunit (Main_Unit)); - if Operating_Mode = Generate_Code - and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit - then - Operating_Mode := Check_Semantics; - end if; + -- Cleanup processing after completing main analysis - -- Analyze (and possibly expand) main unit + -- Comment needed for ASIS mode test and GNATprove mode test??? - Scope_Suppress := Suppress_Options; - Semantics (Cunit (Main_Unit)); + pragma Assert + (Operating_Mode = Generate_Code + or else Operating_Mode = Check_Semantics); - -- Cleanup processing after completing main analysis + if Operating_Mode = Generate_Code + or else (ASIS_Mode or GNATprove_Mode) + then + Instantiate_Bodies; + end if; - -- Comment needed for ASIS mode test and GNATprove mode test??? + -- Analyze inlined bodies and check elaboration rules in GNATprove + -- mode as well as during compilation. - pragma Assert - (Operating_Mode = Generate_Code - or else Operating_Mode = Check_Semantics); + if Operating_Mode = Generate_Code or else GNATprove_Mode then + if Inline_Processing_Required then + Analyze_Inlined_Bodies; + end if; - if Operating_Mode = Generate_Code - or else (ASIS_Mode or GNATprove_Mode) - then - Instantiate_Bodies; - end if; + -- Remove entities from program that do not have any execution + -- time references. - -- Analyze inlined bodies and check elaboration rules in GNATprove - -- mode as well as during compilation. + if Debug_Flag_UU then + Collect_Garbage_Entities; + end if; - if Operating_Mode = Generate_Code or else GNATprove_Mode then - if Inline_Processing_Required then - Analyze_Inlined_Bodies; - end if; + Check_Elab_Calls; - -- Remove entities from program that do not have any execution - -- time references. + -- Remove any ignored Ghost code as it must not appear in the + -- executable. - if Debug_Flag_UU then - Collect_Garbage_Entities; + Remove_Ignored_Ghost_Code; end if; - Check_Elab_Calls; + -- At this stage we can unnest subprogram bodies if required - -- Remove any ignored Ghost code as it must not appear in the - -- executable. + Exp_Unst.Unnest_Subprograms (Cunit (Main_Unit)); - Remove_Ignored_Ghost_Code; - end if; + -- List library units if requested - -- At this stage we can unnest subprogram bodies if required - - Exp_Unst.Unnest_Subprograms (Cunit (Main_Unit)); + if List_Units then + Lib.List; + end if; - -- List library units if requested + -- Output waiting warning messages - if List_Units then - Lib.List; + Lib.Xref.Process_Deferred_References; + Sem_Warn.Output_Non_Modified_In_Out_Warnings; + Sem_Warn.Output_Unreferenced_Messages; + Sem_Warn.Check_Unused_Withs; + Sem_Warn.Output_Unused_Warnings_Off_Warnings; end if; - - -- Output waiting warning messages - - Lib.Xref.Process_Deferred_References; - Sem_Warn.Output_Non_Modified_In_Out_Warnings; - Sem_Warn.Output_Unreferenced_Messages; - Sem_Warn.Check_Unused_Withs; - Sem_Warn.Output_Unused_Warnings_Off_Warnings; end if; - end if; + end; -- Qualify all entity names in inner packages, package bodies, etc -- 2.30.2