s-fileio.adb (Open): Normalize file name to lower case in non-case sensitive file name systems to...

2007-08-31  Robert Dewar  <dewar@adacore.com>

	* s-fileio.adb (Open): Normalize file name to lower case in non-case
	sensitive file name systems to avoid unexpected mismatch in Vista.

From-SVN: r127981

1 files changed, 43 insertions, 25 deletions

diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index 5607e70..40a02fb 100644
--- a/gcc/ada/s-fileio.adb
+++ b/gcc/ada/s-fileio.adb
@@ -34,8 +34,11 @@
 with Ada.Finalization;            use Ada.Finalization;
 with Ada.IO_Exceptions;           use Ada.IO_Exceptions;
 with Interfaces.C_Streams;        use Interfaces.C_Streams;
+
 with System.CRTL;
+with System.Case_Util;            use System.Case_Util;
 with System.Soft_Links;
+
 with Ada.Unchecked_Deallocation;
 
 package body System.File_IO is
@@ -91,6 +94,14 @@ package body System.File_IO is
      (C, text_translation_required, "__gnat_text_translation_required");
    --  If true, add appropriate suffix to control string for Open
 
+   function Get_Case_Sensitive return Integer;
+   pragma Import (C, Get_Case_Sensitive,
+                  "__gnat_get_file_names_case_sensitive");
+   File_Names_Case_Sensitive : constant Boolean := Get_Case_Sensitive /= 0;
+   --  Set to indicate whether the operating system convention is for file
+   --  names to be case sensitive (e.g., in Unix, set True), or non case
+   --  sensitive (e.g., in OS/2, set False).
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -870,6 +881,17 @@ package body System.File_IO is
             Full_Name_Len := Full_Name_Len + 1;
          end loop;
 
+         --  Fullname is generated by calling system's full_name. The problem
+         --  is, full_name does nothing about the casing, so a file name
+         --  comparison may generally speaking not be valid on non-case
+         --  sensitive systems, and in particular we get unexpected failures
+         --  on Windows/Vista because of this. So we use s-casuti to force
+         --  the name to lower case.
+
+         if not File_Names_Case_Sensitive then
+            To_Lower (Fullname (1 .. Full_Name_Len));
+         end if;
+
          --  If Shared=None or Shared=Yes, then check for the existence
          --  of another file with exactly the same full name.
 
@@ -889,9 +911,9 @@ package body System.File_IO is
                   if Fullname (1 .. Full_Name_Len) = P.Name.all then
 
                      --  If we get a match, and either file has Shared=None,
-                     --  then raise Use_Error, since we don't allow two
-                     --  files of the same name to be opened unless they
-                     --  specify the required sharing mode.
+                     --  then raise Use_Error, since we don't allow two files
+                     --  of the same name to be opened unless they specify the
+                     --  required sharing mode.
 
                      if Shared = None
                        or else P.Shared_Status = None
@@ -907,13 +929,12 @@ package body System.File_IO is
                         Stream := P.Stream;
                         exit;
 
-                     --  Otherwise one of the files has Shared=Yes and one
-                     --  has Shared=No. If the current file has Shared=No
-                     --  then all is well but we don't want to share any
-                     --  other file's stream. If the current file has
-                     --  Shared=Yes, we would like to share a stream, but
-                     --  not from a file that has Shared=No, so in either
-                     --  case we just keep going on the search.
+                     --  Otherwise one of the files has Shared=Yes and one has
+                     --  Shared=No. If the current file has Shared=No then all
+                     --  is well but we don't want to share any other file's
+                     --  stream. If the current file has Shared=Yes, we would
+                     --  like to share a stream, but not from a file that has
+                     --  Shared=No, so either way, we just continue the search.
 
                      else
                         null;
@@ -937,10 +958,9 @@ package body System.File_IO is
          if Stream = NULL_Stream then
             Fopen_Mode (Mode, Text, Creat, Amethod, Fopstr);
 
-            --  A special case, if we are opening (OPEN case) a file and
-            --  the mode returned by Fopen_Mode is not "r" or "r+", then
-            --  we first make sure that the file exists as required by
-            --  Ada semantics.
+            --  A special case, if we are opening (OPEN case) a file and the
+            --  mode returned by Fopen_Mode is not "r" or "r+", then we first
+            --  make sure that the file exists as required by Ada semantics.
 
             if Creat = False and then Fopstr (1) /= 'r' then
                if file_exists (Namestr'Address) = 0 then
@@ -948,17 +968,15 @@ package body System.File_IO is
                end if;
             end if;
 
-            --  Now open the file. Note that we use the name as given
-            --  in the original Open call for this purpose, since that
-            --  seems the clearest implementation of the intent. It
-            --  would presumably work to use the full name here, but
-            --  if there is any difference, then we should use the
-            --  name used in the call.
-
-            --  Note: for a corresponding delete, we will use the
-            --  full name, since by the time of the delete, the
-            --  current working directory may have changed and
-            --  we do not want to delete a different file!
+            --  Now open the file. Note that we use the name as given in the
+            --  original Open call for this purpose, since that seems the
+            --  clearest implementation of the intent. It would presumably
+            --  work to use the full name here, but if there is any difference,
+            --  then we should use the name used in the call.
+
+            --  Note: for a corresponding delete, we will use the full name,
+            --  since by the time of the delete, the current working directory
+            --  may have changed and we do not want to delete a different file!
 
             Stream := fopen (Namestr'Address, Fopstr'Address, Encoding);