Skip to content

R
riscv-gcc-1
Commit f9325b03 by Arnaud Charlet
Options

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

2008-08-06  Jerome Lambourg  <lambourg@adacore.com>

	* g-comlin.adb (Define_Switch, Get_Switches): New.
	(Can_Have_Parameter, Require_Parameter, Actual_Switch): New, used when
	ungrouping switches.
	(For_Each_Simple_Switch): Allow more control over parameters handling.
	This generic method now allows ungrouping of switches with parameters
	and switches with more than one letter after the prefix.
	(Set_Command_Line): Take care of switches that are prefixed with a
	switch handling parameters without delimiter (-gnatya and -gnaty3 for
	example).
	(Add_Switch, Remove_Switch): Handle parameters possibly present inside
	a group, as in gnaty3aM80 (3 and 80 are parameters). Report status of
	the operation.
	(Start, Alias_Switches, Group_Switches): Take care of parameters
	possibly present inside a group.

	* g-comlin.ads (Define_Switch): New method used to define a list of
	expected switches, that are necessary for correctly ungrouping switches
	with more that one character after the prefix.
	(Get_Switches): Method that builds a getopt string from the list of
	switches as set previously by Define_Switch.
	(Add_Switch, Remove_Switch): New versions of the methods, reporting the
	status of the operation. Also allow the removal of switches with
	parameters only.
	(Command_Line_Configuration_Record): Maintain a list of expected
	switches.

