-- --
-- B o d y --
-- --
--- $Revision: 1.21 $
--- --
--- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2004 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
--- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Command_Line;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GNAT.Command_Line is
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;
+ type Parameter_Type is record
+ Arg_Num : Positive;
+ First : Positive;
+ Last : Positive;
+ end record;
The_Parameter : Parameter_Type;
The_Switch : Parameter_Type;
-- This type and this variable are provided to store the current switch
-- Go to the next argument on the command line. If we are at the end
-- of the current section, we want to make sure there is no other
-- identical section on the command line (there might be multiple
- -- instances of -largs).
- -- Return True if there as another argument, False otherwise
+ -- instances of -largs). Returns True iff there is another argument.
+
+ 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);
+ -- Given a file name, converts it to canonical case form. For systems
+ -- where file names are case sensitive, this procedure has no effect.
+ -- If file names are not case sensitive (i.e. for example if you have
+ -- the file "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then
+ -- this call converts the given string to canonical all lower case form,
+ -- so that two file names compare equal if they refer to the same file.
+
+ ------------------------------
+ -- Canonical_Case_File_Name --
+ ------------------------------
+
+ 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;
---------------
-- Expansion --
S : String (1 .. 1024);
Last : Natural;
- It : Pointer := Iterator'Unrestricted_Access;
+ It : constant Pointer := Iterator'Unrestricted_Access;
+
+ Current : Depth := It.Current_Depth;
+ NL : Positive;
begin
+ -- It is assumed that a directory is opened at the current level;
+ -- otherwise, GNAT.Directory_Operations.Directory_Error will be raised
+ -- at the first call to Read.
+
loop
- Read (It.Dir, S, Last);
+ Read (It.Levels (Current).Dir, S, Last);
+
+ -- If we have exhausted the directory, close it and go back one level
if Last = 0 then
- Close (It.Dir);
- return String'(1 .. 0 => ' ');
- end if;
+ Close (It.Levels (Current).Dir);
+
+ -- If we are at level 1, we are finished; return an empty string.
+
+ if Current = 1 then
+ return String'(1 .. 0 => ' ');
+ else
+ -- Otherwise, continue with the directory at the previous level
+
+ Current := Current - 1;
+ It.Current_Depth := Current;
+ end if;
+
+ -- If this is a directory, that is neither "." or "..", attempt to
+ -- go to the next level.
+
+ 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
+ -- We can go to the next level only if we have not reached the
+ -- maximum depth,
+
+ if Current < It.Maximum_Depth then
+ NL := It.Levels (Current).Name_Last;
+
+ -- And if relative path of this new directory is not too long
+
+ 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));
+
+ -- Open the new directory, and read from it
+
+ GNAT.Directory_Operations.Open
+ (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
+ end if;
+ end if;
+
+ -- If not a directory, check the relative path against the pattern
- if GNAT.Regexp.Match (S (1 .. Last), Iterator.Regexp) then
- return S (1 .. Last);
+ else
+ declare
+ Name : String :=
+ It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) &
+ S (1 .. Last);
+ begin
+ Canonical_Case_File_Name (Name);
+
+ -- If it matches, return the relative path
+
+ if GNAT.Regexp.Match (Name, Iterator.Regexp) then
+ return Name;
+ end if;
+ end;
end if;
end loop;
begin
if In_Expansion then
declare
- S : String := Expansion (Expansion_It);
+ S : constant String := Expansion (Expansion_It);
+
begin
if S'Length /= 0 then
return S;
else
In_Expansion := False;
end if;
-
end;
end if;
Current_Argument := 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
declare
-- Getopt --
------------
- function Getopt (Switches : String) return Character is
- Dummy : Boolean;
+ function Getopt
+ (Switches : String;
+ Concatenate : Boolean := True) return Character
+ is
+ Dummy : Boolean;
+ pragma Unreferenced (Dummy);
begin
- -- If we have finished to parse 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
-- element
if Current_Argument > CL.Argument_Count
or else (Current_Index > CL.Argument (Current_Argument)'Last
- and then not Goto_Next_Argument_In_Section)
+ and then not Goto_Next_Argument_In_Section)
then
return ASCII.NUL;
end if;
Length := Length + 1;
end loop;
- if (Switches (Length - 1) = ':'
- or else Switches (Length - 1) = '?'
- or else Switches (Length - 1) = '!')
+ 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;
if Current_Index + Length - 1 - Index <= Arg'Last
and then
- Switches (Index .. Length - 1) =
- Arg (Current_Index .. Current_Index + Length - 1 - Index)
+ Switches (Index .. Length - 1) =
+ Arg (Current_Index .. Current_Index + Length - 1 - Index)
and then Length - Index > Max_Length
then
Index_Switches := 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;
+ Index := Index + 1;
end loop;
End_Index := Current_Index + Max_Length - 1;
- -- If the switch is not accepted, skip it, unless we had a '*' in
- -- Switches
+ -- If switch is not accepted, skip it, unless we had '*' in Switches
if Index_Switches = 0 then
if Switches (Switches'First) = '*' then
return '*';
end if;
+ -- Depending on the value of Concatenate, the full switch is
+ -- a single character (True) or the rest of the argument (False).
+
+ 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 => Current_Index);
- Current_Index := Current_Index + 1;
+ Last => End_Index);
+ Current_Index := End_Index + 1;
raise Invalid_Switch;
end if;
First => Current_Index,
Last => End_Index);
- -- If switch needs an argument
+ -- Case of switch needs an argument
if Index_Switches + Max_Length <= Switches'Last then
raise Invalid_Parameter;
end if;
+ when '=' =>
+
+ -- 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 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
Dummy := Goto_Next_Argument_In_Section;
when others =>
+ if Concatenate or else End_Index = Arg'Last then
+ Current_Index := End_Index + 1;
- Current_Index := End_Index + 1;
+ else
+ -- If Concatenate is False and the full argument is not
+ -- recognized as a switch, this is an invalid switch.
+ 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;
- else
+
+ elsif Concatenate or else End_Index = Arg'Last then
Current_Index := End_Index + 1;
+
+ else
+ -- If Concatenate is False and the full argument is not
+ -- recognized as a switch, this is an invalid switch.
+
+ 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);
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;
then
Current_Argument := Index + 1;
Current_Index := 1;
+
if Current_Argument <= CL.Argument_Count then
Current_Section := Section (Current_Argument);
end if;
Index := Index + 1;
end loop;
+
Current_Argument := Positive'Last;
Current_Index := 2; -- so that Get_Argument returns nothing
end Goto_Section;
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)
+ and then
+ CL.Argument (Index) = Switch_Character &
+ Section_Delimiters
+ (Section_Index .. Last - 1)
then
Section (Index) := 0;
Delimiter_Found := True;
(Variable : out Parameter_Type;
Arg_Num : Positive;
First : Positive;
- Last : Positive) is
+ Last : Positive)
+ is
begin
Variable.Arg_Num := Arg_Num;
Variable.First := First;
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 is unspecified, use the current directory ("./" or ".\")
+
if Directory = "" then
- GNAT.Directory_Operations.Open
- (Iterator.Dir, "." & Directory_Separator);
+ Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
+ Iterator.Start := 3;
+
else
- GNAT.Directory_Operations.Open (Iterator.Dir, Directory);
+ Iterator.Dir_Name (1 .. Directory'Length) := Directory;
+ Iterator.Start := Directory'Length + 1;
+ Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
+
+ -- Make sure that the last character is a directory separator
+
+ if Directory (Directory'Last) /= Directory_Separator then
+ Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
+ Iterator.Start := Iterator.Start + 1;
+ end if;
end if;
- Iterator.Regexp := GNAT.Regexp.Compile (Pattern, Basic_Regexp, True);
+ Iterator.Levels (1).Name_Last := Iterator.Start - 1;
+
+ -- Open the initial Directory, at depth 1
+
+ GNAT.Directory_Operations.Open
+ (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
+
+ -- If in the current directory and the pattern starts with "./" or ".\",
+ -- drop the "./" or ".\" from the pattern.
+
+ 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;
+
+ -- Maximum_Depth is equal to 1 plus the number of directory separators
+ -- in the pattern.
+
+ 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
OSDN Git Service
