diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 161 | ||||
| -rw-r--r-- | gcc/ada/makeutl.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 52 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 156 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 120 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 8 |
12 files changed, 306 insertions, 294 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 423c1743417..f71dfc16f7a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2011-09-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch5.adb (Analyze_Iterator_Specification): If the domain + of iteration is an expression, its value must be captured in a + renaming declaration, so that modification of the elements is + propagated to the original container. + +2011-09-02 Pascal Obry <obry@adacore.com> + + * prj-proc.adb, prj.adb, makeutl.adb, makeutl.ads, prj-dect.adb, + prj-nmsc.adb, prj-util.adb, prj-conf.adb, prj-env.adb, + prj-tree.adb: Minor reformatting and style fixes. + 2011-09-02 Robert Dewar <dewar@adacore.com> * s-rident.ads: Add new restriction No_Implicit_Aliasing diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 848db592a1a..cfca418595e 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -850,9 +850,7 @@ package body Makeutl is Allow_Wildcards => True); end if; - if Value = Nil_Variable_Value - and then Test_Without_Suffix - then + if Value = Nil_Variable_Value and then Test_Without_Suffix then Lang := Get_Language_From_Name (Project, Get_Name_String (Source_Lang)); @@ -872,8 +870,8 @@ package body Makeutl is Name (1 .. Last) := SF_Name; if Last > Body_Suffix'Length - and then Name (Last - Body_Suffix'Length + 1 .. Last) = - Body_Suffix + and then + Name (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix then Truncated := True; Last := Last - Body_Suffix'Length; @@ -881,8 +879,8 @@ package body Makeutl is if not Truncated and then Last > Spec_Suffix'Length - and then Name (Last - Spec_Suffix'Length + 1 .. Last) = - Spec_Suffix + and then + Name (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix then Truncated := True; Last := Last - Spec_Suffix'Length; @@ -900,9 +898,7 @@ package body Makeutl is Allow_Wildcards => True); end if; - if Value = Nil_Variable_Value - and then Check_ALI_Suffix - then + if Value = Nil_Variable_Value and then Check_ALI_Suffix then Last := SF_Name'Length; while Name (Last) /= '.' loop Last := Last - 1; @@ -994,9 +990,12 @@ package body Makeutl is ------------------------------ procedure Initialize_Source_Record (Source : Prj.Source_Id) is + procedure Set_Object_Project - (Obj_Dir : String; Obj_Proj : Project_Id; Obj_Path : Path_Name_Type; - Stamp : Time_Stamp_Type); + (Obj_Dir : String; + Obj_Proj : Project_Id; + Obj_Path : Path_Name_Type; + Stamp : Time_Stamp_Type); -- Update information about object file, switches file,... ------------------------ @@ -1004,8 +1003,10 @@ package body Makeutl is ------------------------ procedure Set_Object_Project - (Obj_Dir : String; Obj_Proj : Project_Id; Obj_Path : Path_Name_Type; - Stamp : Time_Stamp_Type) is + (Obj_Dir : String; + Obj_Proj : Project_Id; + Obj_Path : Path_Name_Type; + Stamp : Time_Stamp_Type) is begin Source.Object_Project := Obj_Proj; Source.Object_Path := Obj_Path; @@ -1031,10 +1032,11 @@ package body Makeutl is declare Switches_Path : constant String := - Normalize_Pathname - (Name => Get_Name_String (Source.Switches), - Resolve_Links => Opt.Follow_Links_For_Files, - Directory => Obj_Dir); + Normalize_Pathname + (Name => + Get_Name_String (Source.Switches), + Resolve_Links => Opt.Follow_Links_For_Files, + Directory => Obj_Dir); begin Source.Switches_Path := Create_Name (Switches_Path); @@ -1093,21 +1095,22 @@ package body Makeutl is -- elsewhere that's where we'll expect to find it). Obj_Proj := Source.Project; + while Obj_Proj /= No_Project loop declare - Dir : constant String := Get_Name_String - (Obj_Proj.Object_Directory.Display_Name); + Dir : constant String := + Get_Name_String + (Obj_Proj.Object_Directory.Display_Name); - Object_Path : constant String := - Normalize_Pathname - (Name => - Get_Name_String (Source.Object), - Resolve_Links => - Opt.Follow_Links_For_Files, - Directory => Dir); + Object_Path : constant String := + Normalize_Pathname + (Name => + Get_Name_String (Source.Object), + Resolve_Links => Opt.Follow_Links_For_Files, + Directory => Dir); Obj_Path : constant Path_Name_Type := Create_Name (Object_Path); - Stamp : Time_Stamp_Type := Empty_Time_Stamp; + Stamp : Time_Stamp_Type := Empty_Time_Stamp; begin -- For specs, we do not check object files if there is a body. @@ -1286,10 +1289,10 @@ package body Makeutl is for Index in reverse 1 .. Linker_Opts.Last loop declare - Options : String_List_Id; - Proj : constant Project_Id := - Linker_Opts.Table (Index).Project; - Option : Name_Id; + Options : String_List_Id; + Proj : constant Project_Id := + Linker_Opts.Table (Index).Project; + Option : Name_Id; Dir_Path : constant String := Get_Name_String (Proj.Directory.Name); @@ -1397,12 +1400,12 @@ package body Makeutl is procedure Add_Multi_Unit_Sources (Tree : Project_Tree_Ref; Source : Prj.Source_Id); - -- Add all units from the same file as the multi-unit Source. + -- Add all units from the same file as the multi-unit Source function Find_File_Add_Extension - (Tree : Project_Tree_Ref; - Base_Main : String) return Prj.Source_Id; - -- Search for Main in the project, adding body or spec extensions. + (Tree : Project_Tree_Ref; + Base_Main : String) return Prj.Source_Id; + -- Search for Main in the project, adding body or spec extensions ---------------------------- -- Add_Multi_Unit_Sources -- @@ -1455,8 +1458,8 @@ package body Makeutl is ----------------------------- function Find_File_Add_Extension - (Tree : Project_Tree_Ref; - Base_Main : String) return Prj.Source_Id + (Tree : Project_Tree_Ref; + Base_Main : String) return Prj.Source_Id is Spec_Source : Prj.Source_Id := No_Source; Source : Prj.Source_Id; @@ -1464,7 +1467,7 @@ package body Makeutl is Suffix : File_Name_Type; begin - Source := No_Source; + Source := No_Source; Iter := For_Each_Source (Tree); -- In all projects loop Source := Prj.Element (Iter); @@ -1611,10 +1614,10 @@ package body Makeutl is -- check later that we found the correct file. Source := Find_Source - (In_Tree => File.Tree, - Project => File.Project, - Base_Name => Main_Id, - Index => File.Index, + (In_Tree => File.Tree, + Project => File.Project, + Base_Name => Main_Id, + Index => File.Index, In_Imported_Only => True); if Source = No_Source then @@ -1624,8 +1627,8 @@ package body Makeutl is if Is_Absolute and then Source /= No_Source - and then File_Name_Type (Source.Path.Name) /= - File.File + and then + File_Name_Type (Source.Path.Name) /= File.File then Debug_Output ("Found a non-matching file", @@ -2192,7 +2195,7 @@ package body Makeutl is -- processed, if it hasn't already been processed. function Insert_No_Roots (Source : Source_Info) return Boolean; - -- Insert Source, but do not look for its roots (see doc for Insert). + -- Insert Source, but do not look for its roots (see doc for Insert) ------------------- -- Was_Processed -- @@ -2506,6 +2509,7 @@ package body Makeutl is if Roots = Nil_Variable_Value then Debug_Output (" -> no roots declared"); + else List := Roots.Values; @@ -2596,7 +2600,7 @@ package body Makeutl is Initialize_Source_Record (Other_Part (Root_Source)); end if; - -- Save the root for the binder. + -- Save the root for the binder Source.Id.Roots := new Source_Roots' (Root => Root_Source, @@ -2745,6 +2749,11 @@ package body Makeutl is Unique_Compile : Boolean) is procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref); + + --------------- + -- Do_Insert -- + --------------- + procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is Unit_Based : constant Boolean := Unique_Compile @@ -2775,7 +2784,7 @@ package body Makeutl is if Is_Compilable (Source) and then (All_Projects - or else Is_Extending (Project, Source.Project)) + or else Is_Extending (Project, Source.Project)) and then not Source.Locally_Removed and then Source.Replaced_By = No_Source and then @@ -2855,25 +2864,25 @@ package body Makeutl is and then Src_Id.Dep_Name = Afile then case Src_Id.Kind is - when Spec => - declare - Bdy : constant Prj.Source_Id := - Other_Part (Src_Id); - begin - if Bdy /= No_Source - and then not Bdy.Locally_Removed - then - Src_Id := Other_Part (Src_Id); + when Spec => + declare + Bdy : constant Prj.Source_Id := + Other_Part (Src_Id); + begin + if Bdy /= No_Source + and then not Bdy.Locally_Removed + then + Src_Id := Other_Part (Src_Id); + end if; + end; + + when Impl => + if Is_Subunit (Src_Id) then + Src_Id := No_Source; end if; - end; - when Impl => - if Is_Subunit (Src_Id) then + when Sep => Src_Id := No_Source; - end if; - - when Sep => - Src_Id := No_Source; end case; exit; @@ -2899,6 +2908,7 @@ package body Makeutl is end loop; end loop; end Insert_Withed_Sources_For; + end Queue; ---------- @@ -2948,6 +2958,10 @@ package body Makeutl is is procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref); + ---------------- + -- Do_Compute -- + ---------------- + procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is Data : constant Builder_Data_Access := Builder_Data (Tree); All_Phases : constant Boolean := @@ -3008,8 +3022,8 @@ package body Makeutl is Only_For_Lang : Name_Id := No_Name) is Builder_Package : constant Package_Id := - Value_Of (Name_Builder, Main_Project.Decl.Packages, - Project_Tree.Shared); + Value_Of (Name_Builder, Main_Project.Decl.Packages, + Project_Tree.Shared); Global_Compilation_Array : Array_Element_Id; Global_Compilation_Elem : Array_Element; @@ -3029,7 +3043,7 @@ package body Makeutl is Switches_For_Lang : Variable_Value := Nil_Variable_Value; -- Value of Builder'Default_Switches(lang) - Name : Name_Id := No_Name; -- main file index for Switches + Name : Name_Id := No_Name; -- main file index for Switches Switches_For_Main : Variable_Value := Nil_Variable_Value; -- Switches for a specific main. When there are several mains, Name is -- set to No_Name, and Switches_For_Main might be left with an actual @@ -3052,7 +3066,6 @@ package body Makeutl is -- use this language as the switches index. if Mains.Number_Of_Mains (Project_Tree) = 0 then - if Only_For_Lang = No_Name then declare Language : Language_Ptr := Main_Project.Languages; @@ -3079,8 +3092,8 @@ package body Makeutl is else for Index in 1 .. Mains.Number_Of_Mains (Project_Tree) loop Source := Mains.Next_Main.Source; - if Source /= No_Source then + if Source /= No_Source then if Switches_For_Main = Nil_Variable_Value then Switches_For_Main := Value_Of (Name => Name_Id (Source.File), @@ -3130,9 +3143,10 @@ package body Makeutl is Default_Switches_Array := Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays; - while Default_Switches_Array /= No_Array and then - Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /= - Name_Default_Switches + while Default_Switches_Array /= No_Array + and then + Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /= + Name_Default_Switches loop Default_Switches_Array := Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Next; @@ -3243,8 +3257,7 @@ package body Makeutl is declare -- Add_Switch might itself be using the name_buffer, so -- we make a temporary here. - Switch : constant String := - Name_Buffer (1 .. Name_Len); + Switch : constant String := Name_Buffer (1 .. Name_Len); begin Success := Add_Switch (Switch => Switch, diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index ceb38bdf39f..8aec8b22c7e 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -336,7 +336,7 @@ package Makeutl is Need_Compilation : Boolean := True; Need_Binding : Boolean := True; Need_Linking : Boolean := True; - -- Which of the compilation phases are needed for this project tree. + -- Which of the compilation phases are needed for this project tree end record; type Builder_Data_Access is access all Builder_Project_Tree_Data; @@ -459,10 +459,10 @@ package Makeutl is Id : Source_Id := null; when Format_Gnatmake => - File : File_Name_Type := No_File; - Unit : Unit_Name_Type := No_Unit_Name; - Index : Int := 0; - Project : Project_Id := No_Project; + File : File_Name_Type := No_File; + Unit : Unit_Name_Type := No_Unit_Name; + Index : Int := 0; + Project : Project_Id := No_Project; end case; end record; -- Information about files stored in the queue. The exact information @@ -473,7 +473,7 @@ package Makeutl is procedure Initialize (Queue_Per_Obj_Dir : Boolean; - Force : Boolean := False); + Force : Boolean := False); -- Initialize the queue. -- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch: -- when True, there cannot be simultaneous compilations with the object diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index ae1d0c6ed7a..a1291222777 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -508,9 +508,9 @@ package body Prj.Conf is else Add_Attributes - (Project_Tree => Project_Tree, - Conf_Decl => Conf_Pack.Decl, - User_Decl => + (Project_Tree => Project_Tree, + Conf_Decl => Conf_Pack.Decl, + User_Decl => Shared.Packages.Table (User_Pack_Id).Decl); end if; @@ -532,8 +532,7 @@ package body Prj.Conf is ("Recursively apply config to aggregated tree", List.Project.Name); Apply_Config_File - (Config_File, - Project_Tree => List.Tree); + (Config_File, Project_Tree => List.Tree); List := List.Next; end loop; end; @@ -1132,8 +1131,7 @@ package body Prj.Conf is if Config_File_Name = "" then if Obj_Dir_Exists then - Args (3) := - new String'(Obj_Dir & Directory_Separator & Auto_Cgpr); + Args (3) := new String'(Obj_Dir & Auto_Cgpr); else declare @@ -1154,9 +1152,7 @@ package body Prj.Conf is else -- We'll have an error message later on - Args (3) := - new String' - (Obj_Dir & Directory_Separator & Auto_Cgpr); + Args (3) := new String'(Obj_Dir & Auto_Cgpr); end if; end; end if; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 8f0ca61af86..e023befa405 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -23,11 +23,11 @@ -- -- ------------------------------------------------------------------------------ -with Err_Vars; use Err_Vars; - with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; +with GNAT.Strings; +with Err_Vars; use Err_Vars; with Opt; use Opt; with Prj.Attr; use Prj.Attr; with Prj.Attr.PM; use Prj.Attr.PM; @@ -37,8 +37,6 @@ with Prj.Tree; use Prj.Tree; with Snames; with Uintp; use Uintp; -with GNAT.Strings; - package body Prj.Dect is use GNAT; @@ -58,10 +56,10 @@ package body Prj.Dect is -- new name, so that the code does not have to check both names forever. procedure Check_Attribute_Allowed - (In_Tree : Project_Node_Tree_Ref; - Project : Project_Node_Id; - Attribute : Project_Node_Id; - Flags : Processing_Flags); + (In_Tree : Project_Node_Tree_Ref; + Project : Project_Node_Id; + Attribute : Project_Node_Id; + Flags : Processing_Flags); -- Check whether the attribute is valid in this project. -- In particular, depending on the type of project (qualifier), some -- attributes might be disabled. @@ -186,20 +184,20 @@ package body Prj.Dect is and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored then case Name_Of (Attribute, In_Tree) is - when Snames.Name_Specification => - Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec); + when Snames.Name_Specification => + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec); - when Snames.Name_Specification_Suffix => - Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix); + when Snames.Name_Specification_Suffix => + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix); - when Snames.Name_Implementation => - Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body); + when Snames.Name_Implementation => + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body); - when Snames.Name_Implementation_Suffix => - Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix); + when Snames.Name_Implementation_Suffix => + Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix); - when others => - null; + when others => + null; end case; end if; end Rename_Obsolescent_Attributes; @@ -234,10 +232,10 @@ package body Prj.Dect is ----------------------------- procedure Check_Attribute_Allowed - (In_Tree : Project_Node_Tree_Ref; - Project : Project_Node_Id; - Attribute : Project_Node_Id; - Flags : Processing_Flags) + (In_Tree : Project_Node_Tree_Ref; + Project : Project_Node_Id; + Attribute : Project_Node_Id; + Flags : Processing_Flags) is Qualif : constant Project_Qualifier := Project_Qualifier_Of (Project, In_Tree); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 6cca2e22cc5..734ef49b12b 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -272,15 +272,15 @@ package body Prj.Env is begin -- Check if the directory is already in the table - for Index in Object_Path_Table.First .. - Object_Path_Table.Last (Object_Paths) + for Index in + Object_Path_Table.First .. Object_Path_Table.Last (Object_Paths) loop -- If it is, remove it, and add it as the last one if Object_Paths.Table (Index) = Object_Dir then - for Index2 in Index + 1 .. - Object_Path_Table.Last (Object_Paths) + for Index2 in + Index + 1 .. Object_Path_Table.Last (Object_Paths) loop Object_Paths.Table (Index2 - 1) := Object_Paths.Table (Index2); end loop; @@ -422,8 +422,8 @@ package body Prj.Env is -- Check if the source directory is already in the table - for Index in Source_Path_Table.First .. - Source_Path_Table.Last (Source_Paths) + for Index in + Source_Path_Table.First .. Source_Path_Table.Last (Source_Paths) loop -- If it is already, no need to add it @@ -458,6 +458,7 @@ package body Prj.Env is Table_Low_Bound => 1, Table_Initial => 5, Table_Increment => 100); + Default_Naming : constant Naming_Id := Naming_Table.First; Namings : Naming_Table.Instance; -- Table storing the naming data for gnatmake/gprmake @@ -779,7 +780,7 @@ package body Prj.Env is is File : File_Descriptor := Invalid_FD; - Buffer : String_Access := new String (1 .. Buffer_Initial); + Buffer : String_Access := new String (1 .. Buffer_Initial); Buffer_Last : Natural := 0; procedure Put_Name_Buffer; @@ -831,9 +832,8 @@ package body Prj.Env is if Source.Replaced_By = No_Source and then Source.Path.Name /= No_Path - and then - (Source.Language.Config.Kind = File_Based - or else Source.Unit /= No_Unit_Index) + and then (Source.Language.Config.Kind = File_Based + or else Source.Unit /= No_Unit_Index) then if Source.Unit /= No_Unit_Index then @@ -999,12 +999,12 @@ package body Prj.Env is Main_Project_Only : Boolean := True; Full_Path : Boolean := False) return String is + + Lang : constant Language_Ptr := + Get_Language_From_Name (Project, "ada"); The_Project : Project_Id := Project; Original_Name : String := Name; - Lang : constant Language_Ptr := - Get_Language_From_Name (Project, "ada"); - Unit : Unit_Index; The_Original_Name : Name_Id; The_Spec_Name : Name_Id; @@ -1140,10 +1140,8 @@ package body Prj.Env is -- Check for spec if not Main_Project_Only - or else - (Unit.File_Names (Spec) /= null - and then Unit.File_Names (Spec).Project = - The_Project) + or else (Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Project = The_Project) then declare Current_Name : File_Name_Type; @@ -1670,7 +1668,7 @@ package body Prj.Env is -- For the object path, we make a distinction depending on -- Including_Libraries. - if Objects_Path and Including_Libraries then + if Objects_Path and then Including_Libraries then if Project.Objects_Path_File_With_Libs = No_Path then Object_Path_Table.Init (Object_Paths); Process_Object_Dirs := True; @@ -1690,7 +1688,7 @@ package body Prj.Env is -- If there is something to do, set Seen to False for all projects, -- then call the recursive procedure Add for Project. - if Process_Source_Dirs or Process_Object_Dirs then + if Process_Source_Dirs or else Process_Object_Dirs then For_All_Projects (Project, In_Tree, Dummy); end if; @@ -1701,8 +1699,8 @@ package body Prj.Env is if Source_FD /= Invalid_FD then Buffer_Last := 0; - for Index in Source_Path_Table.First .. - Source_Path_Table.Last (Source_Paths) + for Index in + Source_Path_Table.First .. Source_Path_Table.Last (Source_Paths) loop Get_Name_String (Source_Paths.Table (Index)); Name_Len := Name_Len + 1; @@ -1727,8 +1725,8 @@ package body Prj.Env is if Object_FD /= Invalid_FD then Buffer_Last := 0; - for Index in Object_Path_Table.First .. - Object_Path_Table.Last (Object_Paths) + for Index in + Object_Path_Table.First .. Object_Path_Table.Last (Object_Paths) loop Get_Name_String (Object_Paths.Table (Index)); Name_Len := Name_Len + 1; @@ -1752,9 +1750,10 @@ package body Prj.Env is -- Set the env vars, if they need to be changed, and set the -- corresponding flags. - if Include_Path and then - Shared.Private_Part.Current_Source_Path_File /= - Project.Include_Path_File + if Include_Path + and then + Shared.Private_Part.Current_Source_Path_File /= + Project.Include_Path_File then Shared.Private_Part.Current_Source_Path_File := Project.Include_Path_File; @@ -2268,7 +2267,6 @@ package body Prj.Env is end if; -- No need to copy the Cache, it will be recomputed as needed - end Copy; end Prj.Env; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 1a8c2114c47..7319ec90a0c 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -37,7 +37,7 @@ with Snames; use Snames; with Targparm; use Targparm; with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Directories; use Ada.Directories; +with Ada.Directories; use Ada, Ada.Directories; with Ada.Strings; use Ada.Strings; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; @@ -217,8 +217,8 @@ package body Prj.Nmsc is generic with procedure Callback - (Path : Path_Information; - Pattern_Index : Natural); + (Path : Path_Information; + Pattern_Index : Natural); procedure Expand_Subdirectory_Pattern (Project : Project_Id; Data : in out Tree_Processing_Data; @@ -392,8 +392,8 @@ package body Prj.Nmsc is -- the same value. procedure Get_Directories - (Project : Project_Id; - Data : in out Tree_Processing_Data); + (Project : Project_Id; + Data : in out Tree_Processing_Data); -- Get the object directory, the exec directory and the source directories -- of a project. @@ -636,11 +636,11 @@ package body Prj.Nmsc is Locally_Removed : Boolean := False; Location : Source_Ptr := No_Location) is - Config : constant Language_Config := Lang_Id.Config; - UData : Unit_Index; - Add_Src : Boolean; - Source : Source_Id; - Prev_Unit : Unit_Index := No_Unit_Index; + Config : constant Language_Config := Lang_Id.Config; + UData : Unit_Index; + Add_Src : Boolean; + Source : Source_Id; + Prev_Unit : Unit_Index := No_Unit_Index; Source_To_Replace : Source_Id := No_Source; begin @@ -665,9 +665,7 @@ package body Prj.Nmsc is Source := Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name); - if Source /= No_Source - and then Source.Index = Index - then + if Source /= No_Source and then Source.Index = Index then Add_Src := False; end if; end if; @@ -891,9 +889,10 @@ package body Prj.Nmsc is Remove_Source (Data.Tree, Source_To_Replace, Id); end if; - if Data.Tree.Replaced_Source_Number > 0 and then - Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /= - No_File + if Data.Tree.Replaced_Source_Number > 0 + and then + Replaced_Source_HTable.Get + (Data.Tree.Replaced_Sources, Id.File) /= No_File then Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File); Data.Tree.Replaced_Source_Number := @@ -1023,7 +1022,7 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is - Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; + Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; Prj_Data : Project_Processing_Data; begin @@ -1031,7 +1030,7 @@ package body Prj.Nmsc is Initialize (Prj_Data, Project); - Check_If_Externally_Built (Project, Data); + Check_If_Externally_Built (Project, Data); if Project.Qualifier /= Aggregate then Get_Directories (Project, Data); @@ -1043,8 +1042,8 @@ package body Prj.Nmsc is end if; case Project.Qualifier is - when Dry => Check_Abstract_Project (Project, Data); - when others => null; + when Dry => Check_Abstract_Project (Project, Data); + when others => null; end case; -- Check configuration. This must be done even for gnatmake (even though @@ -1125,8 +1124,8 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is - Shared : constant Shared_Project_Tree_Data_Access := - Data.Tree.Shared; + Shared : constant Shared_Project_Tree_Data_Access := + Data.Tree.Shared; Dot_Replacement : File_Name_Type := No_File; Casing : Casing_Type := All_Lower_Case; @@ -1418,8 +1417,9 @@ package body Prj.Nmsc is Lang_Index.Config.Compiler_Driver := File_Name_Type (Element.Value.Value); - when Name_Required_Switches | - Name_Leading_Required_Switches => + when Name_Required_Switches + | Name_Leading_Required_Switches + => Put (Into_List => Lang_Index.Config. Compiler_Leading_Required_Switches, @@ -2951,8 +2951,8 @@ package body Prj.Nmsc is if Project.Library_Name /= No_Name then if Current_Verbosity = High then - Write_Attr ("Library name: ", - Get_Name_String (Project.Library_Name)); + Write_Attr + ("Library name: ", Get_Name_String (Project.Library_Name)); end if; pragma Assert (Lib_Dir.Kind = Single); @@ -3096,7 +3096,7 @@ package body Prj.Nmsc is Project.Library := Project.Library_Dir /= No_Path_Information - and then Project.Library_Name /= No_Name; + and then Project.Library_Name /= No_Name; if Project.Extends = No_Project then case Project.Qualifier is @@ -5178,13 +5178,13 @@ package body Prj.Nmsc is No_Sources : constant Boolean := ((not Source_Files.Default - and then Source_Files.Values = Nil_String) - or else - (not Source_Dirs.Default - and then Source_Dirs.Values = Nil_String) - or else - (not Languages.Default - and then Languages.Values = Nil_String)) + and then Source_Files.Values = Nil_String) + or else + (not Source_Dirs.Default + and then Source_Dirs.Values = Nil_String) + or else + (not Languages.Default + and then Languages.Values = Nil_String)) and then Project.Extends = No_Project; -- Start of processing for Get_Directories @@ -5231,9 +5231,7 @@ package body Prj.Nmsc is Must_Exist => False, Externally_Built => Project.Externally_Built); - if not Dir_Exists - and then not Project.Externally_Built - then + if not Dir_Exists and then not Project.Externally_Built then -- The object directory does not exist, report an error if the -- project is not externally built. @@ -5273,7 +5271,7 @@ package body Prj.Nmsc is -- We set the object directory to its default - Project.Exec_Directory := Project.Object_Directory; + Project.Exec_Directory := Project.Object_Directory; if Exec_Dir.Value /= Empty_String then Get_Name_String (Exec_Dir.Value); @@ -5342,19 +5340,19 @@ package body Prj.Nmsc is Remove_Source_Dirs := False; Add_To_Or_Remove_From_Source_Dirs - (Path => (Name => Project.Directory.Name, - Display_Name => Project.Directory.Display_Name), - Rank => 1); + (Path => (Name => Project.Directory.Name, + Display_Name => Project.Directory.Display_Name), + Rank => 1); else Remove_Source_Dirs := False; Find_Source_Dirs - (Project => Project, - Data => Data, - Patterns => Source_Dirs.Values, - Ignore => Ignore_Source_Sub_Dirs.Values, - Search_For => Search_Directories, - Resolve_Links => Opt.Follow_Links_For_Dirs); + (Project => Project, + Data => Data, + Patterns => Source_Dirs.Values, + Ignore => Ignore_Source_Sub_Dirs.Values, + Search_For => Search_Directories, + Resolve_Links => Opt.Follow_Links_For_Dirs); if Project.Source_Dirs = Nil_String and then Project.Qualifier = Standard @@ -5371,12 +5369,12 @@ package body Prj.Nmsc is then Remove_Source_Dirs := True; Find_Source_Dirs - (Project => Project, - Data => Data, - Patterns => Excluded_Source_Dirs.Values, - Ignore => Nil_String, - Search_For => Search_Directories, - Resolve_Links => Opt.Follow_Links_For_Dirs); + (Project => Project, + Data => Data, + Patterns => Excluded_Source_Dirs.Values, + Ignore => Nil_String, + Search_For => Search_Directories, + Resolve_Links => Opt.Follow_Links_For_Dirs); end if; Debug_Output ("putting source directories in canonical cases"); @@ -6291,9 +6289,11 @@ package body Prj.Nmsc is declare Source_File_Path_Name : constant String := - Path_Name_Of - (File_Name_Type (Source_List_File.Value), - Project.Project.Directory.Display_Name); + Path_Name_Of + (File_Name_Type + (Source_List_File.Value), + Project.Project. + Directory.Display_Name); begin Has_Explicit_Sources := True; @@ -7254,6 +7254,7 @@ package body Prj.Nmsc is Source_Dir := Project.Project.Source_Dirs; Src_Dir_Rank := Project.Project.Source_Dir_Ranks; + while Source_Dir /= Nil_String loop begin Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank); @@ -7303,7 +7304,7 @@ package body Prj.Nmsc is if not Opt.Follow_Links_For_Files or else Is_Regular_File - (Display_Source_Directory & Name (1 .. Last)) + (Display_Source_Directory & Name (1 .. Last)) then Name_Len := Last; Name_Buffer (1 .. Name_Len) := Name (1 .. Last); @@ -7459,8 +7460,8 @@ package body Prj.Nmsc is if Source.Unit /= No_Unit_Index then declare Unit_Except : Unit_Exception := - Unit_Exceptions_Htable.Get - (Project.Unit_Exceptions, Source.Unit.Name); + Unit_Exceptions_Htable.Get + (Project.Unit_Exceptions, Source.Unit.Name); begin Unit_Except.Name := Source.Unit.Name; @@ -7516,7 +7517,7 @@ package body Prj.Nmsc is procedure Check_Missing_Sources is Extending : constant Boolean := - Project.Project.Extends /= No_Project; + Project.Project.Extends /= No_Project; Language : Language_Ptr; Source : Source_Id; Alt_Lang : Language_List; @@ -7787,8 +7788,8 @@ package body Prj.Nmsc is Id.Project := Project.Project; Lang_Id := Project.Project.Languages; - while Lang_Id /= No_Language_Index and then - Lang_Id.Name /= Src.Language + while Lang_Id /= No_Language_Index + and then Lang_Id.Name /= Src.Language loop Lang_Id := Lang_Id.Next; end loop; @@ -7802,9 +7803,9 @@ package body Prj.Nmsc is " in source info file"); end if; - Id.Language := Lang_Id; - Id.Kind := Src.Kind; - Id.Index := Src.Index; + Id.Language := Lang_Id; + Id.Kind := Src.Kind; + Id.Index := Src.Index; Id.Path := (Path_Name_Type (Src.Display_Path_Name), @@ -7812,8 +7813,7 @@ package body Prj.Nmsc is Name_Len := 0; Add_Str_To_Name_Buffer - (Ada.Directories.Simple_Name - (Get_Name_String (Src.Path_Name))); + (Directories.Simple_Name (Get_Name_String (Src.Path_Name))); Id.File := Name_Find; Id.Next_With_File_Name := @@ -7822,16 +7822,16 @@ package body Prj.Nmsc is Name_Len := 0; Add_Str_To_Name_Buffer - (Ada.Directories.Simple_Name + (Directories.Simple_Name (Get_Name_String (Src.Display_Path_Name))); Id.Display_File := Name_Find; - Id.Dep_Name := Dependency_Name - (Id.File, Id.Language.Config.Dependency_Kind); - Id.Naming_Exception := Src.Naming_Exception; - Id.Object := Object_Name - (Id.File, Id.Language.Config.Object_File_Suffix); - Id.Switches := Switches_Name (Id.File); + Id.Dep_Name := + Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind); + Id.Naming_Exception := Src.Naming_Exception; + Id.Object := + Object_Name (Id.File, Id.Language.Config.Object_File_Suffix); + Id.Switches := Switches_Name (Id.File); -- Add the source id to the Unit_Sources_HT hash table, if the -- unit name is not null. @@ -7840,7 +7840,8 @@ package body Prj.Nmsc is declare UData : Unit_Index := - Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name); + Units_Htable.Get + (Data.Tree.Units_HT, Src.Unit_Name); begin if UData = No_Unit_Index then UData := new Unit_Data; @@ -8014,9 +8015,8 @@ package body Prj.Nmsc is when Warning | Error => declare Msg : constant String := - "<there are no " & - Lang_Name & - " sources in this project"; + "<there are no " + & Lang_Name & " sources in this project"; begin Error_Msg_Warn := Data.Flags.When_No_Sources = Warning; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index b6049cc8936..b872d5aa838 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -462,9 +462,9 @@ package body Prj.Proc is ------------------------- function Get_Attribute_Index - (Tree : Project_Node_Tree_Ref; - Attr : Project_Node_Id; - Index : Name_Id) return Name_Id + (Tree : Project_Node_Tree_Ref; + Attr : Project_Node_Id; + Index : Name_Id) return Name_Id is begin if Index = All_Other_Names @@ -685,8 +685,8 @@ package body Prj.Proc is Index : Name_Id := No_Name; begin - if Present (Term_Project) and then - Term_Project /= From_Project_Node + if Present (Term_Project) + and then Term_Project /= From_Project_Node then -- This variable or attribute comes from another project @@ -1331,8 +1331,8 @@ package body Prj.Proc is -- Should never happen - Write_Line ("package """ & Get_Name_String (With_Name) & - """ not found"); + Write_Line + ("package """ & Get_Name_String (With_Name) & """ not found"); raise Program_Error; else @@ -1363,8 +1363,8 @@ package body Prj.Proc is Env => Env, Reset_Tree => Reset_Tree); - if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /= - Configuration + if Project_Qualifier_Of + (From_Project_Node, From_Project_Node_Tree) /= Configuration then Process_Project_Tree_Phase_2 (In_Tree => In_Tree, @@ -1381,17 +1381,16 @@ package body Prj.Proc is ------------------------------- procedure Process_Declarative_Items - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - From_Project_Node : Project_Node_Id; - Node_Tree : Project_Node_Tree_Ref; - Env : Prj.Tree.Environment; - Pkg : Package_Id; - Item : Project_Node_Id; - Child_Env : in out Prj.Tree.Environment) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + Node_Tree : Project_Node_Tree_Ref; + Env : Prj.Tree.Environment; + Pkg : Package_Id; + Item : Project_Node_Id; + Child_Env : in out Prj.Tree.Environment) is - Shared : constant Shared_Project_Tree_Data_Access := - In_Tree.Shared; + Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; procedure Check_Or_Set_Typed_Variable (Value : in out Variable_Value; @@ -1459,8 +1458,8 @@ package body Prj.Proc is (String_Type_Of (Declaration, Node_Tree), Node_Tree); while Present (Current_String) - and then String_Value_Of (Current_String, Node_Tree) /= - Value.Value + and then + String_Value_Of (Current_String, Node_Tree) /= Value.Value loop Current_String := Next_Literal_String (Current_String, Node_Tree); @@ -1548,16 +1547,17 @@ package body Prj.Proc is declare Project_Name : constant Name_Id := - Name_Of (Project_Of_Renamed_Package, Node_Tree); + Name_Of (Project_Of_Renamed_Package, + Node_Tree); Renamed_Project : constant Project_Id := - Imported_Or_Extended_Project_From - (Project, Project_Name); + Imported_Or_Extended_Project_From + (Project, Project_Name); Renamed_Package : constant Package_Id := - Package_From - (Renamed_Project, Shared, - Name_Of (Current_Item, Node_Tree)); + Package_From + (Renamed_Project, Shared, + Name_Of (Current_Item, Node_Tree)); begin -- For a renamed package, copy the declarations of the @@ -1566,8 +1566,9 @@ package body Prj.Proc is -- declaration. Copy_Package_Declarations - (From => Shared.Packages.Table (Renamed_Package).Decl, - To => Shared.Packages.Table (New_Pkg).Decl, + (From => + Shared.Packages.Table (Renamed_Package).Decl, + To => Shared.Packages.Table (New_Pkg).Decl, New_Loc => Location_Of (Current_Item, Node_Tree), Restricted => False, Shared => Shared); @@ -2359,8 +2360,8 @@ package body Prj.Proc is (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); if Current_Verbosity = High then - Debug_Decrease_Indent ("Done Process tree, phase 1, Success=" - & Success'Img); + Debug_Decrease_Indent + ("Done Process tree, phase 1, Success=" & Success'Img); end if; end Process_Project_Tree_Phase_1; @@ -2396,12 +2397,10 @@ package body Prj.Proc is -- all virtual extending projects to object directory of main project. if Project /= No_Project - and then - Is_Extending_All (From_Project_Node, From_Project_Node_Tree) + and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree) then declare - Object_Dir : constant Path_Information := - Project.Object_Directory; + Object_Dir : constant Path_Information := Project.Object_Directory; begin Prj := In_Tree.Projects; @@ -2471,10 +2470,9 @@ package body Prj.Proc is Debug_Decrease_Indent ("Done Process tree, phase 2"); - Success := - Total_Errors_Detected = 0 - and then - (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); + Success := Total_Errors_Detected = 0 + and then + (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); end Process_Project_Tree_Phase_2; ----------------------- @@ -2489,8 +2487,7 @@ package body Prj.Proc is Env : in out Prj.Tree.Environment; Extended_By : Project_Id) is - Shared : constant Shared_Project_Tree_Data_Access := - In_Tree.Shared; + Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared; Child_Env : Prj.Tree.Environment; -- Only used for the root aggregate project (if any). This is left @@ -2576,9 +2573,9 @@ package body Prj.Proc is --------------------------------- procedure Process_Aggregated_Projects is - List : Aggregated_Project_List; + List : Aggregated_Project_List; Loaded_Project : Prj.Tree.Project_Node_Id; - Success : Boolean := True; + Success : Boolean := True; begin if Project.Qualifier /= Aggregate then return; @@ -2587,10 +2584,10 @@ package body Prj.Proc is Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name); Prj.Nmsc.Process_Aggregated_Projects - (Tree => In_Tree, - Project => Project, - Node_Tree => From_Project_Node_Tree, - Flags => Env.Flags); + (Tree => In_Tree, + Project => Project, + Node_Tree => From_Project_Node_Tree, + Flags => Env.Flags); List := Project.Aggregated_Projects; while Success and then List /= null loop @@ -2636,6 +2633,7 @@ package body Prj.Proc is Env => Env, Reset_Tree => False); end if; + else Debug_Output ("Failed to parse", Name_Id (List.Path)); end if; @@ -2667,8 +2665,8 @@ package body Prj.Proc is Current_Pkg := First; while Current_Pkg /= No_Package - and then Shared.Packages.Table (Current_Pkg).Name /= - Element.Name + and then + Shared.Packages.Table (Current_Pkg).Name /= Element.Name loop Current_Pkg := Shared.Packages.Table (Current_Pkg).Next; end loop; @@ -2702,9 +2700,7 @@ package body Prj.Proc is Attribute1 := Attr_Value1.Next; end loop; - if Attribute1 = No_Variable - or else Attr_Value1.Value.Default - then + if Attribute1 = No_Variable or else Attr_Value1.Value.Default then -- Attribute Languages is not declared in the extending project. -- Check if it is declared in the project being extended. @@ -2715,8 +2711,8 @@ package body Prj.Proc is Attribute2 := Attr_Value2.Next; end loop; - if Attribute2 /= No_Variable and then - not Attr_Value2.Value.Default + if Attribute2 /= No_Variable + and then not Attr_Value2.Value.Default then -- As attribute Languages is declared in the project being -- extended, copy its value for the extending project. @@ -2748,8 +2744,8 @@ package body Prj.Proc is Imported : Project_List; Declaration_Node : Project_Node_Id := Empty_Node; - Name : constant Name_Id := - Name_Of (From_Project_Node, From_Project_Node_Tree); + Name : constant Name_Id := + Name_Of (From_Project_Node, From_Project_Node_Tree); Name_Node : constant Tree_Private_Part.Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get @@ -2793,8 +2789,8 @@ package body Prj.Proc is -- being a virtual extending project. if Name_Len > Virtual_Prefix'Length - and then Name_Buffer (1 .. Virtual_Prefix'Length) = - Virtual_Prefix + and then + Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix then Project.Virtual := True; end if; @@ -2827,9 +2823,7 @@ package body Prj.Proc is Process_Imported_Projects (Imported, Limited_With => False); - if Project.Qualifier = Aggregate - and then In_Tree.Is_Root_Tree - then + if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then Initialize_And_Copy (Child_Env, Copy_From => Env); else @@ -2874,9 +2868,7 @@ package body Prj.Proc is Process_Aggregated_Projects; end if; - if Project.Qualifier = Aggregate - and then In_Tree.Is_Root_Tree - then + if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then Free (Child_Env); end if; end; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index aee8da5c48c..2b420e1fd63 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -104,7 +104,6 @@ package body Prj.Tree is Zone := In_Tree.Project_Nodes.Table (To).Comments; if No (Zone) then - -- Create new N_Comment_Zones node Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); @@ -144,9 +143,9 @@ package body Prj.Tree is -- Create new N_Comment node - if (Where = After or else Where = After_End) and then - Token /= Tok_EOF and then - Comments.Table (J).Follows_Empty_Line + if (Where = After or else Where = After_End) + and then Token /= Tok_EOF + and then Comments.Table (J).Follows_Empty_Line then Comments.Table (1 .. Comments.Last - J + 1) := Comments.Table (J .. Comments.Last); diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index c1f9409de15..9454f9ff418 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -128,8 +128,8 @@ package body Prj.Util is --------------- procedure Duplicate - (This : in out Name_List_Index; - Shared : Shared_Project_Tree_Data_Access) + (This : in out Name_List_Index; + Shared : Shared_Project_Tree_Data_Access) is Old_Current : Name_List_Index; New_Current : Name_List_Index; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 796e601cada..124536136d7 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -358,7 +358,6 @@ package body Prj is Name_Len := Name_Len - 1; return Name_Find; - end Extend_Name; --------------------- @@ -377,7 +376,7 @@ package body Prj is procedure Language_Changed (Iter : in out Source_Iterator) is begin - Iter.Current := No_Source; + Iter.Current := No_Source; if Iter.Language_Name /= No_Name then while Iter.Language /= null @@ -580,6 +579,7 @@ package body Prj is begin Iterator := For_Each_Source (In_Tree => Tree, Project => Proj); + while Element (Iterator) /= No_Source loop if Element (Iterator).File = Base_Name and then (Index = 0 or else Element (Iterator).Index = Index) @@ -626,6 +626,7 @@ package body Prj is Include_Aggregated => False, With_State => Result); end if; + else Look_For_Sources (No_Project, In_Tree, Result); end if; @@ -1363,8 +1364,8 @@ package body Prj is procedure For_All_Projects is new For_Every_Project_Imported (Boolean, Recursive_Add); - Dummy : Boolean := False; - List : Project_List; + Dummy : Boolean := False; + List : Project_List; begin List := Local_Tree.Projects; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index e93d00ec6ea..b5584e64d6e 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2263,6 +2263,8 @@ package body Sem_Ch5 is -- If domain of iteration is an expression, create a declaration for it, -- so that finalization actions are introduced outside of the loop. + -- The declaration must be a renaming because the body of the loop may + -- assign to elements. if not Is_Entity_Name (Iter_Name) then declare @@ -2273,10 +2275,10 @@ package body Sem_Ch5 is Typ := Etype (Iter_Name); Decl := - Make_Object_Declaration (Loc, + Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Id, - Object_Definition => New_Occurrence_Of (Typ, Loc), - Expression => Relocate_Node (Iter_Name)); + Subtype_Mark => New_Occurrence_Of (Typ, Loc), + Name => Relocate_Node (Iter_Name)); Insert_Actions (Parent (Parent (N)), New_List (Decl)); Rewrite (Name (N), New_Occurrence_Of (Id, Loc)); |