Support -prompt and -lbl in gdb_test

This teaches gdb_test to forward the -prompt and -lbl options to
gdb_test_multiple.

The option parsing is done with parse_args.

As a cleanup, instead of using llength and lindex to get at the
positional arguments, use lassign, and check whether the corresponding
variable is empty.

Convert gdb.base/ui-redirect.exp and gdb.xml/tdesc-reload.exp to use
gdb_test -prompt/-lbl instead of gdb_test_multiple as examples.

Change-Id: I243e1296d32c05a421ccef30b63d43a89eaeb4a0

diff --git a/gdb/testsuite/gdb.base/ui-redirect.exp b/gdb/testsuite/gdb.base/ui-redirect.exp
index 13bc964f46c92c4956fb659335f184d7e00f7d8e..4ed82ae63bf505609f99a2926c65f441521ba7ba 100644 (file)
--- a/gdb/testsuite/gdb.base/ui-redirect.exp
+++ b/gdb/testsuite/gdb.base/ui-redirect.exp
@@ -117,12 +117,10 @@ with_test_prefix "debugging" {
     gdb_test "set logging enabled on" \
     "Copying output to /dev/null.*Copying debug output to /dev/null\\."
 
-    set prompt "$gdb_prompt \\\[infrun\\\] fetch_inferior_event: exit\r\n$"
-    gdb_test_multiple "continue" "continue" -prompt $prompt {
-       -re "Continuing.*\\\[infrun\\\] .*\\\[infrun\\\] .*Breakpoint \[0-9\]+, foo.*$prompt$" {
-           pass $gdb_test_name
-       }
-    }
+    gdb_test \
+       -prompt "$gdb_prompt \\\[infrun\\\] fetch_inferior_event: exit\r\n$" \
+       "continue" \
+       "Continuing.*\\\[infrun\\\] .*\\\[infrun\\\] .*Breakpoint \[0-9\]+, foo.*"
 
     gdb_test "set debug infrun 0"
     gdb_test "set logging enabled off" "Done logging to /dev/null\\."

diff --git a/gdb/testsuite/gdb.xml/tdesc-reload.exp b/gdb/testsuite/gdb.xml/tdesc-reload.exp
index 76dd70fb6d3729e753c4a7fdb742c5772d1a8eb8..6e3fe2f530422bf0a01577c3752a6a329425aea1 100644 (file)
--- a/gdb/testsuite/gdb.xml/tdesc-reload.exp
+++ b/gdb/testsuite/gdb.xml/tdesc-reload.exp
@@ -68,11 +68,7 @@ if ![runto_main] then {
 
 # Run info registers just to check this appears to run fine with the
 # new target description.
-gdb_test_multiple "info all-registers" "Run info registers" -lbl {
-    -re -wrap "" {
-       pass $gdb_test_name
-    }
-}
+gdb_test -lbl "info all-registers" "" "Run info registers"
 
 # Write out the current target description.
 gdb_test_no_output "pipe maint print xml-tdesc | cat > $xml_file_3" \

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 0b1104bd299d664b97882ceeeae3bb1f92a3b1bc..97841ca19a1e9a632e665f92a2b4b35c6c8c531f 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1313,7 +1313,8 @@ proc gdb_test_multiline { name args } {
 }
 
 
-# gdb_test COMMAND PATTERN MESSAGE QUESTION RESPONSE
+# gdb_test [-prompt PROMPT_REGEXP] [-lbl]
+#          COMMAND [PATTERN] [MESSAGE] [QUESTION RESPONSE]
 # Send a command to gdb; test the result.
 #
 # COMMAND is the command to execute, send to GDB with send_gdb.  If
@@ -1331,61 +1332,73 @@ proc gdb_test_multiline { name args } {
 #   doesn't print the question.
 # RESPONSE is the response to send when QUESTION appears.
 #
+# -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,
 #    0 if the test passes,
 #   -1 if there was an internal error.
-#  
+#
 proc gdb_test { args } {
     global gdb_prompt
     upvar timeout timeout
 
+    parse_args {
+       {prompt ""}
+       {lbl}
+    }
+
+    lassign $args command pattern message question response
+
     # Can't have a question without a response.
-    if { [llength $args] == 4 || [llength $args] > 5 } {
+    if { $question != "" && $response == "" || [llength $args] > 5 } {
        error "Unexpected arguments: $args"
     }
 
-    if [llength $args]>2 then {
-       set message [lindex $args 2]
-    } else {
-       set message [lindex $args 0]
+    if { $message == "" } {
+       set message $command
     }
-    set command [lindex $args 0]
-    set pattern [lindex $args 1]
 
-    set must_see_question 0
-    if { [llength $args] == 5 } {
-       set must_see_question 1
-       set saw_question 0
+    if { $prompt == "" } {
+       set prompt "$gdb_prompt $"
     }
 
+    set saw_question 0
+
     set user_code {}
     lappend user_code {
-       -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" {
+       -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$prompt" {
            if ![string match "" $message] then {
-               if {$must_see_question} {
+               if { $question != "" } {
                    gdb_assert $saw_question "$message"
                } else {
                    pass "$message"
                }
-            }
-        }
+           }
+       }
     }
 
-    if { [llength $args] == 5 } {
-       set question_string [lindex $args 3]
-       set response_string [lindex $args 4]
+    if { $question != "" } {
        lappend user_code {
-           -re "(${question_string})$" {
+           -re "$question$" {
                set saw_question 1
-               send_gdb "$response_string\n"
+               send_gdb "$response\n"
                exp_continue
            }
        }
-     }
+    }
 
     set user_code [join $user_code]
-    return [gdb_test_multiple $command $message $user_code]
+
+    set opts {}
+    lappend "-prompt $prompt"
+    if {$lbl} {
+       lappend opts "-lbl"
+    }
+
+    return [gdb_test_multiple $command $message {*}$opts $user_code]
 }
 
 # Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR.