[PATCH] gdb/testsuite: introduce parse_options procedure

[PATCH] gdb/testsuite: introduce parse_options procedure

[Simon Marchi]

In the testsuite, I really like when procedures take optional arguments
using shell-like options that start with dash (for example,
gdb_test_multiple).  I think this leads to clearer code than using
parameters with defaults value.

For example, if one wants to specify arg3 but not arg2 when calling the
following proc:

    proc some_proc { arg1 { arg2 "" } { arg3 "" } } { ... }

they would have to do:

    some_proc value1 "" value3

I find it nicer when it's shell-like:

    some_proc value1 -arg3 value3
    some_proc -arg3 value3 value1

This patch adds a `parse_options` procedure to help doing this without
much code.  See the documentation above the proc to see how it works.

I modified the gdb_test_multiple procedure to use it, and I think the
result is quite readable.

Note that because arguments to gdb_test_multiple sometimes start with a
hyphen (such as MI commands, but not only), I found it necessary to
support the typical "--" argument, which stops the processing of
options.  Otherwise, parse_options would complain about the argument
being an unrecognized option of gdb_test_multiple.  I added it at a few
places where I found it to be necessary.

gdb/testsuite/ChangeLog:

	* lib/gdb.exp (parse_options): New proc.
	(gdb_test_multiple): Handle args using parse_options.
	(gdb_test): Add `--` to gdb_test_multiple call.
	(gdb_test_no_output): Likewise.
	* gdb.mi/list-thread-groups-available.exp: Likewise.
	* gdb.mi/list-thread-groups-no-inferior.exp: Likewise.
	* gdb.mi/mi-fortran-modules.exp: Likewise.

Change-Id: I8910bfba360a25ed28e5ed8c0aea165acbca996f
---
 .../gdb.mi/list-thread-groups-available.exp   |   2 +-
 .../gdb.mi/list-thread-groups-no-inferior.exp |   2 +-
 gdb/testsuite/gdb.mi/mi-fortran-modules.exp   |   4 +-
 gdb/testsuite/lib/gdb.exp                     | 198 +++++++++++++++---
 4 files changed, 174 insertions(+), 32 deletions(-)

diff --git a/gdb/testsuite/gdb.mi/list-thread-groups-available.exp b/gdb/testsuite/gdb.mi/list-thread-groups-available.exp
index 697ee343d8b4..86a455a34cb1 100644
--- a/gdb/testsuite/gdb.mi/list-thread-groups-available.exp
+++ b/gdb/testsuite/gdb.mi/list-thread-groups-available.exp
@@ -58,7 +58,7 @@ set process_entry_re "{${id_re},${type_re}(,$description_re)?(,$user_re)?(,$core
 # timeout (especially when running with check-read1).
 set cmd "-list-thread-groups --available"
 set test "list available thread groups"
