[RFA,testsuite,1/5] Introduce parse_args
Commit Message
Hi,
The first of these new functions is called parse_args. It was written a
loooooooooong time ago by Ian Taylor (then at Cygnus). A part of libugi
(used by Insight and Source Navigator(?)), I have been given permission
to donate this upstream.
It is a very useful utility function which allows you to do getopt-y
kinds of things in Tcl. From the documentation:
proc myproc {foo args} {
parse_args {{bar} {baz "abc"} {qux}}
# ...
}
myproc ABC -bar -baz DEF peanut butter
will define the following variables in myproc:
foo (=ABC), bar (=1), baz (=DEF), and qux (=0)
args will be the list {peanut butter}
This will be used by subsequent patches in this series to cleanup
mi_create_breakpoint.
Keith
testsuite/ChangeLog
2014-04-15 Keith Seitz <keiths@redhat.com>
From Ian Lance Taylor <iant@cygnus.com>:
* lib/gdb.exp (parse_args): New procedure.
Comments
>>>>> "Keith" == Keith Seitz <keiths@redhat.com> writes:
Keith> testsuite/ChangeLog
Keith> 2014-04-15 Keith Seitz <keiths@redhat.com>
Keith> From Ian Lance Taylor <iant@cygnus.com>:
Keith> * lib/gdb.exp (parse_args): New procedure.
Thanks Keith.
This is ok.
Tom
@@ -4660,5 +4660,68 @@ proc using_fission { } {
return [regexp -- "-gsplit-dwarf" $debug_flags]
}
+# Search the caller's ARGS list and set variables according to the list of
+# valid options described by ARGSET.
+#
+# The first member of each one- or two-element list in ARGSET defines the
+# name of a variable that will be added to the caller's scope.
+#
+# If only one element is given to describe an option, it the value is
+# 0 if the option is not present in (the caller's) ARGS or 1 if
+# it is.
+#
+# If two elements are given, the second element is the default value of
+# the variable. This is then overwritten if the option exists in ARGS.
+#
+# Any parse_args elements in (the caller's) ARGS will be removed, leaving
+# any optional components.
+
+# Example:
+# proc myproc {foo args} {
+# parse_args {{bar} {baz "abc"} {qux}}
+# # ...
+# }
+# myproc ABC -bar -baz DEF peanut butter
+# will define the following variables in myproc:
+# foo (=ABC), bar (=1), baz (=DEF), and qux (=0)
+# args will be the list {peanut butter}
+
+proc parse_args { argset } {
+ upvar args args
+
+ foreach argument $argset {
+ if {[llength $argument] == 1} {
+ # No default specified, so we assume that we should set
+ # the value to 1 if the arg is present and 0 if it's not.
+ # It is assumed that no value is given with the argument.
+ set result [lsearch -exact $args "-$argument"]
+ if {$result != -1} then {
+ uplevel 1 [list set $argument 1]
+ set args [lreplace $args $result $result]
+ } else {
+ uplevel 1 [list set $argument 0]
+ }
+ } elseif {[llength $argument] == 2} {
+ # There are two items in the argument. The second is a
+ # default value to use if the item is not present.
+ # Otherwise, the variable is set to whatever is provided
+ # after the item in the args.
+ set arg [lindex $argument 0]
+ set result [lsearch -exact $args "-[lindex $arg 0]"]
+ if {$result != -1} then {
+ uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
+ set args [lreplace $args $result [expr $result+1]]
+ } else {
+ uplevel 1 [list set $arg [lindex $argument 1]]
+ }
+ } else {
+ error "Badly formatted argument \"$argument\" in argument set"
+ }
+ }
+
+ # The remaining args should be checked to see that they match the
+ # number of items expected to be passed into the procedure...
+}
+
# Always load compatibility stuff.
load_lib future.exp