File program-transform-name-tools.diff of Package gcc43

2008-05-29  Arnaud Charlet  <charlet@adacore.com>

        PR ada/864
        * osint.ads, osint.adb (Program_Name): New parameter "Prog" to
        allow recognition of program suffix in addition to prefix.

        * gnatchop.adb (Locate_Executable): Add support for prefix.

        * make.adb, gnatcmd.adb, gnatlink.adb, prj-makr.adb,
        mlib-utl.adb: Adjust calls to Program_Name.


Index: gcc/ada/gnatchop.adb
===================================================================
--- gcc/ada/gnatchop.adb	(revision 136151)
+++ gcc/ada/gnatchop.adb	(working copy)
@@ -524,13 +524,16 @@ procedure Gnatchop is
      (Program_Name    : String;
       Look_For_Prefix : Boolean := True) return String_Access
    is
+      Gnatchop_Str    : constant String := "gnatchop";
       Current_Command : constant String := Normalize_Pathname (Command_Name);
       End_Of_Prefix   : Natural;
       Start_Of_Prefix : Positive;
+      Start_Of_Suffix : Positive;
       Result          : String_Access;
 
    begin
       Start_Of_Prefix := Current_Command'First;
+      Start_Of_Suffix := Current_Command'Last + 1;
       End_Of_Prefix   := Start_Of_Prefix - 1;
 
       if Look_For_Prefix then
@@ -549,18 +552,28 @@ procedure Gnatchop is
 
          --  Find End_Of_Prefix
 
-         for J in reverse Start_Of_Prefix .. Current_Command'Last loop
-            if Current_Command (J) = '-' then
-               End_Of_Prefix := J;
+         for J in Start_Of_Prefix ..
+                  Current_Command'Last - Gnatchop_Str'Length + 1
+         loop
+            if Current_Command (J .. J + Gnatchop_Str'Length - 1) =
+                                                                  Gnatchop_Str
+            then
+               End_Of_Prefix := J - 1;
                exit;
             end if;
          end loop;
       end if;
 
+      if End_Of_Prefix > Current_Command'First then
+         Start_Of_Suffix := End_Of_Prefix + Gnatchop_Str'Length + 1;
+      end if;
+
       declare
          Command : constant String :=
-                     Current_Command (Start_Of_Prefix .. End_Of_Prefix) &
-                                                                Program_Name;
+                     Current_Command (Start_Of_Prefix .. End_Of_Prefix)
+                       & Program_Name
+                       & Current_Command (Start_Of_Suffix ..
+                                          Current_Command'Last);
       begin
          Result := Locate_Exec_On_Path (Command);
 
Index: gcc/ada/gnatcmd.adb
===================================================================
--- gcc/ada/gnatcmd.adb	(revision 136151)
+++ gcc/ada/gnatcmd.adb	(working copy)
@@ -772,7 +772,7 @@ procedure GNATCmd is
       Name : Path_Name_Type;
       --  Path of the file FD
 
-      GN_Name : constant String := Program_Name ("gnatmake").all;
+      GN_Name : constant String := Program_Name ("gnatmake", "gnat").all;
       --  Name for gnatmake
 
       GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name);
@@ -1532,7 +1532,7 @@ begin
 
    declare
       Program : constant String :=
-                  Program_Name (Command_List (The_Command).Unixcmd.all).all;
+        Program_Name (Command_List (The_Command).Unixcmd.all, "gnat").all;
 
       Exec_Path : String_Access;
 
Index: gcc/ada/make.adb
===================================================================
--- gcc/ada/make.adb	(revision 136151)
+++ gcc/ada/make.adb	(working copy)
@@ -664,9 +664,9 @@ package body Make is
    -- Compiler, Binder & Linker Data and Subprograms --
    ----------------------------------------------------
 
-   Gcc             : String_Access := Program_Name ("gcc");
-   Gnatbind        : String_Access := Program_Name ("gnatbind");
-   Gnatlink        : String_Access := Program_Name ("gnatlink");
+   Gcc             : String_Access := Program_Name ("gcc", "gnatmake");
+   Gnatbind        : String_Access := Program_Name ("gnatbind", "gnatmake");
+   Gnatlink        : String_Access := Program_Name ("gnatlink", "gnatmake");
    --  Default compiler, binder, linker programs
 
    Saved_Gcc       : String_Access := null;
Index: gcc/ada/mlib-utl.adb
===================================================================
--- gcc/ada/mlib-utl.adb	(revision 136151)
+++ gcc/ada/mlib-utl.adb	(working copy)
@@ -136,7 +136,7 @@ package body MLib.Utl is
 
    begin
       if Ar_Exec = null then
-         Ar_Name := Osint.Program_Name (Archive_Builder);
+         Ar_Name := Osint.Program_Name (Archive_Builder, "gnatmake");
          Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
 
          if Ar_Exec = null then
@@ -177,7 +177,7 @@ package body MLib.Utl is
 
          --  ranlib
 
-         Ranlib_Name := Osint.Program_Name (Archive_Indexer);
+         Ranlib_Name := Osint.Program_Name (Archive_Indexer, "gnatmake");
 
          if Ranlib_Name'Length > 0 then
             Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
@@ -408,7 +408,7 @@ package body MLib.Utl is
       if Driver_Name = No_Name then
          if Gcc_Exec = null then
             if Gcc_Name = null then
-               Gcc_Name :=  Osint.Program_Name ("gcc");
+               Gcc_Name :=  Osint.Program_Name ("gcc", "gnatmake");
             end if;
 
             Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all);
