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 ...@@ -524,13 +524,16 @@ procedure Gnatchop is
(Program_Name : String; (Program_Name : String;
Look_For_Prefix : Boolean := True) return String_Access Look_For_Prefix : Boolean := True) return String_Access
is is
Gnatchop_Str : constant String := "gnatchop";
Current_Command : constant String := Normalize_Pathname (Command_Name); Current_Command : constant String := Normalize_Pathname (Command_Name);
End_Of_Prefix : Natural; End_Of_Prefix : Natural;
Start_Of_Prefix : Positive; Start_Of_Prefix : Positive;
Start_Of_Suffix : Positive;
Result : String_Access; Result : String_Access;
begin begin
Start_Of_Prefix := Current_Command'First; Start_Of_Prefix := Current_Command'First;
Start_Of_Suffix := Current_Command'Last + 1;
End_Of_Prefix := Start_Of_Prefix - 1; End_Of_Prefix := Start_Of_Prefix - 1;
if Look_For_Prefix then if Look_For_Prefix then
...@@ -549,18 +552,28 @@ procedure Gnatchop is ...@@ -549,18 +552,28 @@ procedure Gnatchop is
-- Find End_Of_Prefix -- Find End_Of_Prefix
for J in reverse Start_Of_Prefix .. Current_Command'Last loop for J in Start_Of_Prefix ..
if Current_Command (J) = '-' then Current_Command'Last - Gnatchop_Str'Length + 1
End_Of_Prefix := J; loop
if Current_Command (J .. J + Gnatchop_Str'Length - 1) =
Gnatchop_Str
then
End_Of_Prefix := J - 1;
exit; exit;
end if; end if;
end loop; end loop;
end if; end if;
if End_Of_Prefix > Current_Command'First then
Start_Of_Suffix := End_Of_Prefix + Gnatchop_Str'Length + 1;
end if;
declare declare
Command : constant String := Command : constant String :=
Current_Command (Start_Of_Prefix .. End_Of_Prefix) & Current_Command (Start_Of_Prefix .. End_Of_Prefix)
Program_Name; & Program_Name
& Current_Command (Start_Of_Suffix ..
Current_Command'Last);
begin begin
Result := Locate_Exec_On_Path (Command); Result := Locate_Exec_On_Path (Command);
......
...@@ -787,7 +787,7 @@ procedure GNATCmd is ...@@ -787,7 +787,7 @@ procedure GNATCmd is
Name : Path_Name_Type; Name : Path_Name_Type;
-- Path of the file FD -- 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 -- Name for gnatmake
GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name); GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name);
...@@ -1345,7 +1345,7 @@ procedure GNATCmd is ...@@ -1345,7 +1345,7 @@ procedure GNATCmd is
if C = Stack then if C = Stack then
Put (Command_List (C).Unixcmd.all); Put (Command_List (C).Unixcmd.all);
else else
Put (Program_Name (Command_List (C).Unixcmd.all).all); Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
end if; end if;
declare declare
...@@ -1581,7 +1581,7 @@ begin ...@@ -1581,7 +1581,7 @@ begin
else else
Program := Program :=
Program_Name (Command_List (The_Command).Unixcmd.all); Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
end if; end if;
-- Locate the executable for the command -- Locate the executable for the command
......
...@@ -137,7 +137,7 @@ procedure Gnatlink is ...@@ -137,7 +137,7 @@ procedure Gnatlink is
-- This table collects the arguments to be passed to compile the binder -- This table collects the arguments to be passed to compile the binder
-- generated file. -- generated file.
Gcc : String_Access := Program_Name ("gcc"); Gcc : String_Access := Program_Name ("gcc", "gnatlink");
Read_Mode : constant String := "r" & ASCII.NUL; Read_Mode : constant String := "r" & ASCII.NUL;
......
...@@ -659,9 +659,9 @@ package body Make is ...@@ -659,9 +659,9 @@ package body Make is
-- Compiler, Binder & Linker Data and Subprograms -- -- Compiler, Binder & Linker Data and Subprograms --
---------------------------------------------------- ----------------------------------------------------
Gcc : String_Access := Program_Name ("gcc"); Gcc : String_Access := Program_Name ("gcc", "gnatmake");
Gnatbind : String_Access := Program_Name ("gnatbind"); Gnatbind : String_Access := Program_Name ("gnatbind", "gnatmake");
Gnatlink : String_Access := Program_Name ("gnatlink"); Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
-- Default compiler, binder, linker programs -- Default compiler, binder, linker programs
Saved_Gcc : String_Access := null; Saved_Gcc : String_Access := null;
......
...@@ -136,7 +136,7 @@ package body MLib.Utl is ...@@ -136,7 +136,7 @@ package body MLib.Utl is
begin begin
if Ar_Exec = null then 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); Ar_Exec := Locate_Exec_On_Path (Ar_Name.all);
if Ar_Exec = null then if Ar_Exec = null then
...@@ -177,7 +177,7 @@ package body MLib.Utl is ...@@ -177,7 +177,7 @@ package body MLib.Utl is
-- ranlib -- ranlib
Ranlib_Name := Osint.Program_Name (Archive_Indexer); Ranlib_Name := Osint.Program_Name (Archive_Indexer, "gnatmake");
if Ranlib_Name'Length > 0 then if Ranlib_Name'Length > 0 then
Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all); Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all);
...@@ -408,7 +408,7 @@ package body MLib.Utl is ...@@ -408,7 +408,7 @@ package body MLib.Utl is
if Driver_Name = No_Name then if Driver_Name = No_Name then
if Gcc_Exec = null then if Gcc_Exec = null then
if Gcc_Name = null then if Gcc_Name = null then
Gcc_Name := Osint.Program_Name ("gcc"); Gcc_Name := Osint.Program_Name ("gcc", "gnatmake");
end if; end if;
Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all); Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all);
......
...@@ -1874,8 +1874,10 @@ package body Osint is ...@@ -1874,8 +1874,10 @@ package body Osint is
-- Program_Name -- -- Program_Name --
------------------ ------------------
function Program_Name (Nam : String) return String_Access is function Program_Name (Nam : String; Prog : String) return String_Access is
Res : String_Access; End_Of_Prefix : Natural := 0;
Start_Of_Prefix : Positive := 1;
Start_Of_Suffix : Positive;
begin begin
-- GNAAMP tool names require special treatment -- GNAAMP tool names require special treatment
...@@ -1907,34 +1909,42 @@ package body Osint is ...@@ -1907,34 +1909,42 @@ package body Osint is
Find_Program_Name; Find_Program_Name;
-- Find the target prefix if any, for the cross compilation case. Start_Of_Suffix := Name_Len + 1;
-- 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 -- 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; exit;
end if;
end loop;
-- If directory separator found, we don't want to look further -- Find End_Of_Prefix
-- since in this case, no prefix has been found.
elsif Is_Directory_Separator (Name_Buffer (Name_Len)) then for J in Start_Of_Prefix .. Name_Len - Prog'Length + 1 loop
Name_Len := 0; if Name_Buffer (J .. J + Prog'Length - 1) = Prog then
End_Of_Prefix := J - 1;
exit; exit;
end if; end if;
Name_Len := Name_Len - 1;
end loop; end loop;
if End_Of_Prefix > 1 then
Start_Of_Suffix := End_Of_Prefix + Prog'Length + 1;
end if;
-- Create the new program name -- Create the new program name
Res := new String (1 .. Name_Len + Nam'Length); return new String'
Res.all (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); (Name_Buffer (Start_Of_Prefix .. End_Of_Prefix)
Res.all (Name_Len + 1 .. Name_Len + Nam'Length) := Nam; & Nam
return Res; & Name_Buffer (Start_Of_Suffix .. Name_Len));
end Program_Name; end Program_Name;
------------------------------ ------------------------------
......
...@@ -105,7 +105,7 @@ package Osint is ...@@ -105,7 +105,7 @@ package Osint is
-- Put simple name of current program being run (excluding the directory -- Put simple name of current program being run (excluding the directory
-- path) in Name_Buffer, with the length in Name_Len. -- 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 -- In the native compilation case, Create a string containing Nam. In the
-- cross compilation case, looks at the prefix of the current program being -- 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 -- run and prepend it to Nam. For instance if the program being run is
...@@ -113,6 +113,9 @@ package Osint is ...@@ -113,6 +113,9 @@ package Osint is
-- to "<target>-gcc". In the specific case where AAMP_On_Target is set, the -- 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 -- name "gcc" is mapped to "gnaamp", and names of the form "gnat*" are
-- mapped to "gnaamp*". This function clobbers Name_Buffer and Name_Len. -- 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; procedure Write_Program_Name;
-- Writes name of program as invoked to the current output -- Writes name of program as invoked to the current output
......
...@@ -1172,7 +1172,7 @@ package body Prj.Makr is ...@@ -1172,7 +1172,7 @@ package body Prj.Makr is
if Gcc_Path = null then if Gcc_Path = null then
declare declare
Prefix_Gcc : String_Access := Prefix_Gcc : String_Access :=
Program_Name (Gcc); Program_Name (Gcc, "gnatname");
begin begin
Gcc_Path := Gcc_Path :=
Locate_Exec_On_Path (Prefix_Gcc.all); 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