From faabb4a757f8201e0593e7645c95a4d9be437967 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 5 Oct 2010 09:26:00 +0000 Subject: [PATCH] 2010-10-05 Emmanuel Briot * gnatcmd.adb, prj-proc.adb, prj-part.adb, prj-ext.adb, prj-ext.ads, switch-m.adb, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-env.adb, prj-env.ads, prj-tree.adb, prj-tree.ads (Project_Search_Path): New type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164969 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 6 + gcc/ada/clean.adb | 5 +- gcc/ada/gnatcmd.adb | 5 +- gcc/ada/prj-env.adb | 454 ++++++++++++++++++++++++++++++++++++++++++- gcc/ada/prj-env.ads | 73 ++++++- gcc/ada/prj-ext.adb | 237 ----------------------- gcc/ada/prj-ext.ads | 30 +-- gcc/ada/prj-nmsc.adb | 23 ++- gcc/ada/prj-nmsc.ads | 5 +- gcc/ada/prj-part.adb | 528 ++++++++++++++++----------------------------------- gcc/ada/prj-proc.adb | 18 +- gcc/ada/prj-tree.adb | 3 +- gcc/ada/prj-tree.ads | 8 +- gcc/ada/switch-m.adb | 8 +- 14 files changed, 735 insertions(+), 668 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c6a1af151b0..6f239a3573b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2010-10-05 Emmanuel Briot + + * gnatcmd.adb, prj-proc.adb, prj-part.adb, prj-ext.adb, prj-ext.ads, + switch-m.adb, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-env.adb, + prj-env.ads, prj-tree.adb, prj-tree.ads (Project_Search_Path): New type. + 2010-10-05 Eric Botcazou * exp_ch5.adb (Make_Field_Expr): Revert previous change (removed). diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index f3a1e2fb7a7..8174e91e5ed 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1692,8 +1692,9 @@ package body Clean is Add_Lib_Search_Dir (Arg (4 .. Arg'Last)); elsif Arg (3) = 'P' then - Prj.Ext.Add_Search_Project_Directory - (Project_Node_Tree, Arg (4 .. Arg'Last)); + Prj.Env.Add_Directories + (Project_Node_Tree.Project_Path, + Arg (4 .. Arg'Last)); else Bad_Argument; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 93f7d1c6b93..855a08dcf0a 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1668,8 +1668,9 @@ begin elsif Argv'Length > 3 and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP" then - Add_Search_Project_Directory - (Project_Node_Tree, Argv (Argv'First + 3 .. Argv'Last)); + Prj.Env.Add_Directories + (Project_Node_Tree.Project_Path, + Argv (Argv'First + 3 .. Argv'Last)); Remove_Switch (Arg_Num); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 07b173a67fe..cb01145d24a 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -24,10 +24,14 @@ ------------------------------------------------------------------------------ with Fmap; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with Hostparm; +with Makeutl; use Makeutl; with Opt; -with Osint; use Osint; -with Output; use Output; -with Prj.Com; use Prj.Com; +with Osint; use Osint; +with Output; use Output; +with Prj.Com; use Prj.Com; +with Sdefault; with Tempdir; package body Prj.Env is @@ -35,6 +39,14 @@ package body Prj.Env is Buffer_Initial : constant := 1_000; -- Initial size of Buffer + Uninitialized_Prefix : constant String := '#' & Path_Separator; + -- Prefix to indicate that the project path has not been initilized yet. + -- Must be two characters long + + No_Project_Default_Dir : constant String := "-"; + -- Indicator in the project path to indicate that the default search + -- directories should not be added to the path + ----------------------- -- Local Subprograms -- ----------------------- @@ -97,6 +109,11 @@ package body Prj.Env is -- Return a project that is either Project or an extended ancestor of -- Project that itself is not extended. + procedure Initialize_Project_Path + (Self : in out Project_Search_Path; Target_Name : String); + -- Initialize Current_Project_Path. + -- Does nothing if the path has already been initialized properly + ---------------------- -- Ada_Include_Path -- ---------------------- @@ -1739,4 +1756,435 @@ package body Prj.Env is return Result; end Ultimate_Extension_Of; + --------------------- + -- Add_Directories -- + --------------------- + + procedure Add_Directories + (Self : in out Project_Search_Path; + Path : String) + is + Tmp : String_Access; + begin + if Self.Path = null then + Self.Path := new String'(Uninitialized_Prefix & Path); + else + Tmp := Self.Path; + Self.Path := new String'(Tmp.all & Path_Separator & Path); + Free (Tmp); + end if; + end Add_Directories; + + ----------------------------- + -- Initialize_Project_Path -- + ----------------------------- + + procedure Initialize_Project_Path + (Self : in out Project_Search_Path; Target_Name : String) + is + Add_Default_Dir : Boolean := True; + First : Positive; + Last : Positive; + New_Len : Positive; + New_Last : Positive; + + Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; + Gpr_Project_Path : constant String := "GPR_PROJECT_PATH"; + -- Name of alternate env. variable that contain path name(s) of + -- directories where project files may reside. GPR_PROJECT_PATH has + -- precedence over ADA_PROJECT_PATH. + + Gpr_Prj_Path : String_Access; + Ada_Prj_Path : String_Access; + -- The path name(s) of directories where project files may reside. + -- May be empty. + + begin + -- If already initialized, nothing else to do + if Self.Path /= null + and then Self.Path (Self.Path'First) /= '#' + then + return; + end if; + + -- The current directory is always first in the search path. Since the + -- Project_Path currently starts with '#:' as a sign that it isn't + -- initialized, we simply replace '#' with '.' + + if Self.Path = null then + Self.Path := new String'('.' & Path_Separator); + else + Self.Path (Self.Path'First) := '.'; + end if; + + -- Then the reset of the project path (if any) currently contains the + -- directories added through Add_Search_Project_Directory + + -- If environment variables are defined and not empty, add their content + + Gpr_Prj_Path := Getenv (Gpr_Project_Path); + Ada_Prj_Path := Getenv (Ada_Project_Path); + + if Gpr_Prj_Path.all /= "" then + Add_Directories (Self, Gpr_Prj_Path.all); + end if; + + Free (Gpr_Prj_Path); + + if Ada_Prj_Path.all /= "" then + Add_Directories (Self, Ada_Prj_Path.all); + end if; + + Free (Ada_Prj_Path); + + -- Copy to Name_Buffer, since we will need to manipulate the path + + Name_Len := Self.Path'Length; + Name_Buffer (1 .. Name_Len) := Self.Path.all; + + -- Scan the directory path to see if "-" is one of the directories. + -- Remove each occurrence of "-" and set Add_Default_Dir to False. + -- Also resolve relative paths and symbolic links. + + First := 3; + loop + while First <= Name_Len + and then (Name_Buffer (First) = Path_Separator) + loop + First := First + 1; + end loop; + + exit when First > Name_Len; + + Last := First; + + while Last < Name_Len + and then Name_Buffer (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; + + -- If the directory is "-", set Add_Default_Dir to False and + -- remove from path. + + if Name_Buffer (First .. Last) = No_Project_Default_Dir then + Add_Default_Dir := False; + + for J in Last + 1 .. Name_Len loop + Name_Buffer (J - No_Project_Default_Dir'Length - 1) := + Name_Buffer (J); + end loop; + + Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; + + -- After removing the '-', go back one character to get the next + -- directory correctly. + + Last := Last - 1; + + elsif not Hostparm.OpenVMS + or else not Is_Absolute_Path (Name_Buffer (First .. Last)) + then + -- On VMS, only expand relative path names, as absolute paths + -- may correspond to multi-valued VMS logical names. + + declare + New_Dir : constant String := + Normalize_Pathname + (Name_Buffer (First .. Last), + Resolve_Links => Opt.Follow_Links_For_Dirs); + + begin + -- If the absolute path was resolved and is different from + -- the original, replace original with the resolved path. + + if New_Dir /= Name_Buffer (First .. Last) + and then New_Dir'Length /= 0 + then + New_Len := Name_Len + New_Dir'Length - (Last - First + 1); + New_Last := First + New_Dir'Length - 1; + Name_Buffer (New_Last + 1 .. New_Len) := + Name_Buffer (Last + 1 .. Name_Len); + Name_Buffer (First .. New_Last) := New_Dir; + Name_Len := New_Len; + Last := New_Last; + end if; + end; + end if; + + First := Last + 1; + end loop; + + Free (Self.Path); + + -- Set the initial value of Current_Project_Path + + if Add_Default_Dir then + declare + Prefix : String_Ptr := Sdefault.Search_Dir_Prefix; + + begin + if Prefix = null then + Prefix := new String'(Executable_Prefix_Path); + + if Prefix.all /= "" then + if Target_Name /= "" then + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + "lib" & Directory_Separator & "gpr" & + Directory_Separator & Target_Name); + end if; + + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + "share" & Directory_Separator & "gpr"); + Add_Str_To_Name_Buffer + (Path_Separator & Prefix.all & + "lib" & Directory_Separator & "gnat"); + end if; + + else + Self.Path := + new String'(Name_Buffer (1 .. Name_Len) & Path_Separator & + Prefix.all & + ".." & Directory_Separator & + ".." & Directory_Separator & + ".." & Directory_Separator & "gnat"); + end if; + + Free (Prefix); + end; + end if; + + if Self.Path = null then + Self.Path := new String'(Name_Buffer (1 .. Name_Len)); + end if; + end Initialize_Project_Path; + + -------------- + -- Get_Path -- + -------------- + + procedure Get_Path + (Self : in out Project_Search_Path; + Path : out String_Access) + is + begin + Initialize_Project_Path (Self, ""); -- ??? Target_Name unspecified + Path := Self.Path; + end Get_Path; + + --------------- + -- Deep_Copy -- + --------------- + + function Deep_Copy + (Self : Project_Search_Path) return Project_Search_Path is + begin + if Self.Path = null then + return Project_Search_Path' + (Path => null, Cache => Projects_Paths.Nil); + else + return Project_Search_Path' + (Path => new String'(Self.Path.all), + Cache => Projects_Paths.Nil); + end if; + end Deep_Copy; + + ------------------ + -- Find_Project -- + ------------------ + + procedure Find_Project + (Self : in out Project_Search_Path; + Project_File_Name : String; + Directory : String; + Path : out Namet.Path_Name_Type) + is + File : constant String := Project_File_Name; + -- Have to do a copy, in case the parameter is Name_Buffer, which we + -- modify below + + function Try_Path_Name (Path : String) return String_Access; + pragma Inline (Try_Path_Name); + -- Try the specified Path + + ------------------- + -- Try_Path_Name -- + ------------------- + + function Try_Path_Name (Path : String) return String_Access is + First : Natural; + Last : Natural; + Result : String_Access := null; + + begin + if Current_Verbosity = High then + Write_Str (" Trying "); + Write_Line (Path); + end if; + + if Is_Absolute_Path (Path) then + if Is_Regular_File (Path) then + Result := new String'(Path); + end if; + + else + -- Because we don't want to resolve symbolic links, we cannot use + -- Locate_Regular_File. So, we try each possible path + -- successively. + + First := Self.Path'First; + while First <= Self.Path'Last loop + while First <= Self.Path'Last + and then Self.Path (First) = Path_Separator + loop + First := First + 1; + end loop; + + exit when First > Self.Path'Last; + + Last := First; + while Last < Self.Path'Last + and then Self.Path (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; + + Name_Len := 0; + + if not Is_Absolute_Path (Self.Path (First .. Last)) then + Add_Str_To_Name_Buffer (Get_Current_Dir); -- ??? System call + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + + Add_Str_To_Name_Buffer (Self.Path (First .. Last)); + Add_Char_To_Name_Buffer (Directory_Separator); + Add_Str_To_Name_Buffer (Path); + + if Current_Verbosity = High then + Write_Str (" Testing file "); + Write_Line (Name_Buffer (1 .. Name_Len)); + end if; + + if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then + Result := new String'(Name_Buffer (1 .. Name_Len)); + exit; + end if; + + First := Last + 1; + end loop; + end if; + + return Result; + end Try_Path_Name; + + -- Local Declarations + + Result : String_Access; + Has_Dot : Boolean := False; + Key : Name_Id; + + -- Start of processing for Project_Path_Name_Of + + begin + Initialize_Project_Path (Self, ""); + + if Current_Verbosity = High then + Write_Str ("Searching for project ("""); + Write_Str (File); + Write_Str (""", """); + Write_Str (Directory); + Write_Line (""");"); + end if; + + -- Check the project cache + + Name_Len := File'Length; + Name_Buffer (1 .. Name_Len) := File; + Key := Name_Find; + Path := Projects_Paths.Get (Self.Cache, Key); + + if Path /= No_Path then + return; + end if; + + -- Check if File contains an extension (a dot before a + -- directory separator). If it is the case we do not try project file + -- with an added extension as it is not possible to have multiple dots + -- on a project file name. + + Check_Dot : for K in reverse File'Range loop + if File (K) = '.' then + Has_Dot := True; + exit Check_Dot; + end if; + + exit Check_Dot when File (K) = Directory_Separator + or else File (K) = '/'; + end loop Check_Dot; + + if not Is_Absolute_Path (File) then + + -- First we try /. + + if not Has_Dot then + Result := Try_Path_Name + (Directory & Directory_Separator & + File & Project_File_Extension); + end if; + + -- Then we try / + + if Result = null then + Result := Try_Path_Name (Directory & Directory_Separator & File); + end if; + end if; + + -- Then we try . + + if Result = null and then not Has_Dot then + Result := Try_Path_Name (File & Project_File_Extension); + end if; + + -- Then we try + + if Result = null then + Result := Try_Path_Name (File); + end if; + + -- If we cannot find the project file, we return an empty string + + if Result = null then + Path := Namet.No_Path; + return; + + else + declare + Final_Result : constant String := + GNAT.OS_Lib.Normalize_Pathname + (Result.all, + Directory => Directory, + Resolve_Links => Opt.Follow_Links_For_Files, + Case_Sensitive => True); + begin + Free (Result); + Name_Len := Final_Result'Length; + Name_Buffer (1 .. Name_Len) := Final_Result; + Path := Name_Find; + Projects_Paths.Set (Self.Cache, Key, Path); + end; + end if; + end Find_Project; + + ---------- + -- Free -- + ---------- + + procedure Free (Self : in out Project_Search_Path) is + begin + Free (Self.Path); + Projects_Paths.Reset (Self.Cache); + end Free; + end Prj.Env; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 9dcde328038..83e078319f8 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -26,6 +26,9 @@ -- This package implements services for Project-aware tools, mostly related -- to the environment (configuration pragma files, path files, mapping files). +with GNAT.Dynamic_HTables; +with System.OS_Lib; + package Prj.Env is procedure Initialize (In_Tree : Project_Tree_Ref); @@ -152,4 +155,72 @@ package Prj.Env is -- Iterate through all the object directories of a project, including -- those of imported or modified projects. + ------------------ + -- Project Path -- + ------------------ + + type Project_Search_Path is private; + -- An abstraction of the project path. This object provides subprograms to + -- search for projects on the path (and caches the results for more + -- efficiency). + + procedure Free (Self : in out Project_Search_Path); + -- Free the memory used by Self + + procedure Add_Directories + (Self : in out Project_Search_Path; + Path : String); + -- Add one or more directories to the path. + -- Directories added with this procedure are added in order after the + -- current directory and before the path given by the environment variable + -- GPR_PROJECT_PATH. A value of "-" will remove the default project + -- directory from the project path. + -- + -- Calls to this subprogram must be performed before the first call to + -- Find_Project below, or PATH will be added at the end of the search + -- path. + + procedure Get_Path + (Self : in out Project_Search_Path; + Path : out String_Access); + -- Return the current value of the project path, either the value set + -- during elaboration of the package or, if procedure Set_Project_Path has + -- been called, the value set by the last call to Set_Project_Path. + -- The returned value must not be modified. + + procedure Find_Project + (Self : in out Project_Search_Path; + Project_File_Name : String; + Directory : String; + Path : out Namet.Path_Name_Type); + -- Search for a the project with the given name either in Directory (which + -- often will be the directory contain the project we are currently + -- parsing and which we found a reference to another project), or in the + -- project path. Extra_Project_Path contains additional directories to + -- search. + -- Project_File_Name can optionally contain directories, and the extension + -- (.gpr) for the file name is optional. + -- Returns No_Name if no such project was found. + + function Deep_Copy (Self : Project_Search_Path) return Project_Search_Path; + -- Return a deep copy of Self. The result can be modified independently of + -- Self, and must be freed by the caller + +private + package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable + (Header_Num => Header_Num, + Element => Path_Name_Type, + No_Element => No_Path, + Key => Name_Id, + Hash => Hash, + Equal => "="); + + type Project_Search_Path is record + Path : System.OS_Lib.String_Access; + -- As a special case, if the first character is '#:" or this variable is + -- unset, this means that the PATH has not been fully initialized yet + -- (although subprograms above will properly take care of that). + + Cache : Projects_Paths.Instance; + end record; end Prj.Env; diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 40816cf24de..cb2cca24e57 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -23,26 +23,11 @@ -- -- ------------------------------------------------------------------------------ -with Hostparm; -with Makeutl; use Makeutl; -with Opt; with Osint; use Osint; with Prj.Tree; use Prj.Tree; -with Sdefault; package body Prj.Ext is - No_Project_Default_Dir : constant String := "-"; - -- Indicator in the project path to indicate that the default search - -- directories should not be added to the path - - Uninitialized_Prefix : constant String := '#' & Path_Separator; - -- Prefix to indicate that the project path has not been initilized yet. - -- Must be two characters long - - procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref); - -- Initialize Current_Project_Path - --------- -- Add -- --------- @@ -65,25 +50,6 @@ package body Prj.Ext is Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value); end Add; - ---------------------------------- - -- Add_Search_Project_Directory -- - ---------------------------------- - - procedure Add_Search_Project_Directory - (Tree : Prj.Tree.Project_Node_Tree_Ref; - Path : String) - is - Tmp : String_Access; - begin - if Tree.Project_Path = null then - Tree.Project_Path := new String'(Uninitialized_Prefix & Path); - else - Tmp := Tree.Project_Path; - Tree.Project_Path := new String'(Tmp.all & Path_Separator & Path); - Free (Tmp); - end if; - end Add_Search_Project_Directory; - ----------- -- Check -- ----------- @@ -109,197 +75,6 @@ package body Prj.Ext is return False; end Check; - ----------------------------- - -- Initialize_Project_Path -- - ----------------------------- - - procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) is - Add_Default_Dir : Boolean := True; - First : Positive; - Last : Positive; - New_Len : Positive; - New_Last : Positive; - - Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; - Gpr_Project_Path : constant String := "GPR_PROJECT_PATH"; - -- Name of alternate env. variable that contain path name(s) of - -- directories where project files may reside. GPR_PROJECT_PATH has - -- precedence over ADA_PROJECT_PATH. - - Gpr_Prj_Path : String_Access := Getenv (Gpr_Project_Path); - Ada_Prj_Path : String_Access := Getenv (Ada_Project_Path); - -- The path name(s) of directories where project files may reside. - -- May be empty. - - begin - -- The current directory is always first in the search path. Since the - -- Project_Path currently starts with '#:' as a sign that it isn't - -- initialized, we simply replace '#' with '.' - - if Tree.Project_Path = null then - Tree.Project_Path := new String'('.' & Path_Separator); - else - Tree.Project_Path (Tree.Project_Path'First) := '.'; - end if; - - -- Then the reset of the project path (if any) currently contains the - -- directories added through Add_Search_Project_Directory - - -- If environment variables are defined and not empty, add their content - - if Gpr_Prj_Path.all /= "" then - Add_Search_Project_Directory (Tree, Gpr_Prj_Path.all); - end if; - - Free (Gpr_Prj_Path); - - if Ada_Prj_Path.all /= "" then - Add_Search_Project_Directory (Tree, Ada_Prj_Path.all); - end if; - - Free (Ada_Prj_Path); - - -- Copy to Name_Buffer, since we will need to manipulate the path - - Name_Len := Tree.Project_Path'Length; - Name_Buffer (1 .. Name_Len) := Tree.Project_Path.all; - - -- Scan the directory path to see if "-" is one of the directories. - -- Remove each occurrence of "-" and set Add_Default_Dir to False. - -- Also resolve relative paths and symbolic links. - - First := 3; - loop - while First <= Name_Len - and then (Name_Buffer (First) = Path_Separator) - loop - First := First + 1; - end loop; - - exit when First > Name_Len; - - Last := First; - - while Last < Name_Len - and then Name_Buffer (Last + 1) /= Path_Separator - loop - Last := Last + 1; - end loop; - - -- If the directory is "-", set Add_Default_Dir to False and - -- remove from path. - - if Name_Buffer (First .. Last) = No_Project_Default_Dir then - Add_Default_Dir := False; - - for J in Last + 1 .. Name_Len loop - Name_Buffer (J - No_Project_Default_Dir'Length - 1) := - Name_Buffer (J); - end loop; - - Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; - - -- After removing the '-', go back one character to get the next - -- directory correctly. - - Last := Last - 1; - - elsif not Hostparm.OpenVMS - or else not Is_Absolute_Path (Name_Buffer (First .. Last)) - then - -- On VMS, only expand relative path names, as absolute paths - -- may correspond to multi-valued VMS logical names. - - declare - New_Dir : constant String := - Normalize_Pathname - (Name_Buffer (First .. Last), - Resolve_Links => Opt.Follow_Links_For_Dirs); - - begin - -- If the absolute path was resolved and is different from - -- the original, replace original with the resolved path. - - if New_Dir /= Name_Buffer (First .. Last) - and then New_Dir'Length /= 0 - then - New_Len := Name_Len + New_Dir'Length - (Last - First + 1); - New_Last := First + New_Dir'Length - 1; - Name_Buffer (New_Last + 1 .. New_Len) := - Name_Buffer (Last + 1 .. Name_Len); - Name_Buffer (First .. New_Last) := New_Dir; - Name_Len := New_Len; - Last := New_Last; - end if; - end; - end if; - - First := Last + 1; - end loop; - - Free (Tree.Project_Path); - - -- Set the initial value of Current_Project_Path - - if Add_Default_Dir then - declare - Prefix : String_Ptr := Sdefault.Search_Dir_Prefix; - - begin - if Prefix = null then - Prefix := new String'(Executable_Prefix_Path); - - if Prefix.all /= "" then - if Tree.Target_Name /= null - and then Tree.Target_Name.all /= "" - then - Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - "lib" & Directory_Separator & "gpr" & - Directory_Separator & Tree.Target_Name.all); - end if; - - Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - "share" & Directory_Separator & "gpr"); - Add_Str_To_Name_Buffer - (Path_Separator & Prefix.all & - "lib" & Directory_Separator & "gnat"); - end if; - - else - Tree.Project_Path := - new String'(Name_Buffer (1 .. Name_Len) & Path_Separator & - Prefix.all & - ".." & Directory_Separator & - ".." & Directory_Separator & - ".." & Directory_Separator & "gnat"); - end if; - - Free (Prefix); - end; - end if; - - if Tree.Project_Path = null then - Tree.Project_Path := new String'(Name_Buffer (1 .. Name_Len)); - end if; - end Initialize_Project_Path; - - ------------------ - -- Project_Path -- - ------------------ - - function Project_Path (Tree : Project_Node_Tree_Ref) return String is - begin - if Tree.Project_Path = null - or else Tree.Project_Path (Tree.Project_Path'First) = '#' - then - Initialize_Project_Path (Tree); - end if; - - return Tree.Project_Path.all; - end Project_Path; - ----------- -- Reset -- ----------- @@ -309,18 +84,6 @@ package body Prj.Ext is Name_To_Name_HTable.Reset (Tree.External_References); end Reset; - ---------------------- - -- Set_Project_Path -- - ---------------------- - - procedure Set_Project_Path - (Tree : Project_Node_Tree_Ref; - New_Path : String) is - begin - Free (Tree.Project_Path); - Tree.Project_Path := new String'(New_Path); - end Set_Project_Path; - -------------- -- Value_Of -- -------------- diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads index c171f5940f1..1fb389c4a7c 100644 --- a/gcc/ada/prj-ext.ads +++ b/gcc/ada/prj-ext.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,34 +30,6 @@ with Prj.Tree; package Prj.Ext is - ------------------ - -- Project Path -- - ------------------ - - procedure Add_Search_Project_Directory - (Tree : Prj.Tree.Project_Node_Tree_Ref; - Path : String); - -- Add a directory to the project path. Directories added with this - -- procedure are added in order after the current directory and before - -- the path given by the environment variable GPR_PROJECT_PATH. A value - -- of "-" will remove the default project directory from the project path. - -- - -- Calls to this subprogram must be performed before the first call to - -- Project_Path below, or PATH will be added at the end of the search - -- path. - - function Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) return String; - -- Return the current value of the project path, either the value set - -- during elaboration of the package or, if procedure Set_Project_Path has - -- been called, the value set by the last call to Set_Project_Path. - - procedure Set_Project_Path - (Tree : Prj.Tree.Project_Node_Tree_Ref; - New_Path : String); - -- Give a new value to the project path. The new value New_Path should - -- always start with the current directory (".") and the path separators - -- should be the correct ones for the platform. - ------------------------- -- External References -- ------------------------- diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index b4c91e828ed..482ecb77d94 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -149,6 +149,7 @@ package body Prj.Nmsc is type Tree_Processing_Data is record Tree : Project_Tree_Ref; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; File_To_Source : Files_Htable.Instance; Flags : Prj.Processing_Flags; end record; @@ -173,9 +174,10 @@ package body Prj.Nmsc is -- projects do not have the same library names. procedure Initialize - (Data : out Tree_Processing_Data; - Tree : Project_Tree_Ref; - Flags : Prj.Processing_Flags); + (Data : out Tree_Processing_Data; + Tree : Project_Tree_Ref; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; + Flags : Prj.Processing_Flags); -- Initialize Data procedure Free (Data : in out Tree_Processing_Data); @@ -6574,14 +6576,16 @@ package body Prj.Nmsc is ---------------- procedure Initialize - (Data : out Tree_Processing_Data; - Tree : Project_Tree_Ref; - Flags : Prj.Processing_Flags) + (Data : out Tree_Processing_Data; + Tree : Project_Tree_Ref; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; + Flags : Prj.Processing_Flags) is begin Files_Htable.Reset (Data.File_To_Source); - Data.Tree := Tree; - Data.Flags := Flags; + Data.Tree := Tree; + Data.Node_Tree := Node_Tree; + Data.Flags := Flags; end Initialize; ---------- @@ -7611,6 +7615,7 @@ package body Prj.Nmsc is procedure Process_Naming_Scheme (Tree : Project_Tree_Ref; Root_Project : Project_Id; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Flags : Processing_Flags) is procedure Recursive_Check @@ -7644,7 +7649,7 @@ package body Prj.Nmsc is -- Start of processing for Process_Naming_Scheme begin Lib_Data_Table.Init; - Initialize (Data, Tree => Tree, Flags => Flags); + Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags); Check_All_Projects (Root_Project, Data, Imported_First => True); Free (Data); diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index c69084f99ff..ce57e9007c1 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,11 +25,14 @@ -- Find source dirs and source files for a project +with Prj.Tree; + private package Prj.Nmsc is procedure Process_Naming_Scheme (Tree : Project_Tree_Ref; Root_Project : Project_Id; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Flags : Processing_Flags); -- Perform consistency and semantic checks on all the projects in the tree. -- This procedure interprets the various case statements in the project diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index b10b5664573..93b6f260b57 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -29,8 +29,8 @@ with Osint; use Osint; with Output; use Output; with Prj.Com; use Prj.Com; with Prj.Dect; +with Prj.Env; use Prj.Env; with Prj.Err; use Prj.Err; -with Prj.Ext; use Prj.Ext; with Sinput; use Sinput; with Sinput.P; use Sinput.P; with Snames; @@ -39,7 +39,6 @@ with Table; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Exceptions; use Ada.Exceptions; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.HTable; use GNAT.HTable; package body Prj.Part is @@ -118,14 +117,6 @@ package body Prj.Part is -- need to have a virtual extending project, to avoid processing the same -- project twice. - package Projects_Paths is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Path_Name_Type, - No_Element => No_Path, - Key => Name_Id, - Hash => Hash, - Equal => "="); - function Has_Circular_Dependencies (Flags : Processing_Flags; Normed_Path_Name : Path_Name_Type; @@ -186,7 +177,7 @@ package body Prj.Part is (In_Tree : Project_Node_Tree_Ref; Project : out Project_Node_Id; Extends_All : out Boolean; - Path_Name : String; + Path_Name_Id : Path_Name_Type; Extended : Boolean; From_Extended : Extension_Origin; In_Limited : Boolean; @@ -239,13 +230,6 @@ package body Prj.Part is -- Is_Config_File should be set to True if the project represents a config -- file (.cgpr) since some specific checks apply. - function Project_Path_Name_Of - (In_Tree : Project_Node_Tree_Ref; - Project_File_Name : String; - Directory : String) return String; - -- Returns the path name of a project file. Returns an empty string - -- if project file cannot be found. - function Project_Name_From (Path_Name : String; Is_Config_File : Boolean) return Name_Id; @@ -472,6 +456,7 @@ package body Prj.Part is Real_Project_File_Name : String_Access := Osint.To_Canonical_File_Spec (Project_File_Name); + Path_Name_Id : Path_Name_Type; begin if Real_Project_File_Name = null then @@ -480,153 +465,146 @@ package body Prj.Part is Project := Empty_Node; - Projects_Paths.Reset; - - if Current_Verbosity >= Medium then - Write_Str ("GPR_PROJECT_PATH="""); - Write_Str (Project_Path (In_Tree)); - Write_Line (""""); - end if; - - declare - Path_Name : constant String := - Project_Path_Name_Of (In_Tree, - Real_Project_File_Name.all, - Directory => Current_Directory); + Find_Project (In_Tree.Project_Path, + Project_File_Name => Real_Project_File_Name.all, + Directory => Current_Directory, + Path => Path_Name_Id); + Free (Real_Project_File_Name); - begin - Free (Real_Project_File_Name); + Prj.Err.Initialize; + Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); + Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); - Prj.Err.Initialize; - Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); - Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); - - -- Parse the main project file - - if Path_Name = "" then + if Path_Name_Id = No_Path then + declare + P : String_Access; + begin + Get_Path (In_Tree.Project_Path, Path => P); Prj.Com.Fail ("project file """ & Project_File_Name & """ not found in " - & Project_Path (In_Tree)); + & P.all); Project := Empty_Node; return; - end if; + end; + end if; - begin - Parse_Single_Project - (In_Tree => In_Tree, - Project => Project, - Extends_All => Dummy, - Path_Name => Path_Name, - Extended => False, - From_Extended => None, - In_Limited => False, - Packages_To_Check => Packages_To_Check, - Depth => 0, - Current_Dir => Current_Directory, - Is_Config_File => Is_Config_File, - Flags => Flags); + -- Parse the main project file - exception - when Types.Unrecoverable_Error => - -- Unrecoverable_Error is raised when a line is too long. - -- A meaningful error message will be displayed later. - Project := Empty_Node; - end; + begin + Parse_Single_Project + (In_Tree => In_Tree, + Project => Project, + Extends_All => Dummy, + Path_Name_Id => Path_Name_Id, + Extended => False, + From_Extended => None, + In_Limited => False, + Packages_To_Check => Packages_To_Check, + Depth => 0, + Current_Dir => Current_Directory, + Is_Config_File => Is_Config_File, + Flags => Flags); - -- If Project is an extending-all project, create the eventual - -- virtual extending projects and check that there are no illegally - -- imported projects. + exception + when Types.Unrecoverable_Error => + -- Unrecoverable_Error is raised when a line is too long. + -- A meaningful error message will be displayed later. + Project := Empty_Node; + end; - if Present (Project) - and then Is_Extending_All (Project, In_Tree) - then - -- First look for projects that potentially need a virtual - -- extending project. + -- If Project is an extending-all project, create the eventual + -- virtual extending projects and check that there are no illegally + -- imported projects. - Virtual_Hash.Reset; - Processed_Hash.Reset; + if Present (Project) + and then Is_Extending_All (Project, In_Tree) + then + -- First look for projects that potentially need a virtual + -- extending project. - -- Mark the extending all project as processed, to avoid checking - -- the imported projects in case of a "limited with" on this - -- extending all project. + Virtual_Hash.Reset; + Processed_Hash.Reset; - Processed_Hash.Set (Project, True); + -- Mark the extending all project as processed, to avoid checking + -- the imported projects in case of a "limited with" on this + -- extending all project. - declare - Declaration : constant Project_Node_Id := - Project_Declaration_Of (Project, In_Tree); - begin - Look_For_Virtual_Projects_For - (Extended_Project_Of (Declaration, In_Tree), In_Tree, - Potentially_Virtual => False); - end; + Processed_Hash.Set (Project, True); - -- Now, check the projects directly imported by the main project. - -- Remove from the potentially virtual any project extended by one - -- of these imported projects. For non extending imported - -- projects, check that they do not belong to the project tree of - -- the project being "extended-all" by the main project. + declare + Declaration : constant Project_Node_Id := + Project_Declaration_Of (Project, In_Tree); + begin + Look_For_Virtual_Projects_For + (Extended_Project_Of (Declaration, In_Tree), In_Tree, + Potentially_Virtual => False); + end; - declare - With_Clause : Project_Node_Id; - Imported : Project_Node_Id := Empty_Node; - Declaration : Project_Node_Id := Empty_Node; + -- Now, check the projects directly imported by the main project. + -- Remove from the potentially virtual any project extended by one + -- of these imported projects. For non extending imported + -- projects, check that they do not belong to the project tree of + -- the project being "extended-all" by the main project. - begin - With_Clause := First_With_Clause_Of (Project, In_Tree); - while Present (With_Clause) loop - Imported := Project_Node_Of (With_Clause, In_Tree); + declare + With_Clause : Project_Node_Id; + Imported : Project_Node_Id := Empty_Node; + Declaration : Project_Node_Id := Empty_Node; - if Present (Imported) then - Declaration := Project_Declaration_Of (Imported, In_Tree); + begin + With_Clause := First_With_Clause_Of (Project, In_Tree); + while Present (With_Clause) loop + Imported := Project_Node_Of (With_Clause, In_Tree); - if Extended_Project_Of (Declaration, In_Tree) /= - Empty_Node - then - loop - Imported := - Extended_Project_Of (Declaration, In_Tree); - exit when No (Imported); - Virtual_Hash.Remove (Imported); - Declaration := - Project_Declaration_Of (Imported, In_Tree); - end loop; - end if; + if Present (Imported) then + Declaration := Project_Declaration_Of (Imported, In_Tree); + + if Extended_Project_Of (Declaration, In_Tree) /= + Empty_Node + then + loop + Imported := + Extended_Project_Of (Declaration, In_Tree); + exit when No (Imported); + Virtual_Hash.Remove (Imported); + Declaration := + Project_Declaration_Of (Imported, In_Tree); + end loop; end if; + end if; - With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); - end loop; - end; + With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); + end loop; + end; - -- Now create all the virtual extending projects + -- Now create all the virtual extending projects - declare - Proj : Project_Node_Id := Virtual_Hash.Get_First; - begin - while Present (Proj) loop - Create_Virtual_Extending_Project (Proj, Project, In_Tree); - Proj := Virtual_Hash.Get_Next; - end loop; - end; - end if; + declare + Proj : Project_Node_Id := Virtual_Hash.Get_First; + begin + while Present (Proj) loop + Create_Virtual_Extending_Project (Proj, Project, In_Tree); + Proj := Virtual_Hash.Get_Next; + end loop; + end; + end if; - -- If there were any kind of error during the parsing, serious - -- or not, then the parsing fails. + -- If there were any kind of error during the parsing, serious + -- or not, then the parsing fails. - if Err_Vars.Total_Errors_Detected > 0 then - Project := Empty_Node; - end if; + if Err_Vars.Total_Errors_Detected > 0 then + Project := Empty_Node; + end if; - if No (Project) or else Always_Errout_Finalize then - Prj.Err.Finalize; + if No (Project) or else Always_Errout_Finalize then + Prj.Err.Finalize; - -- Reinitialize to avoid duplicate warnings later on + -- Reinitialize to avoid duplicate warnings later on - Prj.Err.Initialize; - end if; - end; + Prj.Err.Initialize; + end if; exception when X : others => @@ -769,6 +747,7 @@ package body Prj.Part is Current_With : With_Record; Extends_All : Boolean := False; + Imported_Path_Name_Id : Path_Name_Type; begin -- Set Current_Project to the last project in the current list, if the @@ -787,51 +766,48 @@ package body Prj.Part is Current_With_Clause := Current_With.Next; if Limited_Withs = Current_With.Limited_With then - declare - Original_Path : constant String := - Get_Name_String (Current_With.Path); + Find_Project + (In_Tree.Project_Path, + Project_File_Name => Get_Name_String (Current_With.Path), + Directory => Project_Directory_Path, + Path => Imported_Path_Name_Id); - Imported_Path_Name : constant String := - Project_Path_Name_Of - (In_Tree, - Original_Path, - Project_Directory_Path); - - Resolved_Path : constant String := - Normalize_Pathname - (Imported_Path_Name, - Directory => Current_Dir, - Resolve_Links => - Opt.Follow_Links_For_Files, - Case_Sensitive => True); + if Imported_Path_Name_Id = No_Path then - Withed_Project : Project_Node_Id := Empty_Node; + -- The project file cannot be found - begin - if Imported_Path_Name = "" then + Error_Msg_File_1 := File_Name_Type (Current_With.Path); + Error_Msg + (Flags, "unknown project file: {", Current_With.Location); - -- The project file cannot be found + -- If this is not imported by the main project file, display + -- the import path. - Error_Msg_File_1 := File_Name_Type (Current_With.Path); - Error_Msg - (Flags, "unknown project file: {", Current_With.Location); + if Project_Stack.Last > 1 then + for Index in reverse 1 .. Project_Stack.Last loop + Error_Msg_File_1 := + File_Name_Type + (Project_Stack.Table (Index).Path_Name); + Error_Msg + (Flags, "\imported by {", Current_With.Location); + end loop; + end if; - -- If this is not imported by the main project file, display - -- the import path. + else + -- New with clause - if Project_Stack.Last > 1 then - for Index in reverse 1 .. Project_Stack.Last loop - Error_Msg_File_1 := - File_Name_Type - (Project_Stack.Table (Index).Path_Name); - Error_Msg - (Flags, "\imported by {", Current_With.Location); - end loop; - end if; + declare + Resolved_Path : constant String := + Normalize_Pathname + (Get_Name_String (Imported_Path_Name_Id), + Directory => Current_Dir, + Resolve_Links => + Opt.Follow_Links_For_Files, + Case_Sensitive => True); - else - -- New with clause + Withed_Project : Project_Node_Id := Empty_Node; + begin Previous_Project := Current_Project; if No (Current_Project) then @@ -890,7 +866,7 @@ package body Prj.Part is (In_Tree => In_Tree, Project => Withed_Project, Extends_All => Extends_All, - Path_Name => Imported_Path_Name, + Path_Name_Id => Imported_Path_Name_Id, Extended => False, From_Extended => From_Extended, In_Limited => Limited_Withs, @@ -939,8 +915,8 @@ package body Prj.Part is Set_Is_Extending_All (Current_Project, In_Tree); end if; end if; - end if; - end; + end; + end if; end if; end loop; end Post_Parse_Context_Clause; @@ -1132,7 +1108,7 @@ package body Prj.Part is (In_Tree : Project_Node_Tree_Ref; Project : out Project_Node_Id; Extends_All : out Boolean; - Path_Name : String; + Path_Name_Id : Path_Name_Type; Extended : Boolean; From_Extended : Extension_Origin; In_Limited : Boolean; @@ -1142,6 +1118,8 @@ package body Prj.Part is Is_Config_File : Boolean; Flags : Processing_Flags) is + Path_Name : constant String := Get_Name_String (Path_Name_Id); + Normed_Path_Name : Path_Name_Type; Canonical_Path_Name : Path_Name_Type; Project_Directory : Path_Name_Type; @@ -1397,7 +1375,7 @@ package body Prj.Part is -- Make sure that gnatmake will use mapping files - Create_Mapping_File := True; + Opt.Create_Mapping_File := True; -- We are extending another project @@ -1557,16 +1535,15 @@ package body Prj.Part is declare Original_Path_Name : constant String := Get_Name_String (Token_Name); - - Extended_Project_Path_Name : constant String := - Project_Path_Name_Of - (In_Tree, - Original_Path_Name, - Get_Name_String - (Project_Directory)); - + Extended_Project_Path_Name_Id : Path_Name_Type; begin - if Extended_Project_Path_Name = "" then + Find_Project + (In_Tree.Project_Path, + Project_File_Name => Original_Path_Name, + Directory => Get_Name_String (Project_Directory), + Path => Extended_Project_Path_Name_Id); + + if Extended_Project_Path_Name_Id = No_Path then -- We could not find the project file to extend @@ -1604,7 +1581,7 @@ package body Prj.Part is (In_Tree => In_Tree, Project => Extended_Project, Extends_All => Extends_All, - Path_Name => Extended_Project_Path_Name, + Path_Name_Id => Extended_Project_Path_Name_Id, Extended => True, From_Extended => From_Ext, In_Limited => In_Limited, @@ -2010,183 +1987,4 @@ package body Prj.Part is end loop; end Project_Name_From; - -------------------------- - -- Project_Path_Name_Of -- - -------------------------- - - function Project_Path_Name_Of - (In_Tree : Project_Node_Tree_Ref; - Project_File_Name : String; - Directory : String) return String - is - - function Try_Path_Name (Path : String) return String_Access; - pragma Inline (Try_Path_Name); - -- Try the specified Path - - ------------------- - -- Try_Path_Name -- - ------------------- - - function Try_Path_Name (Path : String) return String_Access is - Prj_Path : constant String := Project_Path (In_Tree); - First : Natural; - Last : Natural; - Result : String_Access := null; - - begin - if Current_Verbosity = High then - Write_Str (" Trying "); - Write_Line (Path); - end if; - - if Is_Absolute_Path (Path) then - if Is_Regular_File (Path) then - Result := new String'(Path); - end if; - - else - -- Because we don't want to resolve symbolic links, we cannot use - -- Locate_Regular_File. So, we try each possible path - -- successively. - - First := Prj_Path'First; - while First <= Prj_Path'Last loop - while First <= Prj_Path'Last - and then Prj_Path (First) = Path_Separator - loop - First := First + 1; - end loop; - - exit when First > Prj_Path'Last; - - Last := First; - while Last < Prj_Path'Last - and then Prj_Path (Last + 1) /= Path_Separator - loop - Last := Last + 1; - end loop; - - Name_Len := 0; - - if not Is_Absolute_Path (Prj_Path (First .. Last)) then - Add_Str_To_Name_Buffer (Get_Current_Dir); - Add_Char_To_Name_Buffer (Directory_Separator); - end if; - - Add_Str_To_Name_Buffer (Prj_Path (First .. Last)); - Add_Char_To_Name_Buffer (Directory_Separator); - Add_Str_To_Name_Buffer (Path); - - if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then - Result := new String'(Name_Buffer (1 .. Name_Len)); - exit; - end if; - - First := Last + 1; - end loop; - end if; - - return Result; - end Try_Path_Name; - - -- Local Declarations - - Result : String_Access; - Result_Id : Path_Name_Type; - Has_Dot : Boolean := False; - Key : Name_Id; - - -- Start of processing for Project_Path_Name_Of - - begin - if Current_Verbosity = High then - Write_Str ("Project_Path_Name_Of ("""); - Write_Str (Project_File_Name); - Write_Str (""", """); - Write_Str (Directory); - Write_Line (""");"); - end if; - - -- Check the project cache - - Name_Len := Project_File_Name'Length; - Name_Buffer (1 .. Name_Len) := Project_File_Name; - Key := Name_Find; - Result_Id := Projects_Paths.Get (Key); - - if Result_Id /= No_Path then - return Get_Name_String (Result_Id); - end if; - - -- Check if Project_File_Name contains an extension (a dot before a - -- directory separator). If it is the case we do not try project file - -- with an added extension as it is not possible to have multiple dots - -- on a project file name. - - Check_Dot : for K in reverse Project_File_Name'Range loop - if Project_File_Name (K) = '.' then - Has_Dot := True; - exit Check_Dot; - end if; - - exit Check_Dot when Project_File_Name (K) = Directory_Separator - or else Project_File_Name (K) = '/'; - end loop Check_Dot; - - if not Is_Absolute_Path (Project_File_Name) then - - -- First we try /. - - if not Has_Dot then - Result := Try_Path_Name - (Directory & Directory_Separator & - Project_File_Name & Project_File_Extension); - end if; - - -- Then we try / - - if Result = null then - Result := Try_Path_Name - (Directory & Directory_Separator & Project_File_Name); - end if; - end if; - - -- Then we try . - - if Result = null and then not Has_Dot then - Result := Try_Path_Name (Project_File_Name & Project_File_Extension); - end if; - - -- Then we try - - if Result = null then - Result := Try_Path_Name (Project_File_Name); - end if; - - -- If we cannot find the project file, we return an empty string - - if Result = null then - return ""; - - else - declare - Final_Result : constant String := - GNAT.OS_Lib.Normalize_Pathname - (Result.all, - Directory => Directory, - Resolve_Links => Opt.Follow_Links_For_Files, - Case_Sensitive => True); - begin - Free (Result); - Name_Len := Final_Result'Length; - Name_Buffer (1 .. Name_Len) := Final_Result; - Result_Id := Name_Find; - - Projects_Paths.Set (Key, Result_Id); - return Final_Result; - end; - end if; - end Project_Path_Name_Of; - end Prj.Part; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 3cbb089ad08..c517a47147b 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -76,9 +76,10 @@ package body Prj.Proc is -- the package or project with declarations Decl. procedure Check - (In_Tree : Project_Tree_Ref; - Project : Project_Id; - Flags : Processing_Flags); + (In_Tree : Project_Tree_Ref; + Project : Project_Id; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; + Flags : Processing_Flags); -- Set all projects to not checked, then call Recursive_Check for the -- main project Project. Project is set to No_Project if errors occurred. -- Current_Dir is for optimization purposes, avoiding extra system calls. @@ -270,12 +271,13 @@ package body Prj.Proc is ----------- procedure Check - (In_Tree : Project_Tree_Ref; - Project : Project_Id; - Flags : Processing_Flags) + (In_Tree : Project_Tree_Ref; + Project : Project_Id; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; + Flags : Processing_Flags) is begin - Process_Naming_Scheme (In_Tree, Project, Flags); + Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags); -- Set the Other_Part field for the units @@ -2316,7 +2318,7 @@ package body Prj.Proc is Success := True; if Project /= No_Project then - Check (In_Tree, Project, Flags); + Check (In_Tree, Project, From_Project_Node_Tree, Flags); end if; -- If main project is an extending all project, set object directory of diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index be8f5fcfeda..55f21950b1a 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Osint; use Osint; +with Prj.Env; use Prj.Env; with Prj.Err; with Ada.Unchecked_Deallocation; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index e4c9583e734..889d3f17913 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -31,6 +31,7 @@ with GNAT.Dynamic_Tables; with Table; with Prj.Attr; use Prj.Attr; +with Prj.Env; package Prj.Tree is @@ -1474,12 +1475,7 @@ package Prj.Tree is -- The target name, if any, specified with the gprbuild or gprclean -- switch --target=. - Project_Path : String_Access := null; - -- The project path, manipulated through subprograms in prj-ext.ads. - -- As a special case, if the first character is '#:" or this variable is - -- unset, this means that the PATH has not been fully initialized yet - -- (although subprograms prj-ext.ads will properly take care of that). - -- + Project_Path : Prj.Env.Project_Search_Path; -- The project path is tree specific, since we might want to load -- simultaneously multiple projects, each with its own search path, in -- particular when using different compilers with different default diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 39188a4ad9d..ce2f7452169 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -28,7 +28,7 @@ with Makeutl; use Makeutl; with Osint; use Osint; with Opt; use Opt; with Prj; use Prj; -with Prj.Ext; use Prj.Ext; +with Prj.Env; use Prj.Env; with Table; package body Switch.M is @@ -664,8 +664,8 @@ package body Switch.M is elsif Switch_Chars'Length > 3 and then Switch_Chars (Ptr .. Ptr + 1) = "aP" then - Add_Search_Project_Directory - (Project_Node_Tree, + Add_Directories + (Project_Node_Tree.Project_Path, Switch_Chars (Ptr + 2 .. Switch_Chars'Last)); elsif C = 'v' and then Switch_Chars'Length = 3 then @@ -813,7 +813,7 @@ package body Switch.M is -- Processing for C switch when 'C' => - Create_Mapping_File := True; + Opt.Create_Mapping_File := True; -- Processing for D switch -- 2.11.0