OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Arnaud Charlet 2006-10-31 18:59:45 +01:00
parent 5b8b905744
commit 64c69860aa
7 changed files with 188 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/ada/gnatcmd.adb
View File

@ -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;

195
gcc/ada/make.adb
View File

@ -88,20 +88,20 @@ package body Make is
-- Note on terminology -- -- Note on terminology --
------------------------- -------------------------
-- In this program, we use the phrase "termination" of a file name to -- In this program, we use the phrase "termination" of a file name to refer
-- refer to the suffix that appears after the unit name portion. Very -- to the suffix that appears after the unit name portion. Very often this
-- often this is simply the extension, but in some cases, the sequence -- is simply the extension, but in some cases, the sequence may be more
-- may be more complex, for example in main.1.ada, the termination in -- complex, for example in main.1.ada, the termination in this name is
-- this name is ".1.ada" and in main_.ada the termination is "_.ada". -- ".1.ada" and in main_.ada the termination is "_.ada".
------------------------------------- -------------------------------------
-- Queue (Q) Manipulation Routines -- -- Queue (Q) Manipulation Routines --
------------------------------------- -------------------------------------
-- The Q is used in Compile_Sources below. Its implementation uses the -- The Q is used in Compile_Sources below. Its implementation uses the GNAT
-- GNAT generic package Table (basically an extensible array). Q_Front -- generic package Table (basically an extensible array). Q_Front points to
-- points to the first valid element in the Q, whereas Q.First is the first -- the first valid element in the Q, whereas Q.First is the first element
-- element ever enqueued, while Q.Last - 1 is the last element in the Q. -- ever enqueued, while Q.Last - 1 is the last element in the Q.
-- --
-- +---+--------------+---+---+---+-----------+---+-------- -- +---+--------------+---+---+---+-----------+---+--------
-- Q | | ........ | | | | ....... | | -- Q | | ........ | | | | ....... | |
@ -109,14 +109,14 @@ package body Make is
-- ^ ^ ^ -- ^ ^ ^
-- Q.First Q_Front Q.Last - 1 -- Q.First Q_Front Q.Last - 1
-- --
-- The elements comprised between Q.First and Q_Front - 1 are the -- The elements comprised between Q.First and Q_Front - 1 are the elements
-- elements that have been enqueued and then dequeued, while the -- that have been enqueued and then dequeued, while the elements between
-- elements between Q_Front and Q.Last - 1 are the elements currently -- Q_Front and Q.Last - 1 are the elements currently in the Q. When the Q
-- in the Q. When the Q is initialized Q_Front = Q.First = Q.Last. -- is initialized Q_Front = Q.First = Q.Last. After Compile_Sources has
-- After Compile_Sources has terminated its execution, Q_Front = Q.Last -- terminated its execution, Q_Front = Q.Last and the elements contained
-- and the elements contained between Q.Front and Q.Last-1 are those that -- between Q.Front and Q.Last-1 are those that were explored and thus
-- were explored and thus marked by Compile_Sources. Whenever the Q is -- marked by Compile_Sources. Whenever the Q is reinitialized, the elements
-- reinitialized, the elements between Q.First and Q.Last - 1 are unmarked. -- between Q.First and Q.Last - 1 are unmarked.
procedure Init_Q; procedure Init_Q;
-- Must be called to (re)initialize the Q -- Must be called to (re)initialize the Q
@ -305,9 +305,9 @@ package body Make is
procedure Add_Library_Search_Dir procedure Add_Library_Search_Dir
(Path : String; (Path : String;
On_Command_Line : Boolean); On_Command_Line : Boolean);
-- Call Add_Lib_Search_Dir with an absolute directory path. If Path is a -- Call Add_Lib_Search_Dir with an absolute directory path. If Path is
-- relative path, when On_Command_Line is True, it is relative to the -- relative path, when On_Command_Line is True, it is relative to the
-- current working directory; when On_Command_Line is False, it is relative -- current working directory. When On_Command_Line is False, it is relative
-- to the project directory of the main project. -- to the project directory of the main project.
procedure Add_Source_Search_Dir procedure Add_Source_Search_Dir
@ -315,7 +315,7 @@ package body Make is
On_Command_Line : Boolean); On_Command_Line : Boolean);
-- Call Add_Src_Search_Dir with an absolute directory path. If Path is a -- Call Add_Src_Search_Dir with an absolute directory path. If Path is a
-- relative path, when On_Command_Line is True, it is relative to the -- relative path, when On_Command_Line is True, it is relative to the
-- current working directory; when On_Command_Line is False, it is relative -- current working directory. When On_Command_Line is False, it is relative
-- to the project directory of the main project. -- to the project directory of the main project.
procedure Add_Source_Dir (N : String); procedure Add_Source_Dir (N : String);
@ -356,9 +356,9 @@ package body Make is
Do_Compile_Step : Boolean := True; Do_Compile_Step : Boolean := True;
Do_Bind_Step : Boolean := True; Do_Bind_Step : Boolean := True;
Do_Link_Step : Boolean := True; Do_Link_Step : Boolean := True;
-- Flags to indicate what step should be executed. -- Flags to indicate what step should be executed. Can be set to False
-- Can be set to False with the switches -c, -b and -l. -- with the switches -c, -b and -l. These flags are reset to True for
-- These flags are reset to True for each invokation of procedure Gnatmake. -- each invokation of procedure Gnatmake.
Shared_String : aliased String := "-shared"; Shared_String : aliased String := "-shared";
Force_Elab_Flags_String : aliased String := "-F"; Force_Elab_Flags_String : aliased String := "-F";
@ -628,14 +628,14 @@ package body Make is
GNAT_Flag : constant String_Access := new String'("-gnatpg"); GNAT_Flag : constant String_Access := new String'("-gnatpg");
Do_Not_Check_Flag : constant String_Access := new String'("-x"); Do_Not_Check_Flag : constant String_Access := new String'("-x");
Object_Suffix : constant String := Get_Target_Object_Suffix.all; Object_Suffix : constant String := Get_Target_Object_Suffix.all;
Executable_Suffix : constant String := Get_Target_Executable_Suffix.all;
Syntax_Only : Boolean := False; Syntax_Only : Boolean := False;
-- Set to True when compiling with -gnats -- Set to True when compiling with -gnats
Display_Executed_Programs : Boolean := True; Display_Executed_Programs : Boolean := True;
-- Set to True if name of commands should be output on stderr -- Set to True if name of commands should be output on stderr (or on stdout
-- if the Commands_To_Stdout flag was set by use of the -S switch).
Output_File_Name_Seen : Boolean := False; Output_File_Name_Seen : Boolean := False;
-- Set to True after having scanned the file_name for -- Set to True after having scanned the file_name for
@ -1457,11 +1457,10 @@ package body Make is
-- Comparing switches is delicate because gcc reorders a number -- Comparing switches is delicate because gcc reorders a number
-- of switches, according to lang-specs.h, but gnatmake doesn't -- of switches, according to lang-specs.h, but gnatmake doesn't
-- have the sufficient knowledge to perform the same -- have sufficient knowledge to perform the same reordering.
-- reordering. Instead, we ignore orders between different -- Instead, we ignore orders between different "first letter"
-- "first letter" switches, but keep orders between same -- switches, but keep orders between same switches, e.g -O -O2
-- switches, e.g -O -O2 is different than -O2 -O, but -g -O is -- is different than -O2 -O, but -g -O is equivalent to -O -g.
-- equivalent to -O -g.
if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
(Prev_Switch'Length >= 6 and then (Prev_Switch'Length >= 6 and then
@ -3482,6 +3481,10 @@ package body Make is
pragma Assert (Args'First = 1); pragma Assert (Args'First = 1);
if Display_Executed_Programs then if Display_Executed_Programs then
if Commands_To_Stdout then
Set_Standard_Output;
end if;
Write_Str (Program); Write_Str (Program);
for J in Args'Range loop for J in Args'Range loop
@ -3529,6 +3532,7 @@ package body Make is
end loop; end loop;
Write_Eol; Write_Eol;
Set_Standard_Error;
end if; end if;
end Display; end Display;
@ -4326,6 +4330,17 @@ package body Make is
Osint.Add_Default_Search_Dirs; Osint.Add_Default_Search_Dirs;
-- Get the target parameters, so that the correct binder generated
-- files are generated if OpenVMS is the target.
begin
Targparm.Get_Target_Parameters;
exception
when Unrecoverable_Error =>
Make_Failed ("*** make failed.");
end;
-- And bind and or link the library -- And bind and or link the library
MLib.Prj.Build_Library MLib.Prj.Build_Library
@ -4875,7 +4890,8 @@ package body Make is
Executable := No_File; Executable := No_File;
Executable_Obsolete := False; Executable_Obsolete := False;
Non_Std_Executable := False; Non_Std_Executable :=
Targparm.Executable_Extension_On_Target /= No_Name;
-- Look inside the linker switches to see if the name -- Look inside the linker switches to see if the name
-- of the final executable program was specified. -- of the final executable program was specified.
@ -6212,8 +6228,7 @@ package body Make is
Project_Tree.Projects.Table (Proj).Depth := 0; Project_Tree.Projects.Table (Proj).Depth := 0;
end loop; end loop;
Recursive_Compute_Depth Recursive_Compute_Depth (Main_Project, Depth => 1);
(Main_Project, Depth => 1);
-- For each project compute the list of the projects it imports -- For each project compute the list of the projects it imports
-- directly or indirectly. -- directly or indirectly.
@ -6228,10 +6243,10 @@ package body Make is
Osint.Add_Default_Search_Dirs; Osint.Add_Default_Search_Dirs;
-- Source file lookups should be cached for efficiency. -- Source file lookups should be cached for efficiency. Source files
-- Source files are not supposed to change. However, we do that now -- are not supposed to change. However, we do that now only if no
-- only if no project file is used; if a project file is used, we -- project file is used; if a project file is used, we do it just
-- do it just after changing the directory to the object directory. -- after changing the directory to the object directory.
Osint.Source_File_Data (Cache => True); Osint.Source_File_Data (Cache => True);
@ -6272,8 +6287,7 @@ package body Make is
(The_Project).Extends /= No_Project; (The_Project).Extends /= No_Project;
function Check_Project (P : Project_Id) return Boolean; function Check_Project (P : Project_Id) return Boolean;
-- Returns True if P is The_Project or a project extended by -- Returns True if P is The_Project or a project extended by The_Project
-- The_Project.
------------------- -------------------
-- Check_Project -- -- Check_Project --
@ -6283,6 +6297,7 @@ package body Make is
begin begin
if All_Projects or P = The_Project then if All_Projects or P = The_Project then
return True; return True;
elsif Extending then elsif Extending then
declare declare
Data : Project_Data := Data : Project_Data :=
@ -6333,8 +6348,9 @@ package body Make is
-- Here we are cheating a little bit: we don't want to -- Here we are cheating a little bit: we don't want to
-- use Sinput.L, because it depends on the GNAT tree -- use Sinput.L, because it depends on the GNAT tree
-- (Atree, Sinfo, ...). So, we pretend that it is -- (Atree, Sinfo, ...). So, we pretend that it is a
-- a project file, and we use Sinput.P. -- project file, and we use Sinput.P.
-- Source_File_Is_Subunit is just scanning through -- Source_File_Is_Subunit is just scanning through
-- the file until it finds one of the reserved words -- the file until it finds one of the reserved words
-- separate, procedure, function, generic or package. -- separate, procedure, function, generic or package.
@ -6350,7 +6366,6 @@ package body Make is
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Sfile := No_Name; Sfile := No_Name;
else else
Sfile := Unit.File_Names (Body_Part).Name; Sfile := Unit.File_Names (Body_Part).Name;
end if; end if;
@ -6376,15 +6391,15 @@ package body Make is
if Put_In_Q then if Put_In_Q then
-- For the first source inserted into the Q, we need -- For the first source inserted into the Q, we need to initialize
-- to initialize the Q, but not for the subsequent sources. -- the Q, but not for the subsequent sources.
if First_Q_Initialization then if First_Q_Initialization then
Init_Q; Init_Q;
end if; end if;
-- And of course, we only insert in the Q if the source -- And of course, we only insert in the Q if the source is not
-- is not marked. -- marked.
if Sfile /= No_Name and then not Is_Marked (Sfile) then if Sfile /= No_Name and then not Is_Marked (Sfile) then
if Verbose_Mode then if Verbose_Mode then
@ -6399,11 +6414,10 @@ package body Make is
elsif Sfile /= No_Name then elsif Sfile /= No_Name then
-- If Put_In_Q is False, we add the source as it it were -- If Put_In_Q is False, we add the source as it it were specified
-- specified on the command line, and we set Put_In_Q to True, -- on the command line, and we set Put_In_Q to True, so that the
-- so that the following sources will be put directly in the -- following sources will be put directly in the queue. This will
-- queue. This will allow parallel compilation processes if -jx -- allow parallel compilation processes if -jx switch is used.
-- switch is used.
if Verbose_Mode then if Verbose_Mode then
Write_Str ("Adding """); Write_Str ("Adding """);
@ -6786,8 +6800,7 @@ package body Make is
Project_Tree.Projects.Table (Project).Depth := Depth; Project_Tree.Projects.Table (Project).Depth := Depth;
-- Mark the project as Seen to avoid endless loop caused by limited -- Mark project as Seen to avoid endless loop caused by limited withs
-- withs.
Project_Tree.Projects.Table (Project).Seen := True; Project_Tree.Projects.Table (Project).Seen := True;
@ -6837,9 +6850,9 @@ package body Make is
return; return;
end if; end if;
-- If the previous switch has set the Project_File_Name_Present -- If the previous switch has set the Project_File_Name_Present flag
-- flag (that is we have seen a -P alone), then the next argument is -- (that is we have seen a -P alone), then the next argument is the name
-- the name of the project file. -- of the project file.
if Project_File_Name_Present and then Project_File_Name = null then if Project_File_Name_Present and then Project_File_Name = null then
if Argv (1) = '-' then if Argv (1) = '-' then
@ -6850,9 +6863,9 @@ package body Make is
Project_File_Name := new String'(Argv); Project_File_Name := new String'(Argv);
end if; end if;
-- If the previous switch has set the Output_File_Name_Present -- If the previous switch has set the Output_File_Name_Present flag
-- flag (that is we have seen a -o), then the next argument is -- (that is we have seen a -o), then the next argument is the name of
-- the name of the output executable. -- the output executable.
elsif Output_File_Name_Present elsif Output_File_Name_Present
and then not Output_File_Name_Seen and then not Output_File_Name_Seen
@ -6864,39 +6877,12 @@ package body Make is
else else
Add_Switch ("-o", Linker, And_Save => And_Save); Add_Switch ("-o", Linker, And_Save => And_Save);
Add_Switch (Executable_Name (Argv), Linker, And_Save => And_Save);
-- Automatically add the executable suffix if it has not been
-- specified explicitly.
declare
Canonical_Argv : String := Argv;
begin
-- Get the file name in canonical case to accept as is
-- names ending with ".EXE" on VMS and Windows.
Canonical_Case_File_Name (Canonical_Argv);
if Executable_Suffix'Length /= 0
and then (Canonical_Argv'Length <= Executable_Suffix'Length
or else Canonical_Argv
(Canonical_Argv'Last -
Executable_Suffix'Length + 1
.. Canonical_Argv'Last)
/= Executable_Suffix)
then
Add_Switch
(Argv & Executable_Suffix,
Linker,
And_Save => And_Save);
else
Add_Switch (Argv, Linker, And_Save => And_Save);
end if;
end;
end if; end if;
-- If the previous switch has set the Object_Directory_Present flag -- If the previous switch has set the Object_Directory_Present flag
-- (that is we have seen a -D), then the next argument is -- (that is we have seen a -D), then the next argument is the path name
-- the path name of the object directory.. -- of the object directory..
elsif Object_Directory_Present elsif Object_Directory_Present
and then not Object_Directory_Seen and then not Object_Directory_Seen
@ -6920,8 +6906,8 @@ package body Make is
-- separator. -- separator.
if Argv (Argv'Last) = Directory_Separator then if Argv (Argv'Last) = Directory_Separator then
Object_Directory_Path := new String'(Argv); Object_Directory_Path :=
new String'(Argv);
else else
Object_Directory_Path := Object_Directory_Path :=
new String'(Argv & Directory_Separator); new String'(Argv & Directory_Separator);
@ -7084,18 +7070,19 @@ package body Make is
(Argv (7 .. Argv'Last), Objects); (Argv (7 .. Argv'Last), Objects);
begin begin
if Src_Path_Name /= null and then if Src_Path_Name /= null
Lib_Path_Name /= null and then Lib_Path_Name /= null
then then
-- Set the RTS_*_Path_Name variables, so that the correct -- Set RTS_*_Path_Name variables, so that correct direct-
-- directories will be set when -- ories will be set when Osint.Add_Default_Search_Dirs
-- Osint.Add_Default_Search_Dirs will be called later. -- is called later.
RTS_Src_Path_Name := Src_Path_Name; RTS_Src_Path_Name := Src_Path_Name;
RTS_Lib_Path_Name := Lib_Path_Name; RTS_Lib_Path_Name := Lib_Path_Name;
elsif Src_Path_Name = null elsif Src_Path_Name = null
and Lib_Path_Name = null then and Lib_Path_Name = null
then
Make_Failed ("RTS path not valid: missing " & Make_Failed ("RTS path not valid: missing " &
"adainclude and adalib directories"); "adainclude and adalib directories");
@ -7378,18 +7365,18 @@ package body Make is
Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save); Add_Switch (Argv, Binder, And_Save => And_Save);
-- By default all switches with more than one character -- By default all switches with more than one character or one
-- or one character switches which are not in 'a' .. 'z' -- character switches are passed to the compiler with the
-- (except 'C', 'F', 'M' and 'B') are passed to the compiler, -- exception of those tested below, which belong to make.
-- unless we are dealing with a debug switch (starts with 'd')
-- or an extended gnatmake switch (starts with 'e').
elsif Argv (2) /= 'd' elsif Argv (2) /= 'd'
and then Argv (2) /= 'e' and then Argv (2) /= 'e'
and then Argv (2 .. Argv'Last) /= "B"
and then Argv (2 .. Argv'Last) /= "C" and then Argv (2 .. Argv'Last) /= "C"
and then Argv (2 .. Argv'Last) /= "F" and then Argv (2 .. Argv'Last) /= "F"
and then Argv (2 .. Argv'Last) /= "M" and then Argv (2 .. Argv'Last) /= "M"
and then Argv (2 .. Argv'Last) /= "B" and then Argv (2 .. Argv'Last) /= "R"
and then Argv (2 .. Argv'Last) /= "S"
and then Argv (2 .. Argv'Last) /= "vl" and then Argv (2 .. Argv'Last) /= "vl"
and then Argv (2 .. Argv'Last) /= "vm" and then Argv (2 .. Argv'Last) /= "vm"
and then Argv (2 .. Argv'Last) /= "vh" and then Argv (2 .. Argv'Last) /= "vh"

8
gcc/ada/makeusg.adb
View File

@ -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
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

55
gcc/ada/prj-util.adb
View File

@ -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
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
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
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;

13
gcc/ada/switch-m.adb
View File

@ -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
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
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
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' =>

68
gcc/ada/targparm.adb
View File

@ -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
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
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
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;

15
gcc/ada/targparm.ads
View File

@ -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
-- 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
-- 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 --
----------------------- -----------------------