Commit 64c69860 by Arnaud Charlet

gnatcmd.adb (Process_Link): Use Osint.Executable_Name instead of handling…

gnatcmd.adb (Process_Link): Use Osint.Executable_Name instead of handling executable extension manually and...

2006-10-31  Arnaud Charlet  <charlet@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* gnatcmd.adb (Process_Link): Use Osint.Executable_Name instead of
	handling executable extension manually and duplicating code.

	* make.adb: Implement new -S switch
	(Gnatmake): Use new function Osint.Executable_Name instead
	of handling executable extension manually.

	* prj-util.adb (Executable_Of): Make sure that if an Executable_Suffix
	is specified, the executable name ends with this suffix.
	Take advantage of Osint.Executable_Name instead of duplicating code.

	* switch-m.adb: Recognize new gnatmake -S switch

	* targparm.ads, targparm.adb (Executable_Extension_On_Target): New
	variable.
	(Get_Target_Parameters): Set Executable_Extension_On_Target if
	available.

	* makeusg.adb: Add line for gnatmake -S switch

From-SVN: r118276
parent 5b8b9057
...@@ -871,8 +871,8 @@ procedure GNATCmd is ...@@ -871,8 +871,8 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'(Name_Buffer (1 .. Name_Len) & new String'(Name_Buffer (1 .. Name_Len) &
Directory_Separator & Directory_Separator &
Base_Name (Arg (Arg'First .. Last)) & Executable_Name
Get_Executable_Suffix.all); (Base_Name (Arg (Arg'First .. Last))));
exit; exit;
end if; end if;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -171,9 +171,13 @@ begin ...@@ -171,9 +171,13 @@ begin
Write_Str (" -s Recompile if compiler switches have changed"); Write_Str (" -s Recompile if compiler switches have changed");
Write_Eol; Write_Eol;
-- Line for -S
Write_Str (" -S Echo commands to stdout instead of stderr");
-- Line for -u -- Line for -u
Write_Str (" -u Unique compilation. Only compile the given files."); Write_Str (" -u Unique compilation, only compile the given files");
Write_Eol; Write_Eol;
-- Line for -U -- Line for -U
......
...@@ -33,6 +33,7 @@ with Osint; use Osint; ...@@ -33,6 +33,7 @@ with Osint; use Osint;
with Output; use Output; with Output; use Output;
with Prj.Com; with Prj.Com;
with Snames; use Snames; with Snames; use Snames;
with Targparm; use Targparm;
package body Prj.Util is package body Prj.Util is
...@@ -99,14 +100,7 @@ package body Prj.Util is ...@@ -99,14 +100,7 @@ package body Prj.Util is
In_Package => Builder_Package, In_Package => Builder_Package,
In_Tree => In_Tree); In_Tree => In_Tree);
Executable_Suffix : constant Variable_Value := Executable_Suffix : Variable_Value := Nil_Variable_Value;
Prj.Util.Value_Of
(Name => Main,
Index => 0,
Attribute_Or_Array_Name =>
Name_Executable_Suffix,
In_Package => Builder_Package,
In_Tree => In_Tree);
Body_Append : constant String := Get_Name_String Body_Append : constant String := Get_Name_String
(In_Tree.Projects.Table (In_Tree.Projects.Table
...@@ -120,6 +114,12 @@ package body Prj.Util is ...@@ -120,6 +114,12 @@ package body Prj.Util is
begin begin
if Builder_Package /= No_Package then if Builder_Package /= No_Package then
Executable_Suffix := Prj.Util.Value_Of
(Variable_Name => Name_Executable_Suffix,
In_Variables => In_Tree.Packages.Table
(Builder_Package).Decl.Attributes,
In_Tree => In_Tree);
if Executable = Nil_Variable_Value and Ada_Main then if Executable = Nil_Variable_Value and Ada_Main then
Get_Name_String (Main); Get_Name_String (Main);
...@@ -179,39 +179,22 @@ package body Prj.Util is ...@@ -179,39 +179,22 @@ package body Prj.Util is
if Executable /= Nil_Variable_Value if Executable /= Nil_Variable_Value
and then Executable.Value /= Empty_Name and then Executable.Value /= Empty_Name
then then
-- Get the executable name. If Executable_Suffix is defined,
-- make sure that it will be the extension of the executable.
declare declare
Exec_Suffix : String_Access := Get_Executable_Suffix; Saved_EEOT : constant Name_Id := Executable_Extension_On_Target;
Result : Name_Id := Executable.Value; Result : Name_Id;
begin begin
if Exec_Suffix'Length /= 0 then if Executable_Suffix /= Nil_Variable_Value
Get_Name_String (Executable.Value); and then not Executable_Suffix.Default
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); then
Executable_Extension_On_Target := Executable_Suffix.Value;
-- If the Executable does not end with the executable
-- suffix, add it.
if Name_Len <= Exec_Suffix'Length
or else
Name_Buffer
(Name_Len - Exec_Suffix'Length + 1 .. Name_Len) /=
Exec_Suffix.all
then
-- Get the original Executable to keep the correct
-- case for systems where file names are case
-- insensitive (Windows).
Get_Name_String (Executable.Value);
Name_Buffer
(Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
Exec_Suffix.all;
Name_Len := Name_Len + Exec_Suffix'Length;
Result := Name_Find;
end if;
Free (Exec_Suffix);
end if; end if;
Result := Executable_Name (Executable.Value);
Executable_Extension_On_Target := Saved_EEOT;
return Result; return Result;
end; end;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- -- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -471,7 +471,6 @@ package body Switch.M is ...@@ -471,7 +471,6 @@ package body Switch.M is
if Last = 0 then if Last = 0 then
return (1 .. 0 => null); return (1 .. 0 => null);
else else
return Global_Switches (Global_Switches'First .. Last); return Global_Switches (Global_Switches'First .. Last);
end if; end if;
...@@ -594,13 +593,13 @@ package body Switch.M is ...@@ -594,13 +593,13 @@ package body Switch.M is
case Switch_Chars (Ptr) is case Switch_Chars (Ptr) is
-- processing for eI switch -- Processing for eI switch
when 'I' => when 'I' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C); Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
-- processing for eL switch -- Processing for eL switch
when 'L' => when 'L' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
...@@ -702,6 +701,12 @@ package body Switch.M is ...@@ -702,6 +701,12 @@ package body Switch.M is
Ptr := Ptr + 1; Ptr := Ptr + 1;
Check_Switches := True; Check_Switches := True;
-- Processing for S switch
when 'S' =>
Ptr := Ptr + 1;
Commands_To_Stdout := True;
-- Processing for v switch -- Processing for v switch
when 'v' => when 'v' =>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -147,25 +147,6 @@ package body Targparm is ...@@ -147,25 +147,6 @@ package body Targparm is
procedure Set_Profile_Restrictions (P : Profile_Name); procedure Set_Profile_Restrictions (P : Profile_Name);
-- Set Restrictions_On_Target for the given profile -- Set Restrictions_On_Target for the given profile
------------------------------
-- Set_Profile_Restrictions --
------------------------------
procedure Set_Profile_Restrictions (P : Profile_Name) is
R : Restriction_Flags renames Profile_Info (P).Set;
V : Restriction_Values renames Profile_Info (P).Value;
begin
for J in R'Range loop
if R (J) then
Restrictions_On_Target.Set (J) := True;
if J in All_Parameter_Restrictions then
Restrictions_On_Target.Value (J) := V (J);
end if;
end if;
end loop;
end Set_Profile_Restrictions;
--------------------------- ---------------------------
-- Get_Target_Parameters -- -- Get_Target_Parameters --
--------------------------- ---------------------------
...@@ -497,6 +478,34 @@ package body Targparm is ...@@ -497,6 +478,34 @@ package body Targparm is
goto Line_Loop_Continue; goto Line_Loop_Continue;
-- See if we have an Executable_Extension
elsif System_Text (P .. P + 45) =
" Executable_Extension : constant String := """
then
P := P + 46;
Name_Len := 0;
while System_Text (P) /= '"'
and then System_Text (P) /= ASCII.LF
loop
Add_Char_To_Name_Buffer (System_Text (P));
P := P + 1;
end loop;
if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then
Set_Standard_Error;
Write_Line
("incorrectly formatted Executable_Extension in system.ads");
Set_Standard_Output;
Fatal := True;
else
Executable_Extension_On_Target := Name_Enter;
end if;
goto Line_Loop_Continue;
-- Next See if we have a configuration parameter -- Next See if we have a configuration parameter
else else
...@@ -635,4 +644,23 @@ package body Targparm is ...@@ -635,4 +644,23 @@ package body Targparm is
end if; end if;
end Get_Target_Parameters; end Get_Target_Parameters;
------------------------------
-- Set_Profile_Restrictions --
------------------------------
procedure Set_Profile_Restrictions (P : Profile_Name) is
R : Restriction_Flags renames Profile_Info (P).Set;
V : Restriction_Values renames Profile_Info (P).Value;
begin
for J in R'Range loop
if R (J) then
Restrictions_On_Target.Set (J) := True;
if J in All_Parameter_Restrictions then
Restrictions_On_Target.Value (J) := V (J);
end if;
end if;
end loop;
end Set_Profile_Restrictions;
end Targparm; end Targparm;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1999-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -129,7 +129,7 @@ package Targparm is ...@@ -129,7 +129,7 @@ package Targparm is
-- then the flag Opt.Address_Is_Private is set True, otherwise this flag -- then the flag Opt.Address_Is_Private is set True, otherwise this flag
-- is set False. -- is set False.
Restrictions_On_Target : Restrictions_Info; Restrictions_On_Target : Restrictions_Info := No_Restrictions;
-- Records restrictions specified by system.ads. Only the Set and Value -- Records restrictions specified by system.ads. Only the Set and Value
-- members are modified. The Violated and Count fields are never modified. -- members are modified. The Violated and Count fields are never modified.
-- Note that entries can be set either by a pragma Restrictions or by -- Note that entries can be set either by a pragma Restrictions or by
...@@ -161,6 +161,17 @@ package Targparm is ...@@ -161,6 +161,17 @@ package Targparm is
-- The name should contain only letters A-Z, digits 1-9, spaces, -- The name should contain only letters A-Z, digits 1-9, spaces,
-- and underscores. -- and underscores.
--------------------------
-- Executable Extension --
--------------------------
Executable_Extension_On_Target : Name_Id := No_Name;
-- Executable extension on the target.
-- This name is useful for setting the executable extension in a
-- dynamic way, e.g. depending on the run-time used, rather than
-- using a configure-time macro as done by Get_Target_Executable_Suffix.
-- If not set (No_Name), use GNAT.OS_Lib.Get_Target_Executable_Suffix.
----------------------- -----------------------
-- Target Parameters -- -- Target Parameters --
----------------------- -----------------------
......
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