gnatcmd.adb, [...] (Project_Search_Path): New type.

2010-10-05  Emmanuel Briot  <briot@adacore.com>

	* 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.

From-SVN: r164969

1 files changed, 163 insertions, 365 deletions

diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index b10b566..93b6f26 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 <directory>/<file_name>.<extension>
-
-         if not Has_Dot then
-            Result := Try_Path_Name
-              (Directory & Directory_Separator &
-               Project_File_Name & Project_File_Extension);
-         end if;
-
-         --  Then we try <directory>/<file_name>
-
-         if Result = null then
-            Result := Try_Path_Name
-              (Directory & Directory_Separator & Project_File_Name);
-         end if;
-      end if;
-
-      --  Then we try <file_name>.<extension>
-
-      if Result = null and then not Has_Dot then
-         Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
-      end if;
-
-      --  Then we try <file_name>
-
-      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;