Add support for Define_Switch with a callback in GNAT.Command_Line.
The callback is called for every instance of the switch found on the
command line. This make it possible to have full control over the
switch value and chain multiple actions if needed.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-30 Pascal Obry <o...@adacore.com>
gcc/ada/
* libgnat/g-comlin.ads (Value_Callback, Define_Switch): New.
* libgnat/g-comlin.adb: Add corresponding implementation.--- gcc/ada/libgnat/g-comlin.adb
+++ gcc/ada/libgnat/g-comlin.adb
@@ -1474,6 +1474,29 @@ package body GNAT.Command_Line is
end if;
end Define_Switch;
+ -------------------
+ -- Define_Switch --
+ -------------------
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Callback : not null Value_Callback;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "";
+ Argument : String := "ARG")
+ is
+ Def : Switch_Definition (Switch_Callback);
+ begin
+ if Switch /= "" or else Long_Switch /= "" then
+ Initialize_Switch_Def
+ (Def, Switch, Long_Switch, Help, Section, Argument);
+ Def.Callback := Callback;
+ Add (Config, Def);
+ end if;
+ end Define_Switch;
+
--------------------
-- Define_Section --
--------------------
@@ -3403,6 +3426,10 @@ package body GNAT.Command_Line is
Local_Config.Switches (Index).String_Output.all :=
new String'(Parameter);
return;
+
+ when Switch_Callback =>
+ Local_Config.Switches (Index).Callback (Switch, Parameter);
+ return;
end case;
end if;
@@ -3471,7 +3498,7 @@ package body GNAT.Command_Line is
for S in Local_Config.Switches'Range loop
case Local_Config.Switches (S).Typ is
- when Switch_Untyped =>
+ when Switch_Untyped | Switch_Callback =>
null; -- Nothing to do
when Switch_Boolean =>
--- gcc/ada/libgnat/g-comlin.ads
+++ gcc/ada/libgnat/g-comlin.ads
@@ -678,6 +678,20 @@ package GNAT.Command_Line is
-- so that you can specify the default value directly in the declaration
-- of the variable). The switch must accept an argument.
+ type Value_Callback is access procedure (Switch, Value : String);
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Callback : not null Value_Callback;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "";
+ Argument : String := "ARG");
+ -- Call Callback for each instance of Switch. The callback is given the
+ -- actual switch and the corresponding value. The switch must accept
+ -- an argument.
+
procedure Set_Usage
(Config : in out Command_Line_Configuration;
Usage : String := "[switches] [arguments]";
@@ -1111,7 +1125,8 @@ private
type Switch_Type is (Switch_Untyped,
Switch_Boolean,
Switch_Integer,
- Switch_String);
+ Switch_String,
+ Switch_Callback);
type Switch_Definition (Typ : Switch_Type := Switch_Untyped) is record
Switch : GNAT.OS_Lib.String_Access;
@@ -1135,6 +1150,8 @@ private
Integer_Default : Integer;
when Switch_String =>
String_Output : access GNAT.Strings.String_Access;
+ when Switch_Callback =>
+ Callback : Value_Callback;
end case;
end record;
type Switch_Definitions is array (Natural range <>) of Switch_Definition;
