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
This commit is contained in:
Vincent Celier 2006-10-31 19:00:14 +01:00 committed by Arnaud Charlet
parent ef6ea465e3
commit ac36caab6b
2 changed files with 32 additions and 20 deletions

View File

@ -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;

View File

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