Skip to content

R
riscv-gcc-1
Commit da2ac8c2 by Emmanuel Briot Committed by Arnaud Charlet
Options

g-comlin.ads, [...] (Command_Line_Configuration, [...]): New types 

2007-09-26  Emmanuel Briot  <briot@adacore.com>

	* g-comlin.ads, g-comlin.adb (Command_Line_Configuration,
	Command_Line): New types
	(Define_Alias, Define_Prefix, Free): New subprograms. These provide
	support for defining how switches can be grouped on a command line (as
	is the case for -gnatw... for GNAT), and how simple switches can be
	used as aliases for more complex switches (-gnatwa is same as
	-gnatwbcef...)
	(Set_Command_Line, Add_Switch, Remove_Switch): New subprogram
	(Start, Current_*): New subprograms
	Added support for parsing an array of strings in addition to the real
	command line.
	(Opt_Parser, Opt_Parser_Data): New type. As a result, some types had to
	 be moved from the body to the private part of the spec.
	(*): All subprograms now have an extra parameter with default value to
	specify which parser should be used. For backward compatibility, it
	defaults to parsing the command line of the application. They were also
	modified to properly handle cases where each of the argument does not
	start at index 1 (which is always true for Ada.Command_Line, but not
	when processing any Argument_List).
	(Free): New subprogram
	(Internal_Initialize_Option_Scan, Find_Longuest_Matching_Switch,
	Argument): New subprograms
	(Switch_Parameter_Type): New enum, which clarifies the code. The extra
	special characters like ':', '=',... are now handled in a single place,
	which makes the code more extensible eventually.
	(Getopt, Full_Switch): When the switch was returned as part of the
	special character '*', make sure it is prepended by the switch character
	('-' in general), so that the application knows whether "foo" or "-foo"
	was specified on the command line.

