Skip to content

R
riscv-gcc-1
Commit b799980e by Emmanuel Briot Committed by Arnaud Charlet
Options

g-comlin.adb, [...] (Display_Help, [...]): New subprograms. 

2010-10-12  Emmanuel Briot  <briot@adacore.com>

	* g-comlin.adb, g-comlin.ads (Display_Help, Getopt, Current_Section,
	Set_Usage): New subprograms.
	(Define_Switch): Change profile to add support for help messages and
	long switches.

From-SVN: r165370
parent 83e350f7
Showing with 1401 additions and 319 deletions
gcc/ada/ChangeLog
2010-10-12 Emmanuel Briot <briot@adacore.com>
* g-comlin.adb, g-comlin.ads (Display_Help, Getopt, Current_Section,
Set_Usage): New subprograms.
(Define_Switch): Change profile to add support for help messages and
long switches.
2010-10-12 Javier Miranda <miranda@adacore.com>
* sem_ch6.adb (New_Overloaded_Entity): Add missing decoration of
......
gcc/ada/g-comlin.adb
......@@ -29,10 +29,12 @@
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Unbounded;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GNAT.Command_Line is
......@@ -112,6 +114,29 @@ package body GNAT.Command_Line is
-- Add a new element to Line. If Before is True, the item is inserted at
-- the beginning, else it is appended.
procedure Add (Config : in out Command_Line_Configuration;
Switch : Switch_Definition);
procedure Add (Def : in out Alias_Definitions_List;
Alias : Alias_Definition);
-- Add a new element to Def.
procedure Initialize_Switch_Def
(Def : out Switch_Definition;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "");
-- Initialize [Def] with the contents of the other parameters.
-- This also checks consistency of the switch parameters, and will raise
-- Invalid_Switch if they do not match.
procedure Decompose_Switch
(Switch : String;
Parameter_Type : out Switch_Parameter_Type;
Switch_Last : out Integer);
-- Given a switch definition ("name:" for instance), extracts the type of
-- parameter that is expected, and the name of the switch
function Can_Have_Parameter (S : String) return Boolean;
-- True if S can have a parameter
......@@ -122,9 +147,14 @@ package body GNAT.Command_Line is
-- Remove any possible trailing '!', ':', '?' and '='
generic
with procedure Callback (Simple_Switch : String; Parameter : String);
with procedure Callback
(Simple_Switch : String;
Separator : String;
Parameter : String;
Index : Integer); -- Index in Config.Switches, or -1
procedure For_Each_Simple_Switch
(Cmd : Command_Line;
(Config : Command_Line_Configuration;
Section : String;
Switch : String;
Parameter : String := "";
Unalias : Boolean := True);
......@@ -161,6 +191,13 @@ package body GNAT.Command_Line is
-- Return True if the characters starting at Index in Type_Str are
-- equivalent to Substring.
procedure Foreach_Switch
(Config : Command_Line_Configuration;
Callback : access function (S : String; Index : Integer) return Boolean;
Section : String);
-- Iterate over all switches defined in Config, for a specific section.
-- Index is set to the index in Config.Switches
--------------
-- Argument --
--------------
......@@ -197,7 +234,6 @@ package body GNAT.Command_Line is
---------------
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;
......@@ -286,6 +322,28 @@ package body GNAT.Command_Line is
end loop;
end Expansion;
---------------------
-- Current_Section --
---------------------
function Current_Section
(Parser : Opt_Parser := Command_Line_Parser) return String is
begin
if Parser.Current_Section = 1 then
return "";
end if;
for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
Parser.Section'Last)
loop
if Parser.Section (Index) = 0 then
return Argument (Parser, Index);
end if;
end loop;
return "";
end Current_Section;
-----------------
-- Full_Switch --
-----------------
......@@ -394,6 +452,35 @@ package body GNAT.Command_Line is
return Argument (Parser, Parser.Current_Argument - 1);
end Get_Argument;
----------------------
-- Decompose_Switch --
----------------------
procedure Decompose_Switch
(Switch : String;
Parameter_Type : out Switch_Parameter_Type;
Switch_Last : out Integer)
is
begin
case Switch (Switch'Last) is
when ':' =>
Parameter_Type := Parameter_With_Optional_Space;
Switch_Last := Switch'Last - 1;
when '=' =>
Parameter_Type := Parameter_With_Space_Or_Equal;
Switch_Last := Switch'Last - 1;
when '!' =>
Parameter_Type := Parameter_No_Space;
Switch_Last := Switch'Last - 1;
when '?' =>
Parameter_Type := Parameter_Optional;
Switch_Last := Switch'Last - 1;
when others =>
Parameter_Type := Parameter_None;
Switch_Last := Switch'Last;
end case;
end Decompose_Switch;
----------------------------------
-- Find_Longest_Matching_Switch --
----------------------------------
......@@ -407,6 +494,7 @@ package body GNAT.Command_Line is
is
Index : Natural;
Length : Natural := 1;
Last : Natural;
P : Switch_Parameter_Type;
begin
......@@ -432,37 +520,26 @@ package body GNAT.Command_Line is
Length := Length + 1;
end loop;
-- Length now marks the separator after the current switch
-- Last will mark the last character of the name of the switch
if Length = Index + 1 then
P := Parameter_None;
Last := Index;
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;
Decompose_Switch (Switches (Index .. Length - 1), P, Last);
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
if Arg'First + Last - Index <= Arg'Last
and then Switches (Index .. Last) =
Arg (Arg'First .. Arg'First + Last - Index)
and then Last - Index + 1 > Switch_Length
then
Param := P;
Index_In_Switches := Index;
Switch_Length := Length - Index;
Switch_Length := Last - Index + 1;
end if;
-- Look for the next switch in Switches
......@@ -599,8 +676,9 @@ package body GNAT.Command_Line is
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
Last => End_Index);
Last => Arg'Last);
Parser.Current_Index := End_Index + 1;
raise Invalid_Switch;
end if;
......@@ -1076,15 +1154,19 @@ package body GNAT.Command_Line is
procedure Define_Alias
(Config : in out Command_Line_Configuration;
Switch : String;
Expanded : String)
Expanded : String;
Section : String := "")
is
Def : Alias_Definition;
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));
Def.Alias := new String'(Switch);
Def.Expansion := new String'(Expanded);
Def.Section := new String'(Section);
Add (Config.Aliases, Def);
end Define_Alias;
-------------------
......@@ -1103,20 +1185,187 @@ package body GNAT.Command_Line is
Add (Config.Prefixes, new String'(Prefix));
end Define_Prefix;
---------
-- Add --
---------
procedure Add (Config : in out Command_Line_Configuration;
Switch : Switch_Definition)
is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Switch_Definitions, Switch_Definitions_List);
Tmp : Switch_Definitions_List;
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
end if;
Tmp := Config.Switches;
if Tmp = null then
Config.Switches := new Switch_Definitions (1 .. 1);
else
Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
Config.Switches (1 .. Tmp'Length) := Tmp.all;
Unchecked_Free (Tmp);
end if;
Config.Switches (Config.Switches'Last) := Switch;
end Add;
---------
-- Add --
---------
procedure Add (Def : in out Alias_Definitions_List;
Alias : Alias_Definition)
is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Alias_Definitions, Alias_Definitions_List);
Tmp : Alias_Definitions_List := Def;
begin
if Tmp = null then
Def := new Alias_Definitions (1 .. 1);
else
Def := new Alias_Definitions (1 .. Tmp'Length + 1);
Def (1 .. Tmp'Length) := Tmp.all;
Unchecked_Free (Tmp);
end if;
Def (Def'Last) := Alias;
end Add;
---------------------------
-- Initialize_Switch_Def --
---------------------------
procedure Initialize_Switch_Def
(Def : out Switch_Definition;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "")
is
P1, P2 : Switch_Parameter_Type := Parameter_None;
Last1, Last2 : Integer;
begin
if Switch /= "" then
Def.Switch := new String'(Switch);
Decompose_Switch (Switch, P1, Last1);
end if;
if Long_Switch /= "" then
Def.Long_Switch := new String'(Long_Switch);
Decompose_Switch (Long_Switch, P2, Last2);
end if;
if Switch /= "" and then Long_Switch /= "" then
if (P1 = Parameter_None and then P2 /= P1)
or else (P2 = Parameter_None and then P1 /= P2)
or else (P1 = Parameter_Optional and then P2 /= P1)
or else (P2 = Parameter_Optional and then P2 /= P1)
then
raise Invalid_Switch
with "Inconsistent parameter types for "
& Switch & " and " & Long_Switch;
end if;
end if;
if Section /= "" then
Def.Section := new String'(Section);
end if;
if Help /= "" then
Def.Help := new String'(Help);
end if;
end Initialize_Switch_Def;
-------------------
-- Define_Switch --
-------------------
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Switch : String)
(Config : in out Command_Line_Configuration;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "")
is
Def : Switch_Definition;
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
Add (Config, Def);
end if;
end Define_Switch;
Add (Config.Switches, new String'(Switch));
-------------------
-- Define_Switch --
-------------------
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Output : access Boolean;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "";
Value : Boolean := True)
is
Def : Switch_Definition (Switch_Boolean);
begin
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
Def.Boolean_Output := Output.all'Unchecked_Access;
Def.Boolean_Value := Value;
Add (Config, Def);
end if;
end Define_Switch;
-------------------
-- Define_Switch --
-------------------
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Output : access Integer;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "";
Initial : Integer := 0;
Default : Integer := 1)
is
Def : Switch_Definition (Switch_Integer);
begin
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
Def.Integer_Output := Output.all'Unchecked_Access;
Def.Integer_Default := Default;
Def.Integer_Initial := Initial;
Add (Config, Def);
end if;
end Define_Switch;
-------------------
-- Define_Switch --
-------------------
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Output : access GNAT.Strings.String_Access;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "")
is
Def : Switch_Definition (Switch_String);
begin
if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
Def.String_Output := Output.all'Unchecked_Access;
Add (Config, Def);
end if;
end Define_Switch;
--------------------
......@@ -1135,37 +1384,98 @@ package body GNAT.Command_Line is
Add (Config.Sections, new String'(Section));
end Define_Section;
--------------------
-- Foreach_Switch --
--------------------
procedure Foreach_Switch
(Config : Command_Line_Configuration;
Callback : access function (S : String; Index : Integer) return Boolean;
Section : String)
is
begin
if Config /= null and then Config.Switches /= null then
for J in Config.Switches'Range loop
if (Section = "" and then Config.Switches (J).Section = null)
or else
(Config.Switches (J).Section /= null
and then Config.Switches (J).Section.all = Section)
then
exit when Config.Switches (J).Switch /= null
and then not Callback (Config.Switches (J).Switch.all, J);
exit when Config.Switches (J).Long_Switch /= null
and then
not Callback (Config.Switches (J).Long_Switch.all, J);
end if;
end loop;
end if;
end Foreach_Switch;
------------------
-- Get_Switches --
------------------
function Get_Switches
(Config : Command_Line_Configuration;
Switch_Char : Character)
return String
Section : String := "";
Switch_Char : Character := '-') return String
is
Ret : Ada.Strings.Unbounded.Unbounded_String;
use type Ada.Strings.Unbounded.Unbounded_String;
use Ada.Strings.Unbounded;
begin
if Config = null or else Config.Switches = null then
return "";
end if;
function Add_Switch (S : String; Index : Integer) return Boolean;
-- Add a switch to Ret
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);
function Add_Switch (S : String; Index : Integer) return Boolean is
pragma Unreferenced (Index);
begin
if S = "*" then
Ret := "*" & Ret; -- Always first
elsif S (S'First) = Switch_Char then
Append (Ret, " " & S (S'First + 1 .. S'Last));
else
Ret := Ret & " " & Config.Switches (J).all;
Append (Ret, " " & S);
end if;
end loop;
return True;
end Add_Switch;
Tmp : Boolean;
pragma Unreferenced (Tmp);
begin
Foreach_Switch (Config, Add_Switch'Access, Section => Section);
return Ada.Strings.Unbounded.To_String (Ret);
-- Adding relevant aliases
if Config.Aliases /= null then
for A in Config.Aliases'Range loop
if Config.Aliases (A).Section.all = Section then
Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
end if;
end loop;
end if;
return To_String (Ret);
end Get_Switches;
------------------------
-- Section_Delimiters --
------------------------
function Section_Delimiters
(Config : Command_Line_Configuration) return String
is
use Ada.Strings.Unbounded;
Result : Unbounded_String;
begin
if Config /= null and then Config.Sections /= null then
for S in Config.Sections'Range loop
Append (Result, " " & Config.Sections (S).all);
end loop;
end if;
return To_String (Result);
end Section_Delimiters;
-----------------------
-- Set_Configuration --
-----------------------
......@@ -1275,24 +1585,17 @@ package body GNAT.Command_Line is
-- Add_Switch if -gnaty3 is actually provided.
if Separator (Parser) = ASCII.NUL then
Add_Switch
(Cmd, Sw & Parameter (Parser), "", ASCII.NUL);
Add_Switch (Cmd, Sw & Parameter (Parser), "");
else
Add_Switch
(Cmd, Sw, Parameter (Parser), Separator (Parser));
Add_Switch (Cmd, Sw, Parameter (Parser));
end if;
else
if Separator (Parser) = ASCII.NUL then
Add_Switch
(Cmd, Sw & Parameter (Parser), "",
Separator (Parser),
Section.all);
(Cmd, Sw & Parameter (Parser), "", Section.all);
else
Add_Switch
(Cmd, Sw,
Parameter (Parser),
Separator (Parser),
Section.all);
(Cmd, Sw, Parameter (Parser), Section.all);
end if;
end if;
end if;
......@@ -1310,12 +1613,10 @@ package body GNAT.Command_Line is
if Section = null then
Add_Switch
(Cmd, Switch_Char & Full_Switch (Parser),
Separator => Separator (Parser));
(Cmd, Switch_Char & Full_Switch (Parser));
else
Add_Switch
(Cmd, Switch_Char & Full_Switch (Parser),
Separator => Separator (Parser),
Section => Section.all);
end if;
end;
......@@ -1397,7 +1698,8 @@ package body GNAT.Command_Line is
----------------------------
procedure For_Each_Simple_Switch
(Cmd : Command_Line;
(Config : Command_Line_Configuration;
Section : String;
Switch : String;
Parameter : String := "";
Unalias : Boolean := True)
......@@ -1407,6 +1709,17 @@ package body GNAT.Command_Line is
Group : String) return Boolean;
-- Perform the analysis of a group of switches
Found_In_Config : Boolean := False;
function Is_In_Config
(Config_Switch : String; Index : Integer) return Boolean;
-- If Switch is the same as Config_Switch, run the callback and sets
-- Found_In_Config to True
function Starts_With
(Config_Switch : String; Index : Integer) return Boolean;
-- if Switch starts with Config_Switch, sets Found_In_Config to True.
-- The return value is for the Foreach_Switch iterator
--------------------
-- Group_Analysis --
--------------------
......@@ -1418,88 +1731,95 @@ package body GNAT.Command_Line is
Idx : Natural;
Found : Boolean;
begin
Idx := Group'First;
while Idx <= Group'Last loop
Found := False;
function Analyze_Simple_Switch
(Switch : String; Index : Integer) return Boolean;
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;
function Analyze_Simple_Switch
(Switch : String; Index : Integer) return Boolean
is
pragma Unreferenced (Index);
begin
if Sw'Length >= Prefix'Length
Full : constant String := Prefix & Group (Idx .. Group'Last);
Sw : constant String := Actual_Switch (Switch);
Last : Natural;
Param : Natural;
-- Verify that sw starts with Prefix
begin
if Sw'Length >= Prefix'Length
and then Looking_At (Sw, Sw'First, Prefix)
-- Verify that sw starts with Prefix
-- Verify that the group starts with sw
and then Looking_At (Sw, Sw'First, Prefix)
and then Looking_At (Full, Full'First, Sw)
then
Last := Idx + Sw'Length - Prefix'Length - 1;
Param := Last + 1;
-- Verify that the group starts with sw
if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
and then Looking_At (Full, Full'First, Sw)
then
Last := Idx + Sw'Length - Prefix'Length - 1;
Param := Last + 1;
-- Include potential parameter to the recursive call.
-- Only numbers are allowed.
if Can_Have_Parameter (Switch) then
while Last < Group'Last
and then Group (Last + 1) in '0' .. '9'
loop
Last := Last + 1;
end loop;
end if;
-- Include potential parameter to the recursive call.
-- Only numbers are allowed.
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;
while Last < Group'Last
and then Group (Last + 1) in '0' .. '9'
loop
Last := Last + 1;
end loop;
end if;
Found := True;
if not Require_Parameter (Switch)
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.
-- Recursive call, using the detected parameter if any
-- 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.
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;
return False;
end if;
Idx := Last + 1;
exit;
end if;
Found := True;
-- Recursive call, using the detected parameter if any
if Last >= Param then
For_Each_Simple_Switch
(Config,
Section,
Prefix & Group (Idx .. Param - 1),
Group (Param .. Last));
else
For_Each_Simple_Switch
(Config, Section, Prefix & Group (Idx .. Last), "");
end if;
end;
end loop;
Idx := Last + 1;
return False;
end if;
end if;
return True;
end Analyze_Simple_Switch;
begin
Idx := Group'First;
while Idx <= Group'Last loop
Found := False;
Foreach_Switch (Config, Analyze_Simple_Switch'Access, Section);
if not Found then
For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
For_Each_Simple_Switch
(Config, Section, Prefix & Group (Idx), "");
Idx := Idx + 1;
end if;
end loop;
......@@ -1507,28 +1827,114 @@ package body GNAT.Command_Line is
return True;
end Group_Analysis;
------------------
-- Is_In_Config --
------------------
function Is_In_Config
(Config_Switch : String; Index : Integer) return Boolean
is
Last : Natural;
P : Switch_Parameter_Type;
begin
Decompose_Switch (Config_Switch, P, Last);
if Config_Switch (Config_Switch'First .. Last) = Switch then
case P is
when Parameter_None =>
if Parameter = "" then
Callback (Switch, "", "", Index => Index);
Found_In_Config := True;
return False;
end if;
when Parameter_With_Optional_Space
| Parameter_With_Space_Or_Equal =>
if Parameter /= "" then
Callback (Switch, " ", Parameter, Index => Index);
Found_In_Config := True;
return False;
end if;
when Parameter_No_Space =>
if Parameter /= "" then
Callback (Switch, "", Parameter, Index);
Found_In_Config := True;
return False;
end if;
when Parameter_Optional =>
Callback (Switch, "", Parameter, Index);
Found_In_Config := True;
return False;
end case;
end if;
return True;
end Is_In_Config;
-----------------
-- Starts_With --
-----------------
function Starts_With
(Config_Switch : String; Index : Integer) return Boolean
is
Last : Natural;
Param : Natural;
P : Switch_Parameter_Type;
begin
-- This function is called when we believe the parameter was
-- specified as part of the switch, instead of separately. Thus we
-- look in the config to find all possible switches.
Decompose_Switch (Config_Switch, P, Last);
if Looking_At
(Switch, Switch'First, Config_Switch (Config_Switch'First .. Last))
then
Param := Switch'First + Last; -- First char of parameter
Last := Switch'First + Last - Config_Switch'First;
-- last char of Switch
case P is
when Parameter_None =>
null; -- Already handled in Is_In_Config
when Parameter_With_Space_Or_Equal =>
if Switch (Param) = ' '
or else Switch (Param) = '='
then
Callback (Switch (Switch'First .. Last),
"=", Switch (Param + 1 .. Switch'Last), Index);
Found_In_Config := True;
return False;
end if;
when Parameter_With_Optional_Space =>
if Switch (Param) = ' ' then
Param := Param + 1;
end if;
Callback (Switch (Switch'First .. Last),
" ", Switch (Param .. Switch'Last), Index);
Found_In_Config := True;
return False;
when Parameter_No_Space | Parameter_Optional =>
Callback (Switch (Switch'First .. Last),
"", Switch (Param .. Switch'Last), Index);
Found_In_Config := True;
return False;
end case;
end if;
return True;
end Starts_With;
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;
Foreach_Switch (Config, Is_In_Config'Access, Section);
if Found_In_Config then
return;
end if;
-- If adding a switch that can in fact be expanded through aliases,
......@@ -1540,13 +1946,16 @@ package body GNAT.Command_Line is
-- be checked for a common prefix and split into simple switches.
if Unalias
and then Cmd.Config /= null
and then Cmd.Config.Aliases /= null
and then Config /= null
and then Config.Aliases /= null
then
for A in Cmd.Config.Aliases'Range loop
if Cmd.Config.Aliases (A).all = Switch and then Parameter = "" then
for A in Config.Aliases'Range loop
if Config.Aliases (A).Section.all = Section
and then Config.Aliases (A).Alias.all = Switch
and then Parameter = ""
then
For_Each_Simple_Switch
(Cmd, Cmd.Config.Expansions (A).all, "");
(Config, Section, Config.Aliases (A).Expansion.all, "");
return;
end if;
end loop;
......@@ -1555,33 +1964,32 @@ package body GNAT.Command_Line is
-- 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
if Config /= null and then Config.Prefixes /= null then
for P in Config.Prefixes'Range loop
if Switch'Length > Config.Prefixes (P)'Length + 1
and then Looking_At
(Switch, Switch'First, Cmd.Config.Prefixes (P).all)
(Switch, Switch'First, 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
if Config.Switches = null then
for S in Switch'First + Config.Prefixes (P)'Length
.. Switch'Last
loop
For_Each_Simple_Switch
(Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
(Config, Section,
Config.Prefixes (P).all & Switch (S), "");
end loop;
return;
elsif Group_Analysis
(Cmd.Config.Prefixes (P).all,
(Config.Prefixes (P).all,
Switch
(Switch'First + Cmd.Config.Prefixes (P)'Length
.. Switch'Last))
(Switch'First + 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;
......@@ -1589,52 +1997,24 @@ package body GNAT.Command_Line is
end if;
-- Test if added switch is a known switch with parameter attached
-- instead of being specified separately
if Parameter = ""
and then Cmd.Config /= null
and then Cmd.Config.Switches /= null
and then Config /= null
and then 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;
Found_In_Config := False;
Foreach_Switch (Config, Starts_With'Access, Section);
if Found_In_Config then
return;
end if;
end if;
Callback (Switch, Parameter);
-- The switch is invalid in the config, but we still want to report it.
-- The config could, for instance, include "*" to specify it accepts
-- all switches.
Callback (Switch, " ", Parameter, Index => -1);
end For_Each_Simple_Switch;
----------------
......@@ -1645,7 +2025,6 @@ package body GNAT.Command_Line is
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False)
is
......@@ -1653,7 +2032,7 @@ package body GNAT.Command_Line is
pragma Unreferenced (Success);
begin
Add_Switch
(Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
(Cmd, Switch, Parameter, Section, Add_Before, Success);
end Add_Switch;
----------------
......@@ -1664,12 +2043,12 @@ package body GNAT.Command_Line is
(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);
procedure Add_Simple_Switch
(Simple, Separator, Param : String; Index : Integer);
-- Add a new switch that has had all its aliases expanded, and switches
-- ungrouped. We know there are no more aliases in Switches.
......@@ -1677,7 +2056,10 @@ package body GNAT.Command_Line is
-- Add_Simple_Switch --
-----------------------
procedure Add_Simple_Switch (Simple : String; Param : String) is
procedure Add_Simple_Switch
(Simple, Separator, Param : String; Index : Integer)
is
pragma Unreferenced (Index);
begin
if Cmd.Expanded = null then
Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
......@@ -1751,7 +2133,7 @@ package body GNAT.Command_Line is
end Add_Simple_Switch;
procedure Add_Simple_Switches is
new For_Each_Simple_Switch (Add_Simple_Switch);
new For_Each_Simple_Switch (Add_Simple_Switch);
-- Start of processing for Add_Switch
......@@ -1771,7 +2153,7 @@ package body GNAT.Command_Line is
end if;
Success := False;
Add_Simple_Switches (Cmd, Switch, Parameter);
Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
Free (Cmd.Coalesce);
end Add_Switch;
......@@ -1857,16 +2239,19 @@ package body GNAT.Command_Line is
Section : String := "";
Success : out Boolean)
is
procedure Remove_Simple_Switch (Simple : String; Param : String);
procedure Remove_Simple_Switch
(Simple, Separator, Param : String; Index : Integer);
-- Removes a simple switch, with no aliasing or grouping
--------------------------
-- Remove_Simple_Switch --
--------------------------
procedure Remove_Simple_Switch (Simple : String; Param : String) is
procedure Remove_Simple_Switch
(Simple, Separator, Param : String; Index : Integer)
is
C : Integer;
pragma Unreferenced (Param);
pragma Unreferenced (Param, Separator, Index);
begin
if Cmd.Expanded /= null then
......@@ -1904,7 +2289,8 @@ package body GNAT.Command_Line is
begin
Success := False;
Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
Remove_Simple_Switches
(Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
Free (Cmd.Coalesce);
end Remove_Switch;
......@@ -1918,14 +2304,18 @@ package body GNAT.Command_Line is
Parameter : String;
Section : String := "")
is
procedure Remove_Simple_Switch (Simple : String; Param : String);
procedure Remove_Simple_Switch
(Simple, Separator, Param : String; Index : Integer);
-- Removes a simple switch, with no aliasing or grouping
--------------------------
-- Remove_Simple_Switch --
--------------------------
procedure Remove_Simple_Switch (Simple : String; Param : String) is
procedure Remove_Simple_Switch
(Simple, Separator, Param : String; Index : Integer)
is
pragma Unreferenced (Separator, Index);
C : Integer;
begin
......@@ -1968,12 +2358,12 @@ package body GNAT.Command_Line is
end Remove_Simple_Switch;
procedure Remove_Simple_Switches is
new For_Each_Simple_Switch (Remove_Simple_Switch);
new For_Each_Simple_Switch (Remove_Simple_Switch);
-- Start of processing for Remove_Switch
begin
Remove_Simple_Switches (Cmd, Switch, Parameter);
Remove_Simple_Switches (Cmd.Config, Switch, Parameter);
Free (Cmd.Coalesce);
end Remove_Switch;
......@@ -2113,17 +2503,24 @@ package body GNAT.Command_Line is
Found : Boolean;
First : Natural;
procedure Check_Cb (Switch : String; Param : String);
-- Comment required ???
procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
-- Checks whether the command line contains [Switch].
-- Sets the global variable [Found] appropriately.
-- This will be called for each simple switch that make up an alias, to
-- know whether the alias should be applied.
procedure Remove_Cb (Switch : String; Param : String);
-- Comment required ???
procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
-- Remove the simple switch [Switch] from the command line, since it is
-- part of a simpler alias
--------------
-- Check_Cb --
--------------
procedure Check_Cb (Switch : String; Param : String) is
procedure Check_Cb
(Switch, Separator, Param : String; Index : Integer)
is
pragma Unreferenced (Separator, Index);
begin
if Found then
for E in Result'Range loop
......@@ -2146,7 +2543,9 @@ package body GNAT.Command_Line is
-- Remove_Cb --
---------------
procedure Remove_Cb (Switch : String; Param : String) is
procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
is
pragma Unreferenced (Separator, Index);
begin
for E in Result'Range loop
if Result (E) /= null
......@@ -2185,12 +2584,16 @@ package body GNAT.Command_Line is
-- then check whether the expanded command line has all of them.
Found := True;
Check_All (Cmd, Cmd.Config.Expansions (A).all);
Check_All (Cmd.Config,
Switch => Cmd.Config.Aliases (A).Expansion.all,
Section => Cmd.Config.Aliases (A).Section.all);
if Found then
First := Integer'Last;
Remove_All (Cmd, Cmd.Config.Expansions (A).all);
Result (First) := new String'(Cmd.Config.Aliases (A).all);
Remove_All (Cmd.Config,
Switch => Cmd.Config.Aliases (A).Expansion.all,
Section => Cmd.Config.Aliases (A).Section.all);
Result (First) := new String'(Cmd.Config.Aliases (A).Alias.all);
end if;
end loop;
end Alias_Switches;
......@@ -2257,6 +2660,8 @@ package body GNAT.Command_Line is
end if;
end loop;
end loop;
Unchecked_Free (Sections_List);
end Sort_Sections;
-----------
......@@ -2288,6 +2693,7 @@ package body GNAT.Command_Line is
Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
end loop;
Free (Cmd.Coalesce_Sections);
Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
for E in Cmd.Sections'Range loop
Cmd.Coalesce_Sections (E) :=
......@@ -2295,6 +2701,7 @@ package body GNAT.Command_Line is
else new String'(Cmd.Sections (E).all));
end loop;
Free (Cmd.Coalesce_Params);
Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
for E in Cmd.Params'Range loop
Cmd.Coalesce_Params (E) :=
......@@ -2453,13 +2860,37 @@ package body GNAT.Command_Line is
----------
procedure Free (Config : in out Command_Line_Configuration) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Switch_Definitions, Switch_Definitions_List);
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Alias_Definitions, Alias_Definitions_List);
begin
if Config /= null then
Free (Config.Aliases);
Free (Config.Expansions);
Free (Config.Prefixes);
Free (Config.Sections);
Free (Config.Switches);
Free (Config.Usage);
Free (Config.Help);
if Config.Aliases /= null then
for A in Config.Aliases'Range loop
Free (Config.Aliases (A).Alias);
Free (Config.Aliases (A).Expansion);
Free (Config.Aliases (A).Section);
end loop;
Unchecked_Free (Config.Aliases);
end if;
if Config.Switches /= null then
for S in Config.Switches'Range loop
Free (Config.Switches (S).Switch);
Free (Config.Switches (S).Long_Switch);
Free (Config.Switches (S).Help);
Free (Config.Switches (S).Section);
end loop;
Unchecked_Free (Config.Switches);
end if;
Unchecked_Free (Config);
end if;
end Free;
......@@ -2472,7 +2903,429 @@ package body GNAT.Command_Line is
begin
Free (Cmd.Expanded);
Free (Cmd.Coalesce);
Free (Cmd.Coalesce_Sections);
Free (Cmd.Coalesce_Params);
Free (Cmd.Params);
Free (Cmd.Sections);
end Free;
---------------
-- Set_Usage --
---------------
procedure Set_Usage
(Config : in out Command_Line_Configuration;
Usage : String := "[switches] [arguments]";
Help : String := "")
is
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
end if;
Free (Config.Usage);
Config.Usage := new String'(Usage);
Config.Help := new String'(Help);
end Set_Usage;
------------------
-- Display_Help --
------------------
procedure Display_Help (Config : Command_Line_Configuration) is
function Switch_Name
(Def : Switch_Definition; Section : String) return String;
-- Return the "-short, --long=ARG" string for Def.
-- Returns "" if the switch is not in the section
function Param_Name
(P : Switch_Parameter_Type; Name : String := "ARG") return String;
-- Return the display for a switch parameter
procedure Display_Section_Help (Section : String);
-- Display the help for a specific section ("" is the default section)
function Param_Name
(P : Switch_Parameter_Type; Name : String := "ARG") return String is
begin
case P is
when Parameter_None =>
return "";
when Parameter_With_Optional_Space =>
return " " & To_Upper (Name);
when Parameter_With_Space_Or_Equal =>
return "=" & To_Upper (Name);
when Parameter_No_Space =>
return To_Upper (Name);
when Parameter_Optional =>
return '[' & To_Upper (Name) & ']';
end case;
end Param_Name;
function Switch_Name
(Def : Switch_Definition; Section : String) return String
is
use Ada.Strings.Unbounded;
Result : Unbounded_String;
P1, P2 : Switch_Parameter_Type;
Last1, Last2 : Integer := 0;
begin
if (Section = "" and then Def.Section = null)
or else (Def.Section /= null and then Def.Section.all = Section)
then
if Def.Switch /= null
and then Def.Switch.all = "*"
then
return "[any switch]";
end if;
if Def.Switch /= null then
Decompose_Switch (Def.Switch.all, P1, Last1);
Append (Result, Def.Switch (Def.Switch'First .. Last1));
if Def.Long_Switch /= null then
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result, ", "
& Def.Long_Switch (Def.Long_Switch'First .. Last2));
Append (Result, Param_Name (P2, "ARG"));
else
Append (Result, Param_Name (P1, "ARG"));
end if;
else -- Long_Switch necessarily not null
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result,
Def.Long_Switch (Def.Long_Switch'First .. Last2));
Append (Result, Param_Name (P2, "ARG"));
end if;
end if;
return To_String (Result);
end Switch_Name;
procedure Display_Section_Help (Section : String) is
Max_Len : Natural := 0;
begin
-- ??? Special display for "*"
New_Line;
if Section /= "" then
Put_Line ("Switches after " & Section);
end if;
-- Compute size of the switches column
for S in Config.Switches'Range loop
Max_Len := Natural'Max
(Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
end loop;
if Config.Aliases /= null then
for A in Config.Aliases'Range loop
if Config.Aliases (A).Section.all = Section then
Max_Len := Natural'Max
(Max_Len, Config.Aliases (A).Alias'Length);
end if;
end loop;
end if;
-- Display the switches
for S in Config.Switches'Range loop
declare
N : constant String :=
Switch_Name (Config.Switches (S), Section);
begin
if N /= "" then
Put (" ");
Put (N);
Put ((1 .. Max_Len - N'Length + 1 => ' '));
if Config.Switches (S).Help /= null then
Put (Config.Switches (S).Help.all);
end if;
New_Line;
end if;
end;
end loop;
-- Display the aliases
if Config.Aliases /= null then
for A in Config.Aliases'Range loop
if Config.Aliases (A).Section.all = Section then
Put (" ");
Put (Config.Aliases (A).Alias.all);
Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
=> ' '));
Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
New_Line;
end if;
end loop;
end if;
end Display_Section_Help;
begin
if Config = null then
return;
end if;
if Config.Usage /= null then
Put_Line ("Usage: "
& Base_Name
(Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
else
Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
& " [switches] [arguments]");
end if;
if Config.Help /= null and then Config.Help.all /= "" then
Put_Line (Config.Help.all);
end if;
Display_Section_Help ("");
if Config.Sections /= null and then Config.Switches /= null then
for S in Config.Sections'Range loop
Display_Section_Help (Config.Sections (S).all);
end loop;
end if;
end Display_Help;
------------
-- Getopt --
------------
procedure Getopt
(Config : Command_Line_Configuration;
Callback : Switch_Handler := null;
Parser : Opt_Parser := Command_Line_Parser)
is
Getopt_Switches : String_Access;
C : Character := ASCII.NUL;
Empty_Name : aliased constant String := "";
Current_Section : Integer := -1;
Section_Name : not null access constant String := Empty_Name'Access;
procedure Simple_Callback
(Simple_Switch, Separator, Parameter : String; Index : Integer);
procedure Do_Callback (Switch, Parameter : String; Index : Integer);
procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
begin
-- Do automatic handling when possible
if Index /= -1 then
case Config.Switches (Index).Typ is
when Switch_Untyped =>
null; -- no automatic handling
when Switch_Boolean =>
Config.Switches (Index).Boolean_Output.all :=
Config.Switches (Index).Boolean_Value;
return;
when Switch_Integer =>
begin
if Parameter = "" then
Config.Switches (Index).Integer_Output.all :=
Config.Switches (Index).Integer_Default;
else
Config.Switches (Index).Integer_Output.all :=
Integer'Value (Parameter);
end if;
exception
when Constraint_Error =>
raise Invalid_Parameter
with "Expected integer parameter for '"
& Switch & "'";
end;
when Switch_String =>
Free (Config.Switches (Index).String_Output.all);
Config.Switches (Index).String_Output.all :=
new String'(Parameter);
end case;
end if;
-- Otherwise calls the user callback if one was defined
if Callback /= null then
Callback (Switch => Switch,
Parameter => Parameter,
Section => Section_Name.all);
end if;
end Do_Callback;
procedure Simple_Callback
(Simple_Switch, Separator, Parameter : String; Index : Integer)
is
pragma Unreferenced (Separator);
begin
Do_Callback (Switch => Simple_Switch,
Parameter => Parameter,
Index => Index);
end Simple_Callback;
procedure For_Each_Simple
is new For_Each_Simple_Switch (Simple_Callback);
begin
-- Initialize sections
if Config.Sections = null then
Config.Sections := new Argument_List'(1 .. 0 => null);
end if;
Internal_Initialize_Option_Scan
(Parser => Parser,
Switch_Char => Parser.Switch_Character,
Stop_At_First_Non_Switch => Parser.Stop_At_First,
Section_Delimiters => Section_Delimiters (Config));
Getopt_Switches := new String'
(Get_Switches (Config, Section_Name.all, Parser.Switch_Character)
& " h -help");
-- Initialize output values for automatically handled switches
for S in Config.Switches'Range loop
case Config.Switches (S).Typ is
when Switch_Untyped =>
null; -- Nothing to do
when Switch_Boolean =>
Config.Switches (S).Boolean_Output.all :=
not Config.Switches (S).Boolean_Value;
when Switch_Integer =>
Config.Switches (S).Integer_Output.all :=
Config.Switches (S).Integer_Initial;
when Switch_String =>
Config.Switches (S).String_Output.all := new String'("");
end case;
end loop;
-- For all sections, and all switches within those sections
loop
C := Getopt (Switches => Getopt_Switches.all,
Concatenate => True,
Parser => Parser);
if C = '*' then
-- Full_Switch already includes the leading '-'
Do_Callback (Switch => Full_Switch (Parser),
Parameter => Parameter (Parser),
Index => -1);
elsif C /= ASCII.NUL then
if Full_Switch (Parser) = "h"
or else Full_Switch (Parser) = "-help"
then
Display_Help (Config);
raise Exit_From_Command_Line;
end if;
-- Do switch expansion if needed
For_Each_Simple
(Config,
Section => Section_Name.all,
Switch => Parser.Switch_Character & Full_Switch (Parser),
Parameter => Parameter (Parser));
else
if Current_Section = -1 then
Current_Section := Config.Sections'First;
else
Current_Section := Current_Section + 1;
end if;
exit when Current_Section > Config.Sections'Last;
Section_Name := Config.Sections (Current_Section);
Goto_Section (Section_Name.all, Parser);
Free (Getopt_Switches);
Getopt_Switches := new String'
(Get_Switches
(Config, Section_Name.all, Parser.Switch_Character));
end if;
end loop;
Free (Getopt_Switches);
exception
when Invalid_Switch =>
Free (Getopt_Switches);
-- Message inspired by "ls" on Unix
Put_Line (Standard_Error,
Base_Name (Ada.Command_Line.Command_Name)
& ": unrecognized option '"
& Parser.Switch_Character & Full_Switch (Parser)
& "'");
Put_Line (Standard_Error,
"Try `"
& Base_Name (Ada.Command_Line.Command_Name)
& " --help` for more information.");
raise;
when others =>
Free (Getopt_Switches);
raise;
end Getopt;
-----------
-- Build --
-----------
procedure Build
(Line : in out Command_Line;
Args : out GNAT.OS_Lib.Argument_List_Access;
Expanded : Boolean := False;
Switch_Char : Character := '-')
is
Iter : Command_Line_Iterator;
Count : Natural := 0;
begin
Start (Line, Iter, Expanded => Expanded);
while Has_More (Iter) loop
if Is_New_Section (Iter) then
Count := Count + 1;
end if;
Count := Count + 1;
Next (Iter);
end loop;
Args := new Argument_List (1 .. Count);
Count := Args'First;
Start (Line, Iter, Expanded => Expanded);
while Has_More (Iter) loop
if Is_New_Section (Iter) then
Args (Count) := new String'
(Switch_Char & Current_Section (Iter));
Count := Count + 1;
end if;
Args (Count) := new String'(Current_Switch (Iter)
& Current_Separator (Iter)
& Current_Parameter (Iter));
Count := Count + 1;
Next (Iter);
end loop;
end Build;
end GNAT.Command_Line;
gcc/ada/g-comlin.ads
......@@ -42,12 +42,15 @@
-- As shown in the example below, one should first retrieve the switches
-- (special command line arguments starting with '-' by default) and their
-- parameters, and then the rest of the command line arguments.
-- This package is flexible enough to accommodate various needs: optional
-- switch parameters, various characters to separate a switch and its
-- parameter, whether to stop the parsing at the first non-switch argument
-- encountered, etc.
--
-- While it may appear easy to parse the command line arguments with
-- Ada.Command_Line, there are in fact lots of special cases to handle in some
-- applications. Those are fully managed by GNAT.Command_Line. Among these are
-- switches with optional parameters, grouping switches (for instance "-ab"
-- might mean the same as "-a -b"), various characters to separate a switch
-- and its parameter (or none: "-a 1" and "-a1" are generally the same, which
-- can introduce confusion with grouped switches),...
--
-- begin
-- loop
-- case Getopt ("a b: ad") is -- Accepts '-a', '-ad', or '-b argument'
......@@ -60,8 +63,7 @@
-- Put_Line ("Got ad");
-- end if;
-- when 'b' =>
-- Put_Line ("Got b + " & Parameter);
-- when 'b' => Put_Line ("Got b + " & Parameter);
-- when others =>
-- raise Program_Error; -- cannot occur!
......@@ -143,17 +145,13 @@
-- end;
----------------------------------------------
-- Creating and manipulating the command line
-- High level command line configuration
----------------------------------------------
-- This package provides mechanisms to create and modify command lines by
-- adding or removing arguments from them. The resulting command line is kept
-- as short as possible by coalescing arguments whenever possible.
-- Complex command lines can thus be constructed, for example from a GUI
-- (although this package does not by itself depend upon any specific GUI
-- toolkit). For instance, if you are configuring the command line to use when
-- spawning a tool with the following characteristics:
-- As shown above, the code is still relatively low-level. For instance, there
-- is no way to indicate which switches are related (thus if "-l" and "--long"
-- should have the same effect, your code will need to test for both cases).
-- Likewise, it is difficult to handle more advanced constructs, like:
-- * Specifying -gnatwa is the same as specifying -gnatwu -gnatwv, but
-- shorter and more readable
......@@ -163,23 +161,81 @@
-- Of course, this can be combined with the above and -gnatwacd is the
-- same as -gnatwc -gnatwd -gnatwu -gnatwv
-- * The switch -T is the same as -gnatwAB
-- * The switch -T is the same as -gnatwAB (same as -gnatwA -gnatwB)
-- * A switch -foo takes one mandatory parameter
-- With the above form of Getopt, you would receive "-gnatwa", "-T" or
-- "-gnatwcd" in the examples above, and thus you require additional manual
-- parsing of the switch.
-- These properties can be configured through this package with the following
-- calls:
-- Instead, this package provides the type Command_Line_Configuration, which
-- stores all the knowledge above. For instance:
-- Config : Command_Line_Configuration;
-- Define_Alias (Config, "-gnatwa", "-gnatwu -gnatwv");
-- Define_Prefix (Config, "-gnatw");
-- Define_Alias (Config, "-gnatwa", "-gnatwuv");
-- Define_Alias (Config, "-T", "-gnatwAB");
-- Using this configuration, one can then construct a command line for the
-- tool with:
-- You then need to specify all possible switches in your application by
-- calling Define_Switch, for instance:
-- Define_Switch (Config, "-gnatwu", Help => "warn on unused entities");
-- Define_Switch (Config, "-gnatwv", Help => "warn on unassigned var");
-- ...
-- Specifying the help message is optional, but makes it easy to then call
-- the function
-- Display_Help (Config);
-- that will display a properly formatted help message for your application,
-- listing all possible switches. That way you have a single place in which
-- to maintain the list of switches and their meaning, rather than maintaing
-- both the string to pass to Getopt and a subprogram to display the help.
-- Both will properly stay synchronized.
-- Once you have this Config, you just have to call
-- Getopt (Config, Callback'Access);
-- to parse the command line. The Callback will be called for each switch
-- found on the command line (in the case of our example, that is "-gnatwu"
-- and then "-gnatwv", not "-gnatwa" itself). This simplifies command line
-- parsing a lot.
-- In fact, this can be further automated for the most command case where the
-- parameter passed to a switch is stored in a variable in the application.
-- When a switch is defined, you only have to indicate where to store the
-- value, and let Getopt do the rest. For instance:
-- Optimization : aliased Integer;
-- Verbose : aliased Boolean;
--
-- Define_Switch (Config, Verbose'Access,
-- "-v", Long_Switch => "--verbose",
-- Help => "Output extra verbose information");
-- Define_Switch (Config, Optimization'Access,
-- "-O?", Help => "Optimization level");
--
-- Getopt (Config); -- No callback
-- Since all switches are handled automatically, we don't even need to pass
-- a callback to Getopt. Once getopt has been called, the two variables
-- Optimization and Verbose have been properly initialized, either to the
-- default value or to the value found on the command line.
----------------------------------------------
-- Creating and manipulating the command line
----------------------------------------------
-- This package provides mechanisms to create and modify command lines by
-- adding or removing arguments from them. The resulting command line is kept
-- as short as possible by coalescing arguments whenever possible.
-- Complex command lines can thus be constructed, for example from a GUI
-- (although this package does not by itself depend upon any specific GUI
-- toolkit).
-- Using the configuration defined earlier, one can then construct a command
-- line for the tool with:
-- Cmd : Command_Line;
-- Set_Configuration (Cmd, Config);
-- Set_Configuration (Cmd, Config); -- Config created earlier
-- Add_Switch (Cmd, "-bar");
-- Add_Switch (Cmd, "-gnatwu");
-- Add_Switch (Cmd, "-gnatwv"); -- will be grouped with the above
......@@ -219,44 +275,11 @@
-- This ensures that "arg1" will always be treated as the argument to -foo,
-- and will not be grouped with other parts of the command line.
---------------------------------------------------
-- Parsing the command line with grouped arguments
---------------------------------------------------
-- The command line construction facility can also be used in conjunction with
-- Getopt to interpret a command line. For example when implementing the tool
-- described above, you would do a first loop with Getopt to pass the switches
-- and their arguments, and create a temporary representation of the command
-- line as a Command_Line object. Finally, you can query each individual
-- switch from that object. For instance:
-- declare
-- Cmd : Command_Line;
-- Iter : Command_Line_Iterator;
-- begin
-- while Getopt ("foo: gnatw! T bar") /= ASCII.NUL loop
-- Add_Switch (Cmd, Full_Switch, Parameter);
-- end loop;
-- Start (Cmd, Iter, Expanded => True);
-- while Has_More (Iter) loop
-- if Current_Switch (Iter) = "-gnatwu" then
-- ...
-- elsif Current_Switch (Iter) = "-gnatwv" then
-- ...
-- end if;
-- Next (Iter);
-- end loop;
-- The above means that your tool does not have to handle on its own whether
-- the user passed -gnatwa (in which case -gnatwu was indeed selected), or
-- just -gnatwu, or a combination of -gnatw switches as in -gnatwuv.
with Ada.Command_Line;
with GNAT.Directory_Operations;
with GNAT.OS_Lib;
with GNAT.Regexp;
with GNAT.Strings;
package GNAT.Command_Line is
......@@ -343,6 +366,11 @@ package GNAT.Command_Line is
-- first character). Does not include the Switch_Char ('-' by default),
-- unless the "*" option of Getopt is used (see below).
function Current_Section
(Parser : Opt_Parser := Command_Line_Parser) return String;
-- Return the name of the current section.
-- The list of valid sections is defined through Initialize_Option_Scan
function Getopt
(Switches : String;
Concatenate : Boolean := True;
......@@ -519,14 +547,28 @@ package GNAT.Command_Line is
type Command_Line_Configuration is private;
procedure Define_Section
(Config : in out Command_Line_Configuration;
Section : String);
-- Indicates a new switch section. All switches belonging to the same
-- section are ordered together, preceded by the section. They are placed
-- at the end of the command line (as in "gnatmake somefile.adb -cargs -g")
-- The section name should not include the leading '-'.
-- So for instance in the case of gnatmake we would use:
-- Define_Section (Config, "cargs");
-- Define_Section (Config, "bargs");
procedure Define_Alias
(Config : in out Command_Line_Configuration;
Switch : String;
Expanded : String);
Expanded : String;
Section : String := "");
-- Indicates that whenever Switch appears on the command line, it should
-- be expanded as Expanded. For instance, for the GNAT compiler switches,
-- we would define "-gnatwa" as an alias for "-gnatwcfijkmopruvz", ie some
-- default warnings to be activated.
-- This expansion is only done within the specified section, which must
-- have been defined first through a call to [Define_Section].
procedure Define_Prefix
(Config : in out Command_Line_Configuration;
......@@ -539,29 +581,150 @@ package GNAT.Command_Line is
-- alphabetically.
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Switch : String);
(Config : in out Command_Line_Configuration;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "");
-- Indicates a new switch. The format of this switch follows the getopt
-- format (trailing ':', '?', etc for defining a switch with parameters).
-- The switches defined in the Command_Line_Configuration object are used
--
-- Switch should also start with the leading '-' (or any other characters).
-- They should all start with the same character, though. If this
-- character is not '-', you will need to call Initialize_Option_Scan to
-- set the proper character for the parser.
--
-- The switches defined in the command_line_configuration object are used
-- when ungrouping switches with more that one character after the prefix.
--
-- Switch and Long_Switch (when specified) are aliases and can be used
-- interchangeably. There is no check that they both take an argument or
-- both take no argument.
-- Switch can be set to "*" to indicate that any switch is supported (in
-- which case Getopt will return '*', see its documentation).
--
-- Help is used by the Display_Help procedure to describe the supported
-- switches.
--
-- In_Section indicates in which section the switch is valid (you need to
-- first define the section through a call to Define_Section).
procedure Define_Section
(Config : in out Command_Line_Configuration;
Section : String);
-- Indicates a new switch section. All switches belonging to the same
-- section are ordered together, preceded by the section. They are placed
-- at the end of the command line (as in "gnatmake somefile.adb -cargs -g")
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Output : access Boolean;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "";
Value : Boolean := True);
-- See Define_Switch for a description of the parameters.
-- When the switch is found on the command line, Getopt will set
-- Output.all to Value.
-- Output is always initially set to "not Value", so that if the switch is
-- not found on the command line, Output still has a valid value.
-- The switch must not take any parameter.
-- Output must exist at least as long as Config, otherwise erroneous memory
-- access may happen.
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Output : access Integer;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "";
Initial : Integer := 0;
Default : Integer := 1);
-- See Define_Switch for a description of the parameters.
-- When the switch is found on the command line, Getopt will set
-- Output.all to the value of the switch's parameter. If the parameter is
-- not an integer, Invalid_Parameter is raised.
-- Output is always initialized to Initial. If the switch has an optional
-- argument which isn't specified by the user, then Output will be set to
-- Default.
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Output : access GNAT.Strings.String_Access;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
Section : String := "");
-- Set Output to the value of the switch's parameter when the switch is
-- found on the command line.
-- Output is always initialized to the empty string.
procedure Set_Usage
(Config : in out Command_Line_Configuration;
Usage : String := "[switches] [arguments]";
Help : String := "");
-- Defines the general format of the call to the application, and a short
-- help text. These are both displayed by Display_Help
procedure Display_Help (Config : Command_Line_Configuration);
-- Display the help for the tool (ie its usage, and its supported switches)
function Get_Switches
(Config : Command_Line_Configuration;
Switch_Char : Character) return String;
-- Get the switches list as expected by Getopt. This list is built using
-- all switches defined previously via Define_Switch above.
Section : String := "";
Switch_Char : Character := '-') return String;
-- Get the switches list as expected by Getopt, for a specific section of
-- the command line. This list is built using all switches defined
-- previously via Define_Switch above.
function Section_Delimiters
(Config : Command_Line_Configuration) return String;
-- Return a string suitable for use in Initialize_Option_Scan
procedure Free (Config : in out Command_Line_Configuration);
-- Free the memory used by Config
type Switch_Handler is access procedure
(Switch : String;
Parameter : String;
Section : String);
-- Called when a switch is found on the command line.
-- [Switch] includes any leading '-' that was specified in Define_Switch.
-- This is slightly different from the functional version of Getopt above,
-- for which Full_Switch omits the first leading '-'.
Exit_From_Command_Line : exception;
-- Emitted when the program should exit.
-- This is called when Getopt below has seen -h, --help or an invalid
-- switch.
procedure Getopt
(Config : Command_Line_Configuration;
Callback : Switch_Handler := null;
Parser : Opt_Parser := Command_Line_Parser);
-- Similar to the standard Getopt function.
-- For each switch found on the command line, this calls Callback.
--
-- The list of valid switches are the ones from the configuration. The
-- switches that were declared through Define_Switch with an Output
-- parameter are never returned (and result in a modification of the Output
-- variable). This function will in fact never call [Callback] if all
-- switches were handled automatically and there is nothing left to do.
--
-- This procedure automatically adds -h and --help to the valid switches,
-- to display the help message and raises Exit_From_Command_Line.
-- If an invalid switch is specified on the command line, this procedure
-- will display an error message and raises Invalid_Switch again.
--
-- This function automatically expands switches:
-- * If Define_Prefix was called (for instance "-gnaty") and the user
-- specifies "-gnatycb" on the command line, then Getopt returns
-- "-gnatyc" and "-gnatyb" separately.
-- * If Define_Alias was called (for instance "-gnatya = -gnatycb") then
-- the latter is returned (in this case it also expands -gnaty as per
-- the above.
-- The goal is to make handling as easy as possible by leaving as much
-- work as possible to this package.
--
-- As opposed to the standard Getopt, this one will analyze all sections
-- as defined by Define_Section, and automatically jump from one section to
-- the next.
------------------------------
-- Generating command lines --
------------------------------
......@@ -572,6 +735,24 @@ package GNAT.Command_Line is
-- subprograms will properly take care of grouping switches when possible,
-- so as to keep the command line as short as possible. They also provide a
-- way to remove a switch from an existing command line.
-- For instance:
-- declare
-- Config : Command_Line_Configuration;
-- Line : Command_Line;
-- Args : Argument_List_Access;
-- begin
-- Define_Switch (Config, "-gnatyc");
-- Define_Switch (Config, ...); -- for all valid switches
-- Define_Prefix (Config, "-gnaty");
--
-- Set_Configuration (Line, Config);
-- Add_Switch (Line, "-O2");
-- Add_Switch (Line, "-gnatyc");
-- Add_Switch (Line, "-gnatyd");
--
-- Build (Line, Args);
-- -- Args is now ["-O2", "-gnatycd"]
-- end;
type Command_Line is private;
......@@ -609,7 +790,6 @@ package GNAT.Command_Line is
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False);
-- Add a new switch to the command line, and combine/group it with existing
......@@ -631,10 +811,6 @@ package GNAT.Command_Line is
-- A Switch with a parameter will never be grouped with another switch to
-- avoid ambiguities as to what the parameter applies to.
--
-- Separator is the character that goes between the switches and its
-- parameter on the command line. If it is set to ASCII.NUL, then no
-- separator is applied, and they are concatenated.
--
-- If the switch is part of a section, then it should be specified so that
-- the switch is correctly placed in the command line, and the section
-- added if not already present. For example, to add the -g switch into the
......@@ -650,7 +826,6 @@ package GNAT.Command_Line is
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False;
Success : out Boolean);
......@@ -740,6 +915,17 @@ package GNAT.Command_Line is
procedure Next (Iter : in out Command_Line_Iterator);
-- Move to the next switch
procedure Build
(Line : in out Command_Line;
Args : out GNAT.OS_Lib.Argument_List_Access;
Expanded : Boolean := False;
Switch_Char : Character := '-');
-- This is a wrapper using the Command_Line_Iterator.
-- It provides a simple way to get all switches (grouped as much as
-- possible), and possibly create an Opt_Parser.
-- [Args] must be freed by the caller.
-- [Expanded] has the same meaning as in [Start].
private
Max_Depth : constant := 100;
......@@ -841,18 +1027,54 @@ private
Command_Line_Parser : constant Opt_Parser :=
Command_Line_Parser_Data'Access;
type Switch_Type is (Switch_Untyped,
Switch_Boolean,
Switch_Integer,
Switch_String);
type Switch_Definition (Typ : Switch_Type := Switch_Untyped) is record
Switch : GNAT.OS_Lib.String_Access;
Long_Switch : GNAT.OS_Lib.String_Access;
Section : GNAT.OS_Lib.String_Access;
Help : GNAT.OS_Lib.String_Access;
case Typ is
when Switch_Untyped =>
null;
when Switch_Boolean =>
Boolean_Output : access Boolean;
Boolean_Value : Boolean; -- will set Output to that value
when Switch_Integer =>
Integer_Output : access Integer;
Integer_Initial : Integer;
Integer_Default : Integer;
when Switch_String =>
String_Output : access GNAT.Strings.String_Access;
end case;
end record;
type Switch_Definitions is array (Natural range <>) of Switch_Definition;
type Switch_Definitions_List is access all Switch_Definitions;
-- [Switch] includes the leading '-'
type Alias_Definition is record
Alias : GNAT.OS_Lib.String_Access;
Expansion : GNAT.OS_Lib.String_Access;
Section : GNAT.OS_Lib.String_Access;
end record;
type Alias_Definitions is array (Natural range <>) of Alias_Definition;
type Alias_Definitions_List is access all Alias_Definitions;
type Command_Line_Configuration_Record is record
Prefixes : GNAT.OS_Lib.Argument_List_Access;
Prefixes : GNAT.OS_Lib.Argument_List_Access;
-- The list of prefixes
Sections : GNAT.OS_Lib.Argument_List_Access;
Sections : GNAT.OS_Lib.Argument_List_Access;
-- The list of sections
Aliases : GNAT.OS_Lib.Argument_List_Access;
Expansions : GNAT.OS_Lib.Argument_List_Access;
-- The aliases (Both arrays have the same bounds)
Switches : GNAT.OS_Lib.Argument_List_Access;
Aliases : Alias_Definitions_List;
Usage : GNAT.OS_Lib.String_Access;
Help : GNAT.OS_Lib.String_Access;
Switches : Switch_Definitions_List;
-- List of expected switches (Used when expanding switch groups)
end record;
type Command_Line_Configuration is access Command_Line_Configuration_Record;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment