From 481f29eb5efa2a11682e4be46842f12ab51cb821 Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Fri, 24 Apr 2009 10:31:57 +0000 Subject: gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree 2009-04-24 Vincent Celier * gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree * prj-env.adb: Move all global variables to the private part of the project tree data. Access these new components instead of the global variables no longer in existence. (Add_To_Path): New Project_Tree_Ref parameter, to access the new components that were previously global variables. * prj-env.ads (Initialize): New Project_Tree_Ref parameter (Set_Mapping_File_Initial_State_To_Empty): New Project_Tree_Ref parameter. * prj-nmsc.adb (Compute_Unit_Name): New Project_Tree_Ref parameter to be able to call Set_Mapping_File_Initial_State_To_Empty with it. * prj.adb (Initialize): Do not call Prj.Env.Initialize (Reset): Do not call Prj.Env.Initialize. Instead, initialize the new components in the private part of the project tree data. * prj.ads (Private_Project_Tree_Data): new components moved from Prj.Env: Current_Source_Path_File, Current_Object_Path_File, Ada_Path_Buffer, Ada_Path_Length, Ada_Prj_Include_File_Set, Ada_Prj_Objects_File_Set, Fill_Mapping_File. From-SVN: r146696 --- gcc/ada/ChangeLog | 27 ++++++++ gcc/ada/gnatcmd.adb | 2 +- gcc/ada/prj-env.adb | 174 ++++++++++++++++++++++++++------------------------- gcc/ada/prj-env.ads | 8 +-- gcc/ada/prj-nmsc.adb | 43 +++++++------ gcc/ada/prj.adb | 30 ++++++--- gcc/ada/prj.ads | 37 +++++++++-- 7 files changed, 197 insertions(+), 124 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ec8255b..cf7cde3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,32 @@ 2009-04-24 Vincent Celier + * gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree + + * prj-env.adb: Move all global variables to the private part of the + project tree data. + Access these new components instead of the global variables no longer + in existence. + (Add_To_Path): New Project_Tree_Ref parameter, to access the new + components that were previously global variables. + + * prj-env.ads (Initialize): New Project_Tree_Ref parameter + (Set_Mapping_File_Initial_State_To_Empty): New Project_Tree_Ref + parameter. + + * prj-nmsc.adb (Compute_Unit_Name): New Project_Tree_Ref parameter to + be able to call Set_Mapping_File_Initial_State_To_Empty with it. + + * prj.adb (Initialize): Do not call Prj.Env.Initialize + (Reset): Do not call Prj.Env.Initialize. Instead, initialize the new + components in the private part of the project tree data. + + * prj.ads (Private_Project_Tree_Data): new components moved from + Prj.Env: Current_Source_Path_File, Current_Object_Path_File, + Ada_Path_Buffer, Ada_Path_Length, Ada_Prj_Include_File_Set, + Ada_Prj_Objects_File_Set, Fill_Mapping_File. + +2009-04-24 Vincent Celier + * opt.ads (Unchecked_Shared_Lib_Imports): New Boolean flag. * prj-nmsc.adb (Check_Library): No error for imports by shared library diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index fa7e25a..592d302 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -2411,7 +2411,7 @@ begin -- First make sure that the recorded file names are empty - Prj.Env.Initialize; + Prj.Env.Initialize (Project_Tree); Prj.Env.Set_Ada_Paths (Project, Project_Tree, Including_Libraries => False); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 7b9b83e..e833d03 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -34,31 +34,7 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; package body Prj.Env is - Current_Source_Path_File : Path_Name_Type := No_Path; - -- Current value of project source path file env var. - -- Used to avoid setting the env var to the same value. - - Current_Object_Path_File : Path_Name_Type := No_Path; - -- Current value of project object path file env var. - -- Used to avoid setting the env var to the same value. - - Ada_Path_Buffer : String_Access := new String (1 .. 1024); - -- A buffer where values for ADA_INCLUDE_PATH - -- and ADA_OBJECTS_PATH are stored. - - Ada_Path_Length : Natural := 0; - -- Index of the last valid character in Ada_Path_Buffer - - Ada_Prj_Include_File_Set : Boolean := False; - Ada_Prj_Objects_File_Set : Boolean := False; - -- These flags are set to True when the corresponding environment variables - -- are set and are used to give these environment variables an empty string - -- value at the end of the program. This has no practical effect on most - -- platforms, except on VMS where the logical names are deassigned, thus - -- avoiding the pollution of the environment of the caller. - Default_Naming : constant Naming_Id := Naming_Table.First; - Fill_Mapping_File : Boolean := True; package Project_Boolean_Htable is new Simple_HTable (Header_Num => Header_Num, @@ -80,7 +56,7 @@ package body Prj.Env is -- Add to Ada_Path_Buffer all the source directories in string list -- Source_Dirs, if any. Increment Ada_Path_Length. - procedure Add_To_Path (Dir : String); + procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref); -- If Dir is not already in the global variable Ada_Path_Buffer, add it. -- Increment Ada_Path_Length. -- If Ada_Path_Length /= 0, prepend a Path_Separator character to @@ -170,7 +146,7 @@ package body Prj.Env is if In_Tree.Projects.Table (Project).Ada_Include_Path = null then - Ada_Path_Length := 0; + In_Tree.Private_Part.Ada_Path_Length := 0; for Index in Project_Table.First .. Project_Table.Last (In_Tree.Projects) @@ -180,7 +156,9 @@ package body Prj.Env is Add (Project); In_Tree.Projects.Table (Project).Ada_Include_Path := - new String'(Ada_Path_Buffer (1 .. Ada_Path_Length)); + new String' + (In_Tree.Private_Part.Ada_Path_Buffer + (1 .. In_Tree.Private_Part.Ada_Path_Length)); end if; return In_Tree.Projects.Table (Project).Ada_Include_Path; @@ -199,10 +177,12 @@ package body Prj.Env is if Recursive then return Ada_Include_Path (Project, In_Tree).all; else - Ada_Path_Length := 0; + In_Tree.Private_Part.Ada_Path_Length := 0; Add_To_Path (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree); - return Ada_Path_Buffer (1 .. Ada_Path_Length); + return + In_Tree.Private_Part.Ada_Path_Buffer + (1 .. In_Tree.Private_Part.Ada_Path_Length); end if; end Ada_Include_Path; @@ -258,17 +238,20 @@ package body Prj.Env is Contains_ALI_Files (Data.Library_ALI_Dir.Name) then Add_To_Path - (Get_Name_String (Data.Library_ALI_Dir.Name)); + (Get_Name_String (Data.Library_ALI_Dir.Name), + In_Tree); else Add_To_Path - (Get_Name_String (Data.Object_Directory.Name)); + (Get_Name_String (Data.Object_Directory.Name), + In_Tree); end if; else -- For a non library project, add the object directory Add_To_Path - (Get_Name_String (Data.Object_Directory.Name)); + (Get_Name_String (Data.Object_Directory.Name), + In_Tree); end if; end if; @@ -299,7 +282,7 @@ package body Prj.Env is if In_Tree.Projects.Table (Project).Ada_Objects_Path = null then - Ada_Path_Length := 0; + In_Tree.Private_Part.Ada_Path_Length := 0; for Index in Project_Table.First .. Project_Table.Last (In_Tree.Projects) @@ -309,7 +292,9 @@ package body Prj.Env is Add (Project); In_Tree.Projects.Table (Project).Ada_Objects_Path := - new String'(Ada_Path_Buffer (1 .. Ada_Path_Length)); + new String' + (In_Tree.Private_Part.Ada_Path_Buffer + (1 .. In_Tree.Private_Part.Ada_Path_Length)); end if; return In_Tree.Projects.Table (Project).Ada_Objects_Path; @@ -368,12 +353,12 @@ package body Prj.Env is begin while Current /= Nil_String loop Source_Dir := In_Tree.String_Elements.Table (Current); - Add_To_Path (Get_Name_String (Source_Dir.Display_Value)); + Add_To_Path (Get_Name_String (Source_Dir.Display_Value), In_Tree); Current := Source_Dir.Next; end loop; end Add_To_Path; - procedure Add_To_Path (Dir : String) is + procedure Add_To_Path (Dir : String; In_Tree : Project_Tree_Ref) is Len : Natural; New_Buffer : String_Access; Min_Len : Natural; @@ -411,16 +396,19 @@ package body Prj.Env is -- Start of processing for Add_To_Path begin - if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then + if Is_Present (In_Tree.Private_Part.Ada_Path_Buffer + (1 .. In_Tree.Private_Part.Ada_Path_Length), + Dir) + then -- Dir is already in the path, nothing to do return; end if; - Min_Len := Ada_Path_Length + Dir'Length; + Min_Len := In_Tree.Private_Part.Ada_Path_Length + Dir'Length; - if Ada_Path_Length > 0 then + if In_Tree.Private_Part.Ada_Path_Length > 0 then -- Add 1 for the Path_Separator character @@ -429,7 +417,7 @@ package body Prj.Env is -- If Ada_Path_Buffer is too small, increase it - Len := Ada_Path_Buffer'Last; + Len := In_Tree.Private_Part.Ada_Path_Buffer'Last; if Len < Min_Len then loop @@ -438,20 +426,25 @@ package body Prj.Env is end loop; New_Buffer := new String (1 .. Len); - New_Buffer (1 .. Ada_Path_Length) := - Ada_Path_Buffer (1 .. Ada_Path_Length); - Free (Ada_Path_Buffer); - Ada_Path_Buffer := New_Buffer; + New_Buffer (1 .. In_Tree.Private_Part.Ada_Path_Length) := + In_Tree.Private_Part.Ada_Path_Buffer + (1 .. In_Tree.Private_Part.Ada_Path_Length); + Free (In_Tree.Private_Part.Ada_Path_Buffer); + In_Tree.Private_Part.Ada_Path_Buffer := New_Buffer; end if; - if Ada_Path_Length > 0 then - Ada_Path_Length := Ada_Path_Length + 1; - Ada_Path_Buffer (Ada_Path_Length) := Path_Separator; + if In_Tree.Private_Part.Ada_Path_Length > 0 then + In_Tree.Private_Part.Ada_Path_Length := + In_Tree.Private_Part.Ada_Path_Length + 1; + In_Tree.Private_Part.Ada_Path_Buffer + (In_Tree.Private_Part.Ada_Path_Length) := Path_Separator; end if; - Ada_Path_Buffer - (Ada_Path_Length + 1 .. Ada_Path_Length + Dir'Length) := Dir; - Ada_Path_Length := Ada_Path_Length + Dir'Length; + In_Tree.Private_Part.Ada_Path_Buffer + (In_Tree.Private_Part.Ada_Path_Length + 1 .. + In_Tree.Private_Part.Ada_Path_Length + Dir'Length) := Dir; + In_Tree.Private_Part.Ada_Path_Length := + In_Tree.Private_Part.Ada_Path_Length + Dir'Length; end Add_To_Path; ------------------------ @@ -1101,7 +1094,7 @@ package body Prj.Env is end if; if Language = No_Name then - if Fill_Mapping_File then + if In_Tree.Private_Part.Fill_Mapping_File then for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop The_Unit_Data := In_Tree.Units.Table (Unit); @@ -1142,9 +1135,9 @@ package body Prj.Env is exit when Source = No_Source; if Source.Language.Name = Language - and then not Source.Locally_Removed - and then Source.Replaced_By = No_Source - and then Source.Path.Name /= No_Path + and then not Source.Locally_Removed + and then Source.Replaced_By = No_Source + and then Source.Path.Name /= No_Path then if Source.Unit /= No_Name then Get_Name_String (Source.Unit); @@ -1180,10 +1173,12 @@ package body Prj.Env is GNAT.OS_Lib.Close (File, Status); if not Status then - Prj.Com.Fail ("disk full, could not write mapping file"); + -- We were able to create the temporary file, so there is no problem -- of protection. However, we are not able to close it, so there must -- be a capacity problem that we express using "disk full". + + Prj.Com.Fail ("disk full, could not write mapping file"); end if; end Create_Mapping_File; @@ -1237,14 +1232,14 @@ package body Prj.Env is -- the empty string. On VMS, this has the effect of deassigning -- the logical names. - if Ada_Prj_Include_File_Set then + if In_Tree.Private_Part.Ada_Prj_Include_File_Set then Setenv (Project_Include_Path_File, ""); - Ada_Prj_Include_File_Set := False; + In_Tree.Private_Part.Ada_Prj_Include_File_Set := False; end if; - if Ada_Prj_Objects_File_Set then + if In_Tree.Private_Part.Ada_Prj_Objects_File_Set then Setenv (Project_Objects_Path_File, ""); - Ada_Prj_Objects_File_Set := False; + In_Tree.Private_Part.Ada_Prj_Objects_File_Set := False; end if; end Delete_All_Path_Files; @@ -1483,6 +1478,7 @@ package body Prj.Env is procedure Recurse (Prj : Project_Id) is Data : Project_Data renames In_Tree.Projects.Table (Prj); List : Project_List := Data.Imported_Projects; + begin if not Get (Seen, Prj) then Set (Seen, Prj, True); @@ -1504,6 +1500,8 @@ package body Prj.Env is end if; end Recurse; + -- Start of processing for For_All_Imported_Projects + begin Recurse (Project); Reset (Seen); @@ -1534,6 +1532,9 @@ package body Prj.Env is end For_Project; procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project); + + -- Start of processing for For_All_Object_Dirs + begin Get_Object_Dirs (Project, In_Tree); end For_All_Object_Dirs; @@ -1557,6 +1558,7 @@ package body Prj.Env is Data : Project_Data renames In_Tree.Projects.Table (Prj); Current : String_List_Id := Data.Source_Dirs; The_String : String_Element; + begin -- If there are Ada sources, call action with the name of every -- source directory. @@ -1571,6 +1573,9 @@ package body Prj.Env is end For_Project; procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project); + + -- Start of processing for For_All_Source_Dirs + begin Get_Source_Dirs (Project, In_Tree); end For_All_Source_Dirs; @@ -1666,11 +1671,11 @@ package body Prj.Env is -- Initialize -- ---------------- - procedure Initialize is + procedure Initialize (In_Tree : Project_Tree_Ref) is begin - Fill_Mapping_File := True; - Current_Source_Path_File := No_Path; - Current_Object_Path_File := No_Path; + In_Tree.Private_Part.Fill_Mapping_File := True; + In_Tree.Private_Part.Current_Source_Path_File := No_Path; + In_Tree.Private_Part.Current_Object_Path_File := No_Path; end Initialize; ------------------- @@ -2089,43 +2094,43 @@ package body Prj.Env is -- Set the env vars, if they need to be changed, and set the -- corresponding flags. - if Current_Source_Path_File /= + if In_Tree.Private_Part.Current_Source_Path_File /= In_Tree.Projects.Table (Project).Include_Path_File then - Current_Source_Path_File := + In_Tree.Private_Part.Current_Source_Path_File := In_Tree.Projects.Table (Project).Include_Path_File; Set_Path_File_Var (Project_Include_Path_File, - Get_Name_String (Current_Source_Path_File)); - Ada_Prj_Include_File_Set := True; + Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File)); + In_Tree.Private_Part.Ada_Prj_Include_File_Set := True; end if; if Including_Libraries then - if Current_Object_Path_File - /= In_Tree.Projects.Table - (Project).Objects_Path_File_With_Libs + if In_Tree.Private_Part.Current_Object_Path_File /= + In_Tree.Projects.Table (Project).Objects_Path_File_With_Libs then - Current_Object_Path_File := + In_Tree.Private_Part.Current_Object_Path_File := In_Tree.Projects.Table (Project).Objects_Path_File_With_Libs; Set_Path_File_Var (Project_Objects_Path_File, - Get_Name_String (Current_Object_Path_File)); - Ada_Prj_Objects_File_Set := True; + Get_Name_String + (In_Tree.Private_Part.Current_Object_Path_File)); + In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True; end if; else - if Current_Object_Path_File /= - In_Tree.Projects.Table - (Project).Objects_Path_File_Without_Libs + if In_Tree.Private_Part.Current_Object_Path_File /= + In_Tree.Projects.Table (Project).Objects_Path_File_Without_Libs then - Current_Object_Path_File := + In_Tree.Private_Part.Current_Object_Path_File := In_Tree.Projects.Table (Project).Objects_Path_File_Without_Libs; Set_Path_File_Var (Project_Objects_Path_File, - Get_Name_String (Current_Object_Path_File)); - Ada_Prj_Objects_File_Set := True; + Get_Name_String + (In_Tree.Private_Part.Current_Object_Path_File)); + In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True; end if; end if; end Set_Ada_Paths; @@ -2134,9 +2139,11 @@ package body Prj.Env is -- Set_Mapping_File_Initial_State_To_Empty -- --------------------------------------------- - procedure Set_Mapping_File_Initial_State_To_Empty is + procedure Set_Mapping_File_Initial_State_To_Empty + (In_Tree : Project_Tree_Ref) + is begin - Fill_Mapping_File := False; + In_Tree.Private_Part.Fill_Mapping_File := False; end Set_Mapping_File_Initial_State_To_Empty; ----------------------- @@ -2145,7 +2152,6 @@ package body Prj.Env is procedure Set_Path_File_Var (Name : String; Value : String) is Host_Spec : String_Access := To_Host_File_Spec (Value); - begin if Host_Spec = null then Prj.Com.Fail @@ -2167,9 +2173,7 @@ package body Prj.Env is Result : Project_Id := Project; begin - while In_Tree.Projects.Table (Result).Extended_By /= - No_Project - loop + while In_Tree.Projects.Table (Result).Extended_By /= No_Project loop Result := In_Tree.Projects.Table (Result).Extended_By; end loop; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 989f4e7..a558cf9 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -28,9 +28,8 @@ package Prj.Env is - procedure Initialize; - -- Called by Prj.Initialize to perform required initialization steps for - -- this package. + procedure Initialize (In_Tree : Project_Tree_Ref); + -- Initialize global components relative to environment variables procedure Print_Sources (In_Tree : Project_Tree_Ref); -- Output the list of sources, after Project files have been scanned @@ -58,7 +57,8 @@ package Prj.Env is -- for the specified project, and that is not information available in -- buildgpr.adb. - procedure Set_Mapping_File_Initial_State_To_Empty; + procedure Set_Mapping_File_Initial_State_To_Empty + (In_Tree : Project_Tree_Ref); -- When creating a mapping file, create an empty map. This case occurs when -- run time source files are found in the project files. This only applies -- to the Ada_Only mode. diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 451c678..14cdb0f 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -487,7 +487,8 @@ package body Prj.Nmsc is Spec_Suffix : File_Name_Type; Casing : Casing_Type; Kind : out Source_Kind; - Unit : out Name_Id); + Unit : out Name_Id; + In_Tree : Project_Tree_Ref); -- Check whether the file matches the naming scheme. If it does, -- compute its unit name. If Unit is set to No_Name on exit, none of the -- other out parameters are relevant. @@ -723,14 +724,14 @@ package body Prj.Nmsc is Id.Project := Project; Id.Language := Lang_Id; Id.Lang_Kind := Lang_Kind; - Id.Compiled := - Lang_Id.Config.Compiler_Driver /= Empty_File_Name; + Id.Compiled := Lang_Id.Config.Compiler_Driver /= + Empty_File_Name; Id.Kind := Kind; Id.Alternate_Languages := Alternate_Languages; Id.Other_Part := Other_Part; - Id.Object_Exists := Config.Object_Generated; - Id.Object_Linked := Config.Objects_Linked; + Id.Object_Exists := Config.Object_Generated; + Id.Object_Linked := Config.Objects_Linked; if Other_Part /= No_Source then Other_Part.Other_Part := Id; @@ -906,9 +907,10 @@ package body Prj.Nmsc is begin Language := Data.Languages; while Language /= No_Language_Index loop + -- If there are no sources for this language, check whether -- there are sources for which this is an alternate - -- language + -- language. if Language.First_Source = No_Source then Iter := For_Each_Source (In_Tree => In_Tree, @@ -2515,11 +2517,11 @@ package body Prj.Nmsc is Data.Decl.Attributes, In_Tree); - List : String_List_Id; - Element : String_Element; - Name : File_Name_Type; - Iter : Source_Iterator; - Source : Source_Id; + List : String_List_Id; + Element : String_Element; + Name : File_Name_Type; + Iter : Source_Iterator; + Source : Source_Id; Project_2 : Project_Id; begin @@ -2855,8 +2857,8 @@ package body Prj.Nmsc is ----------------------------------- procedure Process_Exceptions_File_Based - (Lang_Id : Language_Ptr; - Kind : Source_Kind) + (Lang_Id : Language_Ptr; + Kind : Source_Kind) is Lang : constant Name_Id := Lang_Id.Name; Exceptions : Array_Element_Id; @@ -2949,8 +2951,8 @@ package body Prj.Nmsc is ----------------------------------- procedure Process_Exceptions_Unit_Based - (Lang_Id : Language_Ptr; - Kind : Source_Kind) + (Lang_Id : Language_Ptr; + Kind : Source_Kind) is Lang : constant Name_Id := Lang_Id.Name; Exceptions : Array_Element_Id; @@ -6419,7 +6421,8 @@ package body Prj.Nmsc is Spec_Suffix : File_Name_Type; Casing : Casing_Type; Kind : out Source_Kind; - Unit : out Name_Id) + Unit : out Name_Id; + In_Tree : Project_Tree_Ref) is Filename : constant String := Get_Name_String (File_Name); Last : Integer := Filename'Last; @@ -6575,7 +6578,7 @@ package body Prj.Nmsc is -- If it is potentially a run time source, disable filling -- of the mapping file to avoid warnings. - Set_Mapping_File_Initial_State_To_Empty; + Set_Mapping_File_Initial_State_To_Empty (In_Tree); end if; end if; end; @@ -6684,7 +6687,8 @@ package body Prj.Nmsc is Spec_Suffix => Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming), Casing => Naming.Casing, Kind => Kind, - Unit => Unit_Name); + Unit => Unit_Name, + In_Tree => In_Tree); case Kind is when Spec => Unit_Kind := Specification; @@ -7551,7 +7555,8 @@ package body Prj.Nmsc is Spec_Suffix => Config.Naming_Data.Spec_Suffix, Casing => Config.Naming_Data.Casing, Kind => Kind, - Unit => Unit); + Unit => Unit, + In_Tree => In_Tree); if Unit /= No_Name then Language := Tmp_Lang; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index c714a22..e76ee8e 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -29,7 +29,6 @@ with Ada.Unchecked_Deallocation; with Debug; with Osint; use Osint; with Prj.Attr; -with Prj.Env; with Prj.Err; use Prj.Err; with Snames; use Snames; with Table; @@ -408,6 +407,7 @@ package body Prj is procedure Language_Changed (Iter : in out Source_Iterator) is begin Iter.Current := No_Source; + if Iter.Language_Name /= No_Name then while Iter.Language /= null and then Iter.Language.Name /= Iter.Language_Name @@ -421,16 +421,20 @@ package body Prj is if Iter.Language = No_Language_Index then if Iter.All_Projects then Iter.Project := Iter.Project + 1; + if Iter.Project > Project_Table.Last (Iter.In_Tree.Projects) then Iter.Project := No_Project; else Project_Changed (Iter); end if; + else Iter.Project := No_Project; end if; + else Iter.Current := Iter.Language.First_Source; + if Iter.Current = No_Source then Iter.Language := Iter.Language.Next; Language_Changed (Iter); @@ -610,7 +614,6 @@ package body Prj is Name_Buffer (1) := '/'; Slash_Id := Name_Find; - Prj.Env.Initialize; Prj.Attr.Initialize; Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); @@ -630,8 +633,10 @@ package body Prj is (Data : Project_Data; Language_Name : Name_Id) return Boolean is - Lang_Ind : Language_Ptr := Data.Languages; + Lang_Ind : Language_Ptr; + begin + Lang_Ind := Data.Languages; while Lang_Ind /= No_Language_Index loop if Lang_Ind.Name = Language_Name then return True; @@ -673,8 +678,7 @@ package body Prj is function Object_Name (Source_File_Name : File_Name_Type; - Object_File_Suffix : Name_Id := No_Name) - return File_Name_Type + Object_File_Suffix : Name_Id := No_Name) return File_Name_Type is begin if Object_File_Suffix = No_Name then @@ -706,9 +710,9 @@ package body Prj is Default_Body_Suffix : File_Name_Type; In_Tree : Project_Tree_Ref) is - Lang : Name_Id; - Suffix : Array_Element_Id; - Found : Boolean := False; + Lang : Name_Id; + Suffix : Array_Element_Id; + Found : Boolean := False; Element : Array_Element; begin @@ -853,6 +857,7 @@ package body Prj is procedure Free (Tree : in out Project_Tree_Ref) is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Project_Tree_Data, Project_Tree_Ref); + begin if Tree /= null then Name_List_Table.Free (Tree.Name_Lists); @@ -898,8 +903,6 @@ package body Prj is procedure Reset (Tree : Project_Tree_Ref) is begin - Prj.Env.Initialize; - -- Visible tables Name_List_Table.Init (Tree.Name_Lists); @@ -945,6 +948,13 @@ package body Prj is In_Tree => Tree); Tree.Private_Part.Default_Naming.Separate_Suffix := Default_Ada_Body_Suffix; + + Tree.Private_Part.Current_Source_Path_File := No_Path; + Tree.Private_Part.Current_Object_Path_File := No_Path; + Tree.Private_Part.Ada_Path_Length := 0; + Tree.Private_Part.Ada_Prj_Include_File_Set := False; + Tree.Private_Part.Ada_Prj_Objects_File_Set := False; + Tree.Private_Part.Fill_Mapping_File := True; end if; end Reset; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index a3bad4a..fb5cc0d 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1563,19 +1563,19 @@ private -- Initialize. type Source_Iterator is record - In_Tree : Project_Tree_Ref; + In_Tree : Project_Tree_Ref; - Project : Project_Id; - All_Projects : Boolean; + Project : Project_Id; + All_Projects : Boolean; -- Current project and whether we should move on to the next - Language : Language_Ptr; + Language : Language_Ptr; -- Current language processed Language_Name : Name_Id; -- Only sources of this language will be returned (or all if No_Name) - Current : Source_Id; + Current : Source_Id; end record; procedure Add_To_Buffer @@ -1625,6 +1625,33 @@ private Source_Paths : Source_Path_Table.Instance; Object_Paths : Object_Path_Table.Instance; Default_Naming : Naming_Data; + + Current_Source_Path_File : Path_Name_Type := No_Path; + -- Current value of project source path file env var. Used to avoid + -- setting the env var to the same value. + + Current_Object_Path_File : Path_Name_Type := No_Path; + -- Current value of project object path file env var. Used to avoid + -- setting the env var to the same value. + + Ada_Path_Buffer : String_Access := new String (1 .. 1024); + -- A buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are + -- stored. + + Ada_Path_Length : Natural := 0; + -- Index of the last valid character in Ada_Path_Buffer + + Ada_Prj_Include_File_Set : Boolean := False; + Ada_Prj_Objects_File_Set : Boolean := False; + -- These flags are set to True when the corresponding environment + -- variables are set and are used to give these environment variables an + -- empty string value at the end of the program. This has no practical + -- effect on most platforms, except on VMS where the logical names are + -- deassigned, thus avoiding the pollution of the environment of the + -- caller. + + Fill_Mapping_File : Boolean := True; + end record; -- Type to represent the part of a project tree which is private to the -- Project Manager. -- cgit v1.1