Source_Index : Int := 0;
Index : Positive;
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
begin
-- First, check for --version and --help
- Check_Version_And_Help ("GNATCLEAN", "2003", Usage'Access);
+ Check_Version_And_Help ("GNATCLEAN", "2003");
Index := 1;
while Index <= Last loop
"for GNAT Project Files");
New_Line;
+ Put_Line (" -aPdir Add directory dir to project search path");
+ New_Line;
+
Put_Line (" -aOdir Specify ALI/object files search path");
Put_Line (" -Idir Like -aOdir");
Put_Line (" -I- Don't look for source/library files " &
function Args_From_Expanded (Args : Boolean_Chars) return String;
-- Return the string made of all characters with True in Args
- type Callback_Procedure is access procedure (Simple_Switch : String);
+ generic
+ with procedure Callback (Simple_Switch : String);
procedure For_Each_Simple_Switch
- (Cmd : Command_Line;
- Switch : String;
- Callback : Callback_Procedure);
+ (Cmd : Command_Line;
+ Switch : String);
-- Breaks Switch into as simple switches as possible (expanding aliases and
-- ungrouping common prefixes when possible), and call Callback for each of
-- these.
----------------------------
procedure For_Each_Simple_Switch
- (Cmd : Command_Line;
- Switch : String;
- Callback : Callback_Procedure)
+ (Cmd : Command_Line;
+ Switch : String)
is
begin
-- Are we adding a switch that can in fact be expanded through aliases ?
for A in Cmd.Config.Aliases'Range loop
if Cmd.Config.Aliases (A).all = Switch then
For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all, Callback);
+ (Cmd, Cmd.Config.Expansions (A).all);
return;
end if;
end loop;
.. Switch'Last
loop
For_Each_Simple_Switch
- (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), Callback);
+ (Cmd, Cmd.Config.Prefixes (P).all & Switch (S));
end loop;
return;
end if;
end if;
end Add_Simple_Switch;
+ procedure Add_Simple_Switches is
+ new For_Each_Simple_Switch (Add_Simple_Switch);
+
-- Start of processing for Add_Switch
begin
- For_Each_Simple_Switch
- (Cmd, Switch, Add_Simple_Switch'Unrestricted_Access);
+ Add_Simple_Switches (Cmd, Switch);
Free (Cmd.Coalesce);
end Add_Switch;
end if;
end Remove_Simple_Switch;
+ procedure Remove_Simple_Switches is
+ new For_Each_Simple_Switch (Remove_Simple_Switch);
+
-- Start of processing for Remove_Switch
begin
- For_Each_Simple_Switch
- (Cmd, Switch, Remove_Simple_Switch'Unrestricted_Access);
+ Remove_Simple_Switches (Cmd, Switch);
Free (Cmd.Coalesce);
end Remove_Switch;
end if;
end Remove_Simple_Switch;
+ procedure Remove_Simple_Switches is
+ new For_Each_Simple_Switch (Remove_Simple_Switch);
+
-- Start of processing for Remove_Switch
begin
- For_Each_Simple_Switch
- (Cmd, Switch, Remove_Simple_Switch'Unrestricted_Access);
+ Remove_Simple_Switches (Cmd, Switch);
Free (Cmd.Coalesce);
end Remove_Switch;
end loop;
end Remove_Cb;
+ procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
+ procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
+
-- Start of processing for Alias_Switches
begin
-- then check whether the expanded command line has all of them.
Found := True;
- For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all,
- Check_Cb'Unrestricted_Access);
+ Check_All (Cmd, Cmd.Config.Expansions (A).all);
if Found then
First := Integer'Last;
- For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all,
- Remove_Cb'Unrestricted_Access);
+ Remove_All (Cmd, Cmd.Config.Expansions (A).all);
Result (First) := new String'(Cmd.Config.Aliases (A).all);
end if;
end loop;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
-with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
+with GNAT.Heap_Sort_G;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Table;
procedure Move (From : Natural; To : Natural);
function Lt (L, R : Natural) return Boolean;
- -- Subprograms needed for GNAT.Heap_Sort_A
+ -- Subprograms needed for GNAT.Heap_Sort_G
--------
-- Lt --
Set_Edges (To, Get_Edges (From));
end Move;
+ package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
+
-- Start of processing for Compute_Edges_And_Vertices
begin
-- We store edges from 1 to 2 * NK and leave zero alone in order to use
- -- GNAT.Heap_Sort_A.
+ -- GNAT.Heap_Sort_G.
Edges_Len := 2 * NK + 1;
-- is sorted by X and then Y. To compute the neighbor list, sort the
-- edges.
- Sort
- (Edges_Len - 1,
- Move'Unrestricted_Access,
- Lt'Unrestricted_Access);
+ Sorting.Sort (Edges_Len - 1);
if Verbose then
Put_Edges (Output, "Sorted Edge Table");
function Lt (L, R : Natural) return Boolean;
procedure Move (From : Natural; To : Natural);
- -- Subprograms needed by GNAT.Heap_Sort_A
+ -- Subprograms needed by GNAT.Heap_Sort_G
--------
-- Lt --
WT.Table (Target) := WT.Table (Source);
end Move;
+ package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
+
-- Start of processing for Build_Identical_Key_Sets
begin
else
Offset := Reduced (S (J).First) - 1;
- Sort
- (S (J).Last - S (J).First + 1,
- Move'Unrestricted_Access,
- Lt'Unrestricted_Access);
+ Sorting.Sort (S (J).Last - S (J).First + 1);
F := S (J).First;
L := F;
end if;
end Scan_Bind_Arg;
+ procedure Check_Version_And_Help is
+ new Check_Version_And_Help_G (Bindusg.Display);
+
-- Start of processing for Gnatbind
begin
-- First, scan to detect --version and/or --help
- Check_Version_And_Help ("GNATBIND", "1995", Bindusg.Display'Access);
+ Check_Version_And_Help ("GNATBIND", "1995");
-- Use low level argument routines to avoid dragging in the secondary stack
end;
end Write_Unit;
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
-- Start of processing for gnatchop
begin
-- First, scan to detect --version and/or --help
- Check_Version_And_Help ("GNATCHOP", "1998", Usage'Unrestricted_Access);
+ Check_Version_And_Help ("GNATCHOP", "1998");
if not Scan_Arguments then
Set_Exit_Status (Failure);
--------------------
procedure Parse_Cmd_Line is
+
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+ -- Start of processing for Parse_Cmd_Line
+
begin
-- First check for --version or --help
- Check_Version_And_Help ("GNATFIND", "1998", Usage'Unrestricted_Access);
+ Check_Version_And_Help ("GNATFIND", "1998");
-- Now scan the other switches
-- Set to true if the next argument is to be added into the list of
-- linker's argument without parsing it.
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+ -- Start of processing for Process_Args
+
begin
-- First, check for --version and --help
- Check_Version_And_Help ("GNATLINK", "1995", Usage'Unrestricted_Access);
+ Check_Version_And_Help ("GNATLINK", "1995");
-- Loop through arguments of gnatlink command
Binder_Options.Table (J);
end loop;
- Args (Args'Last) := Binder_Body_Src_File;
+ -- Use the full path of the binder generated source, so that it is
+ -- guaranteed that the debugger will find this source, even with
+ -- STABS.
+
+ Args (Args'Last) :=
+ new String'(Normalize_Pathname (Binder_Body_Src_File.all));
if Verbose_Mode then
Write_Str (Base_Name (Gcc_Path.all));
end loop;
end Usage;
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
-- Start of processing for Gnatls
begin
-- First check for --version or --help
- Check_Version_And_Help ("GNATLS", "1997", Usage'Unrestricted_Access);
+ Check_Version_And_Help ("GNATLS", "1997");
-- Loop to scan out arguments
---------------
procedure Scan_Args is
+
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+ -- Start of processing for Scan_Args
+
begin
-- First check for --version or --help
- Check_Version_And_Help ("GNATNAME", "2001", Usage'Unrestricted_Access);
+ Check_Version_And_Help ("GNATNAME", "2001");
-- Now scan the other switches
--------------------
procedure Parse_Cmd_Line is
+
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+ -- Start of processing for Parse_Cmd_Line
+
begin
-- First check for --version or --help
- Check_Version_And_Help ("GNATXREF", "1998", Usage'Unrestricted_Access);
+ Check_Version_And_Help ("GNATXREF", "1998");
loop
case
procedure Scan_Command_Line is
Switch : Character;
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+ -- Start of processing for Scan_Command_Line
+
begin
-- First check for --version or --help
- Check_Version_And_Help ("GNATPREP", "1996", Usage'Access);
+ Check_Version_And_Help ("GNATPREP", "1996");
-- Now scan the other switches
Osint.Fail ("invalid switch: ", Switch);
end Bad_Switch;
- ----------------------------
- -- Check_Version_And_Help --
- ----------------------------
+ ------------------------------
+ -- Check_Version_And_Help_G --
+ ------------------------------
- procedure Check_Version_And_Help
+ procedure Check_Version_And_Help_G
(Tool_Name : String;
Initial_Year : String;
- Usage : Procedure_Ptr;
Version_String : String := Gnatvsn.Gnat_Version_String)
is
Version_Switch_Present : Boolean := False;
if Help_Switch_Present then
Set_Standard_Output;
- Usage.all;
+ Usage;
Write_Eol;
Write_Line ("Report bugs to report@adacore.com");
Exit_Program (E_Success);
end if;
- end Check_Version_And_Help;
+ end Check_Version_And_Help_G;
---------------------
-- Display_Version --
-- --
------------------------------------------------------------------------------
--- This package together with a child package appropriate to the client
--- tool scans switches. Note that the body of the appropraite Usage package
--- must be coordinated with the switches that are recognized by this package.
--- These Usage packages also act as the official documentation for the
--- switches that are recognized. In addition, package Debug documents
--- the otherwise undocumented debug switches that are also recognized.
+-- This package together with a child package appropriate to the client tool
+-- scans switches. Note that the body of the appropraite Usage package must be
+-- coordinated with the switches that are recognized by this package. These
+-- Usage packages also act as the official documentation for the switches
+-- that are recognized. In addition, package Debug documents the otherwise
+-- undocumented debug switches that are also recognized.
with Gnatvsn;
with Types; use Types;
+------------
+-- Switch --
+------------
+
package Switch is
-- Common switches for GNU tools
-- Subprograms --
-----------------
- type Procedure_Ptr is access procedure;
-
- procedure Check_Version_And_Help
+ generic
+ with procedure Usage;
+ -- Print tool-specific part of --help message
+ procedure Check_Version_And_Help_G
(Tool_Name : String;
Initial_Year : String;
- Usage : Procedure_Ptr;
Version_String : String := Gnatvsn.Gnat_Version_String);
- -- Check if switches --version or --help is used. If one of this switch
- -- is used, issue the proper messages and end the process.
+ -- Check if switches --version or --help is used. If one of this switch is
+ -- used, issue the proper messages and end the process.
procedure Display_Version
(Tool_Name : String;
-- Display version of a tool when switch --version is used
function Is_Switch (Switch_Chars : String) return Boolean;
- -- Returns True iff Switch_Chars is at least two characters long,
- -- and the first character is an hyphen ('-').
+ -- Returns True iff Switch_Chars is at least two characters long, and the
+ -- first character is an hyphen ('-').
function Is_Front_End_Switch (Switch_Chars : String) return Boolean;
- -- Returns True iff Switch_Chars represents a front-end switch,
- -- ie. it starts with -I, -gnat or -?RTS.
+ -- Returns True iff Switch_Chars represents a front-end switch, i.e. it
+ -- starts with -I, -gnat or -?RTS.
private
Ptr : in out Integer;
Result : out Nat;
Switch : Character);
- -- Scan natural integer parameter for switch. On entry, Ptr points
- -- just past the switch character, on exit it points past the last
- -- digit of the integer value.
+ -- Scan natural integer parameter for switch. On entry, Ptr points just
+ -- past the switch character, on exit it points past the last digit of the
+ -- integer value.
procedure Scan_Pos
(Switch_Chars : String;
Ptr : in out Integer;
Result : out Pos;
Switch : Character);
- -- Scan positive integer parameter for switch. On entry, Ptr points
- -- just past the switch character, on exit it points past the last
- -- digit of the integer value.
+ -- Scan positive integer parameter for switch. On entry, Ptr points just
+ -- past the switch character, on exit it points past the last digit of the
+ -- integer value.
procedure Bad_Switch (Switch : Character);
procedure Bad_Switch (Switch : String);
projects / thirdparty / gcc.git / commitdiff
