From 8c3828db106ca2bf4289d30d8c147c9f005ac1ce Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 27 Oct 2004 13:56:03 +0000 Subject: 2004-10-26 Vincent Celier * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@89677 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/a-direct.adb | 48 +++++++++++++++++++++++++++++++--------------- gcc/ada/a-dirval-mingw.adb | 10 +++++++++- gcc/ada/a-dirval-vms.adb | 10 +++++++++- gcc/ada/a-dirval.adb | 11 +++++++++-- gcc/ada/a-dirval.ads | 5 +++-- 5 files changed, 63 insertions(+), 21 deletions(-) diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index db0a9317c75..33562f11fb8 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -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; diff --git a/gcc/ada/a-dirval-mingw.adb b/gcc/ada/a-dirval-mingw.adb index 93dcae1c5f9..da36471b93b 100644 --- a/gcc/ada/a-dirval-mingw.adb +++ b/gcc/ada/a-dirval-mingw.adb @@ -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; - diff --git a/gcc/ada/a-dirval-vms.adb b/gcc/ada/a-dirval-vms.adb index 76cae74aa34..a7f2d24242c 100644 --- a/gcc/ada/a-dirval-vms.adb +++ b/gcc/ada/a-dirval-vms.adb @@ -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; - diff --git a/gcc/ada/a-dirval.adb b/gcc/ada/a-dirval.adb index f0740d2c0e0..ef643d5b4e1 100644 --- a/gcc/ada/a-dirval.adb +++ b/gcc/ada/a-dirval.adb @@ -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; - - diff --git a/gcc/ada/a-dirval.ads b/gcc/ada/a-dirval.ads index 23d681cdbfd..a9ab3f4fbb7 100644 --- a/gcc/ada/a-dirval.ads +++ b/gcc/ada/a-dirval.ads @@ -42,6 +42,7 @@ private package Ada.Directories.Validity is 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; -- cgit v1.2.1