-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2007, Free Software Foundation, Inc. --
+-- 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 2, or (at your option) any later ver- --
+-- 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. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- 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 GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Strings.Unbounded;
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GNAT.Command_Line is
Parameter_With_Optional_Space, -- ':' in getopt
Parameter_With_Space_Or_Equal, -- '=' in getopt
Parameter_No_Space, -- '!' in getopt
- Parameter_Optional); -- '?' in getop
+ Parameter_Optional); -- '?' in getopt
procedure Set_Parameter
(Variable : out Parameter_Type;
Index_In_Switches : out Integer;
Switch_Length : out Integer;
Param : out Switch_Parameter_Type);
- -- return the Longest switch from Switches that matches at least
- -- partially Arg. Index_In_Switches is set to 0 if none matches
+ -- 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);
- type Boolean_Chars is array (Character) of Boolean;
-
procedure Remove (Line : in out Argument_List_Access; Index : Integer);
-- Remove a specific element from Line
- procedure Append
- (Line : in out Argument_List_Access;
- Str : String_Access);
- -- Append a new element to Line
+ 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 Args_From_Expanded (Args : Boolean_Chars) return String;
- -- Return the string made of all characters with True in Args
+ function Can_Have_Parameter (S : String) return Boolean;
+ -- True if S can have a parameter.
- type Callback_Procedure is access procedure (Simple_Switch : String);
+ 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;
- Callback : Callback_Procedure);
+ (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;
- Params : Argument_List_Access);
- -- Group switches with common prefixes whenever possible.
- -- Once they have been grouped, we also check items for possible aliasing
+ (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 or more switches by an alias, ie a shorter
+ -- When possible, replace one or more switches by an alias, i.e. a shorter
-- version.
function Looking_At
(It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
end if;
end if;
+ end if;
- -- If not a directory, check the relative path against the pattern
+ -- Check the relative path against the pattern
- else
- declare
- Name : String :=
- It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
- & S (1 .. Last);
- begin
- Canonical_Case_File_Name (Name);
+ -- Note that we try to match also against directory names, since
+ -- clients of this function may expect to retrieve directories.
- -- If it matches return the relative path
+ declare
+ Name : String :=
+ It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
+ & S (1 .. Last);
- if GNAT.Regexp.Match (Name, Iterator.Regexp) then
- return Name;
- end if;
- end;
- end if;
- end loop;
+ begin
+ Canonical_Case_File_Name (Name);
+
+ -- If it matches return the relative path
- return String'(1 .. 0 => ' ');
+ if GNAT.Regexp.Match (Name, Iterator.Regexp) then
+ return Name;
+ end if;
+ end;
+ end loop;
end Expansion;
-----------------
-- 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 currrent argument first character is lost.
+ -- otherwise the current argument first character is lost.
Set_Parameter
(Parser.The_Switch,
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
end if;
end Free;
- ------------------------
- -- Args_From_Expanded --
- ------------------------
-
- function Args_From_Expanded (Args : Boolean_Chars) return String is
- Result : String (1 .. Args'Length);
- Index : Natural := Result'First;
-
- begin
- for A in Args'Range loop
- if Args (A) then
- Result (Index) := A;
- Index := Index + 1;
- end if;
- end loop;
-
- return Result (1 .. Index - 1);
- end Args_From_Expanded;
-
------------------
-- Define_Alias --
------------------
Config := new Command_Line_Configuration_Record;
end if;
- Append (Config.Aliases, new String'(Switch));
- Append (Config.Expansions, new String'(Expanded));
+ Add (Config.Aliases, new String'(Switch));
+ Add (Config.Expansions, new String'(Expanded));
end Define_Alias;
-------------------
Config := new Command_Line_Configuration_Record;
end if;
- Append (Config.Prefixes, new String'(Prefix));
+ 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)
+ (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 --
----------------------
Getopt_Description : String := "";
Switch_Char : Character := '-')
is
- Tmp : Argument_List_Access;
- Parser : Opt_Parser;
- S : Character;
+ 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);
Parser => Parser);
exit when S = ASCII.NUL;
- if S = '*' then
- Add_Switch (Cmd, Full_Switch (Parser), Parameter (Parser),
- Separator (Parser));
- else
- Add_Switch
- (Cmd, Switch_Char & Full_Switch (Parser),
- Parameter (Parser), Separator (Parser));
- end if;
+ 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
- Add_Switch (Cmd, Switch_Char & Full_Switch (Parser));
+ -- 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;
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;
- Callback : Callback_Procedure)
+ (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
- -- Are we adding a switch that can in fact be expanded through aliases ?
- -- If yes, we add separately each of its expansion.
+ -- 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 further split into simple switches
+ -- be checked for a common prefix and split into simple switches.
- if Cmd.Config /= null
+ 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 then
+ if Cmd.Config.Aliases (A).all = Switch and then Parameter = "" then
For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all, Callback);
+ (Cmd, Cmd.Config.Expansions (A).all, "");
return;
end if;
end loop;
end if;
- -- Are we adding a switch grouping several switches ? If yes, add each
- -- of the simple switches instead.
+ -- If adding a switch grouping several switches, add each of the simple
+ -- switches instead.
- if Cmd.Config /= null
- and then Cmd.Config.Prefixes /= null
- then
+ 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
then
-- Alias expansion will be done recursively
- for S in Switch'First + Cmd.Config.Prefixes (P)'Length
- .. Switch'Last
- loop
- For_Each_Simple_Switch
- (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), Callback);
- end loop;
- return;
+ 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;
- Callback (Switch);
+ -- 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;
----------------
----------------
procedure Add_Switch
- (Cmd : in out Command_Line;
- Switch : String;
- Parameter : String := "";
- Separator : Character := ' ')
+ (Cmd : in out Command_Line;
+ Switch : String;
+ Parameter : String := "";
+ Separator : Character := ' ';
+ Section : String := "";
+ Add_Before : Boolean := False)
is
- procedure Add_Simple_Switch (Simple : String);
+ 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 is no more aliases in Switches
+ -- ungrouped. We know there are no more aliases in Switches.
-----------------------
-- Add_Simple_Switch --
-----------------------
- procedure Add_Simple_Switch (Simple : String) is
+ 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 Parameter = "" then
+
+ 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.Params := new Argument_List'
- (1 .. 1 => new String'(Separator & Parameter));
+ Cmd.Sections := new Argument_List'
+ (1 .. 1 => new String'(Section));
end if;
else
- -- Do we already have this switch ?
+ -- Do we already have this switch?
for C in Cmd.Expanded'Range loop
if Cmd.Expanded (C).all = Simple
and then
- ((Cmd.Params (C) = null and then Parameter = "")
- or else
- (Cmd.Params (C) /= null
- and then Cmd.Params (C).all = Separator & Parameter))
+ ((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;
- Append (Cmd.Expanded, new String'(Simple));
+ -- 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);
- if Parameter = "" then
- Append (Cmd.Params, null);
else
- Append (Cmd.Params, new String'(Separator & Parameter));
+ 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
- For_Each_Simple_Switch
- (Cmd, Switch, Add_Simple_Switch'Unrestricted_Access);
+ Success := False;
+ Add_Simple_Switches (Cmd, Switch, Parameter);
Free (Cmd.Coalesce);
end Add_Switch;
Unchecked_Free (Tmp);
end Remove;
- ------------
- -- Append --
- ------------
+ ---------
+ -- Add --
+ ---------
- procedure Append
- (Line : in out Argument_List_Access;
- Str : String_Access)
+ 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);
- Line (Tmp'Range) := Tmp.all;
+
+ 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);
+ Line := new Argument_List'(1 .. 1 => Str);
end if;
+ end Add;
+
+ -------------------
+ -- Remove_Switch --
+ -------------------
- Line (Line'Last) := Str;
- end Append;
+ 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)
+ (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);
+ 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) is
+ 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 then
+ 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;
end Remove_Simple_Switch;
+ procedure Remove_Simple_Switches is
+ new For_Each_Simple_Switch (Remove_Simple_Switch);
+
-- Start of processing for Remove_Switch
begin
- For_Each_Simple_Switch
- (Cmd, Switch, Remove_Simple_Switch'Unrestricted_Access);
+ Success := False;
+ Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
Free (Cmd.Coalesce);
end Remove_Switch;
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
- Parameter : String)
+ Parameter : String;
+ Section : String := "")
is
- procedure Remove_Simple_Switch (Simple : String);
+ 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) is
+ procedure Remove_Simple_Switch (Simple : String; Param : String) is
C : Integer;
begin
while C <= Cmd.Expanded'Last loop
if Cmd.Expanded (C).all = Simple
and then
- ((Cmd.Params (C) = null and then Parameter = "")
+ ((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
Cmd.Params (C) (Cmd.Params (C)'First + 1
.. Cmd.Params (C)'Last) =
- Parameter))
+ Param))
then
Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C);
+ Remove (Cmd.Sections, C);
-- The switch is necessarily unique by construction of
- -- Add_Switch
+ -- Add_Switch.
return;
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
- For_Each_Simple_Switch
- (Cmd, Switch, Remove_Simple_Switch'Unrestricted_Access);
+ Remove_Simple_Switches (Cmd, Switch, Parameter);
Free (Cmd.Coalesce);
end Remove_Switch;
--------------------
procedure Group_Switches
- (Cmd : Command_Line;
- Result : Argument_List_Access;
- Params : Argument_List_Access)
+ (Cmd : Command_Line;
+ Result : Argument_List_Access;
+ Sections : Argument_List_Access;
+ Params : Argument_List_Access)
is
- type Boolean_Array is array (Result'Range) of Boolean;
+ 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
- Matched : Boolean_Array;
- Count : Natural;
- First : Natural;
- From_Args : Boolean_Chars;
+ 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
end if;
for P in Cmd.Config.Prefixes'Range loop
- Matched := (others => False);
- Count := 0;
+ Group := Ada.Strings.Unbounded.Null_Unbounded_String;
+ First := 0;
for C in Result'Range loop
if Result (C) /= null
- and then Params (C) = null -- ignored if has a parameter
+ and then Compatible_Parameter (Params (C))
and then Looking_At
(Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
then
- Matched (C) := True;
- Count := Count + 1;
- end if;
- end loop;
-
- if Count > 1 then
- From_Args := (others => False);
- First := 0;
+ -- 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;
- for M in Matched'Range loop
- if Matched (M) then
if First = 0 then
- First := M;
+ First := C;
end if;
- for A in Result (M)'First + Cmd.Config.Prefixes (P)'Length
- .. Result (M)'Last
- loop
- From_Args (Result (M)(A)) := True;
- end loop;
- Free (Result (M));
+ 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 loop;
+ end if;
+ end loop;
- Result (First) := new String'
- (Cmd.Config.Prefixes (P).all & Args_From_Expanded (From_Args));
+ 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;
Found : Boolean;
First : Natural;
- procedure Check_Cb (Switch : String);
+ procedure Check_Cb (Switch : String; Param : String);
-- Comment required ???
- procedure Remove_Cb (Switch : String);
+ procedure Remove_Cb (Switch : String; Param : String);
-- Comment required ???
--------------
-- Check_Cb --
--------------
- procedure Check_Cb (Switch : String) is
+ 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 -- Ignore if has a param
+ 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;
-- Remove_Cb --
---------------
- procedure Remove_Cb (Switch : String) is
+ procedure Remove_Cb (Switch : String; Param : String) is
begin
for E in Result'Range loop
- if Result (E) /= null and then Result (E).all = Switch then
+ 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
-- then check whether the expanded command line has all of them.
Found := True;
- For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all,
- Check_Cb'Unrestricted_Access);
+ Check_All (Cmd, Cmd.Config.Expansions (A).all);
if Found then
First := Integer'Last;
- For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all,
- Remove_Cb'Unrestricted_Access);
+ 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 --
-----------
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
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
+ if Cmd.Sections (E) = null then
+ Cmd.Coalesce_Sections (E) := null;
+ else
+ Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all);
+ end if;
+ end loop;
+
+ Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
+ for E in Cmd.Params'Range loop
+ if Cmd.Params (E) = null then
+ Cmd.Coalesce_Params (E) := null;
+ else
+ Cmd.Coalesce_Params (E) := new String'(Cmd.Params (E).all);
+ end if;
+ end loop;
+
-- Not a clone, since we will not modify the parameters anyway
- Cmd.Coalesce_Params := Cmd.Params;
- Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
- Group_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
+ 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.List := Cmd.Expanded;
+ Iter.Params := Cmd.Params;
+ Iter.Sections := Cmd.Sections;
else
- Iter.List := Cmd.Coalesce;
- Iter.Params := Cmd.Coalesce_Params;
+ 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
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 --
-----------------------
Free (Config.Aliases);
Free (Config.Expansions);
Free (Config.Prefixes);
+ Free (Config.Sections);
+ Free (Config.Switches);
Unchecked_Free (Config);
end if;
end Free;
OSDN Git Service