Index: gcc/ada/gnatlink.adb
===================================================================
--- gcc/ada/gnatlink.adb	(revision 136151)
+++ gcc/ada/gnatlink.adb	(working copy)
@@ -137,7 +137,7 @@ procedure Gnatlink is
    --  This table collects the arguments to be passed to compile the binder
    --  generated file.
 
-   Gcc : String_Access := Program_Name ("gcc");
+   Gcc : String_Access := Program_Name ("gcc", "gnatlink");
 
    Read_Mode  : constant String := "r" & ASCII.Nul;
 
Index: gcc/ada/osint.adb
===================================================================
--- gcc/ada/osint.adb	(revision 136151)
+++ gcc/ada/osint.adb	(working copy)
@@ -1870,42 +1870,52 @@ package body Osint is
    -- Program_Name --
    ------------------
 
-   function Program_Name (Nam : String) return String_Access is
-      Res : String_Access;
+   function Program_Name (Nam : String; Prog : String) return String_Access is
+      End_Of_Prefix   : Natural := 0;
+      Start_Of_Prefix : Positive := 1;
+      Start_Of_Suffix : Positive;
 
    begin
       --  Get the name of the current program being executed
 
       Find_Program_Name;
 
-      --  Find the target prefix if any, for the cross compilation case.
-      --  For instance in "alpha-dec-vxworks-gcc" the target prefix is
-      --  "alpha-dec-vxworks-"
-
-      while Name_Len > 0  loop
-
-         --  All done if we find the last hyphen
+      Start_Of_Suffix := Name_Len + 1;
 
-         if Name_Buffer (Name_Len) = '-' then
+      --  Find the target prefix if any, for the cross compilation case.
+      --  For instance in "powerpc-elf-gcc" the target prefix is
+      --  "powerpc-elf-"
+      --  Ditto for suffix, e.g. in "gcc-4.1", the suffix is "-4.1"
+
+      for J in reverse 1 .. Name_Len loop
+         if Name_Buffer (J) = '/'
+           or else Name_Buffer (J) = Directory_Separator
+           or else Name_Buffer (J) = ':'
+         then
+            Start_Of_Prefix := J + 1;
             exit;
+         end if;
+      end loop;
 
-         --  If directory separator found, we don't want to look further
-         --  since in this case, no prefix has been found.
+      --  Find End_Of_Prefix
 
-         elsif Is_Directory_Separator (Name_Buffer (Name_Len)) then
-            Name_Len := 0;
+      for J in Start_Of_Prefix .. Name_Len - Prog'Length + 1 loop
+         if Name_Buffer (J .. J + Prog'Length - 1) = Prog then
+            End_Of_Prefix := J - 1;
             exit;
          end if;
-
-         Name_Len := Name_Len - 1;
       end loop;
 
+      if End_Of_Prefix > 1 then
+         Start_Of_Suffix := End_Of_Prefix + Prog'Length + 1;
+      end if;
+
       --  Create the new program name
 
-      Res := new String (1 .. Name_Len + Nam'Length);
-      Res.all (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
-      Res.all (Name_Len + 1 .. Name_Len + Nam'Length) := Nam;
-      return Res;
+      return new String'
+        (Name_Buffer (Start_Of_Prefix .. End_Of_Prefix)
+         & Nam
+         & Name_Buffer (Start_Of_Suffix .. Name_Len));
    end Program_Name;
 
    ------------------------------
Index: gcc/ada/osint.ads
===================================================================
--- gcc/ada/osint.ads	(revision 136151)
+++ gcc/ada/osint.ads	(working copy)
@@ -105,7 +105,7 @@ package Osint is
    --  Put simple name of current program being run (excluding the directory
    --  path) in Name_Buffer, with the length in Name_Len.
 
-   function Program_Name (Nam : String) return String_Access;
+   function Program_Name (Nam : String; Prog : String) return String_Access;
    --  In the native compilation case, Create a string containing Nam. In the
    --  cross compilation case, looks at the prefix of the current program being
    --  run and prepend it to Nam. For instance if the program being run is
Index: gcc/ada/prj-makr.adb
===================================================================
--- gcc/ada/prj-makr.adb	(revision 136151)
+++ gcc/ada/prj-makr.adb	(working copy)
@@ -316,7 +316,7 @@ package body Prj.Makr is
                         if Gcc_Path = null then
                            declare
                               Prefix_Gcc : String_Access :=
-                                             Program_Name (Gcc);
+                                             Program_Name (Gcc, "gnatname");
                            begin
                               Gcc_Path :=
                                 Locate_Exec_On_Path (Prefix_Gcc.all);