[Ada] Preserve casing of output files
authorArnaud Charlet <charlet@adacore.com>
Fri, 29 May 2020 08:41:00 +0000 (04:41 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Fri, 10 Jul 2020 09:16:22 +0000 (05:16 -0400)
gcc/ada/

* osint-c.adb (Set_File_Name): Preserve casing of file.
* osint.adb (File_Names_Equal): New.
(Executable_Name): Use File_Equal instead of
Canonical_Case_File_Name.

gcc/ada/osint-c.adb
gcc/ada/osint.adb

index 7708c1de9cbe016bd85485637812c9c2c00e654d..0010a8deec18ebf413c66247777a9b1700e165b0 100644 (file)
@@ -412,22 +412,23 @@ package body Osint.C is
          --  Remove extension preparing to replace it
 
          declare
-            Name  : String  := Name_Buffer (1 .. Dot_Index);
-            First : Positive;
+            Name   : String  := Name_Buffer (1 .. Dot_Index);
+            Output : String  := Output_Object_File_Name.all;
+            First  : Positive;
 
          begin
-            Name_Buffer (1 .. Output_Object_File_Name'Length) :=
-              Output_Object_File_Name.all;
+            Name_Buffer (1 .. Output_Object_File_Name'Length) := Output;
 
             --  Put two names in canonical case, to allow object file names
             --  with upper-case letters on Windows.
+            --  Do it with a copy (Output) and keep Name_Buffer as is since we
+            --  want to preserve the original casing.
 
             Canonical_Case_File_Name (Name);
-            Canonical_Case_File_Name
-              (Name_Buffer (1 .. Output_Object_File_Name'Length));
+            Canonical_Case_File_Name (Output);
 
             Dot_Index := 0;
-            for J in reverse Output_Object_File_Name'Range loop
+            for J in reverse Output'Range loop
                if Name_Buffer (J) = '.' then
                   Dot_Index := J;
                   exit;
@@ -451,7 +452,7 @@ package body Osint.C is
 
             --  Check name of object file is what we expect
 
-            if Name /= Name_Buffer (First .. Dot_Index) then
+            if Name /= Output (First .. Dot_Index) then
                Fail ("incorrect object file name");
             end if;
          end;
index 776a31ae2bbb0252b6740ec44087730af5d87f72..3ae76cf9a5a0f6c72ccdcf9120f3bc2a3a1b7353 100644 (file)
@@ -100,6 +100,10 @@ package body Osint is
    --  executable is stored in directory "/foo/bar/bin", this routine returns
    --  "/foo/bar/". Return "" if location is not recognized as described above.
 
+   function File_Names_Equal (File1, File2 : String) return Boolean;
+   --  Compare File1 and File2 taking into account the case insensitivity
+   --  of the OS.
+
    function Update_Path (Path : String_Ptr) return String_Ptr;
    --  Update the specified path to replace the prefix with the location where
    --  GNAT is installed. See the file prefix.c in GCC for details.
@@ -852,30 +856,22 @@ package body Osint is
          end if;
 
          if Add_Suffix then
-            declare
-               Buffer : String := Name_Buffer (1 .. Name_Len);
-
-            begin
-               --  Get the file name in canonical case to accept as is. Names
-               --  end with ".EXE" on Windows.
-
-               Canonical_Case_File_Name (Buffer);
-
-               --  If Executable doesn't end with the executable suffix, add it
-
-               if Buffer'Length <= Exec_Suffix'Length
-                 or else
-                   Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
-                     /= Exec_Suffix.all
-               then
-                  Name_Buffer
-                    (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
-                      Exec_Suffix.all;
-                  Name_Len := Name_Len + Exec_Suffix'Length;
-                  Free (Exec_Suffix);
-                  return Name_Find;
-               end if;
-            end;
+            --  If Executable doesn't end with the executable suffix, add it
+
+            if Name_Len <= Exec_Suffix'Length
+              or else not
+                File_Names_Equal
+                  (Name_Buffer
+                    (Name_Len - Exec_Suffix'Length + 1 .. Name_Len),
+                   Exec_Suffix.all)
+            then
+               Name_Buffer
+                 (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
+                   Exec_Suffix.all;
+               Name_Len := Name_Len + Exec_Suffix'Length;
+               Free (Exec_Suffix);
+               return Name_Find;
+            end if;
          end if;
       end if;
 
@@ -889,7 +885,6 @@ package body Osint is
    is
       Exec_Suffix    : String_Access;
       Add_Suffix     : Boolean;
-      Canonical_Name : String := Name;
 
    begin
       if Executable_Extension_On_Target = No_Name then
@@ -909,25 +904,26 @@ package body Osint is
 
          begin
             Free (Exec_Suffix);
-            Canonical_Case_File_Name (Canonical_Name);
-
             Add_Suffix := True;
+
             if Only_If_No_Suffix then
-               for J in reverse Canonical_Name'Range loop
-                  if Canonical_Name (J) = '.' then
+               for J in reverse Name'Range loop
+                  if Name (J) = '.' then
                      Add_Suffix := False;
                      exit;
 
-                  elsif Is_Directory_Separator (Canonical_Name (J)) then
+                  elsif Is_Directory_Separator (Name (J)) then
                      exit;
                   end if;
                end loop;
             end if;
 
             if Add_Suffix and then
-              (Canonical_Name'Length <= Suffix'Length
-               or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
-                                       .. Canonical_Name'Last) /= Suffix)
+              (Name'Length <= Suffix'Length
+               or else not
+                 File_Names_Equal
+                   (Name (Name'Last - Suffix'Length + 1 .. Name'Last),
+                    Suffix))
             then
                declare
                   Result : String (1 .. Name'Length + Suffix'Length);
@@ -1057,6 +1053,19 @@ package body Osint is
       Exit_Program (E_Fatal);
    end Fail;
 
+   ----------------------
+   -- File_Names_Equal --
+   ----------------------
+
+   function File_Names_Equal (File1, File2 : String) return Boolean is
+   begin
+      if File_Names_Case_Sensitive then
+         return File1 = File2;
+      else
+         return To_Lower (File1) = To_Lower (File2);
+      end if;
+   end File_Names_Equal;
+
    ---------------
    -- File_Hash --
    ---------------