with Ada.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
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 Get_File_Names_Case_Sensitive return Integer;
pragma Import (C, Get_File_Names_Case_Sensitive,
"__gnat_get_file_names_case_sensitive");
File_Names_Case_Sensitive : constant Boolean :=
Get_File_Names_Case_Sensitive /= 0;
procedure Canonical_Case_File_Name (S : in out String);
procedure Canonical_Case_File_Name (S : in out String) is
begin
if not File_Names_Case_Sensitive then
for J in S'Range loop
if S (J) in 'A' .. 'Z' then
S (J) := Character'Val (
Character'Pos (S (J)) +
Character'Pos ('a') -
Character'Pos ('A'));
end if;
end loop;
end if;
end Canonical_Case_File_Name;
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 : constant Pointer := Iterator'Unrestricted_Access;
Current : Depth := It.Current_Depth;
NL : Positive;
begin
loop
Read (It.Levels (Current).Dir, S, Last);
if Last = 0 then
Close (It.Levels (Current).Dir);
if Current = 1 then
return String'(1 .. 0 => ' ');
else
Current := Current - 1;
It.Current_Depth := Current;
end if;
elsif Is_Directory
(It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
and then S (1 .. Last) /= "."
and then S (1 .. Last) /= ".."
then
if Current < It.Maximum_Depth then
NL := It.Levels (Current).Name_Last;
if NL + Last + 1 < Max_Path_Length then
Current := Current + 1;
It.Current_Depth := Current;
It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
NL := NL + Last + 1;
It.Dir_Name (NL) := Directory_Separator;
It.Levels (Current).Name_Last := NL;
Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
GNAT.Directory_Operations.Open
(It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
end if;
end if;
else
declare
Name : String :=
It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) &
S (1 .. Last);
begin
Canonical_Case_File_Name (Name);
if GNAT.Regexp.Match (Name, Iterator.Regexp) then
return Name;
end if;
end;
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 : constant 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;
Concatenate : Boolean := True) return Character
is
Dummy : Boolean;
pragma Unreferenced (Dummy);
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) = '?' 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;
if Concatenate then
End_Index := Current_Index;
else
End_Index := Arg'Last;
end if;
Set_Parameter (The_Switch,
Arg_Num => Current_Argument,
First => Current_Index,
Last => End_Index);
Current_Index := End_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
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;
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 =>
if Concatenate or else End_Index = Arg'Last then
Current_Index := End_Index + 1;
else
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 case;
elsif Concatenate or else End_Index = Arg'Last then
Current_Index := End_Index + 1;
else
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);
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");
First : Positive := Pattern'First;
Pat : String := Pattern;
begin
Canonical_Case_File_Name (Pat);
Iterator.Current_Depth := 1;
if Directory = "" then
Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
Iterator.Start := 3;
else
Iterator.Dir_Name (1 .. Directory'Length) := Directory;
Iterator.Start := Directory'Length + 1;
Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
if Directory (Directory'Last) /= Directory_Separator then
Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
Iterator.Start := Iterator.Start + 1;
end if;
end if;
Iterator.Levels (1).Name_Last := Iterator.Start - 1;
GNAT.Directory_Operations.Open
(Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
if Directory = "" and then Pat'Length > 2
and then Pat (Pat'First) = '.'
and then Pat (Pat'First + 1) = Directory_Separator
then
First := Pat'First + 2;
end if;
Iterator.Regexp :=
GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
Iterator.Maximum_Depth := 1;
for Index in First .. Pat'Last loop
if Pat (Index) = Directory_Separator then
Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
exit when Iterator.Maximum_Depth = Max_Depth;
end if;
end loop;
end Start_Expansion;
begin
Section (CL.Argument_Count + 1) := 0;
end GNAT.Command_Line;