diff options
-rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/ada/clean.adb | 6 | ||||
-rw-r--r-- | gcc/ada/make.adb | 181 | ||||
-rw-r--r-- | gcc/ada/makeutl.adb | 90 | ||||
-rw-r--r-- | gcc/ada/mlib-prj.adb | 2 | ||||
-rw-r--r-- | gcc/ada/prj-env.adb | 453 | ||||
-rw-r--r-- | gcc/ada/prj-env.ads | 7 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.adb | 12 | ||||
-rw-r--r-- | gcc/ada/prj-proc.adb | 89 | ||||
-rw-r--r-- | gcc/ada/prj.adb | 229 | ||||
-rw-r--r-- | gcc/ada/prj.ads | 55 |
11 files changed, 467 insertions, 673 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0693594..4385443 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2009-04-24 Emmanuel Briot <briot@adacore.com> + + * prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb, + clean.adb, prj-nmsc.adb, prj-env.adb, prj-env.ads (Project_Data.Seen): + field removed. This is not a property of the + project, just a boolean used to traverse the project tree, and storing + it in the structure prevents doing multiple traversal in parallel. + (Project_Data.Checked): also removed, since it was playing the same role + as Seen when we had two nested loops, and this is no longer necessary + (For_All_Imported_Projects): removed, since in fact there was already + the equivalent in For_Every_Project_Imported. The latter was rewritten + to use a local hash table instead of Project_Data.Seen + Various loops were rewritten to use For_Every_Project_Imported, thus + removing the need for Project_Data.Seen. This avoids a lot of code + duplication + 2009-04-24 Ed Schonberg <schonberg@adacore.com> * sem_res.adb (Resolve_Actuals): Do not create blocks around code diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 5df43cd..8a70175 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -878,7 +878,7 @@ package body Clean is -- Source_Dirs or Source_Files is specified as an empty list, -- so always look for Ada units in extending projects. - if Data.Ada_Sources_Present + if Has_Ada_Sources (Data) or else Data.Extends /= No_Project then for Unit in Unit_Table.First .. @@ -1028,8 +1028,8 @@ package body Clean is for Proj in Project_Table.First .. Project_Table.Last (Project_Tree.Projects) loop - if Project_Tree.Projects.Table - (Proj).Other_Sources_Present + if Has_Foreign_Sources + (Project_Tree.Projects.Table (Proj)) then Global_Archive := True; exit; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 168e4f3..4478ce9 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -587,15 +587,9 @@ package body Make is procedure Debug_Msg (S : String; N : Unit_Name_Type); -- If Debug.Debug_Flag_W is set outputs string S followed by name N - procedure Recursive_Compute_Depth - (Project : Project_Id; - Depth : Natural); + procedure Recursive_Compute_Depth (Project : Project_Id); -- Compute depth of Project and of the projects it depends on - procedure Compute_All_Imported_Projects (Project : Project_Id); - -- Compute, the list of the projects imported directly or indirectly by - -- project Project. - ----------------------- -- Gnatmake Routines -- ----------------------- @@ -3717,95 +3711,6 @@ package body Make is end if; end Compile_Sources; - ----------------------------------- - -- Compute_All_Imported_Projects -- - ----------------------------------- - - procedure Compute_All_Imported_Projects (Project : Project_Id) is - procedure Add_To_List (Prj : Project_Id); - -- Add a project to the list All_Imported_Projects of project Project - - procedure Recursive_Add_Imported (Project : Project_Id); - -- Recursively add the projects imported by project Project, but not - -- those that are extended. - - ----------------- - -- Add_To_List -- - ----------------- - - procedure Add_To_List (Prj : Project_Id) is - Element : constant Project_Element := - (Prj, Project_Tree.Projects.Table (Project).All_Imported_Projects); - List : Project_List; - begin - Project_List_Table.Increment_Last (Project_Tree.Project_Lists); - List := Project_List_Table.Last (Project_Tree.Project_Lists); - Project_Tree.Project_Lists.Table (List) := Element; - Project_Tree.Projects.Table (Project).All_Imported_Projects := List; - end Add_To_List; - - ---------------------------- - -- Recursive_Add_Imported -- - ---------------------------- - - procedure Recursive_Add_Imported (Project : Project_Id) is - List : Project_List; - Element : Project_Element; - Prj : Project_Id; - - begin - if Project /= No_Project then - - -- For all the imported projects - - List := Project_Tree.Projects.Table (Project).Imported_Projects; - while List /= Empty_Project_List loop - Element := Project_Tree.Project_Lists.Table (List); - Prj := Element.Project; - - -- Get the ultimate extending project - - while - Project_Tree.Projects.Table (Prj).Extended_By /= No_Project - loop - Prj := Project_Tree.Projects.Table (Prj).Extended_By; - end loop; - - -- If project has not yet been visited, add to list and recurse - - if not Project_Tree.Projects.Table (Prj).Seen then - Project_Tree.Projects.Table (Prj).Seen := True; - Add_To_List (Prj); - Recursive_Add_Imported (Prj); - end if; - - List := Element.Next; - end loop; - - -- Recurse on projects being imported, if any - - Recursive_Add_Imported - (Project_Tree.Projects.Table (Project).Extends); - end if; - end Recursive_Add_Imported; - - begin - -- Reset the Seen flag for all projects - - for Index in 1 .. Project_Table.Last (Project_Tree.Projects) loop - Project_Tree.Projects.Table (Index).Seen := False; - end loop; - - -- Make sure the list is empty - - Project_Tree.Projects.Table (Project).All_Imported_Projects := - Empty_Project_List; - - -- Add to the list all projects imported directly or indirectly - - Recursive_Add_Imported (Project); - end Compute_All_Imported_Projects; - ---------------------------------- -- Configuration_Pragmas_Switch -- ---------------------------------- @@ -7065,16 +6970,7 @@ package body Make is Add_Source_Directories (Main_Project, Project_Tree); Add_Object_Directories (Main_Project, Project_Tree); - -- Compute depth of each project - - for Proj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Project_Tree.Projects.Table (Proj).Seen := False; - Project_Tree.Projects.Table (Proj).Depth := 0; - end loop; - - Recursive_Compute_Depth (Main_Project, Depth => 1); + Recursive_Compute_Depth (Main_Project); -- For each project compute the list of the projects it imports -- directly or indirectly. @@ -7082,7 +6978,7 @@ package body Make is for Proj in Project_Table.First .. Project_Table.Last (Project_Tree.Projects) loop - Compute_All_Imported_Projects (Proj); + Compute_All_Imported_Projects (Proj, Project_Tree); end loop; else @@ -7632,51 +7528,56 @@ package body Make is -- Recursive_Compute_Depth -- ----------------------------- - procedure Recursive_Compute_Depth - (Project : Project_Id; - Depth : Natural) - is - List : Project_List; - Proj : Project_Id; + procedure Recursive_Compute_Depth (Project : Project_Id) is + use Project_Boolean_Htable; + Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; - begin - -- Nothing to do if there is no project or if the project has already - -- been seen or if the depth is large enough. + procedure Recurse (Prj : Project_Id; Depth : Natural); - if Project = No_Project - or else Project_Tree.Projects.Table (Project).Seen - or else Project_Tree.Projects.Table (Project).Depth >= Depth - then - return; - end if; + procedure Recurse (Prj : Project_Id; Depth : Natural) is + Data : Project_Data renames Project_Tree.Projects.Table (Prj); + List : Project_List; + Proj : Project_Id; + begin + if Data.Depth >= Depth + or Get (Seen, Prj) + then + return; + end if; - Project_Tree.Projects.Table (Project).Depth := Depth; + -- We need a test to avoid infinite recursions with limited withs: + -- If we have A -> B -> A, then when set level of A to n, we try and + -- set level of B to n+1, and then level of A to n + 2,... - -- Mark project as Seen to avoid endless loop caused by limited withs + Set (Seen, Prj, True); - Project_Tree.Projects.Table (Project).Seen := True; + Data.Depth := Depth; - List := Project_Tree.Projects.Table (Project).Imported_Projects; + List := Data.Imported_Projects; - -- Visit each imported project + -- Visit each imported project - while List /= Empty_Project_List loop - Proj := Project_Tree.Project_Lists.Table (List).Project; - List := Project_Tree.Project_Lists.Table (List).Next; - Recursive_Compute_Depth - (Project => Proj, - Depth => Depth + 1); - end loop; + while List /= Empty_Project_List loop + Proj := Project_Tree.Project_Lists.Table (List).Project; + List := Project_Tree.Project_Lists.Table (List).Next; + Recurse (Prj => Proj, Depth => Depth + 1); + end loop; - -- Visit a project being extended, if any + -- We again allow changing the depth of this project later on if it + -- is in fact imported by a lower-level project. - Recursive_Compute_Depth - (Project => Project_Tree.Projects.Table (Project).Extends, - Depth => Depth + 1); + Set (Seen, Prj, False); + end Recurse; - -- Reset the Seen flag, as we leave this project + begin + for Proj in Project_Table.First .. + Project_Table.Last (Project_Tree.Projects) + loop + Project_Tree.Projects.Table (Proj).Depth := 0; + end loop; - Project_Tree.Projects.Table (Project).Seen := False; + Recurse (Project, Depth => 1); + Reset (Seen); end Recursive_Compute_Depth; ------------------------------- diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index afddc05..7281711 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -364,74 +364,53 @@ package body Makeutl is (Project : Project_Id; In_Tree : Project_Tree_Ref) return String_List is - procedure Recursive_Add_Linker_Options (Proj : Project_Id); + procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean); -- The recursive routine used to add linker options - ---------------------------------- - -- Recursive_Add_Linker_Options -- - ---------------------------------- + ------------------- + -- Recursive_Add -- + ------------------- - procedure Recursive_Add_Linker_Options (Proj : Project_Id) is - Data : Project_Data; + procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is + pragma Unreferenced (Dummy); + Data : Project_Data renames In_Tree.Projects.Table (Proj); Linker_Package : Package_Id; Options : Variable_Value; - Imported : Project_List; begin - if Proj /= No_Project then - Data := In_Tree.Projects.Table (Proj); - - if not Data.Seen then - In_Tree.Projects.Table (Proj).Seen := True; - Imported := Data.Imported_Projects; - - while Imported /= Empty_Project_List loop - Recursive_Add_Linker_Options - (In_Tree.Project_Lists.Table - (Imported).Project); - Imported := In_Tree.Project_Lists.Table - (Imported).Next; - end loop; - - if Proj /= Project then - Linker_Package := - Prj.Util.Value_Of - (Name => Name_Linker, - In_Packages => Data.Decl.Packages, - In_Tree => In_Tree); - Options := - Prj.Util.Value_Of - (Name => Name_Ada, - Index => 0, - Attribute_Or_Array_Name => Name_Linker_Options, - In_Package => Linker_Package, - In_Tree => In_Tree); - - -- If attribute is present, add the project with - -- the attribute to table Linker_Opts. - - if Options /= Nil_Variable_Value then - Linker_Opts.Increment_Last; - Linker_Opts.Table (Linker_Opts.Last) := - (Project => Proj, Options => Options.Values); - end if; - end if; - end if; + Linker_Package := + Prj.Util.Value_Of + (Name => Name_Linker, + In_Packages => Data.Decl.Packages, + In_Tree => In_Tree); + Options := + Prj.Util.Value_Of + (Name => Name_Ada, + Index => 0, + Attribute_Or_Array_Name => Name_Linker_Options, + In_Package => Linker_Package, + In_Tree => In_Tree); + + -- If attribute is present, add the project with + -- the attribute to table Linker_Opts. + + if Options /= Nil_Variable_Value then + Linker_Opts.Increment_Last; + Linker_Opts.Table (Linker_Opts.Last) := + (Project => Proj, Options => Options.Values); end if; - end Recursive_Add_Linker_Options; + end Recursive_Add; + + procedure For_All_Projects is + new For_Every_Project_Imported (Boolean, Recursive_Add); + Dummy : Boolean := False; -- Start of processing for Linker_Options_Switches begin Linker_Opts.Init; - for Index in Project_Table.First .. - Project_Table.Last (In_Tree.Projects) - loop - In_Tree.Projects.Table (Index).Seen := False; - end loop; - - Recursive_Add_Linker_Options (Project); + For_All_Projects (Project, In_Tree, Dummy); Last_Linker_Option := 0; @@ -449,8 +428,7 @@ package body Makeutl is In_Tree.Projects.Table (Proj).Dir_Path := new String' (Get_Name_String - (In_Tree.Projects.Table - (Proj).Directory.Name)); + (In_Tree.Projects.Table (Proj).Directory.Name)); end if; while Options /= Nil_String loop diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index b02718d..167dfdb 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2008, AdaCore -- +-- Copyright (C) 2001-2009, AdaCore -- -- -- -- 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- -- diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 451fcc4..e3cdf4c 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -30,22 +30,10 @@ with Output; use Output; with Prj.Com; use Prj.Com; with Tempdir; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; - package body Prj.Env is Default_Naming : constant Naming_Id := Naming_Table.First; - package Project_Boolean_Htable is new Simple_HTable - (Header_Num => Header_Num, - Element => Boolean, - No_Element => False, - Key => Project_Id, - Hash => Hash, - Equal => "="); - -- A table that associates a project to a boolean. This is used to detect - -- whether a project was already processed for instance. - ----------------------- -- Local Subprograms -- ----------------------- @@ -73,9 +61,6 @@ package body Prj.Env is -- Add Object_Dir to object path table. Make sure it is not duplicate -- and it is the last one in the current table. - function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean; - -- Return True if there is at least one ALI file in the directory Dir - procedure Set_Path_File_Var (Name : String; Value : String); -- Call Setenv, after calling To_Host_File_Spec @@ -91,70 +76,35 @@ package body Prj.Env is function Ada_Include_Path (Project : Project_Id; - In_Tree : Project_Tree_Ref) return String_Access is - - procedure Add (Project : Project_Id); - -- Add all the source directories of a project to the path only if - -- this project has not been visited. Calls itself recursively for - -- projects being extended, and imported projects. Adds the project - -- to the list Seen if this is the call to Add for this project. + In_Tree : Project_Tree_Ref) return String_Access + is + procedure Add (Project : Project_Id; Dummy : in out Boolean); + -- Add source dirs of Project to the path --------- -- Add -- --------- - procedure Add (Project : Project_Id) is + procedure Add (Project : Project_Id; Dummy : in out Boolean) is + pragma Unreferenced (Dummy); begin - -- If Seen is empty, then the project cannot have been visited - - if not In_Tree.Projects.Table (Project).Seen then - In_Tree.Projects.Table (Project).Seen := True; - - declare - Data : constant Project_Data := - In_Tree.Projects.Table (Project); - List : Project_List := Data.Imported_Projects; - - begin - -- Add to path all source directories of this project - - Add_To_Path (Data.Source_Dirs, In_Tree); - - -- Call Add to the project being extended, if any - - if Data.Extends /= No_Project then - Add (Data.Extends); - end if; - - -- Call Add for each imported project, if any - - while List /= Empty_Project_List loop - Add - (In_Tree.Project_Lists.Table (List).Project); - List := In_Tree.Project_Lists.Table (List).Next; - end loop; - end; - end if; + Add_To_Path (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree); end Add; + procedure For_All_Projects is + new For_Every_Project_Imported (Boolean, Add); + Dummy : Boolean := False; + -- Start of processing for Ada_Include_Path begin -- If it is the first time we call this function for -- this project, compute the source path - if - In_Tree.Projects.Table (Project).Ada_Include_Path = null - then + if In_Tree.Projects.Table (Project).Ada_Include_Path = null then In_Tree.Private_Part.Ada_Path_Length := 0; + For_All_Projects (Project, In_Tree, Dummy); - for Index in Project_Table.First .. - Project_Table.Last (In_Tree.Projects) - loop - In_Tree.Projects.Table (Index).Seen := False; - end loop; - - Add (Project); In_Tree.Projects.Table (Project).Ada_Include_Path := new String' (In_Tree.Private_Part.Ada_Path_Buffer @@ -195,102 +145,40 @@ package body Prj.Env is In_Tree : Project_Tree_Ref; Including_Libraries : Boolean := True) return String_Access is - procedure Add (Project : Project_Id); - -- Add all the object directories of a project to the path only if - -- this project has not been visited. Calls itself recursively for - -- projects being extended, and imported projects. Adds the project - -- to the list Seen if this is the first call to Add for this project. + procedure Add (Project : Project_Id; Dummy : in out Boolean); + -- Add all the object directories of a project to the path --------- -- Add -- --------- - procedure Add (Project : Project_Id) is + procedure Add (Project : Project_Id; Dummy : in out Boolean) is + pragma Unreferenced (Dummy); + Path : constant Path_Name_Type := + Get_Object_Directory + (In_Tree, Project, + Including_Libraries => Including_Libraries, + Only_If_Ada => False); begin - -- If this project has not been seen yet - - if not In_Tree.Projects.Table (Project).Seen then - In_Tree.Projects.Table (Project).Seen := True; - - declare - Data : constant Project_Data := - In_Tree.Projects.Table (Project); - List : Project_List := Data.Imported_Projects; - - begin - -- Add to path the object directory of this project - -- except if we don't include library project and - -- this is a library project. - - if (Data.Library and then Including_Libraries) - or else - (Data.Object_Directory /= No_Path_Information - and then - (not Including_Libraries or else not Data.Library)) - then - -- For a library project, add the library directory, - -- if there is no object directory or if it contains ALI - -- files; otherwise add the object directory. - - if Data.Library then - if Data.Object_Directory = No_Path_Information - or else - Contains_ALI_Files (Data.Library_ALI_Dir.Name) - then - Add_To_Path - (Get_Name_String (Data.Library_ALI_Dir.Name), - In_Tree); - else - Add_To_Path - (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), - In_Tree); - end if; - end if; - - -- Call Add to the project being extended, if any - - if Data.Extends /= No_Project then - Add (Data.Extends); - end if; - - -- Call Add for each imported project, if any - - while List /= Empty_Project_List loop - Add - (In_Tree.Project_Lists.Table (List).Project); - List := In_Tree.Project_Lists.Table (List).Next; - end loop; - end; - + if Path /= No_Path then + Add_To_Path (Get_Name_String (Path), In_Tree); end if; end Add; + procedure For_All_Projects is + new For_Every_Project_Imported (Boolean, Add); + Dummy : Boolean := False; + -- Start of processing for Ada_Objects_Path begin -- If it is the first time we call this function for -- this project, compute the objects path - if - In_Tree.Projects.Table (Project).Ada_Objects_Path = null - then + if In_Tree.Projects.Table (Project).Ada_Objects_Path = null then In_Tree.Private_Part.Ada_Path_Length := 0; + For_All_Projects (Project, In_Tree, Dummy); - for Index in Project_Table.First .. - Project_Table.Last (In_Tree.Projects) - loop - In_Tree.Projects.Table (Index).Seen := False; - end loop; - - Add (Project); In_Tree.Projects.Table (Project).Ada_Objects_Path := new String' (In_Tree.Private_Part.Ada_Path_Buffer @@ -495,45 +383,6 @@ package body Prj.Env is end loop; end Add_To_Source_Path; - ------------------------ - -- Contains_ALI_Files -- - ------------------------ - - function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is - Dir_Name : constant String := Get_Name_String (Dir); - Direct : Dir_Type; - Name : String (1 .. 1_000); - Last : Natural; - Result : Boolean := False; - - begin - Open (Direct, Dir_Name); - - -- For each file in the directory, check if it is an ALI file - - loop - Read (Direct, Name, Last); - exit when Last = 0; - Canonical_Case_File_Name (Name (1 .. Last)); - Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali"; - exit when Result; - end loop; - - Close (Direct); - return Result; - - exception - -- If there is any problem, close the directory if open and return - -- True; the library directory will be added to the path. - - when others => - if Is_Open (Direct) then - Close (Direct); - end if; - - return True; - end Contains_ALI_Files; - -------------------------------- -- Create_Config_Pragmas_File -- -------------------------------- @@ -1457,56 +1306,6 @@ package body Prj.Env is return ""; end File_Name_Of_Library_Unit_Body; - ------------------------------- - -- For_All_Imported_Projects -- - ------------------------------- - - procedure For_All_Imported_Projects - (Project : Project_Id; - In_Tree : Project_Tree_Ref) - is - use Project_Boolean_Htable; - Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; - - procedure Recurse (Prj : Project_Id); - -- Process Prj recursively - - ------------- - -- Recurse -- - ------------- - - 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); - - Action (Prj); - - -- If we are extending a project, visit it - - if Data.Extends /= No_Project then - Recurse (Data.Extends); - end if; - - -- And visit all imported projects - - while List /= Empty_Project_List loop - Recurse (In_Tree.Project_Lists.Table (List).Project); - List := In_Tree.Project_Lists.Table (List).Next; - end loop; - end if; - end Recurse; - - -- Start of processing for For_All_Imported_Projects - - begin - Recurse (Project); - Reset (Seen); - end For_All_Imported_Projects; - ------------------------- -- For_All_Object_Dirs -- ------------------------- @@ -1515,28 +1314,34 @@ package body Prj.Env is (Project : Project_Id; In_Tree : Project_Tree_Ref) is - procedure For_Project (Prj : Project_Id); + procedure For_Project (Prj : Project_Id; Dummy : in out Integer); -- Get all object directories of Prj ----------------- -- For_Project -- ----------------- - procedure For_Project (Prj : Project_Id) is + procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is + pragma Unreferenced (Dummy); Data : Project_Data renames In_Tree.Projects.Table (Prj); begin + -- ??? Set_Ada_Paths has a different behavior for library project + -- files, should we have the same ? + if Data.Object_Directory /= No_Path_Information then Get_Name_String (Data.Object_Directory.Display_Name); Action (Name_Buffer (1 .. Name_Len)); end if; end For_Project; - procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project); + procedure Get_Object_Dirs is + new For_Every_Project_Imported (Integer, For_Project); + Dummy : Integer := 1; -- Start of processing for For_All_Object_Dirs begin - Get_Object_Dirs (Project, In_Tree); + Get_Object_Dirs (Project, In_Tree, Dummy); end For_All_Object_Dirs; ------------------------- @@ -1547,14 +1352,15 @@ package body Prj.Env is (Project : Project_Id; In_Tree : Project_Tree_Ref) is - procedure For_Project (Prj : Project_Id); + procedure For_Project (Prj : Project_Id; Dummy : in out Integer); -- Get all object directories of Prj ----------------- -- For_Project -- ----------------- - procedure For_Project (Prj : Project_Id) is + procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is + pragma Unreferenced (Dummy); Data : Project_Data renames In_Tree.Projects.Table (Prj); Current : String_List_Id := Data.Source_Dirs; The_String : String_Element; @@ -1572,12 +1378,14 @@ package body Prj.Env is end if; end For_Project; - procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project); + procedure Get_Source_Dirs is + new For_Every_Project_Imported (Integer, For_Project); + Dummy : Integer := 1; -- Start of processing for For_All_Source_Dirs begin - Get_Source_Dirs (Project, In_Tree); + Get_Source_Dirs (Project, In_Tree, Dummy); end For_All_Source_Dirs; ------------------- @@ -1860,146 +1668,45 @@ package body Prj.Env is Len : Natural; - procedure Add (Proj : Project_Id); - -- Add all the source/object directories of a project to the path only - -- if this project has not been visited. Calls an internal procedure - -- recursively for projects being extended, and imported projects. - - --------- - -- Add -- - --------- - - procedure Add (Proj : Project_Id) is - - procedure Recursive_Add (Project : Project_Id); - -- Recursive procedure to add the source/object paths of extended/ - -- imported projects. - - ------------------- - -- Recursive_Add -- - ------------------- + procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean); + -- Recursive procedure to add the source/object paths of extended/ + -- imported projects. - procedure Recursive_Add (Project : Project_Id) is - begin - -- If Seen is False, then the project has not yet been visited + ------------------- + -- Recursive_Add -- + ------------------- - if not In_Tree.Projects.Table (Project).Seen then - In_Tree.Projects.Table (Project).Seen := True; - - declare - Data : constant Project_Data := - In_Tree.Projects.Table (Project); - List : Project_List := Data.Imported_Projects; - - begin - if Process_Source_Dirs then - - -- Add to path all source directories of this project if - -- there are Ada sources. - - if In_Tree.Projects.Table (Project).Ada_Sources /= - Nil_String - then - Add_To_Source_Path (Data.Source_Dirs, In_Tree); - end if; - end if; - - if Process_Object_Dirs then - - -- Add to path the object directory of this project - -- except if we don't include library project and this - -- is a library project. - - if (Data.Library and Including_Libraries) - or else - (Data.Object_Directory /= No_Path_Information - and then - (not Including_Libraries or else not Data.Library)) - then - -- For a library project, add the library ALI - -- directory if there is no object directory or - -- if the library ALI directory contains ALI files; - -- otherwise add the object directory. - - if Data.Library then - if Data.Object_Directory = No_Path_Information - or else Contains_ALI_Files - (Data.Library_ALI_Dir.Name) - then - Add_To_Object_Path - (Data.Library_ALI_Dir.Name, In_Tree); - else - Add_To_Object_Path - (Data.Object_Directory.Name, In_Tree); - end if; - - -- For a non-library project, add object directory if - -- it is not a virtual project, and if there are Ada - -- sources in the project or one of the projects it - -- extends. If there are no Ada sources, adding the - -- object directory could disrupt the order of the - -- object dirs in the path. - - elsif not Data.Virtual then - declare - Add_Object_Dir : Boolean := False; - Prj : Project_Id := Project; - - begin - while not Add_Object_Dir - and then Prj /= No_Project - loop - if In_Tree.Projects.Table - (Prj).Ada_Sources /= Nil_String - then - Add_Object_Dir := True; - - else - Prj := - In_Tree.Projects.Table (Prj).Extends; - end if; - end loop; - - if Add_Object_Dir then - Add_To_Object_Path - (Data.Object_Directory.Name, In_Tree); - end if; - end; - end if; - end if; - end if; - - -- Call Add to the project being extended, if any - - if Data.Extends /= No_Project then - Recursive_Add (Data.Extends); - end if; + procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean) is + pragma Unreferenced (Dummy); + Data : constant Project_Data := In_Tree.Projects.Table (Project); + Path : Path_Name_Type; + begin + -- ??? This is almost the equivalent of For_All_Source_Dirs + if Process_Source_Dirs then - -- Call Add for each imported project, if any + -- Add to path all source directories of this project if + -- there are Ada sources. - while List /= Empty_Project_List loop - Recursive_Add - (In_Tree.Project_Lists.Table - (List).Project); - List := - In_Tree.Project_Lists.Table (List).Next; - end loop; - end; + if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then + Add_To_Source_Path (Data.Source_Dirs, In_Tree); end if; - end Recursive_Add; + end if; - begin - Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0); - Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0); + if Process_Object_Dirs then + Path := Get_Object_Directory + (In_Tree, Project, + Including_Libraries => Including_Libraries, + Only_If_Ada => True); - for Index in Project_Table.First .. - Project_Table.Last (In_Tree.Projects) - loop - In_Tree.Projects.Table (Index).Seen := False; - end loop; + if Path /= No_Path then + Add_To_Object_Path (Path, In_Tree); + end if; + end if; + end Recursive_Add; - Recursive_Add (Proj); - end Add; + procedure For_All_Projects is + new For_Every_Project_Imported (Boolean, Recursive_Add); + Dummy : Boolean := False; -- Start of processing for Set_Ada_Paths @@ -2042,7 +1749,9 @@ package body Prj.Env is -- then call the recursive procedure Add for Project. if Process_Source_Dirs or Process_Object_Dirs then - Add (Project); + Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0); + Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0); + For_All_Projects (Project, In_Tree, Dummy); end if; -- Write and close any file that has been created diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index a558cf9..0f12ebb 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -172,11 +172,4 @@ package Prj.Env is -- Iterate through all the object directories of a project, including -- those of imported or modified projects. - generic - with procedure Action (Project : Project_Id); - procedure For_All_Imported_Projects - (Project : Project_Id; - In_Tree : Project_Tree_Ref); - -- Execute Action for Project and all imported or extended projects - end Prj.Env; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 7c3677b..3928fc1 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -5445,7 +5445,7 @@ package body Prj.Nmsc is Read (Dir, Name_Buffer, Name_Len); if Current_Verbosity = High then - Write_Str (" Checking "); + Write_Str (" Checking "); Write_Line (Name_Buffer (1 .. Name_Len)); end if; @@ -6450,7 +6450,7 @@ package body Prj.Nmsc is if Last = Filename'Last then if Current_Verbosity = High then - Write_Line (" No matching suffix"); + Write_Line (" No matching suffix"); end if; return; end if; @@ -6602,9 +6602,9 @@ package body Prj.Nmsc is and then Current_Verbosity = High then case Kind is - when Spec => Write_Str (" spec of "); - when Impl => Write_Str (" body of "); - when Sep => Write_Str (" sep of "); + when Spec => Write_Str (" spec of "); + when Impl => Write_Str (" body of "); + when Sep => Write_Str (" sep of "); end case; Write_Line (Get_Name_String (Unit)); @@ -8456,7 +8456,7 @@ package body Prj.Nmsc is begin if Current_Verbosity = High then - Write_Str ("Putting "); + Write_Str (" Putting "); Write_Str (Get_Name_String (Unit_Name)); Write_Line (" in the unit list."); end if; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index ac7fd3c..e4ffe49 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -141,16 +141,19 @@ package body Prj.Proc is -- recursively for all imported projects and a extended project, if any. -- Then process the declarative items of the project. - procedure Recursive_Check - (Project : Project_Id; + type Recursive_Check_Data is record In_Tree : Project_Tree_Ref; - Current_Dir : String; - When_No_Sources : Error_Warning); - -- If Project is not marked as checked, mark it as checked, call - -- Check_Naming_Scheme for the project, then call itself for a - -- possible extended project and all the imported projects of Project. + Current_Dir : String_Access; + When_No_Sources : Error_Warning; + end record; + -- Data passed to Recursive_Check -- Current_Dir is for optimization purposes, avoiding extra system calls. + procedure Recursive_Check + (Project : Project_Id; + Data : in out Recursive_Check_Data); + -- Check_Naming_Scheme for the project + --------- -- Add -- --------- @@ -274,16 +277,14 @@ package body Prj.Proc is Current_Dir : String; When_No_Sources : Error_Warning) is - begin - -- Make sure that all projects are marked as not checked + Dir : aliased String := Current_Dir; - for Index in Project_Table.First .. - Project_Table.Last (In_Tree.Projects) - loop - In_Tree.Projects.Table (Index).Checked := False; - end loop; - - Recursive_Check (Project, In_Tree, Current_Dir, When_No_Sources); + procedure Check_All_Projects is new + For_Every_Project_Imported (Recursive_Check_Data, Recursive_Check); + Data : Recursive_Check_Data := + (In_Tree, Dir'Unchecked_Access, When_No_Sources); + begin + Check_All_Projects (Project, In_Tree, Data, Imported_First => True); -- Set the Other_Part field for the units @@ -2461,55 +2462,19 @@ package body Prj.Proc is procedure Recursive_Check (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Current_Dir : String; - When_No_Sources : Error_Warning) + Data : in out Recursive_Check_Data) is - Data : Project_Data; - Imported_Project_List : Project_List := Empty_Project_List; - begin - -- Do nothing if Project is No_Project, or Project has already - -- been marked as checked. - - if Project /= No_Project - and then not In_Tree.Projects.Table (Project).Checked - then - -- Mark project as checked, to avoid infinite recursion in - -- ill-formed trees, where a project imports itself. - - In_Tree.Projects.Table (Project).Checked := True; - - Data := In_Tree.Projects.Table (Project); - - -- Call itself for a possible extended project. - -- (if there is no extended project, then nothing happens). - - Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources); - - -- Call itself for all imported projects - - Imported_Project_List := Data.Imported_Projects; - while Imported_Project_List /= Empty_Project_List loop - Recursive_Check - (In_Tree.Project_Lists.Table - (Imported_Project_List).Project, - In_Tree, Current_Dir, When_No_Sources); - Imported_Project_List := - In_Tree.Project_Lists.Table - (Imported_Project_List).Next; - end loop; - - if Verbose_Mode then - Write_Str ("Checking project file """); - Write_Str (Get_Name_String (Data.Name)); - Write_Line (""""); - end if; - - Prj.Nmsc.Check - (Project, In_Tree, Error_Report, When_No_Sources, - Current_Dir); + if Verbose_Mode then + Write_Str ("Checking project file """); + Write_Str + (Get_Name_String (Data.In_Tree.Projects.Table (Project).Name)); + Write_Line (""""); end if; + + Prj.Nmsc.Check + (Project, Data.In_Tree, Error_Report, Data.When_No_Sources, + Data.Current_Dir.all); end Recursive_Check; ----------------------- diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 913ad88..eb7f653 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -34,6 +34,8 @@ with Snames; use Snames; with Table; with Uintp; use Uintp; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; + with System.Case_Util; use System.Case_Util; with System.HTable; @@ -130,8 +132,6 @@ package body Prj is Config_File_Name => No_Path, Config_File_Temp => False, Config_Checked => False, - Checked => False, - Seen => False, Need_To_Build_Lib => False, Depth => 0, Unkept_Comments => False); @@ -157,6 +157,9 @@ package body Prj is procedure Project_Changed (Iter : in out Source_Iterator); -- Called when a new project or language was selected for this iterator. + function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean; + -- Return True if there is at least one ALI file in the directory Dir + ------------------- -- Add_To_Buffer -- ------------------- @@ -497,8 +500,11 @@ package body Prj is procedure For_Every_Project_Imported (By : Project_Id; In_Tree : Project_Tree_Ref; - With_State : in out State) + With_State : in out State; + Imported_First : Boolean := False) is + use Project_Boolean_Htable; + Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; procedure Recursive_Check (Project : Project_Id); -- Check if a project has already been seen. If not seen, mark it as @@ -509,30 +515,41 @@ package body Prj is --------------------- procedure Recursive_Check (Project : Project_Id) is + Data : Project_Data renames In_Tree.Projects.Table (Project); List : Project_List; begin - if not In_Tree.Projects.Table (Project).Seen then - In_Tree.Projects.Table (Project).Seen := True; - Action (Project, With_State); + if not Get (Seen, Project) then + Set (Seen, Project, True); + + if not Imported_First then + Action (Project, With_State); + end if; + + -- Visited all extended projects - List := In_Tree.Projects.Table (Project).Imported_Projects; + if Data.Extends /= No_Project then + Recursive_Check (Data.Extends); + end if; + + -- Visited all imported projects + + List := Data.Imported_Projects; while List /= Empty_Project_List loop Recursive_Check (In_Tree.Project_Lists.Table (List).Project); List := In_Tree.Project_Lists.Table (List).Next; end loop; + + if Imported_First then + Action (Project, With_State); + end if; end if; end Recursive_Check; -- Start of processing for For_Every_Project_Imported begin - for Project in Project_Table.First .. - Project_Table.Last (In_Tree.Projects) - loop - In_Tree.Projects.Table (Project).Seen := False; - end loop; - Recursive_Check (Project => By); + Reset (Seen); end For_Every_Project_Imported; -------------- @@ -1189,6 +1206,10 @@ package body Prj is function Has_Ada_Sources (Data : Project_Data) return Boolean is Lang : Language_Ptr := Data.Languages; begin + if Data.Ada_Sources /= Nil_String then + return True; + end if; + while Lang /= No_Language_Index loop if Lang.Name = Name_Ada then return Lang.First_Source /= No_Source; @@ -1218,6 +1239,188 @@ package body Prj is return False; end Has_Foreign_Sources; + ------------------------ + -- Contains_ALI_Files -- + ------------------------ + + function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is + Dir_Name : constant String := Get_Name_String (Dir); + Direct : Dir_Type; + Name : String (1 .. 1_000); + Last : Natural; + Result : Boolean := False; + + begin + Open (Direct, Dir_Name); + + -- For each file in the directory, check if it is an ALI file + + loop + Read (Direct, Name, Last); + exit when Last = 0; + Canonical_Case_File_Name (Name (1 .. Last)); + Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali"; + exit when Result; + end loop; + + Close (Direct); + return Result; + + exception + -- If there is any problem, close the directory if open and return + -- True; the library directory will be added to the path. + + when others => + if Is_Open (Direct) then + Close (Direct); + end if; + + return True; + end Contains_ALI_Files; + + -------------------------- + -- Get_Object_Directory -- + -------------------------- + + function Get_Object_Directory + (In_Tree : Project_Tree_Ref; + Project : Project_Id; + Including_Libraries : Boolean; + Only_If_Ada : Boolean := False) return Path_Name_Type + is + Data : Project_Data renames In_Tree.Projects.Table (Project); + begin + if (Data.Library and Including_Libraries) + or else + (Data.Object_Directory /= No_Path_Information + and then (not Including_Libraries or else not Data.Library)) + then + -- For a library project, add the library ALI directory if there is + -- no object directory or if the library ALI directory contains ALI + -- files; otherwise add the object directory. + + if Data.Library then + if Data.Object_Directory = No_Path_Information + or else Contains_ALI_Files (Data.Library_ALI_Dir.Name) + then + return Data.Library_ALI_Dir.Name; + else + return Data.Object_Directory.Name; + end if; + + -- For a non-library project, add object directory if it is not a + -- virtual project, and if there are Ada sources in the project or + -- one of the projects it extends. If there are no Ada sources, + -- adding the object directory could disrupt the order of the + -- object dirs in the path. + + elsif not Data.Virtual then + declare + Add_Object_Dir : Boolean := not Only_If_Ada; + Prj : Project_Id := Project; + + begin + while not Add_Object_Dir and then Prj /= No_Project loop + if Has_Ada_Sources (In_Tree.Projects.Table (Prj)) then + Add_Object_Dir := True; + else + Prj := In_Tree.Projects.Table (Prj).Extends; + end if; + end loop; + + if Add_Object_Dir then + return Data.Object_Directory.Name; + end if; + end; + end if; + end if; + return No_Path; + end Get_Object_Directory; + + ----------------------------------- + -- Ultimate_Extending_Project_Of -- + ----------------------------------- + + function Ultimate_Extending_Project_Of + (Proj : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id + is + Prj : Project_Id := Proj; + begin + while In_Tree.Projects.Table (Prj).Extended_By /= No_Project loop + Prj := In_Tree.Projects.Table (Prj).Extended_By; + end loop; + + return Prj; + end Ultimate_Extending_Project_Of; + + ----------------------------------- + -- Compute_All_Imported_Projects -- + ----------------------------------- + + procedure Compute_All_Imported_Projects + (Project : Project_Id; In_Tree : Project_Tree_Ref) + is + procedure Add_To_List (Prj : Project_Id); + -- Add a project to the list All_Imported_Projects of project Project + + procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean); + -- Recursively add the projects imported by project Project, but not + -- those that are extended. + + ----------------- + -- Add_To_List -- + ----------------- + + procedure Add_To_List (Prj : Project_Id) is + Element : constant Project_Element := + (Prj, In_Tree.Projects.Table (Project).All_Imported_Projects); + List : Project_List; + begin + -- Check that the project is not already in the list. We know the one + -- passed to Recursive_Add have never been visited before, but the + -- one passed it are the extended projects. + + List := In_Tree.Projects.Table (Project).All_Imported_Projects; + while List /= Empty_Project_List loop + if In_Tree.Project_Lists.Table (List).Project = Prj then + return; + end if; + List := In_Tree.Project_Lists.Table (List).Next; + end loop; + + -- Add it to the list + + Project_List_Table.Increment_Last (In_Tree.Project_Lists); + List := Project_List_Table.Last (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table (List) := Element; + In_Tree.Projects.Table (Project).All_Imported_Projects := List; + end Add_To_List; + + ------------------- + -- Recursive_Add -- + ------------------- + + procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is + pragma Unreferenced (Dummy); + Prj2 : Project_Id; + begin + -- A project is not importing itself + if Project /= Prj then + Prj2 := Ultimate_Extending_Project_Of (Prj, In_Tree); + Add_To_List (Prj2); + end if; + end Recursive_Add; + + procedure For_All_Projects is + new For_Every_Project_Imported (Boolean, Recursive_Add); + Dummy : Boolean := False; + + begin + In_Tree.Projects.Table (Project).All_Imported_Projects := + Empty_Project_List; + For_All_Projects (Project, In_Tree, Dummy); + end Compute_All_Imported_Projects; + begin -- Make sure that the standard config and user project file extensions are -- compatible with canonical case file naming. diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 88d0477..7dca8c7 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -906,6 +906,29 @@ package Prj is Naming : in out Naming_Data; Suffix : File_Name_Type); + function Get_Object_Directory + (In_Tree : Project_Tree_Ref; + Project : Project_Id; + Including_Libraries : Boolean; + Only_If_Ada : Boolean := False) return Path_Name_Type; + -- Return the object directory to use for the project. This depends on + -- whether we have a library project or a standard project. This function + -- might return No_Name when no directory applies. + -- If we have a a library project file and Including_Libraries is True then + -- the library dir is returned instead of the object dir. + -- If Only_If_Ada is True, then No_Name will be returned when the project + -- doesn't Ada sources. + + procedure Compute_All_Imported_Projects + (Project : Project_Id; In_Tree : Project_Tree_Ref); + -- Compute, the list of the projects imported directly or indirectly by + -- project Project. The result is stored in Project.All_Imported_Projects + + function Ultimate_Extending_Project_Of + (Proj : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id; + -- Returns the ultimate extending project of project Proj. If project Proj + -- is not extended, returns Proj. + function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data; pragma Inline (Standard_Naming_Data); @@ -1310,14 +1333,6 @@ package Prj is Config_Checked : Boolean := False; -- A flag to avoid checking repetitively the configuration pragmas file - Checked : Boolean := False; - -- A flag to avoid checking repetitively the naming scheme of this - -- project file. - - Seen : Boolean := False; - -- A flag to mark a project as "visited" to avoid processing the same - -- project several time. - Depth : Natural := 0; -- The maximum depth of a project in the project graph. Depth of main -- project is 0. @@ -1496,6 +1511,16 @@ package Prj is -- Otherwise, this information will be automatically added to Naming_Data -- when a project is processed, in the lists Spec_Suffix and Body_Suffix. + package Project_Boolean_Htable is new Simple_HTable + (Header_Num => Header_Num, + Element => Boolean, + No_Element => False, + Key => Project_Id, + Hash => Hash, + Equal => "="); + -- A table that associates a project to a boolean. This is used to detect + -- whether a project was already processed for instance. + generic type State is limited private; with procedure Action @@ -1504,15 +1529,19 @@ package Prj is procedure For_Every_Project_Imported (By : Project_Id; In_Tree : Project_Tree_Ref; - With_State : in out State); + With_State : in out State; + Imported_First : Boolean := False); -- Call Action for each project imported directly or indirectly by project - -- By. Action is called according to the order of importation: if A + -- By, as well as extended projects. + -- The order of processing depends on Imported_First: + -- If False, Action is called according to the order of importation: if A -- imports B, directly or indirectly, Action will be called for A before -- it is called for B. If two projects import each other directly or -- indirectly (using at least one "limited with"), it is not specified - -- for which of these two projects Action will be called first. Projects - -- that are extended by other projects are not considered. With_State may - -- be used by Action to choose a behavior or to report some global result. + -- for which of these two projects Action will be called first. + -- The order is reversed if Imported_First is True. + -- With_State may be used by Action to choose a behavior or to report some + -- global result. function Extend_Name (File : File_Name_Type; |