[RFA testsuite 1/5] Introduce parse_args

[Keith Seitz <keiths at redhat dot com>]

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.



diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 73e935a..7a25edb 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -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