URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [ada/] [g-comlin.adb] - Rev 516
Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T . C O M M A N D _ L I N E -- -- -- -- B o d y -- -- -- -- Copyright (C) 1999-2009, 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- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- <http://www.gnu.org/licenses/>. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Ada.Strings.Unbounded; with GNAT.OS_Lib; use GNAT.OS_Lib; package body GNAT.Command_Line is package CL renames Ada.Command_Line; type Switch_Parameter_Type is (Parameter_None, Parameter_With_Optional_Space, -- ':' in getopt Parameter_With_Space_Or_Equal, -- '=' in getopt Parameter_No_Space, -- '!' in getopt Parameter_Optional); -- '?' in getopt procedure Set_Parameter (Variable : out Parameter_Type; Arg_Num : Positive; First : Positive; Last : Positive; Extra : Character := ASCII.NUL); pragma Inline (Set_Parameter); -- Set the parameter that will be returned by Parameter below -- Parameters need to be defined ??? 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 current section, we want to make sure there is no other identical -- section on the command line (there might be multiple 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. 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 at least partially -- partially Arg. Index_In_Switches is set to 0 if none matches. -- What are other parameters??? in particular Param is not always set??? 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); procedure Remove (Line : in out Argument_List_Access; Index : Integer); -- Remove a specific element from Line procedure Add (Line : in out Argument_List_Access; Str : String_Access; Before : Boolean := False); -- Add a new element to Line. If Before is True, the item is inserted at -- the beginning, else it is appended. function Can_Have_Parameter (S : String) return Boolean; -- True if S can have a parameter function Require_Parameter (S : String) return Boolean; -- True if S requires a parameter function Actual_Switch (S : String) return String; -- Remove any possible trailing '!', ':', '?' and '=' generic with procedure Callback (Simple_Switch : String; Parameter : String); procedure For_Each_Simple_Switch (Cmd : Command_Line; Switch : String; Parameter : String := ""; Unalias : Boolean := True); -- Breaks Switch into as simple switches as possible (expanding aliases and -- ungrouping common prefixes when possible), and call Callback for each of -- these. procedure Sort_Sections (Line : GNAT.OS_Lib.Argument_List_Access; Sections : GNAT.OS_Lib.Argument_List_Access; Params : GNAT.OS_Lib.Argument_List_Access); -- Reorder the command line switches so that the switches belonging to a -- section are grouped together. procedure Group_Switches (Cmd : Command_Line; Result : Argument_List_Access; Sections : 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 one or more switches by an alias, i.e. 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 -- ------------------------------ 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 -- --------------- function Expansion (Iterator : Expansion_Iterator) return String is use GNAT.Directory_Operations; type Pointer is access all Expansion_Iterator; It : constant Pointer := Iterator'Unrestricted_Access; S : String (1 .. 1024); Last : Natural; 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.Levels (Current).Dir, S, Last); -- If we have exhausted the directory, close it and go back one level if Last = 0 then 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; end if; -- Check the relative path against the pattern -- Note that we try to match also against directory names, since -- clients of this function may expect to retrieve directories. 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 loop; end Expansion; ----------------- -- Full_Switch -- ----------------- function Full_Switch (Parser : Opt_Parser := Command_Line_Parser) return String is begin if Parser.The_Switch.Extra = ASCII.NUL then 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; ------------------ -- Get_Argument -- ------------------ function Get_Argument (Do_Expansion : Boolean := False; Parser : Opt_Parser := Command_Line_Parser) return String is begin if Parser.In_Expansion then declare S : constant String := Expansion (Parser.Expansion_It); begin if S'Length /= 0 then return S; else Parser.In_Expansion := False; end if; end; end if; if Parser.Current_Argument > Parser.Arg_Count then -- If this is the first time this function is called if Parser.Current_Index = 1 then Parser.Current_Argument := 1; while Parser.Current_Argument <= Parser.Arg_Count and then Parser.Section (Parser.Current_Argument) /= Parser.Current_Section loop Parser.Current_Argument := Parser.Current_Argument + 1; end loop; else return String'(1 .. 0 => ' '); end if; elsif Parser.Section (Parser.Current_Argument) = 0 then while Parser.Current_Argument <= Parser.Arg_Count and then Parser.Section (Parser.Current_Argument) /= Parser.Current_Section loop Parser.Current_Argument := Parser.Current_Argument + 1; end loop; end if; Parser.Current_Index := Integer'Last; while Parser.Current_Argument <= Parser.Arg_Count and then Parser.Is_Switch (Parser.Current_Argument) loop Parser.Current_Argument := Parser.Current_Argument + 1; end loop; if Parser.Current_Argument > Parser.Arg_Count then return String'(1 .. 0 => ' '); elsif Parser.Section (Parser.Current_Argument) = 0 then return Get_Argument (Do_Expansion); end if; Parser.Current_Argument := Parser.Current_Argument + 1; -- Could it be a file name with wild cards to expand? if Do_Expansion then declare Arg : constant String := Argument (Parser, Parser.Current_Argument - 1); Index : Positive; begin Index := Arg'First; while Index <= Arg'Last loop if Arg (Index) = '*' or else Arg (Index) = '?' or else Arg (Index) = '[' then Parser.In_Expansion := True; Start_Expansion (Parser.Expansion_It, Arg); return Get_Argument (Do_Expansion); end if; Index := Index + 1; end loop; end; end if; return Argument (Parser, Parser.Current_Argument - 1); 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 -- ------------ function Getopt (Switches : String; Concatenate : Boolean := True; Parser : Opt_Parser := Command_Line_Parser) return Character is Dummy : Boolean; pragma Unreferenced (Dummy); begin <<Restart>> -- 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 Parser.Current_Argument > Parser.Arg_Count or else (Parser.Current_Index > Argument (Parser, Parser.Current_Argument)'Last and then not Goto_Next_Argument_In_Section (Parser)) then return ASCII.NUL; end if; -- By default, the switch will not have a parameter Parser.The_Parameter := (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL); Parser.The_Separator := ASCII.NUL; declare Arg : constant String := Argument (Parser, Parser.Current_Argument); Index_Switches : Natural := 0; Max_Length : Natural := 0; End_Index : Natural; Param : Switch_Parameter_Type; begin -- If we are on a new item, test if this might be a switch if Parser.Current_Index = Arg'First then if Arg (Arg'First) /= Parser.Switch_Character then -- If it isn't a switch, return it immediately. We also know it -- 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; if Parser.Stop_At_First then Parser.Current_Argument := Positive'Last; return ASCII.NUL; elsif not Goto_Next_Argument_In_Section (Parser) then return ASCII.NUL; else -- Recurse to get the next switch on the command line goto Restart; end if; end if; -- We are on the first character of a new command line argument, -- which starts with Switch_Character. Further analysis is needed. Parser.Current_Index := Parser.Current_Index + 1; Parser.Is_Switch (Parser.Current_Argument) := True; end if; 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, it is either invalid or is returned -- in the context of '*'. if Index_Switches = 0 then -- Depending on the value of Concatenate, the full switch is -- a single character or the rest of the argument. End_Index := (if Concatenate then Parser.Current_Index else Arg'Last); if Switches (Switches'First) = '*' then -- Always prepend the switch character, so that users know that -- this comes from a switch on the command line. This is -- especially important when Concatenate is False, since -- otherwise the current argument first character is lost. 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; 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; 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 Parameter_With_Space_Or_Equal => -- 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 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 Parser.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; when Parameter_No_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); else Parser.Current_Index := End_Index + 1; raise Invalid_Parameter; end if; when Parameter_Optional => if End_Index < Arg'Last then Set_Parameter (Parser.The_Parameter, Arg_Num => Parser.Current_Argument, First => End_Index + 1, Last => Arg'Last); end if; Dummy := Goto_Next_Argument_In_Section (Parser); when Parameter_None => if Concatenate or else End_Index = Arg'Last then Parser.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. 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; Set_Parameter (Parser.The_Switch, Arg_Num => Parser.Current_Argument, First => Parser.Current_Index, Last => Arg'Last); Parser.Current_Index := Arg'Last + 1; raise Invalid_Switch; end if; end case; return Switches (Index_Switches); end; end Getopt; ----------------------------------- -- Goto_Next_Argument_In_Section -- ----------------------------------- function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean is begin Parser.Current_Argument := Parser.Current_Argument + 1; if Parser.Current_Argument > Parser.Arg_Count or else Parser.Section (Parser.Current_Argument) = 0 then loop Parser.Current_Argument := Parser.Current_Argument + 1; if Parser.Current_Argument > Parser.Arg_Count then Parser.Current_Index := 1; return False; end if; exit when Parser.Section (Parser.Current_Argument) = Parser.Current_Section; end loop; end if; Parser.Current_Index := Argument (Parser, Parser.Current_Argument)'First; return True; end Goto_Next_Argument_In_Section; ------------------ -- Goto_Section -- ------------------ procedure Goto_Section (Name : String := ""; Parser : Opt_Parser := Command_Line_Parser) is Index : Integer; begin Parser.In_Expansion := False; if Name = "" then Parser.Current_Argument := 1; Parser.Current_Index := 1; Parser.Current_Section := 1; return; end if; Index := 1; while Index <= Parser.Arg_Count loop if Parser.Section (Index) = 0 and then Argument (Parser, Index) = Parser.Switch_Character & Name then Parser.Current_Argument := Index + 1; Parser.Current_Index := 1; if Parser.Current_Argument <= Parser.Arg_Count then Parser.Current_Section := Parser.Section (Parser.Current_Argument); end if; return; end if; Index := Index + 1; end loop; Parser.Current_Argument := Positive'Last; Parser.Current_Index := 2; -- so that Get_Argument returns nothing end Goto_Section; ---------------------------- -- Initialize_Option_Scan -- ---------------------------- procedure Initialize_Option_Scan (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; Section_Delimiters : String := "") is begin Free (Parser); if Command_Line = null then Parser := new Opt_Parser_Data (CL.Argument_Count); Internal_Initialize_Option_Scan (Parser => Parser, 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; Delimiter_Found : Boolean; Discard : Boolean; pragma Warnings (Off, Discard); begin Parser.Current_Argument := 0; Parser.Current_Index := 0; Parser.In_Expansion := False; Parser.Switch_Character := Switch_Char; Parser.Stop_At_First := Stop_At_First_Non_Switch; Parser.Section := (others => 1); -- 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 -- item on the command line a section number Section_Num := 1; Section_Index := Section_Delimiters'First; 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 .. Parser.Arg_Count loop if Argument (Parser, Index)(1) = Parser.Switch_Character and then Argument (Parser, Index) = Parser.Switch_Character & Section_Delimiters (Section_Index .. Last - 1) then Parser.Section (Index) := 0; Delimiter_Found := True; elsif Parser.Section (Index) = 0 then Delimiter_Found := False; elsif Delimiter_Found then Parser.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; Discard := Goto_Next_Argument_In_Section (Parser); end Internal_Initialize_Option_Scan; --------------- -- Parameter -- --------------- function Parameter (Parser : Opt_Parser := Command_Line_Parser) return String is begin if Parser.The_Parameter.First > Parser.The_Parameter.Last then return String'(1 .. 0 => ' '); else return Argument (Parser, Parser.The_Parameter.Arg_Num) (Parser.The_Parameter.First .. Parser.The_Parameter.Last); end if; end Parameter; --------------- -- Separator -- --------------- function Separator (Parser : Opt_Parser := Command_Line_Parser) return Character is begin return Parser.The_Separator; end Separator; ------------------- -- Set_Parameter -- ------------------- procedure Set_Parameter (Variable : out Parameter_Type; Arg_Num : Positive; First : Positive; Last : Positive; Extra : Character := ASCII.NUL) is begin Variable.Arg_Num := Arg_Num; Variable.First := First; Variable.Last := Last; Variable.Extra := Extra; end Set_Parameter; --------------------- -- Start_Expansion -- --------------------- 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 is unspecified, use the current directory ("./" or ".\") 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)); -- 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.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; ---------- -- 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; ------------------ -- 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; Add (Config.Aliases, new String'(Switch)); Add (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; Add (Config.Prefixes, new String'(Prefix)); end Define_Prefix; ------------------- -- Define_Switch -- ------------------- procedure Define_Switch (Config : in out Command_Line_Configuration; Switch : String) is begin if Config = null then Config := new Command_Line_Configuration_Record; end if; Add (Config.Switches, new String'(Switch)); end Define_Switch; -------------------- -- Define_Section -- -------------------- procedure Define_Section (Config : in out Command_Line_Configuration; Section : String) is begin if Config = null then Config := new Command_Line_Configuration_Record; end if; Add (Config.Sections, new String'(Section)); end Define_Section; ------------------ -- Get_Switches -- ------------------ function Get_Switches (Config : Command_Line_Configuration; Switch_Char : Character) return String is Ret : Ada.Strings.Unbounded.Unbounded_String; use type Ada.Strings.Unbounded.Unbounded_String; begin if Config = null or else Config.Switches = null then return ""; end if; for J in Config.Switches'Range loop if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then Ret := Ret & " " & Config.Switches (J) (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last); else Ret := Ret & " " & Config.Switches (J).all; end if; end loop; return Ada.Strings.Unbounded.To_String (Ret); end Get_Switches; ----------------------- -- Set_Configuration -- ----------------------- procedure Set_Configuration (Cmd : in out Command_Line; Config : Command_Line_Configuration) is begin Cmd.Config := Config; end Set_Configuration; ----------------------- -- Get_Configuration -- ----------------------- function Get_Configuration (Cmd : Command_Line) return Command_Line_Configuration is begin return Cmd.Config; end Get_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; Section : String_Access := null; function Real_Full_Switch (S : Character; Parser : Opt_Parser) return String; -- Ensure that the returned switch value contains the -- Switch_Char prefix if needed. ---------------------- -- Real_Full_Switch -- ---------------------- function Real_Full_Switch (S : Character; Parser : Opt_Parser) return String is begin if S = '*' then return Full_Switch (Parser); else return Switch_Char & Full_Switch (Parser); end if; end Real_Full_Switch; -- Start of processing for Set_Command_Line 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; declare Sw : constant String := Real_Full_Switch (S, Parser); Is_Section : Boolean := False; begin if Cmd.Config /= null and then Cmd.Config.Sections /= null then Section_Search : for S in Cmd.Config.Sections'Range loop if Sw = Cmd.Config.Sections (S).all then Section := Cmd.Config.Sections (S); Is_Section := True; exit Section_Search; end if; end loop Section_Search; end if; if not Is_Section then if Section = null then -- Work around some weird cases: some switches may -- expect parameters, but have the same value as -- longer switches: -gnaty3 (-gnaty, parameter=3) and -- -gnatya (-gnatya, no parameter). -- So we are calling add_switch here with parameter -- attached. This will be anyway correctly handled by -- Add_Switch if -gnaty3 is actually provided. if Separator (Parser) = ASCII.NUL then Add_Switch (Cmd, Sw & Parameter (Parser), "", ASCII.NUL); else Add_Switch (Cmd, Sw, Parameter (Parser), Separator (Parser)); end if; else if Separator (Parser) = ASCII.NUL then Add_Switch (Cmd, Sw & Parameter (Parser), "", Separator (Parser), Section.all); else Add_Switch (Cmd, Sw, Parameter (Parser), Separator (Parser), Section.all); end if; end if; end if; end; exception when Invalid_Parameter => -- Add it with no parameter, if that's the way the user -- wants it. -- Specify the separator in all cases, as the switch might -- need to be unaliased, and the alias might contain -- switches with parameters. if Section = null then Add_Switch (Cmd, Switch_Char & Full_Switch (Parser), Separator => Separator (Parser)); else Add_Switch (Cmd, Switch_Char & Full_Switch (Parser), Separator => Separator (Parser), Section => Section.all); end if; 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; ------------------------ -- Can_Have_Parameter -- ------------------------ function Can_Have_Parameter (S : String) return Boolean is begin if S'Length <= 1 then return False; end if; case S (S'Last) is when '!' | ':' | '?' | '=' => return True; when others => return False; end case; end Can_Have_Parameter; ----------------------- -- Require_Parameter -- ----------------------- function Require_Parameter (S : String) return Boolean is begin if S'Length <= 1 then return False; end if; case S (S'Last) is when '!' | ':' | '=' => return True; when others => return False; end case; end Require_Parameter; ------------------- -- Actual_Switch -- ------------------- function Actual_Switch (S : String) return String is begin if S'Length <= 1 then return S; end if; case S (S'Last) is when '!' | ':' | '?' | '=' => return S (S'First .. S'Last - 1); when others => return S; end case; end Actual_Switch; ---------------------------- -- For_Each_Simple_Switch -- ---------------------------- procedure For_Each_Simple_Switch (Cmd : Command_Line; Switch : String; Parameter : String := ""; Unalias : Boolean := True) is function Group_Analysis (Prefix : String; Group : String) return Boolean; -- Perform the analysis of a group of switches -------------------- -- Group_Analysis -- -------------------- function Group_Analysis (Prefix : String; Group : String) return Boolean is Idx : Natural; Found : Boolean; begin Idx := Group'First; while Idx <= Group'Last loop Found := False; for S in Cmd.Config.Switches'Range loop declare Sw : constant String := Actual_Switch (Cmd.Config.Switches (S).all); Full : constant String := Prefix & Group (Idx .. Group'Last); Last : Natural; Param : Natural; begin if Sw'Length >= Prefix'Length -- Verify that sw starts with Prefix and then Looking_At (Sw, Sw'First, Prefix) -- Verify that the group starts with sw and then Looking_At (Full, Full'First, Sw) then Last := Idx + Sw'Length - Prefix'Length - 1; Param := Last + 1; if Can_Have_Parameter (Cmd.Config.Switches (S).all) then -- Include potential parameter to the recursive call. -- Only numbers are allowed. while Last < Group'Last and then Group (Last + 1) in '0' .. '9' loop Last := Last + 1; end loop; end if; if not Require_Parameter (Cmd.Config.Switches (S).all) or else Last >= Param then if Idx = Group'First and then Last = Group'Last and then Last < Param then -- The group only concerns a single switch. Do not -- perform recursive call. -- Note that we still perform a recursive call if -- a parameter is detected in the switch, as this -- is a way to correctly identify such a parameter -- in aliases. return False; end if; Found := True; -- Recursive call, using the detected parameter if any if Last >= Param then For_Each_Simple_Switch (Cmd, Prefix & Group (Idx .. Param - 1), Group (Param .. Last)); else For_Each_Simple_Switch (Cmd, Prefix & Group (Idx .. Last), ""); end if; Idx := Last + 1; exit; end if; end if; end; end loop; if not Found then For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), ""); Idx := Idx + 1; end if; end loop; return True; end Group_Analysis; begin -- First determine if the switch corresponds to one belonging to the -- configuration. If so, run callback and exit. if Cmd.Config /= null and then Cmd.Config.Switches /= null then for S in Cmd.Config.Switches'Range loop declare Config_Switch : String renames Cmd.Config.Switches (S).all; begin if Actual_Switch (Config_Switch) = Switch and then ((Can_Have_Parameter (Config_Switch) and then Parameter /= "") or else (not Require_Parameter (Config_Switch) and then Parameter = "")) then Callback (Switch, Parameter); return; end if; end; end loop; end if; -- If adding a switch that can in fact be expanded through aliases, -- add separately each of its expansions. -- 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 split into simple switches. if Unalias and then 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 and then Parameter = "" then For_Each_Simple_Switch (Cmd, Cmd.Config.Expansions (A).all, ""); return; end if; end loop; end if; -- If adding a switch grouping several switches, 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 if Cmd.Config.Switches = null then 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), ""); end loop; return; elsif Group_Analysis (Cmd.Config.Prefixes (P).all, Switch (Switch'First + Cmd.Config.Prefixes (P)'Length .. Switch'Last)) then -- Recursive calls already done on each switch of the group: -- Return without executing Callback. return; end if; end if; end loop; end if; -- Test if added switch is a known switch with parameter attached if Parameter = "" and then Cmd.Config /= null and then Cmd.Config.Switches /= null then for S in Cmd.Config.Switches'Range loop declare Sw : constant String := Actual_Switch (Cmd.Config.Switches (S).all); Last : Natural; Param : Natural; begin -- Verify that switch starts with Sw -- What if the "verification" fails??? if Switch'Length >= Sw'Length and then Looking_At (Switch, Switch'First, Sw) then Param := Switch'First + Sw'Length - 1; Last := Param; if Can_Have_Parameter (Cmd.Config.Switches (S).all) then while Last < Switch'Last and then Switch (Last + 1) in '0' .. '9' loop Last := Last + 1; end loop; end if; -- If full Switch is a known switch with attached parameter -- then we use this parameter in the callback. if Last = Switch'Last then Callback (Switch (Switch'First .. Param), Switch (Param + 1 .. Last)); return; end if; end if; end; end loop; end if; Callback (Switch, Parameter); end For_Each_Simple_Switch; ---------------- -- Add_Switch -- ---------------- procedure Add_Switch (Cmd : in out Command_Line; Switch : String; Parameter : String := ""; Separator : Character := ' '; Section : String := ""; Add_Before : Boolean := False) is Success : Boolean; pragma Unreferenced (Success); begin Add_Switch (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success); end Add_Switch; ---------------- -- Add_Switch -- ---------------- procedure Add_Switch (Cmd : in out Command_Line; Switch : String; Parameter : String := ""; Separator : Character := ' '; Section : String := ""; Add_Before : Boolean := False; Success : out Boolean) is procedure Add_Simple_Switch (Simple : String; Param : String); -- Add a new switch that has had all its aliases expanded, and switches -- ungrouped. We know there are no more aliases in Switches. ----------------------- -- Add_Simple_Switch -- ----------------------- procedure Add_Simple_Switch (Simple : String; Param : String) is begin if Cmd.Expanded = null then Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple)); if Param /= "" then Cmd.Params := new Argument_List' (1 .. 1 => new String'(Separator & Param)); else Cmd.Params := new Argument_List'(1 .. 1 => null); end if; if Section = "" then Cmd.Sections := new Argument_List'(1 .. 1 => null); else Cmd.Sections := new Argument_List' (1 .. 1 => new String'(Section)); 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 Param = "") or else (Cmd.Params (C) /= null and then Cmd.Params (C).all = Separator & Param)) and then ((Cmd.Sections (C) = null and then Section = "") or else (Cmd.Sections (C) /= null and then Cmd.Sections (C).all = Section)) then return; end if; end loop; -- Inserting at least one switch Success := True; Add (Cmd.Expanded, new String'(Simple), Add_Before); if Param /= "" then Add (Cmd.Params, new String'(Separator & Param), Add_Before); else Add (Cmd.Params, null, Add_Before); end if; if Section = "" then Add (Cmd.Sections, null, Add_Before); else Add (Cmd.Sections, new String'(Section), Add_Before); end if; end if; end Add_Simple_Switch; procedure Add_Simple_Switches is new For_Each_Simple_Switch (Add_Simple_Switch); -- Start of processing for Add_Switch begin Success := False; Add_Simple_Switches (Cmd, Switch, Parameter); 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; --------- -- Add -- --------- procedure Add (Line : in out Argument_List_Access; Str : String_Access; Before : Boolean := False) is Tmp : Argument_List_Access := Line; begin if Tmp /= null then Line := new Argument_List (Tmp'First .. Tmp'Last + 1); if Before then Line (Tmp'First) := Str; Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all; else Line (Tmp'Range) := Tmp.all; Line (Tmp'Last + 1) := Str; end if; Unchecked_Free (Tmp); else Line := new Argument_List'(1 .. 1 => Str); end if; end Add; ------------------- -- Remove_Switch -- ------------------- procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; Remove_All : Boolean := False; Has_Parameter : Boolean := False; Section : String := "") is Success : Boolean; pragma Unreferenced (Success); begin Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success); end Remove_Switch; ------------------- -- Remove_Switch -- ------------------- procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; Remove_All : Boolean := False; Has_Parameter : Boolean := False; Section : String := ""; Success : out Boolean) is procedure Remove_Simple_Switch (Simple : String; Param : String); -- Removes a simple switch, with no aliasing or grouping -------------------------- -- Remove_Simple_Switch -- -------------------------- procedure Remove_Simple_Switch (Simple : String; Param : String) is C : Integer; pragma Unreferenced (Param); begin if Cmd.Expanded /= null then C := Cmd.Expanded'First; while C <= Cmd.Expanded'Last loop if Cmd.Expanded (C).all = Simple and then (Remove_All or else (Cmd.Sections (C) = null and then Section = "") or else (Cmd.Sections (C) /= null and then Section = Cmd.Sections (C).all)) and then (not Has_Parameter or else Cmd.Params (C) /= null) then Remove (Cmd.Expanded, C); Remove (Cmd.Params, C); Remove (Cmd.Sections, C); Success := True; if not Remove_All then return; end if; else C := C + 1; end if; end loop; end if; end Remove_Simple_Switch; procedure Remove_Simple_Switches is new For_Each_Simple_Switch (Remove_Simple_Switch); -- Start of processing for Remove_Switch begin Success := False; Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter); Free (Cmd.Coalesce); end Remove_Switch; ------------------- -- Remove_Switch -- ------------------- procedure Remove_Switch (Cmd : in out Command_Line; Switch : String; Parameter : String; Section : String := "") is procedure Remove_Simple_Switch (Simple : String; Param : String); -- Removes a simple switch, with no aliasing or grouping -------------------------- -- Remove_Simple_Switch -- -------------------------- procedure Remove_Simple_Switch (Simple : String; Param : 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.Sections (C) = null and then Section = "") or else (Cmd.Sections (C) /= null and then Section = Cmd.Sections (C).all)) and then ((Cmd.Params (C) = null and then Param = "") 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) = Param)) then Remove (Cmd.Expanded, C); Remove (Cmd.Params, C); Remove (Cmd.Sections, 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; procedure Remove_Simple_Switches is new For_Each_Simple_Switch (Remove_Simple_Switch); -- Start of processing for Remove_Switch begin Remove_Simple_Switches (Cmd, Switch, Parameter); Free (Cmd.Coalesce); end Remove_Switch; -------------------- -- Group_Switches -- -------------------- procedure Group_Switches (Cmd : Command_Line; Result : Argument_List_Access; Sections : Argument_List_Access; Params : Argument_List_Access) is function Compatible_Parameter (Param : String_Access) return Boolean; -- True when the parameter can be part of a group -------------------------- -- Compatible_Parameter -- -------------------------- function Compatible_Parameter (Param : String_Access) return Boolean is begin -- No parameter OK if Param = null then return True; -- We need parameters without separators elsif Param (Param'First) /= ASCII.NUL then return False; -- Parameters must be all digits else for J in Param'First + 1 .. Param'Last loop if Param (J) not in '0' .. '9' then return False; end if; end loop; return True; end if; end Compatible_Parameter; -- Local declarations Group : Ada.Strings.Unbounded.Unbounded_String; First : Natural; use type Ada.Strings.Unbounded.Unbounded_String; -- Start of processing for Group_Switches begin if Cmd.Config = null or else Cmd.Config.Prefixes = null then return; end if; for P in Cmd.Config.Prefixes'Range loop Group := Ada.Strings.Unbounded.Null_Unbounded_String; First := 0; for C in Result'Range loop if Result (C) /= null and then Compatible_Parameter (Params (C)) and then Looking_At (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all) then -- If we are still in the same section, group the switches if First = 0 or else (Sections (C) = null and then Sections (First) = null) or else (Sections (C) /= null and then Sections (First) /= null and then Sections (C).all = Sections (First).all) then Group := Group & Result (C) (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. Result (C)'Last); if Params (C) /= null then Group := Group & Params (C) (Params (C)'First + 1 .. Params (C)'Last); Free (Params (C)); end if; if First = 0 then First := C; end if; Free (Result (C)); else -- We changed section: we put the grouped switches to the -- first place, on continue with the new section. Result (First) := new String' (Cmd.Config.Prefixes (P).all & Ada.Strings.Unbounded.To_String (Group)); Group := Ada.Strings.Unbounded.To_Unbounded_String (Result (C) (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. Result (C)'Last)); First := C; end if; end if; end loop; if First > 0 then Result (First) := new String' (Cmd.Config.Prefixes (P).all & Ada.Strings.Unbounded.To_String (Group)); 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; Param : String); -- Comment required ??? procedure Remove_Cb (Switch : String; Param : String); -- Comment required ??? -------------- -- Check_Cb -- -------------- procedure Check_Cb (Switch : String; Param : String) is begin if Found then for E in Result'Range loop if Result (E) /= null and then (Params (E) = null or else Params (E) (Params (E)'First + 1 .. Params (E)'Last) = 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; Param : String) is begin for E in Result'Range loop if Result (E) /= null and then (Params (E) = null or else Params (E) (Params (E)'First + 1 .. Params (E)'Last) = Param) and then Result (E).all = Switch then if First > E then First := E; end if; Free (Result (E)); Free (Params (E)); return; end if; end loop; end Remove_Cb; procedure Check_All is new For_Each_Simple_Switch (Check_Cb); procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb); -- Start of processing for Alias_Switches begin 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; Check_All (Cmd, Cmd.Config.Expansions (A).all); if Found then First := Integer'Last; Remove_All (Cmd, Cmd.Config.Expansions (A).all); Result (First) := new String'(Cmd.Config.Aliases (A).all); end if; end loop; end Alias_Switches; ------------------- -- Sort_Sections -- ------------------- procedure Sort_Sections (Line : GNAT.OS_Lib.Argument_List_Access; Sections : GNAT.OS_Lib.Argument_List_Access; Params : GNAT.OS_Lib.Argument_List_Access) is Sections_List : Argument_List_Access := new Argument_List'(1 .. 1 => null); Found : Boolean; Old_Line : constant Argument_List := Line.all; Old_Sections : constant Argument_List := Sections.all; Old_Params : constant Argument_List := Params.all; Index : Natural; begin if Line = null then return; end if; -- First construct a list of all sections for E in Line'Range loop if Sections (E) /= null then Found := False; for S in Sections_List'Range loop if (Sections_List (S) = null and then Sections (E) = null) or else (Sections_List (S) /= null and then Sections (E) /= null and then Sections_List (S).all = Sections (E).all) then Found := True; exit; end if; end loop; if not Found then Add (Sections_List, Sections (E)); end if; end if; end loop; Index := Line'First; for S in Sections_List'Range loop for E in Old_Line'Range loop if (Sections_List (S) = null and then Old_Sections (E) = null) or else (Sections_List (S) /= null and then Old_Sections (E) /= null and then Sections_List (S).all = Old_Sections (E).all) then Line (Index) := Old_Line (E); Sections (Index) := Old_Sections (E); Params (Index) := Old_Params (E); Index := Index + 1; end if; end loop; end loop; end Sort_Sections; ----------- -- Start -- ----------- procedure Start (Cmd : in out Command_Line; Iter : in out Command_Line_Iterator; Expanded : Boolean) is begin if Cmd.Expanded = null then Iter.List := null; return; end if; -- Reorder the expanded line so that sections are grouped Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params); -- 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; Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range); for E in Cmd.Sections'Range loop Cmd.Coalesce_Sections (E) := (if Cmd.Sections (E) = null then null else new String'(Cmd.Sections (E).all)); end loop; Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range); for E in Cmd.Params'Range loop Cmd.Coalesce_Params (E) := (if Cmd.Params (E) = null then null else new String'(Cmd.Params (E).all)); end loop; -- Not a clone, since we will not modify the parameters anyway Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params); Group_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params); end if; if Expanded then Iter.List := Cmd.Expanded; Iter.Params := Cmd.Params; Iter.Sections := Cmd.Sections; else Iter.List := Cmd.Coalesce; Iter.Params := Cmd.Coalesce_Params; Iter.Sections := Cmd.Coalesce_Sections; 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; -------------------- -- Is_New_Section -- -------------------- function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is Section : constant String := Current_Section (Iter); begin if Iter.Sections = null then return False; elsif Iter.Current = Iter.Sections'First or else Iter.Sections (Iter.Current - 1) = null then return Section /= ""; end if; return Section /= Iter.Sections (Iter.Current - 1).all; end Is_New_Section; --------------------- -- Current_Section -- --------------------- function Current_Section (Iter : Command_Line_Iterator) return String is begin if Iter.Sections = null or else Iter.Current > Iter.Sections'Last or else Iter.Sections (Iter.Current) = null then return ""; end if; return Iter.Sections (Iter.Current).all; end Current_Section; ----------------------- -- 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); Free (Config.Sections); Free (Config.Switches); 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;