Ada: improve support for case insensitive OSes in Ada.Directories
Arnaud Charlet
charlet@ACT-Europe.FR
Wed Oct 27 10:16:00 GMT 2004
Tested on x86-windows
Improve support for case insensitive OSes in Ada.Directories
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.
-------------- next part --------------
Index: a-dirval.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-dirval.ads,v
retrieving revision 1.1
diff -u -p -r1.1 a-dirval.ads
--- a-dirval.ads 5 Apr 2004 14:57:42 -0000 1.1
+++ a-dirval.ads 27 Oct 2004 09:34:10 -0000
@@ -42,6 +42,7 @@ private package Ada.Directories.Validity
function Is_Valid_Path_Name (Name : String) return Boolean;
-- 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;
Index: a-dirval.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-dirval.adb,v
retrieving revision 1.1
diff -u -p -r1.1 a-dirval.adb
--- a-dirval.adb 5 Apr 2004 14:57:42 -0000 1.1
+++ a-dirval.adb 27 Oct 2004 09:34:10 -0000
@@ -36,6 +36,15 @@
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 --
------------------------
@@ -86,5 +95,3 @@ package body Ada.Directories.Validity is
end Is_Valid_Simple_Name;
end Ada.Directories.Validity;
-
-
Index: a-dirval-vms.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-dirval-vms.adb,v
retrieving revision 1.1
diff -u -p -r1.1 a-dirval-vms.adb
--- a-dirval-vms.adb 14 May 2004 10:01:59 -0000 1.1
+++ a-dirval-vms.adb 27 Oct 2004 09:34:10 -0000
@@ -45,6 +45,15 @@ package body Ada.Directories.Validity is
'_' | '$' | '-' | '.' => False,
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 --
------------------------
@@ -172,4 +181,3 @@ package body Ada.Directories.Validity is
end Is_Valid_Simple_Name;
end Ada.Directories.Validity;
-
Index: a-dirval-mingw.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-dirval-mingw.adb,v
retrieving revision 1.2
diff -u -p -r1.2 a-dirval-mingw.adb
--- a-dirval-mingw.adb 4 Oct 2004 14:55:32 -0000 1.2
+++ a-dirval-mingw.adb 27 Oct 2004 09:34:10 -0000
@@ -45,6 +45,15 @@ package body Ada.Directories.Validity is
DEL .. NBSP => True,
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 --
------------------------
@@ -145,4 +154,3 @@ package body Ada.Directories.Validity is
end Is_Valid_Simple_Name;
end Ada.Directories.Validity;
-
Index: a-direct.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-direct.adb,v
retrieving revision 1.2
diff -u -p -r1.2 a-direct.adb
--- a-direct.adb 13 Sep 2004 10:18:41 -0000 1.2
+++ a-direct.adb 27 Oct 2004 09:34:11 -0000
@@ -34,6 +34,7 @@
with Ada.Directories.Validity; use Ada.Directories.Validity;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
@@ -67,15 +68,20 @@ package body Ada.Directories is
-- Get the next entry in a directory, setting Entry_Fetched if successful
-- 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 --
---------------
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
begin
+ To_Lower_If_Case_Insensitive (Simple);
+
-- 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
-- character of the file name, the base name is the empty string.
@@ -147,6 +153,7 @@ package body Ada.Directories is
Last := Last + Extension'Length;
end if;
+ To_Lower_If_Case_Insensitive (Result (1 .. Last));
return Result (1 .. Last);
end if;
end Compose;
@@ -186,6 +193,7 @@ package body Ada.Directories is
return Get_Current_Dir;
else
+ To_Lower_If_Case_Insensitive (Result (1 .. Last));
return Result (1 .. Last);
end if;
end;
@@ -333,9 +341,11 @@ package body Ada.Directories is
-- The implementation uses GNAT.Directory_Operations.Get_Current_Dir
- Cur : constant String := Get_Current_Dir;
+ Cur : String := Normalize_Pathname (Get_Current_Dir);
begin
+ To_Lower_If_Case_Insensitive (Cur);
+
if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
return Cur (1 .. Cur'Last - 1);
else
@@ -609,12 +619,11 @@ package body Ada.Directories is
-- Use GNAT.OS_Lib.Normalize_Pathname
declare
- Value : constant String := Normalize_Pathname (Name);
- Result : String (1 .. Value'Length);
+ Value : String := Normalize_Pathname (Name);
+ subtype Result is String (1 .. Value'Length);
begin
- Result := Value;
- return Result;
- -- Should use subtype conversion, not junk copy ???
+ To_Lower_If_Case_Insensitive (Value);
+ return Result (Value);
end;
end if;
end Full_Name;
@@ -719,7 +728,6 @@ package body Ada.Directories is
begin
-- First, the invalid cases
-
if not (Is_Regular_File (Name) or else Is_Directory (Name)) then
raise Name_Error;
@@ -836,13 +844,11 @@ package body Ada.Directories is
-- The implementation uses GNAT.Directory_Operations.Base_Name
declare
- Value : constant String :=
- GNAT.Directory_Operations.Base_Name (Name);
- Result : String (1 .. Value'Length);
+ Value : String := GNAT.Directory_Operations.Base_Name (Name);
+ subtype Result is String (1 .. Value'Length);
begin
- Result := Value;
- return Result;
- -- Should use subtype conversion instead of junk copy ???
+ To_Lower_If_Case_Insensitive (Value);
+ return Result (Value);
end;
end if;
end Simple_Name;
@@ -943,5 +949,17 @@ package body Ada.Directories is
Search.Value.Is_Valid := True;
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;
More information about the Gcc-patches
mailing list