From-SVN: r128791
parent dd05ba27
Showing with 1725 additions and 396 deletions
gcc/ada/g-comlin.adb
...@@ -31,73 +31,33 @@ ...@@ -31,73 +31,33 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Command_Line; with Ada.Unchecked_Deallocation;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GNAT.Command_Line is package body GNAT.Command_Line is
package CL renames Ada.Command_Line; package CL renames Ada.Command_Line;
type Section_Number is new Natural range 0 .. 65534; type Switch_Parameter_Type is
for Section_Number'Size use 16; (Parameter_None,
Parameter_With_Optional_Space, -- ':' in getopt
type Parameter_Type is record Parameter_With_Space_Or_Equal, -- '=' in getopt
Arg_Num : Positive; Parameter_No_Space, -- '!' in getopt
First : Positive; Parameter_Optional); -- '?' in getop
Last : Positive;
end record;
The_Parameter : Parameter_Type;
The_Switch : Parameter_Type;
-- This type and this variable are provided to store the current switch
-- and parameter.
type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
pragma Pack (Is_Switch_Type);
Is_Switch : Is_Switch_Type := (others => False);
-- Indicates wich arguments on the command line are considered not be
-- switches or parameters to switches (this leaves e.g. the filenames...).
type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
pragma Pack (Section_Type);
Section : Section_Type := (others => 1);
-- Contains the number of the section associated with the current switch.
-- If this number is 0, then it is a section delimiter, which is never
-- returns by GetOpt. The last element of this array is set to 0 to avoid
-- the need to test for reaching the end of the command line in loops.
Current_Argument : Natural := 1;
-- Number of the current argument parsed on the command line
Current_Index : Natural := 1;
-- Index in the current argument of the character to be processed
Current_Section : Section_Number := 1;
Expansion_It : aliased Expansion_Iterator;
-- When Get_Argument is expanding a file name, this is the iterator used
In_Expansion : Boolean := False;
-- True if we are expanding a file
Switch_Character : Character := '-';
-- The character at the beginning of the command line arguments, indicating
-- the beginning of a switch.
Stop_At_First : Boolean := False;
-- If it is True then Getopt stops at the first non-switch argument
procedure Set_Parameter procedure Set_Parameter
(Variable : out Parameter_Type; (Variable : out Parameter_Type;
Arg_Num : Positive; Arg_Num : Positive;
First : Positive; First : Positive;
Last : Positive); Last : Positive;
Extra : Character := ASCII.NUL);
pragma Inline (Set_Parameter); pragma Inline (Set_Parameter);
-- Set the parameter that will be returned by Parameter below -- Set the parameter that will be returned by Parameter below
-- Parameters need to be defined ???
function Goto_Next_Argument_In_Section return Boolean; function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
-- Go to the next argument on the command line. If we are at the end of the -- Go to the next argument on the command line. If we are at the end of
-- current section, we want to make sure there is no other identical -- the current section, we want to make sure there is no other identical
-- section on the command line (there might be multiple instances of -- section on the command line (there might be multiple instances of
-- -largs). Returns True iff there is another argument. -- -largs). Returns True iff there is another argument.
...@@ -116,6 +76,87 @@ package body GNAT.Command_Line is ...@@ -116,6 +76,87 @@ package body GNAT.Command_Line is
-- converts the given string to canonical all lower case form, so that two -- converts the given string to canonical all lower case form, so that two
-- file names compare equal if they refer to the same file. -- file names compare equal if they refer to the same file.
procedure Internal_Initialize_Option_Scan
(Parser : Opt_Parser;
Switch_Char : Character;
Stop_At_First_Non_Switch : Boolean;
Section_Delimiters : String);
-- Initialize Parser, which must have been allocated already
function Argument (Parser : Opt_Parser; Index : Integer) return String;
-- Return the index-th command line argument
procedure Find_Longest_Matching_Switch
(Switches : String;
Arg : String;
Index_In_Switches : out Integer;
Switch_Length : out Integer;
Param : out Switch_Parameter_Type);
-- return the Longest switch from Switches that matches at least
-- partially Arg. Index_In_Switches is set to 0 if none matches
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Argument_List, Argument_List_Access);
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Command_Line_Configuration_Record, Command_Line_Configuration);
type Boolean_Chars is array (Character) of Boolean;
procedure Remove (Line : in out Argument_List_Access; Index : Integer);
-- Remove a specific element from Line
procedure Append
(Line : in out Argument_List_Access;
Str : String_Access);
-- Append a new element to Line
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);
procedure For_Each_Simple_Switch
(Cmd : Command_Line;
Switch : String;
Callback : Callback_Procedure);
-- Breaks Switch into as simple switches as possible (expanding aliases and
-- ungrouping common prefixes when possible), and call Callback for each of
-- these.
procedure Group_Switches
(Cmd : Command_Line;
Result : Argument_List_Access;
Params : Argument_List_Access);
-- Group switches with common prefixes whenever possible.
-- Once they have been grouped, we also check items for possible aliasing
procedure Alias_Switches
(Cmd : Command_Line;
Result : Argument_List_Access;
Params : Argument_List_Access);
-- When possible, replace or more switches by an alias, ie a shorter
-- version.
function Looking_At
(Type_Str : String;
Index : Natural;
Substring : String) return Boolean;
-- Return True if the characters starting at Index in Type_Str are
-- equivalent to Substring.
--------------
-- Argument --
--------------
function Argument (Parser : Opt_Parser; Index : Integer) return String is
begin
if Parser.Arguments /= null then
return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
else
return CL.Argument (Index);
end if;
end Argument;
------------------------------ ------------------------------
-- Canonical_Case_File_Name -- -- Canonical_Case_File_Name --
------------------------------ ------------------------------
...@@ -125,8 +166,8 @@ package body GNAT.Command_Line is ...@@ -125,8 +166,8 @@ package body GNAT.Command_Line is
if not File_Names_Case_Sensitive then if not File_Names_Case_Sensitive then
for J in S'Range loop for J in S'Range loop
if S (J) in 'A' .. 'Z' then if S (J) in 'A' .. 'Z' then
S (J) := Character'Val ( S (J) := Character'Val
Character'Pos (S (J)) + (Character'Pos (S (J)) +
Character'Pos ('a') - Character'Pos ('a') -
Character'Pos ('A')); Character'Pos ('A'));
end if; end if;
...@@ -167,7 +208,7 @@ package body GNAT.Command_Line is ...@@ -167,7 +208,7 @@ package body GNAT.Command_Line is
if Current = 1 then if Current = 1 then
return String'(1 .. 0 => ' '); return String'(1 .. 0 => ' ');
else else
-- Otherwise, continue with the directory at the previous level -- Otherwise continue with the directory at the previous level
Current := Current - 1; Current := Current - 1;
It.Current_Depth := Current; It.Current_Depth := Current;
...@@ -210,19 +251,18 @@ package body GNAT.Command_Line is ...@@ -210,19 +251,18 @@ package body GNAT.Command_Line is
else else
declare declare
Name : String := Name : String :=
It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) & It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
S (1 .. Last); & S (1 .. Last);
begin begin
Canonical_Case_File_Name (Name); Canonical_Case_File_Name (Name);
-- If it matches, return the relative path -- If it matches return the relative path
if GNAT.Regexp.Match (Name, Iterator.Regexp) then if GNAT.Regexp.Match (Name, Iterator.Regexp) then
return Name; return Name;
end if; end if;
end; end;
end if; end if;
end loop; end loop;
return String'(1 .. 0 => ' '); return String'(1 .. 0 => ' ');
...@@ -232,90 +272,99 @@ package body GNAT.Command_Line is ...@@ -232,90 +272,99 @@ package body GNAT.Command_Line is
-- Full_Switch -- -- Full_Switch --
----------------- -----------------
function Full_Switch return String is function Full_Switch
(Parser : Opt_Parser := Command_Line_Parser) return String
is
begin begin
return CL.Argument (The_Switch.Arg_Num) if Parser.The_Switch.Extra = ASCII.NUL then
(The_Switch.First .. The_Switch.Last); return Argument (Parser, Parser.The_Switch.Arg_Num)
(Parser.The_Switch.First .. Parser.The_Switch.Last);
else
return Parser.The_Switch.Extra
& Argument (Parser, Parser.The_Switch.Arg_Num)
(Parser.The_Switch.First .. Parser.The_Switch.Last);
end if;
end Full_Switch; end Full_Switch;
------------------ ------------------
-- Get_Argument -- -- Get_Argument --
------------------ ------------------
function Get_Argument (Do_Expansion : Boolean := False) return String is function Get_Argument
Total : constant Natural := CL.Argument_Count; (Do_Expansion : Boolean := False;
Parser : Opt_Parser := Command_Line_Parser) return String
is
begin begin
if In_Expansion then if Parser.In_Expansion then
declare declare
S : constant String := Expansion (Expansion_It); S : constant String := Expansion (Parser.Expansion_It);
begin begin
if S'Length /= 0 then if S'Length /= 0 then
return S; return S;
else else
In_Expansion := False; Parser.In_Expansion := False;
end if; end if;
end; end;
end if; end if;
if Current_Argument > Total then if Parser.Current_Argument > Parser.Arg_Count then
-- If this is the first time this function is called -- If this is the first time this function is called
if Current_Index = 1 then if Parser.Current_Index = 1 then
Current_Argument := 1; Parser.Current_Argument := 1;
while Current_Argument <= CL.Argument_Count while Parser.Current_Argument <= Parser.Arg_Count
and then Section (Current_Argument) /= Current_Section and then Parser.Section (Parser.Current_Argument) /=
Parser.Current_Section
loop loop
Current_Argument := Current_Argument + 1; Parser.Current_Argument := Parser.Current_Argument + 1;
end loop; end loop;
else else
return String'(1 .. 0 => ' '); return String'(1 .. 0 => ' ');
end if; end if;
elsif Section (Current_Argument) = 0 then elsif Parser.Section (Parser.Current_Argument) = 0 then
while Current_Argument <= CL.Argument_Count while Parser.Current_Argument <= Parser.Arg_Count
and then Section (Current_Argument) /= Current_Section and then Parser.Section (Parser.Current_Argument) /=
Parser.Current_Section
loop loop
Current_Argument := Current_Argument + 1; Parser.Current_Argument := Parser.Current_Argument + 1;
end loop; end loop;
end if; end if;
Current_Index := 2; Parser.Current_Index := Integer'Last;
while Current_Argument <= Total while Parser.Current_Argument <= Parser.Arg_Count
and then Is_Switch (Current_Argument) and then Parser.Is_Switch (Parser.Current_Argument)
loop loop
Current_Argument := Current_Argument + 1; Parser.Current_Argument := Parser.Current_Argument + 1;
end loop; end loop;
if Current_Argument > Total then if Parser.Current_Argument > Parser.Arg_Count then
return String'(1 .. 0 => ' '); return String'(1 .. 0 => ' ');
end if; elsif Parser.Section (Parser.Current_Argument) = 0 then
if Section (Current_Argument) = 0 then
return Get_Argument (Do_Expansion); return Get_Argument (Do_Expansion);
end if; end if;
Current_Argument := Current_Argument + 1; Parser.Current_Argument := Parser.Current_Argument + 1;
-- Could it be a file name with wild cards to expand? -- Could it be a file name with wild cards to expand?
if Do_Expansion then if Do_Expansion then
declare declare
Arg : constant String := CL.Argument (Current_Argument - 1); Arg : constant String :=
Index : Positive := Arg'First; Argument (Parser, Parser.Current_Argument - 1);
Index : Positive;
begin begin
Index := Arg'First;
while Index <= Arg'Last loop while Index <= Arg'Last loop
if Arg (Index) = '*' if Arg (Index) = '*'
or else Arg (Index) = '?' or else Arg (Index) = '?'
or else Arg (Index) = '[' or else Arg (Index) = '['
then then
In_Expansion := True; Parser.In_Expansion := True;
Start_Expansion (Expansion_It, Arg); Start_Expansion (Parser.Expansion_It, Arg);
return Get_Argument (Do_Expansion); return Get_Argument (Do_Expansion);
end if; end if;
...@@ -324,308 +373,354 @@ package body GNAT.Command_Line is ...@@ -324,308 +373,354 @@ package body GNAT.Command_Line is
end; end;
end if; end if;
return CL.Argument (Current_Argument - 1); return Argument (Parser, Parser.Current_Argument - 1);
end Get_Argument; end Get_Argument;
----------------------------------
-- Find_Longest_Matching_Switch --
----------------------------------
procedure Find_Longest_Matching_Switch
(Switches : String;
Arg : String;
Index_In_Switches : out Integer;
Switch_Length : out Integer;
Param : out Switch_Parameter_Type)
is
Index : Natural;
Length : Natural := 1;
P : Switch_Parameter_Type;
begin
Index_In_Switches := 0;
Switch_Length := 0;
-- Remove all leading spaces first to make sure that Index points
-- at the start of the first switch.
Index := Switches'First;
while Index <= Switches'Last and then Switches (Index) = ' ' loop
Index := Index + 1;
end loop;
while Index <= Switches'Last loop
-- Search the length of the parameter at this position in Switches
Length := Index;
while Length <= Switches'Last
and then Switches (Length) /= ' '
loop
Length := Length + 1;
end loop;
if Length = Index + 1 then
P := Parameter_None;
else
case Switches (Length - 1) is
when ':' =>
P := Parameter_With_Optional_Space;
Length := Length - 1;
when '=' =>
P := Parameter_With_Space_Or_Equal;
Length := Length - 1;
when '!' =>
P := Parameter_No_Space;
Length := Length - 1;
when '?' =>
P := Parameter_Optional;
Length := Length - 1;
when others =>
P := Parameter_None;
end case;
end if;
-- If it is the one we searched, it may be a candidate
if Arg'First + Length - 1 - Index <= Arg'Last
and then Switches (Index .. Length - 1) =
Arg (Arg'First .. Arg'First + Length - 1 - Index)
and then Length - Index > Switch_Length
then
Param := P;
Index_In_Switches := Index;
Switch_Length := Length - Index;
end if;
-- Look for the next switch in Switches
while Index <= Switches'Last
and then Switches (Index) /= ' '
loop
Index := Index + 1;
end loop;
Index := Index + 1;
end loop;
end Find_Longest_Matching_Switch;
------------ ------------
-- Getopt -- -- Getopt --
------------ ------------
function Getopt function Getopt
(Switches : String; (Switches : String;
Concatenate : Boolean := True) return Character Concatenate : Boolean := True;
Parser : Opt_Parser := Command_Line_Parser) return Character
is is
Dummy : Boolean; Dummy : Boolean;
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
begin begin
<<Restart>>
-- If we have finished parsing the current command line item (there -- If we have finished parsing the current command line item (there
-- might be multiple switches in a single item), then go to the next -- might be multiple switches in a single item), then go to the next
-- element -- element
if Current_Argument > CL.Argument_Count if Parser.Current_Argument > Parser.Arg_Count
or else (Current_Index > CL.Argument (Current_Argument)'Last or else (Parser.Current_Index >
and then not Goto_Next_Argument_In_Section) Argument (Parser, Parser.Current_Argument)'Last
and then not Goto_Next_Argument_In_Section (Parser))
then then
return ASCII.NUL; return ASCII.NUL;
end if; end if;
-- If we are on a new item, test if this might be a switch -- By default, the switch will not have a parameter
if Current_Index = 1 then
if CL.Argument (Current_Argument)(1) /= Switch_Character then
if Switches (Switches'First) = '*' then
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => 1,
Last => CL.Argument (Current_Argument)'Last);
Is_Switch (Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section;
return '*';
end if;
if Stop_At_First then
Current_Argument := Positive'Last;
return ASCII.NUL;
elsif not Goto_Next_Argument_In_Section then
return ASCII.NUL;
else Parser.The_Parameter :=
return Getopt (Switches); (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
end if; Parser.The_Separator := ASCII.NUL;
end if;
Current_Index := 2;
Is_Switch (Current_Argument) := True;
end if;
declare declare
Arg : constant String := CL.Argument (Current_Argument); Arg : constant String :=
Argument (Parser, Parser.Current_Argument);
Index_Switches : Natural := 0; Index_Switches : Natural := 0;
Max_Length : Natural := 0; Max_Length : Natural := 0;
Index : Natural;
Length : Natural := 1;
End_Index : Natural; End_Index : Natural;
Param : Switch_Parameter_Type;
begin begin
-- Remove all leading spaces first to make sure that Index points -- If we are on a new item, test if this might be a switch
-- at the start of the first switch.
if Parser.Current_Index = Arg'First then
Index := Switches'First; if Arg (Arg'First) /= Parser.Switch_Character then
while Index <= Switches'Last and then Switches (Index) = ' ' loop
Index := Index + 1; -- If it isn't a switch, return it immediately. We also know it
end loop; -- isn't the parameter to a previous switch, since that has
-- already been handled
if Switches (Switches'First) = '*' then
Set_Parameter
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Arg'First,
Last => Arg'Last);
Parser.Is_Switch (Parser.Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section (Parser);
return '*';
end if;
while Index <= Switches'Last loop if Parser.Stop_At_First then
Parser.Current_Argument := Positive'Last;
return ASCII.NUL;
-- Search the length of the parameter at this position in Switches elsif not Goto_Next_Argument_In_Section (Parser) then
return ASCII.NUL;
Length := Index; else
while Length <= Switches'Last -- Recurse to get the next switch on the command line
and then Switches (Length) /= ' '
loop
Length := Length + 1;
end loop;
if (Switches (Length - 1) = ':' or else goto Restart;
Switches (Length - 1) = '=' or else end if;
Switches (Length - 1) = '?' or else
Switches (Length - 1) = '!')
and then Length > Index + 1
then
Length := Length - 1;
end if;
-- If it is the one we searched, it may be a candidate
if Current_Index + Length - 1 - Index <= Arg'Last
and then
Switches (Index .. Length - 1) =
Arg (Current_Index .. Current_Index + Length - 1 - Index)
and then Length - Index > Max_Length
then
Index_Switches := Index;
Max_Length := Length - Index;
end if; end if;
-- Look for the next switch in Switches -- We are on the first character of a new command line argument,
-- which starts with Switch_Character. Further analysis is needed.
while Index <= Switches'Last
and then Switches (Index) /= ' ' loop
Index := Index + 1;
end loop;
Index := Index + 1; Parser.Current_Index := Parser.Current_Index + 1;
end loop; Parser.Is_Switch (Parser.Current_Argument) := True;
end if;
End_Index := Current_Index + Max_Length - 1; Find_Longest_Matching_Switch
(Switches => Switches,
Arg => Arg (Parser.Current_Index .. Arg'Last),
Index_In_Switches => Index_Switches,
Switch_Length => Max_Length,
Param => Param);
-- If switch is not accepted, skip it, unless we had '*' in Switches -- If switch is not accepted, it is either invalid or is returned
-- in the context of '*'.
if Index_Switches = 0 then if Index_Switches = 0 then
if Switches (Switches'First) = '*' then
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => 1,
Last => CL.Argument (Current_Argument)'Last);
Is_Switch (Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section;
return '*';
end if;
-- Depending on the value of Concatenate, the full switch is -- Depending on the value of Concatenate, the full switch is
-- a single character (True) or the rest of the argument (False). -- a single character or the rest of the argument.
if Concatenate then if Concatenate then
End_Index := Current_Index; End_Index := Parser.Current_Index;
else else
End_Index := Arg'Last; End_Index := Arg'Last;
end if; end if;
Set_Parameter (The_Switch, if Switches (Switches'First) = '*' then
Arg_Num => Current_Argument,
First => Current_Index,
Last => End_Index);
Current_Index := End_Index + 1;
raise Invalid_Switch;
end if;
Set_Parameter (The_Switch, -- Always prepend the switch character, so that users know that
Arg_Num => Current_Argument, -- this comes from a switch on the command line. This is
First => Current_Index, -- especially important when Concatenate is False, since
Last => End_Index); -- otherwise the currrent argument first character is lost.
-- Case of switch needs an argument Set_Parameter
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
Last => Arg'Last,
Extra => Parser.Switch_Character);
Parser.Is_Switch (Parser.Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section (Parser);
return '*';
end if;
if Index_Switches + Max_Length <= Switches'Last then Set_Parameter
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
Last => End_Index);
Parser.Current_Index := End_Index + 1;
raise Invalid_Switch;
end if;
case Switches (Index_Switches + Max_Length) is End_Index := Parser.Current_Index + Max_Length - 1;
Set_Parameter
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
Last => End_Index);
case Param is
when Parameter_With_Optional_Space =>
if End_Index < Arg'Last then
Set_Parameter
(Parser.The_Parameter,
Arg_Num => Parser.Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section (Parser);
elsif Parser.Current_Argument < Parser.Arg_Count
and then Parser.Section (Parser.Current_Argument + 1) /= 0
then
Parser.Current_Argument := Parser.Current_Argument + 1;
Parser.The_Separator := ' ';
Set_Parameter
(Parser.The_Parameter,
Arg_Num => Parser.Current_Argument,
First => Argument (Parser, Parser.Current_Argument)'First,
Last => Argument (Parser, Parser.Current_Argument)'Last);
Parser.Is_Switch (Parser.Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section (Parser);
else
Parser.Current_Index := End_Index + 1;
raise Invalid_Parameter;
end if;
when ':' => when Parameter_With_Space_Or_Equal =>
if End_Index < Arg'Last then -- If the switch is of the form <switch>=xxx
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section;
elsif Section (Current_Argument + 1) /= 0 then if End_Index < Arg'Last then
Set_Parameter
(The_Parameter,
Arg_Num => Current_Argument + 1,
First => 1,
Last => CL.Argument (Current_Argument + 1)'Last);
Current_Argument := Current_Argument + 1;
Is_Switch (Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section;
if Arg (End_Index + 1) = '='
and then End_Index + 1 < Arg'Last
then
Parser.The_Separator := '=';
Set_Parameter
(Parser.The_Parameter,
Arg_Num => Parser.Current_Argument,
First => End_Index + 2,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section (Parser);
else else
Current_Index := End_Index + 1; Parser.Current_Index := End_Index + 1;
raise Invalid_Parameter; raise Invalid_Parameter;
end if; end if;
when '=' => -- If the switch is of the form <switch> xxx
-- If the switch is of the form <switch>=xxx
if End_Index < Arg'Last then
if Arg (End_Index + 1) = '='
and then End_Index + 1 < Arg'Last
then
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => End_Index + 2,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section;
else
Current_Index := End_Index + 1;
raise Invalid_Parameter;
end if;
-- If the switch is of the form <switch> xxx elsif Parser.Current_Argument < Parser.Arg_Count
and then Parser.Section (Parser.Current_Argument + 1) /= 0
then
Parser.Current_Argument := Parser.Current_Argument + 1;
Parser.The_Separator := ' ';
Set_Parameter
(Parser.The_Parameter,
Arg_Num => Parser.Current_Argument,
First => Argument (Parser, Parser.Current_Argument)'First,
Last => Argument (Parser, Parser.Current_Argument)'Last);
Parser.Is_Switch (Parser.Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section (Parser);
else
Parser.Current_Index := End_Index + 1;
raise Invalid_Parameter;
end if;
elsif Section (Current_Argument + 1) /= 0 then when Parameter_No_Space =>
Set_Parameter
(The_Parameter,
Arg_Num => Current_Argument + 1,
First => 1,
Last => CL.Argument (Current_Argument + 1)'Last);
Current_Argument := Current_Argument + 1;
Is_Switch (Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section;
else if End_Index < Arg'Last then
Current_Index := End_Index + 1; Set_Parameter
raise Invalid_Parameter; (Parser.The_Parameter,
end if; Arg_Num => Parser.Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section (Parser);
when '!' => else
Parser.Current_Index := End_Index + 1;
raise Invalid_Parameter;
end if;
if End_Index < Arg'Last then when Parameter_Optional =>
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section;
else if End_Index < Arg'Last then
Current_Index := End_Index + 1; Set_Parameter
raise Invalid_Parameter; (Parser.The_Parameter,
end if; Arg_Num => Parser.Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
end if;
when '?' => Dummy := Goto_Next_Argument_In_Section (Parser);
if End_Index < Arg'Last then when Parameter_None =>
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
else if Concatenate or else End_Index = Arg'Last then
Set_Parameter (The_Parameter, Parser.Current_Index := End_Index + 1;
Arg_Num => Current_Argument,
First => 2,
Last => 1);
end if;
Dummy := Goto_Next_Argument_In_Section;
when others => else
if Concatenate or else End_Index = Arg'Last then -- If Concatenate is False and the full argument is not
Current_Index := End_Index + 1; -- recognized as a switch, this is an invalid switch.
else if Switches (Switches'First) = '*' then
-- If Concatenate is False and the full argument is not Set_Parameter
-- recognized as a switch, this is an invalid switch. (Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
if Switches (Switches'First) = '*' then First => Arg'First,
Set_Parameter Last => Arg'Last);
(The_Switch, Parser.Is_Switch (Parser.Current_Argument) := True;
Arg_Num => Current_Argument, Dummy := Goto_Next_Argument_In_Section (Parser);
First => 1, return '*';
Last => CL.Argument (Current_Argument)'Last);
Is_Switch (Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section;
return '*';
end if;
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => Current_Index,
Last => Arg'Last);
Current_Index := Arg'Last + 1;
raise Invalid_Switch;
end if; end if;
end case;
elsif Concatenate or else End_Index = Arg'Last then
Current_Index := End_Index + 1;
else Set_Parameter
-- If Concatenate is False and the full argument is not (Parser.The_Switch,
-- recognized as a switch, this is an invalid switch. Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
if Switches (Switches'First) = '*' then Last => Arg'Last);
Set_Parameter Parser.Current_Index := Arg'Last + 1;
(The_Switch, raise Invalid_Switch;
Arg_Num => Current_Argument, end if;
First => 1, end case;
Last => CL.Argument (Current_Argument)'Last);
Is_Switch (Current_Argument) := True;
Dummy := Goto_Next_Argument_In_Section;
return '*';
end if;
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => Current_Index,
Last => Arg'Last);
Current_Index := Arg'Last + 1;
raise Invalid_Switch;
end if;
return Switches (Index_Switches); return Switches (Index_Switches);
end; end;
...@@ -635,21 +730,31 @@ package body GNAT.Command_Line is ...@@ -635,21 +730,31 @@ package body GNAT.Command_Line is
-- Goto_Next_Argument_In_Section -- -- Goto_Next_Argument_In_Section --
----------------------------------- -----------------------------------
function Goto_Next_Argument_In_Section return Boolean is function Goto_Next_Argument_In_Section
(Parser : Opt_Parser) return Boolean
is
begin begin
Current_Index := 1; Parser.Current_Argument := Parser.Current_Argument + 1;
Current_Argument := Current_Argument + 1;
if Section (Current_Argument) = 0 then if Parser.Current_Argument > Parser.Arg_Count
or else Parser.Section (Parser.Current_Argument) = 0
then
loop loop
if Current_Argument > CL.Argument_Count then Parser.Current_Argument := Parser.Current_Argument + 1;
if Parser.Current_Argument > Parser.Arg_Count then
Parser.Current_Index := 1;
return False; return False;
end if; end if;
Current_Argument := Current_Argument + 1; exit when Parser.Section (Parser.Current_Argument) =
exit when Section (Current_Argument) = Current_Section; Parser.Current_Section;
end loop; end loop;
end if; end if;
Parser.Current_Index :=
Argument (Parser, Parser.Current_Argument)'First;
return True; return True;
end Goto_Next_Argument_In_Section; end Goto_Next_Argument_In_Section;
...@@ -657,29 +762,33 @@ package body GNAT.Command_Line is ...@@ -657,29 +762,33 @@ package body GNAT.Command_Line is
-- Goto_Section -- -- Goto_Section --
------------------ ------------------
procedure Goto_Section (Name : String := "") is procedure Goto_Section
Index : Integer := 1; (Name : String := "";
Parser : Opt_Parser := Command_Line_Parser)
is
Index : Integer;
begin begin
In_Expansion := False; Parser.In_Expansion := False;
if Name = "" then if Name = "" then
Current_Argument := 1; Parser.Current_Argument := 1;
Current_Index := 1; Parser.Current_Index := 1;
Current_Section := 1; Parser.Current_Section := 1;
return; return;
end if; end if;
while Index <= CL.Argument_Count loop Index := 1;
while Index <= Parser.Arg_Count loop
if Section (Index) = 0 if Parser.Section (Index) = 0
and then CL.Argument (Index) = Switch_Character & Name and then Argument (Parser, Index) = Parser.Switch_Character & Name
then then
Current_Argument := Index + 1; Parser.Current_Argument := Index + 1;
Current_Index := 1; Parser.Current_Index := 1;
if Current_Argument <= CL.Argument_Count then if Parser.Current_Argument <= Parser.Arg_Count then
Current_Section := Section (Current_Argument); Parser.Current_Section :=
Parser.Section (Parser.Current_Argument);
end if; end if;
return; return;
end if; end if;
...@@ -687,8 +796,8 @@ package body GNAT.Command_Line is ...@@ -687,8 +796,8 @@ package body GNAT.Command_Line is
Index := Index + 1; Index := Index + 1;
end loop; end loop;
Current_Argument := Positive'Last; Parser.Current_Argument := Positive'Last;
Current_Index := 2; -- so that Get_Argument returns nothing Parser.Current_Index := 2; -- so that Get_Argument returns nothing
end Goto_Section; end Goto_Section;
---------------------------- ----------------------------
...@@ -697,11 +806,60 @@ package body GNAT.Command_Line is ...@@ -697,11 +806,60 @@ package body GNAT.Command_Line is
procedure Initialize_Option_Scan procedure Initialize_Option_Scan
(Switch_Char : Character := '-'; (Switch_Char : Character := '-';
Stop_At_First_Non_Switch : Boolean := False;
Section_Delimiters : String := "")
is
begin
Internal_Initialize_Option_Scan
(Parser => Command_Line_Parser,
Switch_Char => Switch_Char,
Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
Section_Delimiters => Section_Delimiters);
end Initialize_Option_Scan;
----------------------------
-- Initialize_Option_Scan --
----------------------------
procedure Initialize_Option_Scan
(Parser : out Opt_Parser;
Command_Line : GNAT.OS_Lib.Argument_List_Access;
Switch_Char : Character := '-';
Stop_At_First_Non_Switch : Boolean := False; Stop_At_First_Non_Switch : Boolean := False;
Section_Delimiters : String := "") Section_Delimiters : String := "")
is is
Section_Num : Section_Number := 1; begin
Section_Index : Integer := Section_Delimiters'First; Free (Parser);
if Command_Line = null then
Parser := new Opt_Parser_Data (CL.Argument_Count);
Initialize_Option_Scan
(Switch_Char => Switch_Char,
Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
Section_Delimiters => Section_Delimiters);
else
Parser := new Opt_Parser_Data (Command_Line'Length);
Parser.Arguments := Command_Line;
Internal_Initialize_Option_Scan
(Parser => Parser,
Switch_Char => Switch_Char,
Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
Section_Delimiters => Section_Delimiters);
end if;
end Initialize_Option_Scan;
-------------------------------------
-- Internal_Initialize_Option_Scan --
-------------------------------------
procedure Internal_Initialize_Option_Scan
(Parser : Opt_Parser;
Switch_Char : Character;
Stop_At_First_Non_Switch : Boolean;
Section_Delimiters : String)
is
Section_Num : Section_Number;
Section_Index : Integer;
Last : Integer; Last : Integer;
Delimiter_Found : Boolean; Delimiter_Found : Boolean;
...@@ -709,18 +867,19 @@ package body GNAT.Command_Line is ...@@ -709,18 +867,19 @@ package body GNAT.Command_Line is
pragma Warnings (Off, Discard); pragma Warnings (Off, Discard);
begin begin
Current_Argument := 0; Parser.Current_Argument := 0;
Current_Index := 0; Parser.Current_Index := 0;
In_Expansion := False; Parser.In_Expansion := False;
Switch_Character := Switch_Char; Parser.Switch_Character := Switch_Char;
Stop_At_First := Stop_At_First_Non_Switch; Parser.Stop_At_First := Stop_At_First_Non_Switch;
-- If we are using sections, we have to preprocess the command line -- If we are using sections, we have to preprocess the command line
-- to delimit them. A section can be repeated, so we just give each -- to delimit them. A section can be repeated, so we just give each
-- item on the command line a section number -- item on the command line a section number
Section_Num := 1;
Section_Index := Section_Delimiters'First;
while Section_Index <= Section_Delimiters'Last loop while Section_Index <= Section_Delimiters'Last loop
Last := Section_Index; Last := Section_Index;
while Last <= Section_Delimiters'Last while Last <= Section_Delimiters'Last
and then Section_Delimiters (Last) /= ' ' and then Section_Delimiters (Last) /= ' '
...@@ -731,21 +890,21 @@ package body GNAT.Command_Line is ...@@ -731,21 +890,21 @@ package body GNAT.Command_Line is
Delimiter_Found := False; Delimiter_Found := False;
Section_Num := Section_Num + 1; Section_Num := Section_Num + 1;
for Index in 1 .. CL.Argument_Count loop for Index in 1 .. Parser.Arg_Count loop
if CL.Argument (Index)(1) = Switch_Character if Argument (Parser, Index)(1) = Parser.Switch_Character
and then and then
CL.Argument (Index) = Switch_Character & Argument (Parser, Index) = Parser.Switch_Character &
Section_Delimiters Section_Delimiters
(Section_Index .. Last - 1) (Section_Index .. Last - 1)
then then
Section (Index) := 0; Parser.Section (Index) := 0;
Delimiter_Found := True; Delimiter_Found := True;
elsif Section (Index) = 0 then elsif Parser.Section (Index) = 0 then
Delimiter_Found := False; Delimiter_Found := False;
elsif Delimiter_Found then elsif Delimiter_Found then
Section (Index) := Section_Num; Parser.Section (Index) := Section_Num;
end if; end if;
end loop; end loop;
...@@ -757,23 +916,36 @@ package body GNAT.Command_Line is ...@@ -757,23 +916,36 @@ package body GNAT.Command_Line is
end loop; end loop;
end loop; end loop;
Discard := Goto_Next_Argument_In_Section; Discard := Goto_Next_Argument_In_Section (Parser);
end Initialize_Option_Scan; end Internal_Initialize_Option_Scan;
--------------- ---------------
-- Parameter -- -- Parameter --
--------------- ---------------
function Parameter return String is function Parameter
(Parser : Opt_Parser := Command_Line_Parser) return String
is
begin begin
if The_Parameter.First > The_Parameter.Last then if Parser.The_Parameter.First > Parser.The_Parameter.Last then
return String'(1 .. 0 => ' '); return String'(1 .. 0 => ' ');
else else
return CL.Argument (The_Parameter.Arg_Num) return Argument (Parser, Parser.The_Parameter.Arg_Num)
(The_Parameter.First .. The_Parameter.Last); (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
end if; end if;
end Parameter; end Parameter;
---------------
-- Separator --
---------------
function Separator
(Parser : Opt_Parser := Command_Line_Parser) return Character
is
begin
return Parser.The_Separator;
end Separator;
------------------- -------------------
-- Set_Parameter -- -- Set_Parameter --
------------------- -------------------
...@@ -782,12 +954,14 @@ package body GNAT.Command_Line is ...@@ -782,12 +954,14 @@ package body GNAT.Command_Line is
(Variable : out Parameter_Type; (Variable : out Parameter_Type;
Arg_Num : Positive; Arg_Num : Positive;
First : Positive; First : Positive;
Last : Positive) Last : Positive;
Extra : Character := ASCII.NUL)
is is
begin begin
Variable.Arg_Num := Arg_Num; Variable.Arg_Num := Arg_Num;
Variable.First := First; Variable.First := First;
Variable.Last := Last; Variable.Last := Last;
Variable.Extra := Extra;
end Set_Parameter; end Set_Parameter;
--------------------- ---------------------
...@@ -862,6 +1036,718 @@ package body GNAT.Command_Line is ...@@ -862,6 +1036,718 @@ package body GNAT.Command_Line is
end loop; end loop;
end Start_Expansion; end Start_Expansion;
begin ----------
Section (CL.Argument_Count + 1) := 0; -- Free --
----------
procedure Free (Parser : in out Opt_Parser) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Opt_Parser_Data, Opt_Parser);
begin
if Parser /= null
and then Parser /= Command_Line_Parser
then
Free (Parser.Arguments);
Unchecked_Free (Parser);
end if;
end Free;
------------------------
-- Args_From_Expanded --
------------------------
function Args_From_Expanded (Args : Boolean_Chars) return String is
Result : String (1 .. Args'Length);
Index : Natural := Result'First;
begin
for A in Args'Range loop
if Args (A) then
Result (Index) := A;
Index := Index + 1;
end if;
end loop;
return Result (1 .. Index - 1);
end Args_From_Expanded;
------------------
-- Define_Alias --
------------------
procedure Define_Alias
(Config : in out Command_Line_Configuration;
Switch : String;
Expanded : String)
is
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
end if;
Append (Config.Aliases, new String'(Switch));
Append (Config.Expansions, new String'(Expanded));
end Define_Alias;
-------------------
-- Define_Prefix --
-------------------
procedure Define_Prefix
(Config : in out Command_Line_Configuration;
Prefix : String)
is
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
end if;
Append (Config.Prefixes, new String'(Prefix));
end Define_Prefix;
-----------------------
-- Set_Configuration --
-----------------------
procedure Set_Configuration
(Cmd : in out Command_Line;
Config : Command_Line_Configuration)
is
begin
Cmd.Config := Config;
end Set_Configuration;
----------------------
-- Set_Command_Line --
----------------------
procedure Set_Command_Line
(Cmd : in out Command_Line;
Switches : String;
Getopt_Description : String := "";
Switch_Char : Character := '-')
is
Tmp : Argument_List_Access;
Parser : Opt_Parser;
S : Character;
begin
Free (Cmd.Expanded);
Free (Cmd.Params);
if Switches /= "" then
Tmp := Argument_String_To_List (Switches);
Initialize_Option_Scan (Parser, Tmp, Switch_Char);
loop
begin
S := Getopt (Switches => "* " & Getopt_Description,
Concatenate => False,
Parser => Parser);
exit when S = ASCII.NUL;
if S = '*' then
Add_Switch (Cmd, Full_Switch (Parser), Parameter (Parser),
Separator (Parser));
else
Add_Switch
(Cmd, Switch_Char & Full_Switch (Parser),
Parameter (Parser), Separator (Parser));
end if;
exception
when Invalid_Parameter =>
-- Add it with no parameter, if that's the way the user
-- wants it
Add_Switch (Cmd, Switch_Char & Full_Switch (Parser));
end;
end loop;
Free (Parser);
end if;
end Set_Command_Line;
----------------
-- Looking_At --
----------------
function Looking_At
(Type_Str : String;
Index : Natural;
Substring : String) return Boolean is
begin
return Index + Substring'Length - 1 <= Type_Str'Last
and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
end Looking_At;
----------------------------
-- For_Each_Simple_Switch --
----------------------------
procedure For_Each_Simple_Switch
(Cmd : Command_Line;
Switch : String;
Callback : Callback_Procedure)
is
begin
-- Are we adding a switch that can in fact be expanded through aliases ?
-- If yes, we add separately each of its expansion.
-- This takes care of expansions like "-T" -> "-gnatwrs", where the
-- alias and its expansion do not have the same prefix. Given the order
-- in which we do things here, the expansion of the alias will itself
-- be checked for a common prefix and further split into simple switches
if Cmd.Config /= null
and then Cmd.Config.Aliases /= null
then
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);
return;
end if;
end loop;
end if;
-- Are we adding a switch grouping several switches ? If yes, add each
-- of the simple switches instead.
if Cmd.Config /= null
and then Cmd.Config.Prefixes /= null
then
for P in Cmd.Config.Prefixes'Range loop
if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
and then Looking_At
(Switch, Switch'First, Cmd.Config.Prefixes (P).all)
then
-- Alias expansion will be done recursively
for S in Switch'First + Cmd.Config.Prefixes (P)'Length
.. Switch'Last
loop
For_Each_Simple_Switch
(Cmd, Cmd.Config.Prefixes (P).all & Switch (S), Callback);
end loop;
return;
end if;
end loop;
end if;
Callback (Switch);
end For_Each_Simple_Switch;
----------------
-- Add_Switch --
----------------
procedure Add_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ')
is
procedure Add_Simple_Switch (Simple : String);
-- Add a new switch that has had all its aliases expanded, and switches
-- ungrouped. We know there is no more aliases in Switches
-----------------------
-- Add_Simple_Switch --
-----------------------
procedure Add_Simple_Switch (Simple : String) is
begin
if Cmd.Expanded = null then
Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
if Parameter = "" then
Cmd.Params := new Argument_List'(1 .. 1 => null);
else
Cmd.Params := new Argument_List'
(1 .. 1 => new String'(Separator & Parameter));
end if;
else
-- Do we already have this switch ?
for C in Cmd.Expanded'Range loop
if Cmd.Expanded (C).all = Simple
and then
((Cmd.Params (C) = null and then Parameter = "")
or else
(Cmd.Params (C) /= null
and then Cmd.Params (C).all = Separator & Parameter))
then
return;
end if;
end loop;
Append (Cmd.Expanded, new String'(Simple));
if Parameter = "" then
Append (Cmd.Params, null);
else
Append (Cmd.Params, new String'(Separator & Parameter));
end if;
end if;
end Add_Simple_Switch;
-- Start of processing for Add_Switch
begin
For_Each_Simple_Switch
(Cmd, Switch, Add_Simple_Switch'Unrestricted_Access);
Free (Cmd.Coalesce);
end Add_Switch;
------------
-- Remove --
------------
procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
Tmp : Argument_List_Access := Line;
begin
Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
if Index /= Tmp'First then
Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
end if;
Free (Tmp (Index));
if Index /= Tmp'Last then
Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
end if;
Unchecked_Free (Tmp);
end Remove;
------------
-- Append --
------------
procedure Append
(Line : in out Argument_List_Access;
Str : String_Access)
is
Tmp : Argument_List_Access := Line;
begin
if Tmp /= null then
Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
Line (Tmp'Range) := Tmp.all;
Unchecked_Free (Tmp);
else
Line := new Argument_List (1 .. 1);
end if;
Line (Line'Last) := Str;
end Append;
-------------------
-- Remove_Switch --
-------------------
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
Remove_All : Boolean := False)
is
procedure Remove_Simple_Switch (Simple : String);
-- Removes a simple switch, with no aliasing or grouping
--------------------------
-- Remove_Simple_Switch --
--------------------------
procedure Remove_Simple_Switch (Simple : String) is
C : Integer;
begin
if Cmd.Expanded /= null then
C := Cmd.Expanded'First;
while C <= Cmd.Expanded'Last loop
if Cmd.Expanded (C).all = Simple then
Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C);
if not Remove_All then
return;
end if;
else
C := C + 1;
end if;
end loop;
end if;
end Remove_Simple_Switch;
-- Start of processing for Remove_Switch
begin
For_Each_Simple_Switch
(Cmd, Switch, Remove_Simple_Switch'Unrestricted_Access);
Free (Cmd.Coalesce);
end Remove_Switch;
-------------------
-- Remove_Switch --
-------------------
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String)
is
procedure Remove_Simple_Switch (Simple : String);
-- Removes a simple switch, with no aliasing or grouping
--------------------------
-- Remove_Simple_Switch --
--------------------------
procedure Remove_Simple_Switch (Simple : String) is
C : Integer;
begin
if Cmd.Expanded /= null then
C := Cmd.Expanded'First;
while C <= Cmd.Expanded'Last loop
if Cmd.Expanded (C).all = Simple
and then
((Cmd.Params (C) = null and then Parameter = "")
or else
(Cmd.Params (C) /= null
and then
-- Ignore the separator stored in Parameter
Cmd.Params (C) (Cmd.Params (C)'First + 1
.. Cmd.Params (C)'Last) =
Parameter))
then
Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C);
-- The switch is necessarily unique by construction of
-- Add_Switch
return;
else
C := C + 1;
end if;
end loop;
end if;
end Remove_Simple_Switch;
-- Start of processing for Remove_Switch
begin
For_Each_Simple_Switch
(Cmd, Switch, Remove_Simple_Switch'Unrestricted_Access);
Free (Cmd.Coalesce);
end Remove_Switch;
--------------------
-- Group_Switches --
--------------------
procedure Group_Switches
(Cmd : Command_Line;
Result : Argument_List_Access;
Params : Argument_List_Access)
is
type Boolean_Array is array (Result'Range) of Boolean;
Matched : Boolean_Array;
Count : Natural;
First : Natural;
From_Args : Boolean_Chars;
begin
if Cmd.Config = null
or else Cmd.Config.Prefixes = null
then
return;
end if;
for P in Cmd.Config.Prefixes'Range loop
Matched := (others => False);
Count := 0;
for C in Result'Range loop
if Result (C) /= null
and then Params (C) = null -- ignored if has a parameter
and then Looking_At
(Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
then
Matched (C) := True;
Count := Count + 1;
end if;
end loop;
if Count > 1 then
From_Args := (others => False);
First := 0;
for M in Matched'Range loop
if Matched (M) then
if First = 0 then
First := M;
end if;
for A in Result (M)'First + Cmd.Config.Prefixes (P)'Length
.. Result (M)'Last
loop
From_Args (Result (M)(A)) := True;
end loop;
Free (Result (M));
end if;
end loop;
Result (First) := new String'
(Cmd.Config.Prefixes (P).all & Args_From_Expanded (From_Args));
end if;
end loop;
end Group_Switches;
--------------------
-- Alias_Switches --
--------------------
procedure Alias_Switches
(Cmd : Command_Line;
Result : Argument_List_Access;
Params : Argument_List_Access)
is
Found : Boolean;
First : Natural;
procedure Check_Cb (Switch : String);
-- Comment required ???
procedure Remove_Cb (Switch : String);
-- Comment required ???
--------------
-- Check_Cb --
--------------
procedure Check_Cb (Switch : String) is
begin
if Found then
for E in Result'Range loop
if Result (E) /= null
and then Params (E) = null -- Ignore if has a param
and then Result (E).all = Switch
then
return;
end if;
end loop;
Found := False;
end if;
end Check_Cb;
---------------
-- Remove_Cb --
---------------
procedure Remove_Cb (Switch : String) is
begin
for E in Result'Range loop
if Result (E) /= null and then Result (E).all = Switch then
if First > E then
First := E;
end if;
Free (Result (E));
return;
end if;
end loop;
end Remove_Cb;
-- Start of processing for Alias_Switches
begin
if Cmd.Config = null
or else Cmd.Config.Aliases = null
then
return;
end if;
for A in Cmd.Config.Aliases'Range loop
-- Compute the various simple switches that make up the alias. We
-- split the expansion into as many simple switches as possible, and
-- 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);
if Found then
First := Integer'Last;
For_Each_Simple_Switch
(Cmd, Cmd.Config.Expansions (A).all,
Remove_Cb'Unrestricted_Access);
Result (First) := new String'(Cmd.Config.Aliases (A).all);
end if;
end loop;
end Alias_Switches;
-----------
-- Start --
-----------
procedure Start
(Cmd : in out Command_Line;
Iter : in out Command_Line_Iterator;
Expanded : Boolean)
is
begin
-- Coalesce the switches as much as possible
if not Expanded
and then Cmd.Coalesce = null
then
Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
for E in Cmd.Expanded'Range loop
Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
end loop;
-- Not a clone, since we will not modify the parameters anyway
Cmd.Coalesce_Params := Cmd.Params;
Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
Group_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
end if;
if Expanded then
Iter.List := Cmd.Expanded;
Iter.Params := Cmd.Params;
else
Iter.List := Cmd.Coalesce;
Iter.Params := Cmd.Coalesce_Params;
end if;
if Iter.List = null then
Iter.Current := Integer'Last;
else
Iter.Current := Iter.List'First;
while Iter.Current <= Iter.List'Last
and then Iter.List (Iter.Current) = null
loop
Iter.Current := Iter.Current + 1;
end loop;
end if;
end Start;
--------------------
-- Current_Switch --
--------------------
function Current_Switch (Iter : Command_Line_Iterator) return String is
begin
return Iter.List (Iter.Current).all;
end Current_Switch;
-----------------------
-- Current_Separator --
-----------------------
function Current_Separator (Iter : Command_Line_Iterator) return String is
begin
if Iter.Params = null
or else Iter.Current > Iter.Params'Last
or else Iter.Params (Iter.Current) = null
then
return "";
else
declare
Sep : constant Character :=
Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
begin
if Sep = ASCII.NUL then
return "";
else
return "" & Sep;
end if;
end;
end if;
end Current_Separator;
-----------------------
-- Current_Parameter --
-----------------------
function Current_Parameter (Iter : Command_Line_Iterator) return String is
begin
if Iter.Params = null
or else Iter.Current > Iter.Params'Last
or else Iter.Params (Iter.Current) = null
then
return "";
else
declare
P : constant String := Iter.Params (Iter.Current).all;
begin
-- Skip separator
return P (P'First + 1 .. P'Last);
end;
end if;
end Current_Parameter;
--------------
-- Has_More --
--------------
function Has_More (Iter : Command_Line_Iterator) return Boolean is
begin
return Iter.List /= null and then Iter.Current <= Iter.List'Last;
end Has_More;
----------
-- Next --
----------
procedure Next (Iter : in out Command_Line_Iterator) is
begin
Iter.Current := Iter.Current + 1;
while Iter.Current <= Iter.List'Last
and then Iter.List (Iter.Current) = null
loop
Iter.Current := Iter.Current + 1;
end loop;
end Next;
----------
-- Free --
----------
procedure Free (Config : in out Command_Line_Configuration) is
begin
if Config /= null then
Free (Config.Aliases);
Free (Config.Expansions);
Free (Config.Prefixes);
Unchecked_Free (Config);
end if;
end Free;
----------
-- Free --
----------
procedure Free (Cmd : in out Command_Line) is
begin
Free (Cmd.Expanded);
Free (Cmd.Coalesce);
Free (Cmd.Params);
end Free;
end GNAT.Command_Line; end GNAT.Command_Line;
gcc/ada/g-comlin.ads
...@@ -31,10 +31,21 @@ ...@@ -31,10 +31,21 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- High level package for command line parsing -- High level package for command line parsing and manipulation
-- This package provides an interface to Ada.Command_Line, to do the -- Parsing the command line
-- parsing of command line arguments. Here is a small usage example: -- ========================
-- This package provides an interface for parsing command line arguments,
-- when they are either read from Ada.Command_Line or read from a string list.
-- As shown in the example below, one should first retrieve the switches
-- (special command line arguments starting with '-' by default) and their
-- parameters, and then the rest of the command line arguments.
-- This package is flexible enough to accomodate various needs: optional
-- switch parameters, various characters to separate a switch and its
-- parameter, whether to stop the parsing at the first non-switch argument
-- encountered, etc.
-- begin -- begin
-- loop -- loop
...@@ -50,7 +61,7 @@ ...@@ -50,7 +61,7 @@
-- when 'b' => -- when 'b' =>
-- Put_Line ("Got b + " & Parameter); -- Put_Line ("Got b + " & Parameter);
--
-- when others => -- when others =>
-- raise Program_Error; -- cannot occur! -- raise Program_Error; -- cannot occur!
-- end case; -- end case;
...@@ -64,16 +75,17 @@ ...@@ -64,16 +75,17 @@
-- Put_Line ("Got " & S); -- Put_Line ("Got " & S);
-- end; -- end;
-- end loop; -- end loop;
--
-- exception -- exception
-- when Invalid_Switch => Put_Line ("Invalid Switch " & Full_Switch); -- when Invalid_Switch => Put_Line ("Invalid Switch " & Full_Switch);
-- when Invalid_Parameter => Put_Line ("No parameter for " & Full_Switch); -- when Invalid_Parameter => Put_Line ("No parameter for " & Full_Switch);
-- end; -- end;
-- A more complicated example would involve the use of sections for the -- A more complicated example would involve the use of sections for the
-- switches, as for instance in gnatmake. These sections are separated by -- switches, as for instance in gnatmake. The same command line is used to
-- special switches chosen by the programer. Each section acts as a -- provide switches for several tools. Each tool recognizes its switches by
-- command line of its own. -- separating them with special switches, chosen by the programer.
-- Each section acts as a command line of its own.
-- begin -- begin
-- Initialize_Option_Scan ('-', False, "largs bargs cargs"); -- Initialize_Option_Scan ('-', False, "largs bargs cargs");
...@@ -84,34 +96,198 @@ ...@@ -84,34 +96,198 @@
-- Goto_Section ("bargs"); -- Goto_Section ("bargs");
-- loop -- loop
-- -- Same loop as above to get switches and arguments -- -- Same loop as above to get switches and arguments
-- -- The supports switches in Get_Opt might be different -- -- The supported switches in Get_Opt might be different
-- end loop; -- end loop;
-- Goto_Section ("cargs"); -- Goto_Section ("cargs");
-- loop -- loop
-- -- Same loop as above to get switches and arguments -- -- Same loop as above to get switches and arguments
-- -- The supports switches in Get_Opt might be different -- -- The supported switches in Get_Opt might be different
-- end loop;
-- end;
-- The example above have shown how to parse the command line when the
-- arguments are read directly from Ada.Command_Line. However, these arguments
-- can also be read from a list of strings. This can be useful in several
-- contexts, either because your system does not support Ada.Command_Line, or
-- because you are manipulating other tools and creating their command line by
-- hand, or for any other reason.
-- To create the list of strings, it is recommended to use
-- GNAT.OS_Lib.Argument_String_To_List.
-- The example below shows how to get the parameters from such a list. Note
-- also the use of '*' to get all the switches, and not report errors when an
-- unexpected switch was used by the user
-- declare
-- Parser : Opt_Parser;
-- Args : constant Argument_List_Access :=
-- GNAT.OS_Lib.Argument_String_To_List ("-g -O1 -Ipath");
-- begin
-- Initialize_Option_Scan (Parser, Args);
-- while Get_Opt ("* g O! I=", Parser) /= ASCII.NUL loop
-- Put_Line ("Switch " & Full_Switch (Parser)
-- & " param=" & Parameter (Parser));
-- end loop; -- end loop;
-- Free (Parser);
-- end; -- end;
--
-- Creating and manipulating the command line
-- ===========================================
-- This package provides handling of command line by providing methods to
-- add or remove arguments from it. The resulting command line is kept as
-- short as possible by coalescing arguments whenever possible.
-- This package can be used to construct complex command lines for instance
-- from an GUI interface (although the package itself does not depend on a
-- specific GUI toolkit). For instance, if you are configuring the command
-- line to use when spawning a tool with the following characteristics:
-- * Specifying -gnatwa is the same as specifying -gnatwu -gnatwv, but
-- shorter and more readable
-- * All switches starting with -gnatw can be grouped, for instance one
-- can write -gnatwcd instead of -gnatwc -gnatwd.
-- Of course, this can be combined with the above and -gnatwacd is the
-- same as -gnatwc -gnatwd -gnatwu -gnatwv
-- * The switch -T is the same as -gnatwAB
-- * A switch -foo takes one mandatory parameter
-- These attributes can be configured through this package with the following
-- calls:
-- Config : Command_Line_Configuration;
-- Define_Prefix (Config, "-gnatw");
-- Define_Alias (Config, "-gnatwa", "-gnatwuv");
-- Define_Alias (Config, "-T", "-gnatwAB");
-- Using this configuration, one can then construct a command line for the
-- tool with:
-- Cmd : Command_Line;
-- Set_Configuration (Cmd, Config);
-- Add_Switch (Cmd, "-bar");
-- Add_Switch (Cmd, "-gnatwu");
-- Add_Switch (Cmd, "-gnatwv"); -- will be grouped with the above
-- Add_Switch (Cmd, "-T");
-- The resulting command line can be iterated over to get all its switches,
-- There are two modes for this iteration: either you want to get the
-- shortest possible command line, which would be:
-- -bar -gnatwaAB
-- or on the other hand you want each individual switch (so that your own
-- tool does not have to do further complex processing), which would be:
-- -bar -gnatwu -gnatwv -gnatwA -gnatwB
-- Of course, we can assume that the tool you want to spawn would understand
-- both of these, since they are both compatible with the description we gave
-- above. However, the first result is useful if you want to show the user
-- what you are spawning (since that keeps the output shorter), and the second
-- output is more useful for a tool that would check whether -gnatwu was
-- passed (which isn't obvious in the first output). Likewise, the second
-- output is more useful if you have a graphical interface since each switch
-- can be associated with a widget, and you immediately know whether -gnatwu
-- was selected.
--
-- Some command line arguments can have parameters, which on a command line
-- appear as a separate argument that must immediately follow the switch.
-- Since the subprograms in this package will reorganize the switches to group
-- them, you need to indicate what is a command line
-- parameter, and what is a switch argument.
-- This is done by passing an extra argument to Add_Switch, as in:
-- Add_Switch (Cmd, "-foo", "arg1");
-- This ensures that "arg1" will always be treated as the argument to -foo,
-- and will not be grouped with other parts of the command line.
-- Parsing the command line with grouped arguments
-- ===============================================
-- This package also works great in collaboration with GNAT.Command_Line, to
-- parse the input to your tools. If you are writing the tool we described
-- above, you would do a first loop with Getopt to pass the switches and
-- their arguments, and create a temporary representation of the command line
-- as a Command_Line object. Finally, you can ask each individual switch to
-- that object. For instance:
-- declare
-- Cmd : Command_Line;
-- Iter : Command_Line_Iterator;
-- begin
-- while Getopt ("foo: gnatw! T bar") /= ASCII.NUL loop
-- Add_Switch (Cmd, Full_Switch, Parameter);
-- end loop;
-- Start (Cmd, Iter, Expanded => True);
-- while Has_More (Iter) loop
-- if Current_Switch (Iter) = "-gnatwu" then ..
-- elsif Current_Switch (Iter) = "-gnatwv" then ...
-- end if;
-- Next (Iter);
-- end loop;
-- The above means that your tool does not have to handle on its own whether
-- the user passed -gnatwa (in which case -gnatwu was indeed selected), or
-- just -gnatwu, or a combination of -gnatw switches as in -gnatwuv.
with Ada.Command_Line;
with GNAT.Directory_Operations; with GNAT.Directory_Operations;
with GNAT.OS_Lib;
with GNAT.Regexp; with GNAT.Regexp;
package GNAT.Command_Line is package GNAT.Command_Line is
-------------
-- Parsing --
-------------
type Opt_Parser is private;
Command_Line_Parser : constant Opt_Parser;
-- This object is responsible for parsing a list of arguments, which by
-- default are the standard command line arguments from Ada.Command_Line.
-- This is really a pointer to actual data, which must therefore be
-- initialized through a call to Initialize_Option_Scan, and must be freed
-- with a call to Free.
--
-- As a special case, Command_Line_Parser does not need to be either
-- initialized or free-ed.
procedure Initialize_Option_Scan procedure Initialize_Option_Scan
(Switch_Char : Character := '-'; (Switch_Char : Character := '-';
Stop_At_First_Non_Switch : Boolean := False; Stop_At_First_Non_Switch : Boolean := False;
Section_Delimiters : String := ""); Section_Delimiters : String := "");
-- This procedure resets the internal state of the package to prepare procedure Initialize_Option_Scan
-- to rescan the parameters. It does not need to be called before the (Parser : out Opt_Parser;
-- first use of Getopt (but it could be), but it must be called if you want Command_Line : GNAT.OS_Lib.Argument_List_Access;
-- to start rescanning the command line parameters from the start. The Switch_Char : Character := '-';
Stop_At_First_Non_Switch : Boolean := False;
Section_Delimiters : String := "");
-- The first procedure resets the internal state of the package to prepare
-- to rescan the parameters. It does not need to be called before the first
-- use of Getopt (but it could be), but it must be called if you want to
-- start rescanning the command line parameters from the start. The
-- optional parameter Switch_Char can be used to reset the switch -- optional parameter Switch_Char can be used to reset the switch
-- character, e.g. to '/' for use in DOS-like systems. The optional -- character, e.g. to '/' for use in DOS-like systems.
-- parameter Stop_At_First_Non_Switch indicates if Getopt is to look for --
-- switches on the whole command line, or if it has to stop as soon as a -- The second subprogram initializes a parser that takes its arguments from
-- non-switch argument is found. -- an array of strings rather than directly from the command line. In this
-- case, the parser is responsible for freeing the strings stored in
-- Command_Line. If you pass null to Command_Line, this will in fact create
-- a second parser for Ada.Command_Line, which doesn't share any data with
-- the default parser. This parser must be free-ed.
--
-- The optional parameter Stop_At_First_Non_Switch indicates if Getopt is
-- to look for switches on the whole command line, or if it has to stop as
-- soon as a non-switch argument is found.
-- --
-- Example: -- Example:
-- --
...@@ -126,27 +302,35 @@ package GNAT.Command_Line is ...@@ -126,27 +302,35 @@ package GNAT.Command_Line is
-- is delimited by any of these delimiters or the end of the command line. -- is delimited by any of these delimiters or the end of the command line.
-- --
-- Example: -- Example:
-- Initialize_Option_Scan ("largs bargs cargs"); -- Initialize_Option_Scan (Section_Delimiters => "largs bargs cargs");
-- --
-- Arguments on command line : my_application -c -bargs -d -e -largs -f -- Arguments on command line : my_application -c -bargs -d -e -largs -f
-- This line is made of three section, the first one is the default one -- This line is made of three section, the first one is the default one
-- and includes only the '-c' switch, the second one is between -bargs -- and includes only the '-c' switch, the second one is between -bargs
-- and -largs and includes '-d -e' and the last one includes '-f' -- and -largs and includes '-d -e' and the last one includes '-f'
procedure Goto_Section (Name : String := ""); procedure Free (Parser : in out Opt_Parser);
-- Free the memory used by the parser. Calling this is not mandatory for
-- the Command_Line_Parser
procedure Goto_Section
(Name : String := "";
Parser : Opt_Parser := Command_Line_Parser);
-- Change the current section. The next Getopt of Get_Argument will start -- Change the current section. The next Getopt of Get_Argument will start
-- looking at the beginning of the section. An empty name ("") refers to -- looking at the beginning of the section. An empty name ("") refers to
-- the first section between the program name and the first section -- the first section between the program name and the first section
-- delimiter. If the section does not exist, then Invalid_Section is -- delimiter. If the section does not exist, then Invalid_Section is
-- raised. -- raised.
function Full_Switch return String; function Full_Switch
(Parser : Opt_Parser := Command_Line_Parser) return String;
-- Returns the full name of the last switch found (Getopt only returns -- Returns the full name of the last switch found (Getopt only returns
-- the first character) -- the first character)
function Getopt function Getopt
(Switches : String; (Switches : String;
Concatenate : Boolean := True) return Character; Concatenate : Boolean := True;
Parser : Opt_Parser := Command_Line_Parser) return Character;
-- This function moves to the next switch on the command line (defined as -- This function moves to the next switch on the command line (defined as
-- switch character followed by a character within Switches, casing being -- switch character followed by a character within Switches, casing being
-- significant). The result returned is the first character of the switch -- significant). The result returned is the first character of the switch
...@@ -196,7 +380,10 @@ package GNAT.Command_Line is ...@@ -196,7 +380,10 @@ package GNAT.Command_Line is
-- --
-- If the first item in switches is '*', then Getopt will catch -- If the first item in switches is '*', then Getopt will catch
-- every element on the command line that was not caught by any other -- every element on the command line that was not caught by any other
-- switch. The character returned by GetOpt is '*' -- switch. The character returned by GetOpt is '*', but Full_Switch
-- contains the full command line argument, including leading '-' if there
-- is one. If this character was not returned, there would be no way of
-- knowing whether it is there or not.
-- --
-- Example -- Example
-- Getopt ("* a b") -- Getopt ("* a b")
...@@ -204,7 +391,6 @@ package GNAT.Command_Line is ...@@ -204,7 +391,6 @@ package GNAT.Command_Line is
-- successively 'a', '*', '*' and 'b'. When '*' is returned, -- successively 'a', '*', '*' and 'b'. When '*' is returned,
-- Full_Switch returns the corresponding item on the command line. -- Full_Switch returns the corresponding item on the command line.
-- --
--
-- When Getopt encounters an invalid switch, it raises the exception -- When Getopt encounters an invalid switch, it raises the exception
-- Invalid_Switch and sets Full_Switch to return the invalid switch. -- Invalid_Switch and sets Full_Switch to return the invalid switch.
-- When Getopt cannot find the parameter associated with a switch, it -- When Getopt cannot find the parameter associated with a switch, it
...@@ -226,7 +412,9 @@ package GNAT.Command_Line is ...@@ -226,7 +412,9 @@ package GNAT.Command_Line is
-- If the command line is '-ab', exception Invalid_Switch will be -- If the command line is '-ab', exception Invalid_Switch will be
-- raised and Full_Switch will return "ab". -- raised and Full_Switch will return "ab".
function Get_Argument (Do_Expansion : Boolean := False) return String; function Get_Argument
(Do_Expansion : Boolean := False;
Parser : Opt_Parser := Command_Line_Parser) return String;
-- Returns the next element on the command line which is not a switch. -- Returns the next element on the command line which is not a switch.
-- This function should not be called before Getopt has returned -- This function should not be called before Getopt has returned
-- ASCII.NUL. -- ASCII.NUL.
...@@ -238,7 +426,8 @@ package GNAT.Command_Line is ...@@ -238,7 +426,8 @@ package GNAT.Command_Line is
-- string. This is useful in non-Unix systems for obtaining normal -- string. This is useful in non-Unix systems for obtaining normal
-- expansion of wild card references. -- expansion of wild card references.
function Parameter return String; function Parameter
(Parser : Opt_Parser := Command_Line_Parser) return String;
-- Returns the parameter associated with the last switch returned by -- Returns the parameter associated with the last switch returned by
-- Getopt. If no parameter was associated with the last switch, or no -- Getopt. If no parameter was associated with the last switch, or no
-- previous call has been made to Get_Argument, raises Invalid_Parameter. -- previous call has been made to Get_Argument, raises Invalid_Parameter.
...@@ -246,6 +435,14 @@ package GNAT.Command_Line is ...@@ -246,6 +435,14 @@ package GNAT.Command_Line is
-- argument was not found on the command line, Parameter returns an empty -- argument was not found on the command line, Parameter returns an empty
-- string. -- string.
function Separator
(Parser : Opt_Parser := Command_Line_Parser) return Character;
-- The separator that was between the switch and its parameter. This is
-- of little use in general, only if you want to know exactly what was on
-- the command line. This is in general a single character, set to
-- ASCII.NUL if the switch and the parameter were concatenated. A space is
-- returned if the switch and its argument were in two separate arguments.
type Expansion_Iterator is limited private; type Expansion_Iterator is limited private;
-- Type used during expansion of file names -- Type used during expansion of file names
...@@ -288,6 +485,154 @@ package GNAT.Command_Line is ...@@ -288,6 +485,154 @@ package GNAT.Command_Line is
-- Raised when a parameter is missing, or an attempt is made to obtain a -- Raised when a parameter is missing, or an attempt is made to obtain a
-- parameter for a switch that does not allow a parameter -- parameter for a switch that does not allow a parameter
-----------------
-- Configuring --
-----------------
type Command_Line_Configuration is private;
procedure Define_Alias
(Config : in out Command_Line_Configuration;
Switch : String;
Expanded : String);
-- Indicates that whenever Switch appears on the command line, it should
-- be expanded as Expanded. For instance, for the GNAT compiler switches,
-- we would define "-gnatwa" as an alias for "-gnatwcfijkmopruvz", ie some
-- default warnings to be activated.
--
-- Likewise, in some context you could define "--verbose" as an alias for
-- ("-v", "--full"), ie two switches.
procedure Define_Prefix
(Config : in out Command_Line_Configuration;
Prefix : String);
-- Indicates that all switches starting with the given prefix should be
-- grouped. For instance, for the GNAT compiler we would define "-gnatw"
-- as a prefix, so that "-gnatwu -gnatwv" can be grouped into "-gnatwuv"
-- It is assume that the remaining of the switch ("uv") is a set of
-- characters whose order is irrelevant. In fact, this package will sort
-- them alphabetically.
procedure Free (Config : in out Command_Line_Configuration);
-- Free the memory used by Config
-------------
-- Editing --
-------------
type Command_Line is private;
procedure Set_Configuration
(Cmd : in out Command_Line;
Config : Command_Line_Configuration);
-- Set the configuration for this command line
procedure Set_Command_Line
(Cmd : in out Command_Line;
Switches : String;
Getopt_Description : String := "";
Switch_Char : Character := '-');
-- Set the new content of the command line, by replacing the current
-- version with Switches.
--
-- The parsing of Switches is done through calls to Getopt, by passing
-- Getopt_Description as an argument. (a "*" is automatically prepended so
-- that all switches and command line arguments are accepted).
--
-- To properly handle switches that take parameters, you should document
-- them in Getopt_Description. Otherwise, the switch and its parameter will
-- be recorded as two separate command line arguments as returned by a
-- Command_Line_Iterator (which might be fine depending on your
-- application).
--
-- This function can be used to reset Cmd by passing an empty string.
procedure Add_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ');
-- Add a new switch to the command line, and combine/group it with existing
-- switches if possible. Nothing is done if the switch already exists with
-- the same parameter.
--
-- If the Switch takes a parameter, the latter should be specified
-- separately, so that the association between the two is always correctly
-- recognized even if the order of switches on the command line changes.
-- For instance, you should pass "--check=full" as ("--check", "full") so
-- that Remove_Switch below can simply take "--check" in parameter. That
-- will automatically remove "full" as well. The value of the parameter is
-- never modified by this package.
--
-- On the other hand, you could decide to simply pass "--check=full" as
-- the Switch above, and then pass no parameter. This means that you need
-- to pass "--check=full" to Remove_Switch as well.
--
-- A Switch with a parameter will never be grouped with another switch to
-- avoid ambiguities as to who the parameter applies to.
--
-- Separator is the character that goes between the switches and its
-- parameter on the command line. If it is set to ASCII.NUL, then no
-- separator is applied, and they are concatenated
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
Remove_All : Boolean := False);
-- Remove Switch from the command line, and ungroup existing switches if
-- necessary.
--
-- The actual parameter to the switches are ignored. If for instance
-- you are removing "-foo", then "-foo param1" and "-foo param2" can
-- be removed.
--
-- If Remove_All is True, then all matching switches are removed, otherwise
-- only the first matching one is removed.
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String);
-- Remove a switch with a specific parameter. If Parameter is the empty
-- string, then only a switch with no parameter will be removed.
---------------
-- Iterating --
---------------
type Command_Line_Iterator is private;
procedure Start
(Cmd : in out Command_Line;
Iter : in out Command_Line_Iterator;
Expanded : Boolean);
-- Start iterating over the command line arguments. If Expanded is true,
-- then the arguments are not grouped and no alias is used. For instance,
-- "-gnatwv" and "-gnatwu" would be returned instead of "-gnatwuv".
--
-- The iterator becomes invalid if the command line is changed through a
-- call to Add_Switch, Remove_Switch or Set_Command_Line.
function Current_Switch (Iter : Command_Line_Iterator) return String;
function Current_Separator (Iter : Command_Line_Iterator) return String;
function Current_Parameter (Iter : Command_Line_Iterator) return String;
-- Return the current switch and its parameter (or the empty string if
-- there is no parameter or the switch was added through Add_Switch
-- without specifying the parameter.
--
-- Separator is the string that goes between the switch and its separator.
-- It could be the empty string if they should be concatenated, or a space
-- for instance. When printing, you should not add any other character.
function Has_More (Iter : Command_Line_Iterator) return Boolean;
-- Return True if there are more switches to be returned
procedure Next (Iter : in out Command_Line_Iterator);
-- Move to the next switch
procedure Free (Cmd : in out Command_Line);
-- Free the memory used by Cmd
private private
Max_Depth : constant := 100; Max_Depth : constant := 100;
...@@ -305,6 +650,22 @@ private ...@@ -305,6 +650,22 @@ private
type Level_Array is array (Depth) of Level; type Level_Array is array (Depth) of Level;
type Section_Number is new Natural range 0 .. 65534;
for Section_Number'Size use 16;
type Parameter_Type is record
Arg_Num : Positive;
First : Positive;
Last : Positive;
Extra : Character;
end record;
type Is_Switch_Type is array (Natural range <>) of Boolean;
pragma Pack (Is_Switch_Type);
type Section_Type is array (Natural range <>) of Section_Number;
pragma Pack (Section_Type);
type Expansion_Iterator is limited record type Expansion_Iterator is limited record
Start : Positive := 1; Start : Positive := 1;
-- Position of the first character of the relative path to check against -- Position of the first character of the relative path to check against
...@@ -324,4 +685,86 @@ private ...@@ -324,4 +685,86 @@ private
-- separators in the pattern. -- separators in the pattern.
end record; end record;
type Opt_Parser_Data (Arg_Count : Natural) is record
Arguments : GNAT.OS_Lib.Argument_List_Access;
-- null if reading from the command line
The_Parameter : Parameter_Type;
The_Separator : Character;
The_Switch : Parameter_Type;
-- This type and this variable are provided to store the current switch
-- and parameter.
Is_Switch : Is_Switch_Type (1 .. Arg_Count) := (others => False);
-- Indicates wich arguments on the command line are considered not be
-- switches or parameters to switches (leaving e.g. filenames,...)
Section : Section_Type (1 .. Arg_Count) := (others => 1);
-- Contains the number of the section associated with the current
-- switch. If this number is 0, then it is a section delimiter, which is
-- never returned by GetOpt.
Current_Argument : Natural := 1;
-- Number of the current argument parsed on the command line
Current_Index : Natural := 1;
-- Index in the current argument of the character to be processed
Current_Section : Section_Number := 1;
Expansion_It : aliased Expansion_Iterator;
-- When Get_Argument is expanding a file name, this is the iterator used
In_Expansion : Boolean := False;
-- True if we are expanding a file
Switch_Character : Character := '-';
-- The character at the beginning of the command line arguments,
-- indicating the beginning of a switch.
Stop_At_First : Boolean := False;
-- If it is True then Getopt stops at the first non-switch argument
end record;
Command_Line_Parser_Data : aliased Opt_Parser_Data
(Ada.Command_Line.Argument_Count);
-- The internal data used when parsing the command line
type Opt_Parser is access all Opt_Parser_Data;
Command_Line_Parser : constant Opt_Parser :=
Command_Line_Parser_Data'Access;
type Command_Line_Configuration_Record is record
Prefixes : GNAT.OS_Lib.Argument_List_Access;
-- The list of prefixes
Aliases : GNAT.OS_Lib.Argument_List_Access;
Expansions : GNAT.OS_Lib.Argument_List_Access;
-- The aliases. Both arrays have the same indices
end record;
type Command_Line_Configuration is access Command_Line_Configuration_Record;
type Command_Line is record
Config : Command_Line_Configuration;
Expanded : GNAT.OS_Lib.Argument_List_Access;
Params : GNAT.OS_Lib.Argument_List_Access;
-- Parameter for the corresponding switch in Expanded. The first
-- character is the separator (or ASCII.NUL if there is no separator)
Coalesce : GNAT.OS_Lib.Argument_List_Access;
Coalesce_Params : GNAT.OS_Lib.Argument_List_Access;
-- Cached version of the command line. This is recomputed every time the
-- command line changes. Switches are grouped as much as possible, and
-- aliases are used to reduce the length of the command line.
-- The parameters are not allocated, they point into Params, so must not
-- be freed.
end record;
type Command_Line_Iterator is record
List : GNAT.OS_Lib.Argument_List_Access;
Params : GNAT.OS_Lib.Argument_List_Access;
Current : Natural;
end record;
end GNAT.Command_Line; end GNAT.Command_Line;
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