CbC/CbC_gcc: gcc/ada/libgnat/a-direct.adb comparison

comparison gcc/ada/libgnat/a-direct.adb @ 145:1830386684a0

gcc-9.2.0

author	anatofuz
date	Thu, 13 Feb 2020 11:34:05 +0900
parents	84e7813d76e9
children

comparison

equal deleted inserted replaced

-:84e7813d76e9
+:1830386684a0
 --                                                                          --
 --                      A D A . D I R E C T O R I E S                       --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2018, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2019, 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- --
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 with Ada.Calendar;               use Ada.Calendar;
 with Ada.Calendar.Formatting;    use Ada.Calendar.Formatting;
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
 with Ada.Directories.Validity;   use Ada.Directories.Validity;
+with Ada.Directories.Hierarchical_File_Names;
+use Ada.Directories.Hierarchical_File_Names;
 with Ada.Strings.Fixed;
 with Ada.Strings.Maps;           use Ada.Strings.Maps;
 with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
 with Ada.Unchecked_Deallocation;
 declare
 Last_DS : constant Natural :=
 Strings.Fixed.Index (Name, Dir_Seps, Going => Strings.Backward);
 begin
-if Last_DS = 0 then
---  There is no directory separator, returns "." representing
---  the current working directory.
-return ".";
 --  If Name indicates a root directory, raise Use_Error, because
 --  it has no containing directory.
-elsif Name = "/"
+if Is_Parent_Directory_Name (Name)
-or else
+or else Is_Current_Directory_Name (Name)
-(Windows
+or else Is_Root_Directory_Name (Name)
-and then
-(Name = "\"
-or else
-(Name'Length = 3
-and then Name (Name'Last - 1 .. Name'Last) = ":\"
-and then (Name (Name'First) in 'a' .. 'z'
-or else
-Name (Name'First) in 'A' .. 'Z'))))
 then
 raise Use_Error with
 "directory """ & Name & """ has no containing directory";
+elsif Last_DS = 0 then
+--  There is no directory separator, so return ".", representing
+--  the current working directory.
+return ".";
 else
 declare
 Last   : Positive := Last_DS - Name'First + 1;
 Result : String (1 .. Last);
 --  Remove any trailing directory separator, except as the
 --  first character or the first character following a drive
 --  number on Windows.
 while Last > 1 loop
-exit when
+exit when Is_Root_Directory_Name (Result (1 .. Last))
-Result (Last) /= '/'
+or else (Result (Last) /= Directory_Separator
-and then
+and then Result (Last) /= '/');
-Result (Last) /= Directory_Separator;
-exit when Windows
-and then Last = 3
-and then Result (2) = ':'
-and then
-(Result (1) in 'A' .. 'Z'
-or else
-Result (1) in 'a' .. 'z');
 Last := Last - 1;
 end loop;
---  Special case of "..": the current directory may be a root
+return Result (1 .. Last);
---  directory.
-if Last = 2 and then Result (1 .. 2) = ".." then
-return Containing_Directory (Current_Directory);
-else
-return Result (1 .. Last);
-end if;
 end;
 end if;
 end;
 end if;
 end Containing_Directory;
 raise Use_Error
 with Full_Name & ": " & Errno_Message (Err => Error);
 end if;
 if Exists = 1 then
+--  Ignore special directories "." and ".."
+if (Full_Name'Length > 1
+and then
+Full_Name
+(Full_Name'Last - 1 .. Full_Name'Last) = "\.")
+or else
+(Full_Name'Length > 2
+and then
+Full_Name
+(Full_Name'Last - 2 .. Full_Name'Last) = "\..")
+then
+Exists := 0;
+end if;
 --  Now check if the file kind matches the filter
 if Is_Regular_File_Attr
 (C_Full_Name'Address, Attr'Access) = 1
 --------------------------
 function Simple_Name_Internal (Path : String) return String is
 Cut_Start : Natural :=
 Strings.Fixed.Index (Path, Dir_Seps, Going => Strings.Backward);
-Cut_End   : Natural;
+--  Cut_End points to the last simple name character
+Cut_End   : Natural := Path'Last;
 begin
---  Cut_Start pointS to the first simple name character
+--  Root directories are considered simple
+if Is_Root_Directory_Name (Path) then
+return Path;
+end if;
+--  Handle trailing directory separators
+if Cut_Start = Path'Last then
+Cut_End   := Path'Last - 1;
+Cut_Start := Strings.Fixed.Index
+(Path (Path'First .. Path'Last - 1),
+Dir_Seps, Going => Strings.Backward);
+end if;
+--  Cut_Start points to the first simple name character
 Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1);
---  Cut_End point to the last simple name character
-Cut_End := Path'Last;
 Check_For_Standard_Dirs : declare
 BN : constant String := Path (Cut_Start .. Cut_End);
 Has_Drive_Letter : constant Boolean :=
 --  If Path separator is not ':' then we are on a DOS based OS
 --  where this character is used as a drive letter separator.
 begin
 if BN = "." or else BN = ".." then
-return "";
+return BN;
 elsif Has_Drive_Letter
 and then BN'Length > 2
 and then Characters.Handling.Is_Letter (BN (BN'First))
 and then BN (BN'First + 1) = ':'

Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-direct.adb @ 145:1830386684a0