2
0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-01-08 00:15:19 +08:00

g-os_lib.adb (Normalize_Pathname): Preserve the double slash ("//") that precede the drive letter on Interix.

* g-os_lib.adb (Normalize_Pathname): Preserve the double slash
        ("//") that precede the drive letter on Interix.

From-SVN: r46542
This commit is contained in:
Vincent Celier 2001-10-26 15:12:03 +00:00 committed by Geert Bosch
parent bdfa170fda
commit 47d5b6edfe
2 changed files with 54 additions and 4 deletions

View File

@ -1,3 +1,8 @@
2001-10-26 Vincent Celier <celier@gnat.com>
* g-os_lib.adb (Normalize_Pathname): Preserve the double slash
("//") that precede the drive letter on Interix.
2001-10-26 Geert Bosch <bosch@gnat.com>
* gnat_rm.texi: Add GNAT Reference Manual.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.74 $
-- $Revision$
-- --
-- Copyright (C) 1995-2001 Ada Core Technologies, Inc. --
-- --
@ -813,6 +813,9 @@ package body GNAT.OS_Lib is
Canonical_File_Addr : System.Address;
Canonical_File_Len : Integer;
Need_To_Check_Drive_Letter : Boolean := False;
-- Set to true if Name is an absolute path that starts with "//"
function Strlen (S : System.Address) return Integer;
pragma Import (C, Strlen, "strlen");
@ -821,6 +824,13 @@ package body GNAT.OS_Lib is
-- if not already present, otherwise return current working directory
-- with terminating directory separator.
function Final_Value (S : String) return String;
-- Make final adjustment to the returned string.
-- To compensate for non standard path name in Interix,
-- if S is "/x" or starts with "/x", where x is a capital
-- letter 'A' to 'Z', add an additional '/' at the beginning
-- so that the returned value starts with "//x".
-------------------
-- Get_Directory --
-------------------
@ -866,6 +876,35 @@ package body GNAT.OS_Lib is
Reference_Dir : constant String := Get_Directory;
-- Current directory name specified
function Final_Value (S : String) return String is
begin
-- Interix has the non standard notion of disk drive
-- indicated by two '/' followed by a capital letter
-- 'A' .. 'Z'. One of the two '/' may have been removed
-- by Normalize_Pathname. It has to be added again.
-- For other OSes, this should not make no difference.
if Need_To_Check_Drive_Letter
and then S'Length >= 2
and then S (S'First) = '/'
and then S (S'First + 1) in 'A' .. 'Z'
and then (S'Length = 2 or else S (S'First + 2) = '/')
then
declare
Result : String (1 .. S'Length + 1);
begin
Result (1) := '/';
Result (2 .. Result'Last) := S;
return Result;
end;
else
return S;
end if;
end Final_Value;
-- Start of processing for Normalize_Pathname
begin
@ -942,20 +981,26 @@ package body GNAT.OS_Lib is
Last := Reference_Dir'Length;
end if;
-- If name starts with "//", we may have a drive letter on Interix
if Last = 1 and then End_Path >= 3 then
Need_To_Check_Drive_Letter := (Path_Buffer (1 .. 2)) = "//";
end if;
Start := Last + 1;
Finish := Last;
-- If we have traversed the full pathname, return it
if Start > End_Path then
return Path_Buffer (1 .. End_Path);
return Final_Value (Path_Buffer (1 .. End_Path));
end if;
-- Remove duplicate directory separators
while Path_Buffer (Start) = Directory_Separator loop
if Start = End_Path then
return Path_Buffer (1 .. End_Path - 1);
return Final_Value (Path_Buffer (1 .. End_Path - 1));
else
Path_Buffer (Start .. End_Path - 1) :=
@ -1014,7 +1059,7 @@ package body GNAT.OS_Lib is
else
if Finish = End_Path then
return Path_Buffer (1 .. Start - 1);
return Final_Value (Path_Buffer (1 .. Start - 1));
else
Path_Buffer (Start + 1 .. Start + End_Path - Finish - 1) :=