-gdb_test_multiple $cmd $test -prompt "$mi_gdb_prompt" {
+gdb_test_multiple -prompt "$mi_gdb_prompt" -- $cmd $test {
     -re "\\^done,groups=\\\[" {
 	# The beginning of the response.
 	exp_continue
diff --git a/gdb/testsuite/gdb.mi/list-thread-groups-no-inferior.exp b/gdb/testsuite/gdb.mi/list-thread-groups-no-inferior.exp
index beea82443ba3..e50c862ac04e 100644
--- a/gdb/testsuite/gdb.mi/list-thread-groups-no-inferior.exp
+++ b/gdb/testsuite/gdb.mi/list-thread-groups-no-inferior.exp
@@ -31,7 +31,7 @@ if [mi_gdb_start] {
 # size.  So we consume the output in chunks.
 
 set test "-list-thread-groups --available"
-gdb_test_multiple $test $test {
+gdb_test_multiple -- $test $test {
     -re "\}" {
         exp_continue
     }
diff --git a/gdb/testsuite/gdb.mi/mi-fortran-modules.exp b/gdb/testsuite/gdb.mi/mi-fortran-modules.exp
index e7ee1b96e461..3e06c058d758 100644
--- a/gdb/testsuite/gdb.mi/mi-fortran-modules.exp
+++ b/gdb/testsuite/gdb.mi/mi-fortran-modules.exp
@@ -65,7 +65,7 @@ set modmany_re \
 set moduse_re \
     "\{module=\"moduse\",files=\\\[\{filename=\"\[^\"\]+$srcfile\",fullname=\"\[^\"\]+$srcfile\",symbols=\\\[\{line=\"44\",name=\"moduse::check_all\",type=\"void \\(void\\)\",description=\"void moduse::check_all\\(void\\);\"\},\{line=\"49\",name=\"moduse::check_var_x\",type=\"void \\(void\\)\",description=\"void moduse::check_var_x\\(void\\);\"\}\\\]\}\\\]\}"
 set state 0
-gdb_test_multiple $cmd $test -prompt $mi_gdb_prompt$ {
+gdb_test_multiple -prompt $mi_gdb_prompt$ -- $cmd $test {
     -re "104\\^done,symbols=\\\[" {
 	if { $state == 0 } { set state 1 }
 	exp_continue
@@ -126,7 +126,7 @@ set moduse_re \
 set cmd "107-symbol-info-module-variables"
 set test "-symbol-info-module-variables"
 set state 0
-gdb_test_multiple $cmd $test -prompt $mi_gdb_prompt$ {
+gdb_test_multiple -prompt $mi_gdb_prompt$ -- $cmd $test {
     -re "107\\^done,symbols=\\\[" {
 	if { $state == 0 } { set state 1 }
 	exp_continue
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 444cea01c36a..26b55b09b3e1 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -713,23 +713,28 @@ proc gdb_internal_error_resync {} {
 }
 
 
-# gdb_test_multiple COMMAND MESSAGE [ -promp PROMPT_REGEXP] [ -lbl ]
-#                   EXPECT_ARGUMENTS
+# gdb_test_multiple [ -prompt PROMPT_REGEXP] [ -lbl ]
+#                   COMMAND MESSAGE EXPECT_ARGUMENTS
 # Send a command to gdb; test the result.
 #
+# The following positional arguments are required:
+#
 # COMMAND is the command to execute, send to GDB with send_gdb.  If
 #   this is the null string no command is sent.
 # MESSAGE is a message to be printed with the built-in failure patterns
 #   if one of them matches.  If MESSAGE is empty COMMAND will be used.
-# -prompt PROMPT_REGEXP specifies a regexp matching the expected prompt
-#   after the command output.  If empty, defaults to "$gdb_prompt $".
-# -lbl specifies that line-by-line matching will be used.
 # EXPECT_ARGUMENTS will be fed to expect in addition to the standard
 #   patterns.  Pattern elements will be evaluated in the caller's
 #   context; action elements will be executed in the caller's context.
 #   Unlike patterns for gdb_test, these patterns should generally include
 #   the final newline and prompt.
 #
+# The following options are supported:
+#
+# -prompt PROMPT_REGEXP specifies a regexp matching the expected prompt
+#  after the command output.  If empty, defaults to "$gdb_prompt $".
+# -lbl specifies that line-by-line matching will be used.
+#
 # Returns:
 #    1 if the test failed, according to a built-in failure pattern
 #    0 if only user-supplied patterns matched
@@ -808,7 +813,7 @@ proc gdb_internal_error_resync {} {
 #	}
 #    }
 #
-proc gdb_test_multiple { command message args } {
+proc gdb_test_multiple { args } {
     global verbose use_gdb_stub
     global gdb_prompt pagination_prompt
     global GDB
@@ -818,30 +823,20 @@ proc gdb_test_multiple { command message args } {
     upvar expect_out expect_out
     global any_spawn_id
 
-    set line_by_line 0
-    set prompt_regexp ""
-    for {set i 0} {$i < [llength $args]} {incr i} {
-	set arg [lindex $args $i]
-	if { $arg  == "-prompt" } {
-	    incr i
-	    set prompt_regexp [lindex $args $i]
-	} elseif { $arg == "-lbl" } {
-	    set line_by_line 1
-	} else {
-	    set user_code $arg
-	    break
-	}
-    }
-    if { [expr $i + 1] < [llength $args] } {
-	error "Too many arguments to gdb_test_multiple"
-    } elseif { ![info exists user_code] } {
-	error "Too few arguments to gdb_test_multiple"
+    set prompt_regexp "$gdb_prompt $"
+
+    set opt_desc {
+	{ "prompt" prompt_regexp true }
+	{ "lbl" line_by_line false }
     }
 
-    if { "$prompt_regexp" == "" } {
-	set prompt_regexp "$gdb_prompt $"
+    set args [parse_options $args $opt_desc]
+    if { [llength $args] != 3 } {
+	error "gdb_test_multiple requires 3 positional argument (command, message and user_code), [llength $args] given)"
     }
 
+    lassign $args command message user_code
+
     if { $message == "" } {
 	set message $command
     }
@@ -1237,7 +1232,7 @@ proc gdb_test { args } {
      }
 
     set user_code [join $user_code]
-    return [gdb_test_multiple $command $message $user_code]
+    return [gdb_test_multiple -- $command $message $user_code]
 }
 
 # Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR.
@@ -1296,7 +1291,7 @@ proc gdb_test_no_output { args } {
     }
 
     set command_regex [string_to_regexp $command]
-    gdb_test_multiple $command $message {
+    gdb_test_multiple -- $command $message {
         -re "^$command_regex\r\n$gdb_prompt $" {
 	    if ![string match "" $message] then {
 		pass "$message"
@@ -7203,5 +7198,152 @@ proc hex_in_list { val hexlist } {
     return [expr $index != -1]
 }
 
+# A simple option parser for TCL procedures.
+#
+# This helps writing procedures that take shell-like options.  Options begin
+# with a single hyphen and may require a following argument.  Arguments which
+# are not options nor arguments to options are called positional arguments.
+#
+# ARGV must be a list of arguments to parse.  Typically, a procedure using
+# PARSE_OPTIONS will pass in its `args` parameter (the va_list of TCL).
+#
+# OPT_DESC must be a list of options descriptions.  An option description is
+# itself a list with the following elements:
+#
+#   1. Option name, without the leading hyphen
+#   2. Variable name
+#   3. Whether the option takes an argument
+#
+# When an option is provided, PARSE_OPTIONS sets the corresponding variable in
+# the context of the caller.  If the option takes an argument, the following
+# element in the argument list is used as the variable value.  Otherwise, the
+# variable is set to "true".
+#
+# If an option is not provided:
+#
+#   - if the option does not take an argument: the variable is set to false
+#   - if the option takes an argument: the variable is not set
+#
+# The latter allows checking whether an option which requires an argument was
+# given or not using `info exists var_name`.  Alternatively, the calling
+# procedure may provide a default value for an option that requires an argument
+# by setting the corresponding variable prior to invoking PARSE_OPTIONS.
+#
+# Positional arguments are accumulated in a separate list, which is returned by
+# PARSE_OPTIONS.
+#
+# A positional argument "--" causes PARSE_OPTIONS to stop looking for options.  All
+# arguments following it are appended the returned list.
+#
+# Here's a somewhat complete example of using PARSE_OPTIONS:
+#
+#     proc some_proc { args } {
+#         # Default value for -opt-with-arg-1.
+#         set opt_with_arg_1 123
+#
+#         set opt_desc {
+#             { "opt-without-arg-1" opt_without_arg_1 false }
+#             { "opt-without-arg-2" opt_without_arg_2 false }
+#             { "opt-with-arg-1" opt_with_arg_1 true }
+#             { "opt-with-arg-2" opt_with_arg_2 true }
+#             { "opt-with-arg-3" opt_with_arg_3 true }
+#         }
+#
+#         set args [parse_options $args $opt_desc]
+#
+#         puts "-opt-without-arg-1: $opt_without_arg_1"
+#         puts "-opt-without-arg-2: $opt_without_arg_2"
+#         puts "-opt-with-arg-1: $opt_with_arg_1"
+#         puts "-opt-with-arg-2: $opt_with_arg_2"
+#         if { ![info exists opt_with_arg_3] } {
+#             puts "-opt-with-arg-3 is not specified"
+#         }
+#
+#         puts "positional arguments: $args"
+#     }
+#
+# Calling the proc above with:
+#
+#     some_proc Hello -opt-without-arg-1 World -opt-with-arg-2 arg2
+#
+# ... would print:
+
+#     -opt-without-arg-1: true
+#     -opt-without-arg-2: false
+#     -opt-with-arg-1: 123
+#     -opt-with-arg-2: arg2
+#     -opt-with-arg-3 is not specified
+#     positional arguments: Hello World
+
+proc parse_options { argv opt_desc } {
+    set argc [llength $argv]
+    set optc [llength $opt_desc]
+    set positional_args {}
+
+    # Initialize variables for options that don't take an argument.
+    for { set opt_idx 0 } { $opt_idx < $optc } { incr opt_idx } {
+	lassign [lindex $opt_desc $opt_idx] opt_name opt_var_name \
+	    opt_requires_arg
+
+	if { !$opt_requires_arg } {
+	    upvar $opt_var_name opt_var
+	    set opt_var false
+	}
+    }
+
+    # For each argument...
+    for { set arg_idx 0 } { $arg_idx < $argc } { incr arg_idx } {
+	set arg [lindex $argv $arg_idx]
+
+	if { $arg == "--" } {
+	    # End of options, append the remainder of arguments to list
+	    # of positional arguments.
+
+	    incr arg_idx
+	    set remainder [lrange $argv $arg_idx end]
+	    set positional_args [concat $positional_args $remainder]
+	    break
+	} elseif { [string index $arg 0] == "-" } {
+	    # It's an option.
+
+	    # Find the option in the option array.
+	    for { set opt_idx 0 } { $opt_idx < $optc } { incr opt_idx } {
+		lassign [lindex $opt_desc $opt_idx] opt_name opt_var_name \
+		    opt_requires_arg
+
+		if { $arg == "-${opt_name}" } {
+		    break
+		}
+	    }
+
+	    if { $opt_idx == $optc } {
+		error "while parsing `$arg`: unrecognized option"
+	    }
+
+	    if { $opt_requires_arg } {
+		# Option requires argument, consume following argument.
+		incr arg_idx
+		if { $arg_idx == $argc } {
+		    error "while parsing `$arg`: option requires an argument"
+		}
+
+		set opt_arg [lindex $argv $arg_idx]
+	    } else {
+		# Option requires no argument, use value "true".
+		set opt_arg true
+	    }
+
+	    # Set variable in the valler.
+	    upvar $opt_var_name opt_var
+	      set opt_var $opt_arg
+	} else {
+	    # It's a positional argument, append to positional argument list.
+	    lappend positional_args $arg
+	}
+    }
+
+    return $positional_args
+}
+
 # Always load compatibility stuff.
 load_lib future.exp
-- 
2.26.2

Re: [PATCH] gdb/testsuite: introduce parse_options procedure

[Keith Seitz]

On 5/26/20 6:02 AM, Simon Marchi via Gdb-patches wrote:
> In the testsuite, I really like when procedures take optional arguments
> using shell-like options that start with dash (for example,
> gdb_test_multiple).  I think this leads to clearer code than using
> parameters with defaults value.

Is this sufficiently more robust than parse_args to warrant two variations
of a similar theme? Can they be merged into one implementation?

Keith

Re: [PATCH] gdb/testsuite: introduce parse_options procedure

[Simon Marchi]

On 2020-05-26 1:45 p.m., Keith Seitz wrote:
> On 5/26/20 6:02 AM, Simon Marchi via Gdb-patches wrote:
>> In the testsuite, I really like when procedures take optional arguments
>> using shell-like options that start with dash (for example,
>> gdb_test_multiple).  I think this leads to clearer code than using
>> parameters with defaults value.
> 
> Is this sufficiently more robust than parse_args to warrant two variations
> of a similar theme? Can they be merged into one implementation?
> 
> Keith
> 

Damn, I completely missed this!  No, there's no point in adding another such
function.  I'll try to use parse_args for what I initially wanted to do (adding
an -inferior-args option to gdb_run_cmd).  If parse_args doesn't do what I need,
I'll look into improving it.

Thanks for letting me know about that.

Simon

Re: [PATCH] gdb/testsuite: introduce parse_options procedure

[Tom Tromey]

>>>>> "Simon" == Simon Marchi via Gdb-patches <gdb-patches@sourceware.org> writes:

Simon> Damn, I completely missed this!  No, there's no point in adding another such
Simon> function.

I didn't remember this either, and I was all set to send a "yes +1"
response to your email :-)

Tom