Commit 1cfd6c3a by Vincent Celier Committed by Arnaud Charlet

2004-10-26 Vincent Celier <celier@gnat.com>

	* a-dirval.ads, a-dirval.adb, a-dirval-vms.adb, a-dirval-mingw.adb
	(Is_Path_Name_Case_Sensitive): New function

	* a-direct.adb (To_Lower_If_Case_Insensitive): New procedure
	(Base_Name, Simple_Name, Current_Directory, Compose,
	Containing_Directory, Full_Name): Call To_Lower_If_Case_Insensitive on
	the result.

From-SVN: r89677
parent 04061aa5
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
with Ada.Directories.Validity; use Ada.Directories.Validity; with Ada.Directories.Validity; use Ada.Directories.Validity;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
...@@ -67,15 +68,20 @@ package body Ada.Directories is ...@@ -67,15 +68,20 @@ package body Ada.Directories is
-- Get the next entry in a directory, setting Entry_Fetched if successful -- Get the next entry in a directory, setting Entry_Fetched if successful
-- or resetting Is_Valid if not. -- or resetting Is_Valid if not.
procedure To_Lower_If_Case_Insensitive (S : in out String);
-- Put S in lower case if file and path names are case-insensitive
--------------- ---------------
-- Base_Name -- -- Base_Name --
--------------- ---------------
function Base_Name (Name : String) return String is function Base_Name (Name : String) return String is
Simple : constant String := Simple_Name (Name); Simple : String := Simple_Name (Name);
-- Simple'First is guaranteed to be 1 -- Simple'First is guaranteed to be 1
begin begin
To_Lower_If_Case_Insensitive (Simple);
-- Look for the last dot in the file name and return the part of the -- Look for the last dot in the file name and return the part of the
-- file name preceding this last dot. If the first dot is the first -- file name preceding this last dot. If the first dot is the first
-- character of the file name, the base name is the empty string. -- character of the file name, the base name is the empty string.
...@@ -147,6 +153,7 @@ package body Ada.Directories is ...@@ -147,6 +153,7 @@ package body Ada.Directories is
Last := Last + Extension'Length; Last := Last + Extension'Length;
end if; end if;
To_Lower_If_Case_Insensitive (Result (1 .. Last));
return Result (1 .. Last); return Result (1 .. Last);
end if; end if;
end Compose; end Compose;
...@@ -186,6 +193,7 @@ package body Ada.Directories is ...@@ -186,6 +193,7 @@ package body Ada.Directories is
return Get_Current_Dir; return Get_Current_Dir;
else else
To_Lower_If_Case_Insensitive (Result (1 .. Last));
return Result (1 .. Last); return Result (1 .. Last);
end if; end if;
end; end;
...@@ -333,9 +341,11 @@ package body Ada.Directories is ...@@ -333,9 +341,11 @@ package body Ada.Directories is
-- The implementation uses GNAT.Directory_Operations.Get_Current_Dir -- The implementation uses GNAT.Directory_Operations.Get_Current_Dir
Cur : constant String := Get_Current_Dir; Cur : String := Normalize_Pathname (Get_Current_Dir);
begin begin
To_Lower_If_Case_Insensitive (Cur);
if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
return Cur (1 .. Cur'Last - 1); return Cur (1 .. Cur'Last - 1);
else else
...@@ -609,12 +619,11 @@ package body Ada.Directories is ...@@ -609,12 +619,11 @@ package body Ada.Directories is
-- Use GNAT.OS_Lib.Normalize_Pathname -- Use GNAT.OS_Lib.Normalize_Pathname
declare declare
Value : constant String := Normalize_Pathname (Name); Value : String := Normalize_Pathname (Name);
Result : String (1 .. Value'Length); subtype Result is String (1 .. Value'Length);
begin begin
Result := Value; To_Lower_If_Case_Insensitive (Value);
return Result; return Result (Value);
-- Should use subtype conversion, not junk copy ???
end; end;
end if; end if;
end Full_Name; end Full_Name;
...@@ -719,7 +728,6 @@ package body Ada.Directories is ...@@ -719,7 +728,6 @@ package body Ada.Directories is
begin begin
-- First, the invalid cases -- First, the invalid cases
if not (Is_Regular_File (Name) or else Is_Directory (Name)) then if not (Is_Regular_File (Name) or else Is_Directory (Name)) then
raise Name_Error; raise Name_Error;
...@@ -836,13 +844,11 @@ package body Ada.Directories is ...@@ -836,13 +844,11 @@ package body Ada.Directories is
-- The implementation uses GNAT.Directory_Operations.Base_Name -- The implementation uses GNAT.Directory_Operations.Base_Name
declare declare
Value : constant String := Value : String := GNAT.Directory_Operations.Base_Name (Name);
GNAT.Directory_Operations.Base_Name (Name); subtype Result is String (1 .. Value'Length);
Result : String (1 .. Value'Length);
begin begin
Result := Value; To_Lower_If_Case_Insensitive (Value);
return Result; return Result (Value);
-- Should use subtype conversion instead of junk copy ???
end; end;
end if; end if;
end Simple_Name; end Simple_Name;
...@@ -943,5 +949,17 @@ package body Ada.Directories is ...@@ -943,5 +949,17 @@ package body Ada.Directories is
Search.Value.Is_Valid := True; Search.Value.Is_Valid := True;
end Start_Search; end Start_Search;
end Ada.Directories; ----------------------------------
-- To_Lower_If_Case_Insensitive --
----------------------------------
procedure To_Lower_If_Case_Insensitive (S : in out String) is
begin
if not Is_Path_Name_Case_Sensitive then
for J in S'Range loop
S (J) := To_Lower (S (J));
end loop;
end if;
end To_Lower_If_Case_Insensitive;
end Ada.Directories;
...@@ -45,6 +45,15 @@ package body Ada.Directories.Validity is ...@@ -45,6 +45,15 @@ package body Ada.Directories.Validity is
DEL .. NBSP => True, DEL .. NBSP => True,
others => False); others => False);
---------------------------------
-- Is_Path_Name_Case_Sensitive --
---------------------------------
function Is_Path_Name_Case_Sensitive return Boolean is
begin
return False;
end Is_Path_Name_Case_Sensitive;
------------------------ ------------------------
-- Is_Valid_Path_Name -- -- Is_Valid_Path_Name --
------------------------ ------------------------
...@@ -145,4 +154,3 @@ package body Ada.Directories.Validity is ...@@ -145,4 +154,3 @@ package body Ada.Directories.Validity is
end Is_Valid_Simple_Name; end Is_Valid_Simple_Name;
end Ada.Directories.Validity; end Ada.Directories.Validity;
...@@ -45,6 +45,15 @@ package body Ada.Directories.Validity is ...@@ -45,6 +45,15 @@ package body Ada.Directories.Validity is
'_' | '$' | '-' | '.' => False, '_' | '$' | '-' | '.' => False,
others => True); others => True);
---------------------------------
-- Is_Path_Name_Case_Sensitive --
---------------------------------
function Is_Path_Name_Case_Sensitive return Boolean is
begin
return False;
end Is_Path_Name_Case_Sensitive;
------------------------ ------------------------
-- Is_Valid_Path_Name -- -- Is_Valid_Path_Name --
------------------------ ------------------------
...@@ -172,4 +181,3 @@ package body Ada.Directories.Validity is ...@@ -172,4 +181,3 @@ package body Ada.Directories.Validity is
end Is_Valid_Simple_Name; end Is_Valid_Simple_Name;
end Ada.Directories.Validity; end Ada.Directories.Validity;
...@@ -36,6 +36,15 @@ ...@@ -36,6 +36,15 @@
package body Ada.Directories.Validity is package body Ada.Directories.Validity is
---------------------------------
-- Is_Path_Name_Case_Sensitive --
---------------------------------
function Is_Path_Name_Case_Sensitive return Boolean is
begin
return True;
end Is_Path_Name_Case_Sensitive;
------------------------ ------------------------
-- Is_Valid_Path_Name -- -- Is_Valid_Path_Name --
------------------------ ------------------------
...@@ -86,5 +95,3 @@ package body Ada.Directories.Validity is ...@@ -86,5 +95,3 @@ package body Ada.Directories.Validity is
end Is_Valid_Simple_Name; end Is_Valid_Simple_Name;
end Ada.Directories.Validity; end Ada.Directories.Validity;
...@@ -42,6 +42,7 @@ private package Ada.Directories.Validity is ...@@ -42,6 +42,7 @@ private package Ada.Directories.Validity is
function Is_Valid_Path_Name (Name : String) return Boolean; function Is_Valid_Path_Name (Name : String) return Boolean;
-- Returns True if Name is a valid path name -- Returns True if Name is a valid path name
end Ada.Directories.Validity; function Is_Path_Name_Case_Sensitive return Boolean;
-- Returns True if file and path names are case-sensitive
end Ada.Directories.Validity;
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