From-SVN: r138775
parent 1c5a12b4
Showing with 504 additions and 64 deletions
gcc/ada/ChangeLog
2008-08-06 Thomas Quinot <quinot@adacore.com>
* xnmake.adb: Use new XUtil package for platform independent text
output.
2008-08-06 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Document compiler switch -gnateG
2008-08-06 Quentin Ochem <ochem@adacore.com>
* s-stausa.adb (Fill_Stack): Fixed pragma assert and top pattern mark
in the case of an empty pattern size.
(Compute_Result): Do not do any computation in the case of an empty
pattern size.
(Report_Result): Fixed computation of the overflow guard.
2008-08-06 Ed Schonberg <schonberg@adacore.com>
* g-awk.adb (Finalize): Do not use directly objects of the type in the
finalization routine to prevent elaboration order anomalies in new
finalization scheme.
2008-08-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Find_Type_Name): protect against duplicate incomplete
declaration for the same type.
2008-08-06 Thomas Quinot <quinot@adacore.com>
* sem.adb: Minor rewording (comment)
2008-08-06 Jerome Lambourg <lambourg@adacore.com>
* g-comlin.adb (Define_Switch, Get_Switches): New.
(Can_Have_Parameter, Require_Parameter, Actual_Switch): New, used when
ungrouping switches.
(For_Each_Simple_Switch): Allow more control over parameters handling.
This generic method now allows ungrouping of switches with parameters
and switches with more than one letter after the prefix.
(Set_Command_Line): Take care of switches that are prefixed with a
switch handling parameters without delimiter (-gnatya and -gnaty3 for
example).
(Add_Switch, Remove_Switch): Handle parameters possibly present inside
a group, as in gnaty3aM80 (3 and 80 are parameters). Report status of
the operation.
(Start, Alias_Switches, Group_Switches): Take care of parameters
possibly present inside a group.
* g-comlin.ads (Define_Switch): New method used to define a list of
expected switches, that are necessary for correctly ungrouping switches
with more that one character after the prefix.
(Get_Switches): Method that builds a getopt string from the list of
switches as set previously by Define_Switch.
(Add_Switch, Remove_Switch): New versions of the methods, reporting the
status of the operation. Also allow the removal of switches with
parameters only.
(Command_Line_Configuration_Record): Maintain a list of expected
switches.
2008-08-06 Doug Rupp <rupp@adacore.com> 2008-08-06 Doug Rupp <rupp@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_param): Force 32bit descriptor if * gcc-interface/decl.c (gnat_to_gnu_param): Force 32bit descriptor if
gcc/ada/g-comlin.adb
...@@ -111,11 +111,22 @@ package body GNAT.Command_Line is ...@@ -111,11 +111,22 @@ package body GNAT.Command_Line is
Str : String_Access); Str : String_Access);
-- Append a new element to Line -- Append a new element to Line
function Can_Have_Parameter (S : String) return Boolean;
-- Tell if S can have a parameter.
function Require_Parameter (S : String) return Boolean;
-- Tell if S requires a paramter.
function Actual_Switch (S : String) return String;
-- Remove any possible trailing '!', ':', '?' and '='
generic generic
with procedure Callback (Simple_Switch : String); with procedure Callback (Simple_Switch : String; Parameter : String);
procedure For_Each_Simple_Switch procedure For_Each_Simple_Switch
(Cmd : Command_Line; (Cmd : Command_Line;
Switch : String); Switch : String;
Parameter : String := "";
Unalias : Boolean := True);
-- Breaks Switch into as simple switches as possible (expanding aliases and -- Breaks Switch into as simple switches as possible (expanding aliases and
-- ungrouping common prefixes when possible), and call Callback for each of -- ungrouping common prefixes when possible), and call Callback for each of
-- these. -- these.
...@@ -1089,6 +1100,22 @@ package body GNAT.Command_Line is ...@@ -1089,6 +1100,22 @@ package body GNAT.Command_Line is
Append (Config.Prefixes, new String'(Prefix)); Append (Config.Prefixes, new String'(Prefix));
end Define_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;
Append (Config.Switches, new String'(Switch));
end Define_Switch;
-------------------- --------------------
-- Define_Section -- -- Define_Section --
-------------------- --------------------
...@@ -1105,6 +1132,35 @@ package body GNAT.Command_Line is ...@@ -1105,6 +1132,35 @@ package body GNAT.Command_Line is
Append (Config.Sections, new String'(Section)); Append (Config.Sections, new String'(Section));
end Define_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 -- -- Set_Configuration --
----------------------- -----------------------
...@@ -1203,16 +1259,33 @@ package body GNAT.Command_Line is ...@@ -1203,16 +1259,33 @@ package body GNAT.Command_Line is
if not Is_Section then if not Is_Section then
if Section = null then if Section = null then
Add_Switch -- Workaround some weird cases: some switches may
(Cmd, Sw, -- expect parameters, but have the same value as
Parameter (Parser), -- longer switches: -gnaty3 (-gnaty, parameter=3) and
Separator (Parser)); -- -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 furnished.
if Separator (Parser) = ASCII.NUL then
Add_Switch
(Cmd, Sw & Parameter (Parser), "");
else
Add_Switch
(Cmd, Sw, Parameter (Parser), Separator (Parser));
end if;
else else
Add_Switch if Separator (Parser) = ASCII.NUL then
(Cmd, Sw, Add_Switch
Parameter (Parser), (Cmd, Sw & Parameter (Parser), "",
Separator (Parser), Separator (Parser),
Section.all); Section.all);
else
Add_Switch
(Cmd, Sw,
Parameter (Parser),
Separator (Parser),
Section.all);
end if;
end if; end if;
end if; end if;
end; end;
...@@ -1250,14 +1323,157 @@ package body GNAT.Command_Line is ...@@ -1250,14 +1323,157 @@ package body GNAT.Command_Line is
and then Type_Str (Index .. Index + Substring'Length - 1) = Substring; and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
end Looking_At; 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 -- -- For_Each_Simple_Switch --
---------------------------- ----------------------------
procedure For_Each_Simple_Switch procedure For_Each_Simple_Switch
(Cmd : Command_Line; (Cmd : Command_Line;
Switch : String) Switch : String;
Parameter : String := "";
Unalias : Boolean := True)
is 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 := Group'First;
Found : Boolean;
begin
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 then
-- The group only concerns a single switch. Do not
-- perform recursive call.
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 begin
-- Are we adding a switch that can in fact be expanded through aliases ? -- Are we adding a switch that can in fact be expanded through aliases ?
-- If yes, we add separately each of its expansion. -- If yes, we add separately each of its expansion.
...@@ -1267,13 +1483,16 @@ package body GNAT.Command_Line is ...@@ -1267,13 +1483,16 @@ package body GNAT.Command_Line is
-- in which we do things here, the expansion of the alias will itself -- 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 further split into simple switches
if Cmd.Config /= null if Unalias
and then Cmd.Config /= null
and then Cmd.Config.Aliases /= null and then Cmd.Config.Aliases /= null
then then
for A in Cmd.Config.Aliases'Range loop 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 For_Each_Simple_Switch
(Cmd, Cmd.Config.Expansions (A).all); (Cmd, Cmd.Config.Expansions (A).all, "");
return; return;
end if; end if;
end loop; end loop;
...@@ -1291,19 +1510,31 @@ package body GNAT.Command_Line is ...@@ -1291,19 +1510,31 @@ package body GNAT.Command_Line is
(Switch, Switch'First, Cmd.Config.Prefixes (P).all) (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
then then
-- Alias expansion will be done recursively -- Alias expansion will be done recursively
if Cmd.Config.Switches = null then
for S in Switch'First + Cmd.Config.Prefixes (P)'Length
.. Switch'Last
loop
For_Each_Simple_Switch
(Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
end loop;
for S in Switch'First + Cmd.Config.Prefixes (P)'Length return;
.. Switch'Last
loop elsif Group_Analysis
For_Each_Simple_Switch (Cmd.Config.Prefixes (P).all,
(Cmd, Cmd.Config.Prefixes (P).all & Switch (S)); Switch
end loop; (Switch'First + Cmd.Config.Prefixes (P)'Length
return; .. Switch'Last))
then
-- Recursive calls already done on each switch of the
-- group. Let's return to not call Callback.
return;
end if;
end if; end if;
end loop; end loop;
end if; end if;
Callback (Switch); Callback (Switch, Parameter);
end For_Each_Simple_Switch; end For_Each_Simple_Switch;
---------------- ----------------
...@@ -1317,7 +1548,25 @@ package body GNAT.Command_Line is ...@@ -1317,7 +1548,25 @@ package body GNAT.Command_Line is
Separator : Character := ' '; Separator : Character := ' ';
Section : String := "") Section : String := "")
is is
procedure Add_Simple_Switch (Simple : String); Success : Boolean;
pragma Unreferenced (Success);
begin
Add_Switch (Cmd, Switch, Parameter, Separator, Section, Success);
end Add_Switch;
----------------
-- Add_Switch --
----------------
procedure Add_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ';
Section : String := "";
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 -- 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 is no more aliases in Switches
...@@ -1325,32 +1574,37 @@ package body GNAT.Command_Line is ...@@ -1325,32 +1574,37 @@ package body GNAT.Command_Line is
-- Add_Simple_Switch -- -- Add_Simple_Switch --
----------------------- -----------------------
procedure Add_Simple_Switch (Simple : String) is procedure Add_Simple_Switch (Simple : String; Param : String) is
begin begin
if Cmd.Expanded = null then if Cmd.Expanded = null then
Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple)); Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
if Parameter = "" then
Cmd.Params := new Argument_List'(1 .. 1 => null); if Param /= "" then
else
Cmd.Params := new Argument_List' Cmd.Params := new Argument_List'
(1 .. 1 => new String'(Separator & Parameter)); (1 .. 1 => new String'(Separator & Param));
else
Cmd.Params := new Argument_List'(1 .. 1 => null);
end if; end if;
if Section = "" then if Section = "" then
Cmd.Sections := new Argument_List'(1 .. 1 => null); Cmd.Sections := new Argument_List'(1 .. 1 => null);
else else
Cmd.Sections := new Argument_List' Cmd.Sections := new Argument_List'
(1 .. 1 => new String'(Section)); (1 .. 1 => new String'(Section));
end if; end if;
else else
-- Do we already have this switch ? -- Do we already have this switch ?
for C in Cmd.Expanded'Range loop for C in Cmd.Expanded'Range loop
if Cmd.Expanded (C).all = Simple if Cmd.Expanded (C).all = Simple
and then and then
((Cmd.Params (C) = null and then Parameter = "") ((Cmd.Params (C) = null and then Param = "")
or else or else
(Cmd.Params (C) /= null (Cmd.Params (C) /= null
and then Cmd.Params (C).all = Separator & Parameter)) and then Cmd.Params (C).all = Separator & Param))
and then and then
((Cmd.Sections (C) = null and then Section = "") ((Cmd.Sections (C) = null and then Section = "")
or else or else
...@@ -1361,12 +1615,15 @@ package body GNAT.Command_Line is ...@@ -1361,12 +1615,15 @@ package body GNAT.Command_Line is
end if; end if;
end loop; end loop;
-- Inserting at least one switch
Success := True;
Append (Cmd.Expanded, new String'(Simple)); Append (Cmd.Expanded, new String'(Simple));
if Parameter = "" then if Param /= "" then
Append (Cmd.Params, null); Append (Cmd.Params, new String'(Separator & Param));
else else
Append (Cmd.Params, new String'(Separator & Parameter)); Append (Cmd.Params, null);
end if; end if;
if Section = "" then if Section = "" then
...@@ -1383,7 +1640,8 @@ package body GNAT.Command_Line is ...@@ -1383,7 +1640,8 @@ package body GNAT.Command_Line is
-- Start of processing for Add_Switch -- Start of processing for Add_Switch
begin begin
Add_Simple_Switches (Cmd, Switch); Success := False;
Add_Simple_Switches (Cmd, Switch, Parameter);
Free (Cmd.Coalesce); Free (Cmd.Coalesce);
end Add_Switch; end Add_Switch;
...@@ -1436,20 +1694,40 @@ package body GNAT.Command_Line is ...@@ -1436,20 +1694,40 @@ package body GNAT.Command_Line is
------------------- -------------------
procedure Remove_Switch procedure Remove_Switch
(Cmd : in out Command_Line; (Cmd : in out Command_Line;
Switch : String; Switch : String;
Remove_All : Boolean := False; Remove_All : Boolean := False;
Section : String := "") Has_Parameter : Boolean := False;
Section : String := "")
is is
procedure Remove_Simple_Switch (Simple : String); Success : Boolean;
pragma Unreferenced (Success);
begin
Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
end Remove_Switch;
-------------------
-- Remove_Switch --
-------------------
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
Remove_All : Boolean := False;
Has_Parameter : Boolean := False;
Section : String := "";
Success : out Boolean)
is
procedure Remove_Simple_Switch (Simple : String; Param : String);
-- Removes a simple switch, with no aliasing or grouping -- Removes a simple switch, with no aliasing or grouping
-------------------------- --------------------------
-- Remove_Simple_Switch -- -- Remove_Simple_Switch --
-------------------------- --------------------------
procedure Remove_Simple_Switch (Simple : String) is procedure Remove_Simple_Switch (Simple : String; Param : String) is
C : Integer; C : Integer;
pragma Unreferenced (Param);
begin begin
if Cmd.Expanded /= null then if Cmd.Expanded /= null then
...@@ -1462,10 +1740,12 @@ package body GNAT.Command_Line is ...@@ -1462,10 +1740,12 @@ package body GNAT.Command_Line is
and then Section = "") and then Section = "")
or else (Cmd.Sections (C) /= null or else (Cmd.Sections (C) /= null
and then Section = Cmd.Sections (C).all)) and then Section = Cmd.Sections (C).all))
and then (not Has_Parameter or else Cmd.Params (C) /= null)
then then
Remove (Cmd.Expanded, C); Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C); Remove (Cmd.Params, C);
Remove (Cmd.Sections, C); Remove (Cmd.Sections, C);
Success := True;
if not Remove_All then if not Remove_All then
return; return;
...@@ -1484,7 +1764,8 @@ package body GNAT.Command_Line is ...@@ -1484,7 +1764,8 @@ package body GNAT.Command_Line is
-- Start of processing for Remove_Switch -- Start of processing for Remove_Switch
begin begin
Remove_Simple_Switches (Cmd, Switch); Success := False;
Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
Free (Cmd.Coalesce); Free (Cmd.Coalesce);
end Remove_Switch; end Remove_Switch;
...@@ -1498,14 +1779,14 @@ package body GNAT.Command_Line is ...@@ -1498,14 +1779,14 @@ package body GNAT.Command_Line is
Parameter : String; Parameter : String;
Section : String := "") Section : String := "")
is is
procedure Remove_Simple_Switch (Simple : String); procedure Remove_Simple_Switch (Simple : String; Param : String);
-- Removes a simple switch, with no aliasing or grouping -- Removes a simple switch, with no aliasing or grouping
-------------------------- --------------------------
-- Remove_Simple_Switch -- -- Remove_Simple_Switch --
-------------------------- --------------------------
procedure Remove_Simple_Switch (Simple : String) is procedure Remove_Simple_Switch (Simple : String; Param : String) is
C : Integer; C : Integer;
begin begin
...@@ -1520,7 +1801,7 @@ package body GNAT.Command_Line is ...@@ -1520,7 +1801,7 @@ package body GNAT.Command_Line is
(Cmd.Sections (C) /= null (Cmd.Sections (C) /= null
and then Section = Cmd.Sections (C).all)) and then Section = Cmd.Sections (C).all))
and then and then
((Cmd.Params (C) = null and then Parameter = "") ((Cmd.Params (C) = null and then Param = "")
or else or else
(Cmd.Params (C) /= null (Cmd.Params (C) /= null
and then and then
...@@ -1529,7 +1810,7 @@ package body GNAT.Command_Line is ...@@ -1529,7 +1810,7 @@ package body GNAT.Command_Line is
Cmd.Params (C) (Cmd.Params (C)'First + 1 Cmd.Params (C) (Cmd.Params (C)'First + 1
.. Cmd.Params (C)'Last) = .. Cmd.Params (C)'Last) =
Parameter)) Param))
then then
Remove (Cmd.Expanded, C); Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C); Remove (Cmd.Params, C);
...@@ -1553,7 +1834,7 @@ package body GNAT.Command_Line is ...@@ -1553,7 +1834,7 @@ package body GNAT.Command_Line is
-- Start of processing for Remove_Switch -- Start of processing for Remove_Switch
begin begin
Remove_Simple_Switches (Cmd, Switch); Remove_Simple_Switches (Cmd, Switch, Parameter);
Free (Cmd.Coalesce); Free (Cmd.Coalesce);
end Remove_Switch; end Remove_Switch;
...@@ -1567,6 +1848,36 @@ package body GNAT.Command_Line is ...@@ -1567,6 +1848,36 @@ package body GNAT.Command_Line is
Sections : Argument_List_Access; Sections : Argument_List_Access;
Params : Argument_List_Access) Params : Argument_List_Access)
is is
function Compatible_Parameter (Param : String_Access) return Boolean;
-- Tell if the parameter can be part of a group
--------------------------
-- Compatible_Parameter --
--------------------------
function Compatible_Parameter (Param : String_Access) return Boolean is
begin
if Param = null then
-- No parameter, OK
return True;
elsif Param (Param'First) /= ASCII.NUL then
-- We need parameters without separators...
return False;
else
-- We need number only parameters.
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;
Group : Ada.Strings.Unbounded.Unbounded_String; Group : Ada.Strings.Unbounded.Unbounded_String;
First : Natural; First : Natural;
use type Ada.Strings.Unbounded.Unbounded_String; use type Ada.Strings.Unbounded.Unbounded_String;
...@@ -1584,7 +1895,7 @@ package body GNAT.Command_Line is ...@@ -1584,7 +1895,7 @@ package body GNAT.Command_Line is
for C in Result'Range loop for C in Result'Range loop
if Result (C) /= null if Result (C) /= null
and then Params (C) = null -- ignored if has a parameter and then Compatible_Parameter (Params (C))
and then Looking_At and then Looking_At
(Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all) (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
then then
...@@ -1602,7 +1913,14 @@ package body GNAT.Command_Line is ...@@ -1602,7 +1913,14 @@ package body GNAT.Command_Line is
Group & Group &
Result (C) Result (C)
(Result (C)'First + Cmd.Config.Prefixes (P)'Length .. (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
Result (C)'Last); Result (C)'Last);
if Params (C) /= null then
Group := Group &
Params (C) (Params (C)'First + 1 .. Params (C)'Last);
Free (Params (C));
end if;
if First = 0 then if First = 0 then
First := C; First := C;
end if; end if;
...@@ -1646,22 +1964,25 @@ package body GNAT.Command_Line is ...@@ -1646,22 +1964,25 @@ package body GNAT.Command_Line is
Found : Boolean; Found : Boolean;
First : Natural; First : Natural;
procedure Check_Cb (Switch : String); procedure Check_Cb (Switch : String; Param : String);
-- Comment required ??? -- Comment required ???
procedure Remove_Cb (Switch : String); procedure Remove_Cb (Switch : String; Param : String);
-- Comment required ??? -- Comment required ???
-------------- --------------
-- Check_Cb -- -- Check_Cb --
-------------- --------------
procedure Check_Cb (Switch : String) is procedure Check_Cb (Switch : String; Param : String) is
begin begin
if Found then if Found then
for E in Result'Range loop for E in Result'Range loop
if Result (E) /= null 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 and then Result (E).all = Switch
then then
return; return;
...@@ -1676,14 +1997,21 @@ package body GNAT.Command_Line is ...@@ -1676,14 +1997,21 @@ package body GNAT.Command_Line is
-- Remove_Cb -- -- Remove_Cb --
--------------- ---------------
procedure Remove_Cb (Switch : String) is procedure Remove_Cb (Switch : String; Param : String) is
begin begin
for E in Result'Range loop 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 if First > E then
First := E; First := E;
end if; end if;
Free (Result (E)); Free (Result (E));
Free (Params (E));
return; return;
end if; end if;
end loop; end loop;
...@@ -1820,11 +2148,20 @@ package body GNAT.Command_Line is ...@@ -1820,11 +2148,20 @@ package body GNAT.Command_Line is
end if; end if;
end loop; 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 -- Not a clone, since we will not modify the parameters anyway
Cmd.Coalesce_Params := Cmd.Params; Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Params); Group_Switches
Group_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Params); (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
end if; end if;
if Expanded then if Expanded then
...@@ -1841,6 +2178,7 @@ package body GNAT.Command_Line is ...@@ -1841,6 +2178,7 @@ package body GNAT.Command_Line is
Iter.Current := Integer'Last; Iter.Current := Integer'Last;
else else
Iter.Current := Iter.List'First; Iter.Current := Iter.List'First;
while Iter.Current <= Iter.List'Last while Iter.Current <= Iter.List'Last
and then Iter.List (Iter.Current) = null and then Iter.List (Iter.Current) = null
loop loop
......
gcc/ada/g-comlin.ads
...@@ -513,6 +513,14 @@ package GNAT.Command_Line is ...@@ -513,6 +513,14 @@ package GNAT.Command_Line is
-- characters whose order is irrelevant. In fact, this package will sort -- characters whose order is irrelevant. In fact, this package will sort
-- them alphabetically. -- them alphabetically.
procedure Define_Switch
(Config : in out Command_Line_Configuration;
Switch : 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
-- when ungrouping switches with more that one character after the prefix.
procedure Define_Section procedure Define_Section
(Config : in out Command_Line_Configuration; (Config : in out Command_Line_Configuration;
Section : String); Section : String);
...@@ -520,6 +528,13 @@ package GNAT.Command_Line is ...@@ -520,6 +528,13 @@ package GNAT.Command_Line is
-- section are ordered together, preceded by the section. They are placed -- 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') -- at the end of the command line (as in 'gnatmake somefile.adb -cargs -g')
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.
procedure Free (Config : in out Command_Line_Configuration); procedure Free (Config : in out Command_Line_Configuration);
-- Free the memory used by Config -- Free the memory used by Config
...@@ -595,11 +610,22 @@ package GNAT.Command_Line is ...@@ -595,11 +610,22 @@ package GNAT.Command_Line is
-- added if not already present. For example, to add the -g switch into the -- added if not already present. For example, to add the -g switch into the
-- -cargs section, you need to call (Cmd, "-g", Section => "-cargs") -- -cargs section, you need to call (Cmd, "-g", Section => "-cargs")
procedure Add_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
Separator : Character := ' ';
Section : String := "";
Success : out Boolean);
-- Same as above, returning the status of
-- the operation
procedure Remove_Switch procedure Remove_Switch
(Cmd : in out Command_Line; (Cmd : in out Command_Line;
Switch : String; Switch : String;
Remove_All : Boolean := False; Remove_All : Boolean := False;
Section : String := ""); Has_Parameter : Boolean := False;
Section : String := "");
-- Remove Switch from the command line, and ungroup existing switches if -- Remove Switch from the command line, and ungroup existing switches if
-- necessary. -- necessary.
-- --
...@@ -610,6 +636,9 @@ package GNAT.Command_Line is ...@@ -610,6 +636,9 @@ package GNAT.Command_Line is
-- If Remove_All is True, then all matching switches are removed, otherwise -- If Remove_All is True, then all matching switches are removed, otherwise
-- only the first matching one is removed. -- only the first matching one is removed.
-- --
-- if Has_Parameter is set to True, then only switches having a parameter
-- are removed.
--
-- If the switch belongs to a section, then this section should be -- If the switch belongs to a section, then this section should be
-- specified: Remove_Switch (Cmd_Line, "-g", Section => "-cargs") called -- specified: Remove_Switch (Cmd_Line, "-g", Section => "-cargs") called
-- on the command line "-g -cargs -g" will result in "-g", while if -- on the command line "-g -cargs -g" will result in "-g", while if
...@@ -617,6 +646,16 @@ package GNAT.Command_Line is ...@@ -617,6 +646,16 @@ package GNAT.Command_Line is
-- If Remove_All is set, then both "-g" will be removed. -- If Remove_All is set, then both "-g" will be removed.
procedure Remove_Switch procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
Remove_All : Boolean := False;
Has_Parameter : Boolean := False;
Section : String := "";
Success : out Boolean);
-- Same as above, reporting the success of the operation (Success is False
-- if no switch was removed).
procedure Remove_Switch
(Cmd : in out Command_Line; (Cmd : in out Command_Line;
Switch : String; Switch : String;
Parameter : String; Parameter : String;
...@@ -774,6 +813,9 @@ private ...@@ -774,6 +813,9 @@ private
Aliases : GNAT.OS_Lib.Argument_List_Access; Aliases : GNAT.OS_Lib.Argument_List_Access;
Expansions : GNAT.OS_Lib.Argument_List_Access; Expansions : GNAT.OS_Lib.Argument_List_Access;
-- The aliases. Both arrays have the same indices -- The aliases. Both arrays have the same indices
Switches : GNAT.OS_Lib.Argument_List_Access;
-- List of expected switches. Used when expanding switch groups.
end record; end record;
type Command_Line_Configuration is access Command_Line_Configuration_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