Commit 686b7752 by Arnaud Charlet

re PR ada/864 (--program-suffix is ignored (for ada))

	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.

From-SVN: r136149
parent fe63b1b1
......@@ -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);
......
......@@ -787,7 +787,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);
......@@ -1345,7 +1345,7 @@ procedure GNATCmd is
if C = Stack then
Put (Command_List (C).Unixcmd.all);
else
Put (Program_Name (Command_List (C).Unixcmd.all).all);
Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
end if;
declare
......@@ -1581,7 +1581,7 @@ begin
else
Program :=
Program_Name (Command_List (The_Command).Unixcmd.all);
Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
end if;
-- Locate the executable for the command
......
......@@ -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;
......
......@@ -659,9 +659,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;
......
......@@ -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);
......
......@@ -1874,8 +1874,10 @@ 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
-- GNAAMP tool names require special treatment
......@@ -1907,34 +1909,42 @@ package body Osint is
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
Start_Of_Suffix := Name_Len + 1;
-- All done if we find the last hyphen
-- 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"
if Name_Buffer (Name_Len) = '-' then
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;
------------------------------
......
......@@ -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
......@@ -113,6 +113,9 @@ package Osint is
-- to "<target>-gcc". In the specific case where AAMP_On_Target is set, the
-- name "gcc" is mapped to "gnaamp", and names of the form "gnat*" are
-- mapped to "gnaamp*". This function clobbers Name_Buffer and Name_Len.
-- Also look at any suffix, e.g. gnatmake-4.1 -> "gcc-4.1".
-- Prog is the default name of the current program being executed, e.g.
-- "gnatmake", "gnatlink".
procedure Write_Program_Name;
-- Writes name of program as invoked to the current output
......
......@@ -1172,7 +1172,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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment