gnatls.adb: Take into account GPR_PROJECT_PATH...

2006-10-31  Vincent Celier  <celier@adacore.com>
        
	* gnatls.adb: Take into account GPR_PROJECT_PATH, when it is defined,
	instead of ADA_PROJECT_PATH, for the project path.
	(Gnatls): When displaying the project path directories, use host dir
	specs.

	* prj-ext.adb (Prj.Ext elaboration): On VMS, only expand relative path
	names in the project path, as absolute paths may correspond to
	multi-valued VMS logical names.

From-SVN: r118278

2 files changed, 32 insertions, 20 deletions

diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index ba18d00..2d3ad74 100644
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -48,9 +48,11 @@ with GNAT.Case_Util; use GNAT.Case_Util;
 procedure Gnatls is
    pragma Ident (Gnat_Static_Version_String);
 
+   Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
    Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
-   --  Name of the env. variable that contains path name(s) of directories
-   --  where project files may reside.
+   --  Names of the env. variables that contains path name(s) of directories
+   --  where project files may reside. If GPR_PROJECT_PATH is defined, its
+   --  value is used, otherwise ADA_PROJECT_PATH is used, if defined.
 
    --  NOTE : The following string may be used by other tools, such as GPS. So
    --  it can only be modified if these other uses are checked and coordinated.
@@ -1547,10 +1549,10 @@ begin
       Write_Eol;
 
       declare
-         Project_Path : constant String_Access := Getenv (Ada_Project_Path);
+         Project_Path : String_Access := Getenv (Gpr_Project_Path);
 
-         Lib    : constant String :=
-                    Directory_Separator & "lib" & Directory_Separator;
+         Lib : constant String :=
+                 Directory_Separator & "lib" & Directory_Separator;
 
          First : Natural;
          Last  : Natural;
@@ -1560,9 +1562,12 @@ begin
       begin
          --  If there is a project path, display each directory in the path
 
+         if Project_Path.all = "" then
+            Project_Path := Getenv (Ada_Project_Path);
+         end if;
+
          if Project_Path.all /= "" then
             First := Project_Path'First;
-
             loop
                while First <= Project_Path'Last
                  and then (Project_Path (First) = Path_Separator)
@@ -1573,7 +1578,6 @@ begin
                exit when First > Project_Path'Last;
 
                Last := First;
-
                while Last < Project_Path'Last
                  and then Project_Path (Last + 1) /= Path_Separator
                loop
@@ -1593,7 +1597,9 @@ begin
                   --  project path.
 
                   Write_Str ("   ");
-                  Write_Str (Project_Path (First .. Last));
+                  Write_Str
+                    (To_Host_Dir_Spec
+                       (Project_Path (First .. Last), True).all);
                   Write_Eol;
                end if;
 
@@ -1630,11 +1636,11 @@ begin
             --  directory <prefix>/lib/gnat/.
 
             if Name_Len >= 5 then
-               Write_Str ("   ");
-               Write_Str (Name_Buffer (1 .. Name_Len));
-               Write_Str ("gnat");
-               Write_Char (Directory_Separator);
-               Write_Eol;
+               Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat";
+               Name_Buffer (Name_Len + 5) := Directory_Separator;
+               Name_Len := Name_Len + 5;
+               Write_Line
+                 (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
             end if;
          end if;
       end;
diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index c92ca9f..649c2ba 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2006, 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,9 +24,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Namet;   use Namet;
-with Output;  use Output;
-with Osint;   use Osint;
+with Hostparm;
+with Namet;    use Namet;
+with Output;   use Output;
+with Osint;    use Osint;
 with Sdefault;
 
 with GNAT.HTable;
@@ -73,7 +74,6 @@ package body Prj.Ext is
    is
       The_Key   : Name_Id;
       The_Value : Name_Id;
-
    begin
       Name_Len := Value'Length;
       Name_Buffer (1 .. Name_Len) := Value;
@@ -251,10 +251,16 @@ begin
 
                Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
 
-            else
+            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));
+                              Normalize_Pathname (Name_Buffer (First .. Last));
+
                begin
                   --  If the absolute path was resolved and is different from
                   --  the original, replace original with the resolved path.