with Ada.Command_Line;
package body GNAT.Command_Line is
package CL renames Ada.Command_Line;
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;
end record;
The_Parameter : Parameter_Type;
The_Switch : Parameter_Type;
type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
pragma Pack (Is_Switch_Type);
Is_Switch : Is_Switch_Type := (others => False);
type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
pragma Pack (Section_Type);
Section : Section_Type := (others => 1);
Current_Argument : Natural := 1;
Current_Index : Natural := 1;
Current_Section : Section_Number := 1;
Expansion_It : aliased Expansion_Iterator;
In_Expansion : Boolean := False;
Switch_Character : Character := '-';
Stop_At_First : Boolean := False;
procedure Set_Parameter
(Variable : out Parameter_Type;
Arg_Num : Positive;
First : Positive;
Last : Positive);
pragma Inline (Set_Parameter);
function Goto_Next_Argument_In_Section return Boolean;
function Expansion (Iterator : Expansion_Iterator) return String is
use GNAT.Directory_Operations;
type Pointer is access all Expansion_Iterator;
S : String (1 .. 1024);
Last : Natural;
It : Pointer := Iterator'Unrestricted_Access;
begin
loop
Read (It.Dir, S, Last);
if Last = 0 then
Close (It.Dir);
return String'(1 .. 0 => ' ');
end if;
if GNAT.Regexp.Match (S (1 .. Last), Iterator.Regexp) then
return S (1 .. Last);
end if;
end loop;
return String'(1 .. 0 => ' ');
end Expansion;
function Full_Switch return String is
begin
return CL.Argument (The_Switch.Arg_Num)
(The_Switch.First .. The_Switch.Last);
end Full_Switch;
function Get_Argument (Do_Expansion : Boolean := False) return String is
Total : constant Natural := CL.Argument_Count;
begin
if In_Expansion then
declare
S : String := Expansion (Expansion_It);
begin
if S'Length /= 0 then
return S;
else
In_Expansion := False;
end if;
end;
end if;
if Current_Argument > Total then
if Current_Index = 1 then
Current_Argument := 1;
while Current_Argument <= CL.Argument_Count
and then Section (Current_Argument) /= Current_Section
loop
Current_Argument := Current_Argument + 1;
end loop;
else
return String'(1 .. 0 => ' ');
end if;
elsif Section (Current_Argument) = 0 then
while Current_Argument <= CL.Argument_Count
and then Section (Current_Argument) /= Current_Section
loop
Current_Argument := Current_Argument + 1;
end loop;
end if;
Current_Index := 2;
while Current_Argument <= Total
and then Is_Switch (Current_Argument)
loop
Current_Argument := Current_Argument + 1;
end loop;
if Current_Argument > Total then
return String'(1 .. 0 => ' ');
end if;
if Section (Current_Argument) = 0 then
return Get_Argument (Do_Expansion);
end if;
Current_Argument := Current_Argument + 1;
if Do_Expansion then
declare
Arg : String renames CL.Argument (Current_Argument - 1);
Index : Positive := Arg'First;
begin
while Index <= Arg'Last loop
if Arg (Index) = '*'
or else Arg (Index) = '?'
or else Arg (Index) = '['
then
In_Expansion := True;
Start_Expansion (Expansion_It, Arg);
return Get_Argument (Do_Expansion);
end if;
Index := Index + 1;
end loop;
end;
end if;
return CL.Argument (Current_Argument - 1);
end Get_Argument;
function Getopt (Switches : String) return Character is
Dummy : Boolean;
begin
if Current_Argument > CL.Argument_Count
or else (Current_Index > CL.Argument (Current_Argument)'Last
and then not Goto_Next_Argument_In_Section)
then
return ASCII.NUL;
end if;
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
return Getopt (Switches);
end if;
end if;
Current_Index := 2;
Is_Switch (Current_Argument) := True;
end if;
declare
Arg : String renames CL.Argument (Current_Argument);
Index_Switches : Natural := 0;
Max_Length : Natural := 0;
Index : Natural := Switches'First;
Length : Natural := 1;
End_Index : Natural;
begin
while Index <= Switches'Last loop
Length := Index;
while Length <= Switches'Last
and then Switches (Length) /= ' '
loop
Length := Length + 1;
end loop;
if (Switches (Length - 1) = ':'
or else Switches (Length - 1) = '?'
or else Switches (Length - 1) = '!')
and then Length > Index + 1
then
Length := Length - 1;
end if;
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;
while Index <= Switches'Last
and then Switches (Index) /= ' ' loop
Index := Index + 1;
end loop;
Index := Index + 1;
end loop;
End_Index := Current_Index + Max_Length - 1;
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;
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => Current_Index,
Last => Current_Index);
Current_Index := Current_Index + 1;
raise Invalid_Switch;
end if;
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => Current_Index,
Last => End_Index);
if Index_Switches + Max_Length <= Switches'Last then
case Switches (Index_Switches + Max_Length) is
when ':' =>
if End_Index < Arg'Last then
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
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
Current_Index := End_Index + 1;
raise Invalid_Parameter;
end if;
when '!' =>
if End_Index < Arg'Last then
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
Dummy := Goto_Next_Argument_In_Section;
else
Current_Index := End_Index + 1;
raise Invalid_Parameter;
end if;
when '?' =>
if End_Index < Arg'Last then
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => End_Index + 1,
Last => Arg'Last);
else
Set_Parameter (The_Parameter,
Arg_Num => Current_Argument,
First => 2,
Last => 1);
end if;
Dummy := Goto_Next_Argument_In_Section;
when others =>
Current_Index := End_Index + 1;
end case;
else
Current_Index := End_Index + 1;
end if;
return Switches (Index_Switches);
end;
end Getopt;
function Goto_Next_Argument_In_Section return Boolean is
begin
Current_Index := 1;
Current_Argument := Current_Argument + 1;
if Section (Current_Argument) = 0 then
loop
if Current_Argument > CL.Argument_Count then
return False;
end if;
Current_Argument := Current_Argument + 1;
exit when Section (Current_Argument) = Current_Section;
end loop;
end if;
return True;
end Goto_Next_Argument_In_Section;
procedure Goto_Section (Name : String := "") is
Index : Integer := 1;
begin
In_Expansion := False;
if Name = "" then
Current_Argument := 1;
Current_Index := 1;
Current_Section := 1;
return;
end if;
while Index <= CL.Argument_Count loop
if Section (Index) = 0
and then CL.Argument (Index) = Switch_Character & Name
then
Current_Argument := Index + 1;
Current_Index := 1;
if Current_Argument <= CL.Argument_Count then
Current_Section := Section (Current_Argument);
end if;
return;
end if;
Index := Index + 1;
end loop;
Current_Argument := Positive'Last;
Current_Index := 2; end Goto_Section;
procedure Initialize_Option_Scan
(Switch_Char : Character := '-';
Stop_At_First_Non_Switch : Boolean := False;
Section_Delimiters : String := "")
is
Section_Num : Section_Number := 1;
Section_Index : Integer := Section_Delimiters'First;
Last : Integer;
Delimiter_Found : Boolean;
begin
Current_Argument := 0;
Current_Index := 0;
In_Expansion := False;
Switch_Character := Switch_Char;
Stop_At_First := Stop_At_First_Non_Switch;
while Section_Index <= Section_Delimiters'Last loop
Last := Section_Index;
while Last <= Section_Delimiters'Last
and then Section_Delimiters (Last) /= ' '
loop
Last := Last + 1;
end loop;
Delimiter_Found := False;
Section_Num := Section_Num + 1;
for Index in 1 .. CL.Argument_Count loop
if CL.Argument (Index)(1) = Switch_Character
and then CL.Argument (Index) = Switch_Character
& Section_Delimiters (Section_Index .. Last - 1)
then
Section (Index) := 0;
Delimiter_Found := True;
elsif Section (Index) = 0 then
Delimiter_Found := False;
elsif Delimiter_Found then
Section (Index) := Section_Num;
end if;
end loop;
Section_Index := Last + 1;
while Section_Index <= Section_Delimiters'Last
and then Section_Delimiters (Section_Index) = ' '
loop
Section_Index := Section_Index + 1;
end loop;
end loop;
Delimiter_Found := Goto_Next_Argument_In_Section;
end Initialize_Option_Scan;
function Parameter return String is
begin
if The_Parameter.First > The_Parameter.Last then
return String'(1 .. 0 => ' ');
else
return CL.Argument (The_Parameter.Arg_Num)
(The_Parameter.First .. The_Parameter.Last);
end if;
end Parameter;
procedure Set_Parameter
(Variable : out Parameter_Type;
Arg_Num : Positive;
First : Positive;
Last : Positive) is
begin
Variable.Arg_Num := Arg_Num;
Variable.First := First;
Variable.Last := Last;
end Set_Parameter;
procedure Start_Expansion
(Iterator : out Expansion_Iterator;
Pattern : String;
Directory : String := "";
Basic_Regexp : Boolean := True)
is
Directory_Separator : Character;
pragma Import (C, Directory_Separator, "__gnat_dir_separator");
begin
if Directory = "" then
GNAT.Directory_Operations.Open
(Iterator.Dir, "." & Directory_Separator);
else
GNAT.Directory_Operations.Open (Iterator.Dir, Directory);
end if;
Iterator.Regexp := GNAT.Regexp.Compile (Pattern, Basic_Regexp, True);
end Start_Expansion;
begin
Section (CL.Argument_Count + 1) := 0;
end GNAT.Command_Line;