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

diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index db0a9317c752cce50c7529ac31e54f91da0e53a2..33562f11fb89a95c1583dd6cde1dc06abfb93aac 100644 (file)
--- 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 93dcae1c5f923b8204383864e4b0ac5d01f0c46e..da36471b93b87032edd89da72eca3e62220bbde5 100644 (file)
--- 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 76cae74aa34032648700b144db861e6be3f72207..a7f2d24242ca1b21ca405d66939365f753de0f82 100644 (file)
--- 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 f0740d2c0e0994f003e5cef062f9b548237b675c..ef643d5b4e1684721167c9f9df2149f7c154d731 100644 (file)
--- 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 23d681cdbfdfa840ee1d297e6966a76c692ad979..a9ab3f4fbb716bbce7ec7319fbfc5fa039713084 100644 (file)
--- 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;