Skip to content

R
riscv-gcc-1
Commit 7d1553e2 by Pascal Obry Committed by Pierre-Marie de Rodat
Options

[Ada] New implementation for Normalize_Pathname 

This implementation fixes an issue on Windows where a single drive letter
was not followed by a directory separator. On Windows the following
program:

   with Ada.Text_IO; use Ada.Text_IO;
   with GNAT.OS_Lib; use GNAT.OS_Lib;
   procedure Main is
   begin
      Put_Line (Normalize_Pathname ("c:\"));
      Put_Line (Normalize_Pathname ("c:\toto\.."));
   end Main;

Must output:

C:\
C:\

2018-01-11  Pascal Obry  <obry@adacore.com>

gcc/ada/

	* libgnat/s-os_lib.adb (Normalize_Pathname): New implementation.

From-SVN: r256501
parent 1646b09f
Showing with 53 additions and 91 deletions
gcc/ada/ChangeLog
2018-01-11 Pascal Obry <obry@adacore.com>
* libgnat/s-os_lib.adb (Normalize_Pathname): New implementation.
2018-01-11 Bob Duff <duff@adacore.com> 2018-01-11 Bob Duff <duff@adacore.com>
* doc/gnat_ugn/gnat_utility_programs.rst: Rewrite gnatpp documentation * doc/gnat_ugn/gnat_utility_programs.rst: Rewrite gnatpp documentation
......
gcc/ada/libgnat/s-os_lib.adb
...@@ -2085,12 +2085,6 @@ package body System.OS_Lib is ...@@ -2085,12 +2085,6 @@ package body System.OS_Lib is
Bufsiz : size_t) return Integer; Bufsiz : size_t) return Integer;
pragma Import (C, Readlink, "__gnat_readlink"); pragma Import (C, Readlink, "__gnat_readlink");
function To_Canonical_File_Spec
(Host_File : System.Address) return System.Address;
pragma Import
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
-- Convert possible foreign file syntax to canonical form
Fold_To_Lower_Case : constant Boolean := Fold_To_Lower_Case : constant Boolean :=
not Case_Sensitive not Case_Sensitive
and then Get_File_Names_Case_Sensitive = 0; and then Get_File_Names_Case_Sensitive = 0;
...@@ -2142,7 +2136,18 @@ package body System.OS_Lib is ...@@ -2142,7 +2136,18 @@ package body System.OS_Lib is
end if; end if;
end if; end if;
-- And ensure that there is a trailing directory separator if the
-- path contains only a drive letter.
if On_Windows
and then Last = 2
and then S1 (1) /= Directory_Separator
and then S1 (2) = ':'
then
return S1 (1 .. Last) & Directory_Separator;
else
return S1 (1 .. Last); return S1 (1 .. Last);
end if;
end Final_Value; end Final_Value;
------------------- -------------------
...@@ -2157,8 +2162,8 @@ package body System.OS_Lib is ...@@ -2157,8 +2162,8 @@ package body System.OS_Lib is
declare declare
Result : String := Result : String :=
Normalize_Pathname Normalize_Pathname
(Dir, "", Resolve_Links, Case_Sensitive) & (Dir, "", Resolve_Links, Case_Sensitive)
Directory_Separator; & Directory_Separator;
Last : Positive := Result'Last - 1; Last : Positive := Result'Last - 1;
begin begin
...@@ -2218,88 +2223,64 @@ package body System.OS_Lib is ...@@ -2218,88 +2223,64 @@ package body System.OS_Lib is
Max_Iterations : constant := 500; Max_Iterations : constant := 500;
Canonical_File_Addr : System.Address; Cur_Dir : constant String := Get_Directory (Directory);
Canonical_File_Len : Integer; Cur_Dir_Len : constant Natural := Cur_Dir'Length;
End_Path : Natural := 0; End_Path : Natural := Name'Length;
Finish : Positive; Last : Positive := 1;
Last : Positive;
Link_Buffer : String (1 .. Max_Path + 2); Link_Buffer : String (1 .. Max_Path + 2);
Path_Buffer : String (1 .. Max_Path + Max_Path + 2); Path_Buffer : String (1 .. End_Path + Cur_Dir_Len + Max_Path + 2);
Start : Natural; -- We need to potentially store in this buffer the following elements:
-- the path itself, the current directory if the path is relative,
-- and additional fragments up to Max_Path in length in case
-- there are any symlinks.
Start, Finish : Positive;
Status : Integer; Status : Integer;
The_Name : String (1 .. Name'Length + 1);
-- Start of processing for Normalize_Pathname -- Start of processing for Normalize_Pathname
begin begin
-- Special case, return null if name is null, or if it is bigger than -- Special case, return null if name is null
-- the biggest name allowed.
if Name'Length = 0 or else Name'Length > Max_Path then if End_Path = 0 then
return ""; return "";
end if; end if;
-- First, convert possible foreign file spec to Unix file spec. If no if Is_Absolute_Path (Name) then
-- conversion is required, all this does is put Name at the beginning Path_Buffer (1 .. End_Path) := Name;
-- of Path_Buffer unchanged.
File_Name_Conversion : begin
The_Name (1 .. Name'Length) := Name;
The_Name (The_Name'Last) := ASCII.NUL;
Canonical_File_Addr := To_Canonical_File_Spec (The_Name'Address); else
Canonical_File_Len := Integer (CRTL.strlen (Canonical_File_Addr)); -- If this is a relative pathname, prepend current directory
Path_Buffer (1 .. Cur_Dir_Len) := Cur_Dir;
-- If syntax conversion has failed, return an empty string to Path_Buffer (Cur_Dir_Len + 1 .. Cur_Dir_Len + End_Path) := Name;
-- indicate the failure. End_Path := Cur_Dir_Len + End_Path;
Last := Cur_Dir_Len;
if Canonical_File_Len = 0 then
return "";
end if; end if;
declare -- Special handling for Windows:
subtype Path_String is String (1 .. Canonical_File_Len); -- * Replace all '/' by '\'
Canonical_File : Path_String; -- * Check the drive letter
for Canonical_File'Address use Canonical_File_Addr; -- * Remove all double-quotes
pragma Import (Ada, Canonical_File);
begin if On_Windows then
Path_Buffer (1 .. Canonical_File_Len) := Canonical_File;
End_Path := Canonical_File_Len;
Last := 1;
end;
end File_Name_Conversion;
-- Replace all '/' by Directory Separators (this is for Windows) -- Replace all '/' by '\'
if Directory_Separator /= '/' then
for Index in 1 .. End_Path loop for Index in 1 .. End_Path loop
if Path_Buffer (Index) = '/' then if Path_Buffer (Index) = '/' then
Path_Buffer (Index) := Directory_Separator; Path_Buffer (Index) := Directory_Separator;
end if; end if;
end loop; end loop;
end if;
-- Resolve directory names for Windows -- If we have an absolute path starting with a directory
-- separator (but not a UNC path), we need to have the drive letter
if On_Windows then -- in front of the path. Get_Current_Dir returns a path starting
-- with a drive letter. So we take this drive letter and prepend it
-- On Windows, if we have an absolute path starting with a directory -- to the current path.
-- separator, we need to have the drive letter appended in front.
-- On Windows, Get_Current_Dir will return a suitable directory name
-- (path starting with a drive letter on Windows). So we take this
-- drive letter and prepend it to the current path.
if Path_Buffer (1) = Directory_Separator if Path_Buffer (1) = Directory_Separator
and then Path_Buffer (2) /= Directory_Separator and then Path_Buffer (2) /= Directory_Separator
then then
declare
Cur_Dir : constant String := Get_Directory ("");
-- Get the current directory to get the drive letter
begin
if Cur_Dir'Length > 2 if Cur_Dir'Length > 2
and then Cur_Dir (Cur_Dir'First + 1) = ':' and then Cur_Dir (Cur_Dir'First + 1) = ':'
then then
...@@ -2309,21 +2290,18 @@ package body System.OS_Lib is ...@@ -2309,21 +2290,18 @@ package body System.OS_Lib is
Cur_Dir (Cur_Dir'First .. Cur_Dir'First + 1); Cur_Dir (Cur_Dir'First .. Cur_Dir'First + 1);
End_Path := End_Path + 2; End_Path := End_Path + 2;
end if; end if;
end;
-- We have a drive letter, ensure it is upper-case -- We have a drive letter already, ensure it is upper-case
elsif Path_Buffer (1) in 'a' .. 'z' elsif Path_Buffer (1) in 'a' .. 'z'
and then Path_Buffer (2) = ':' and then Path_Buffer (2) = ':'
then then
System.Case_Util.To_Upper (Path_Buffer (1 .. 1)); System.Case_Util.To_Upper (Path_Buffer (1 .. 1));
end if; end if;
end if;
-- On Windows, remove all double-quotes that are possibly part of the -- Remove all double-quotes that are possibly part of the
-- path but can cause problems with other methods. -- path but can cause problems with other methods.
if On_Windows then
declare declare
Index : Natural; Index : Natural;
...@@ -2347,30 +2325,10 @@ package body System.OS_Lib is ...@@ -2347,30 +2325,10 @@ package body System.OS_Lib is
for J in 1 .. Max_Iterations loop for J in 1 .. Max_Iterations loop
-- If we don't have an absolute pathname, prepend the directory
-- Reference_Dir.
if Last = 1
and then not Is_Absolute_Path (Path_Buffer (1 .. End_Path))
then
declare
Reference_Dir : constant String := Get_Directory (Directory);
Ref_Dir_Len : constant Natural := Reference_Dir'Length;
-- Current directory name specified and its length
begin
Path_Buffer (Ref_Dir_Len + 1 .. Ref_Dir_Len + End_Path) :=
Path_Buffer (1 .. End_Path);
End_Path := Ref_Dir_Len + End_Path;
Path_Buffer (1 .. Ref_Dir_Len) := Reference_Dir;
Last := Ref_Dir_Len;
end;
end if;
Start := Last + 1; Start := Last + 1;
Finish := Last; Finish := Last;
-- Ensure that Windows network drives are kept, e.g: \\server\drive-c -- Ensure that Windows UNC path is preserved, e.g: \\server\drive-c
if Start = 2 if Start = 2
and then Directory_Separator = '\' and then Directory_Separator = '\'
...@@ -2434,11 +2392,11 @@ package body System.OS_Lib is ...@@ -2434,11 +2392,11 @@ package body System.OS_Lib is
Start := Last; Start := Last;
loop loop
Start := Start - 1; Start := Start - 1;
exit when Start < 1 exit when Start = 1
or else Path_Buffer (Start) = Directory_Separator; or else Path_Buffer (Start) = Directory_Separator;
end loop; end loop;
if Start <= 1 then if Start = 1 then
if Finish = End_Path then if Finish = End_Path then
return (1 => Directory_Separator); return (1 => Directory_Separator);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment