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 13bc964f..4ed82ae 100644
--- a/gdb/testsuite/gdb.base/ui-redirect.exp
+++ b/gdb/testsuite/gdb.base/ui-redirect.exp
@@ -117,12 +117,10 @@
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 76dd70f..6e3fe2f 100644
--- a/gdb/testsuite/gdb.xml/tdesc-reload.exp
+++ b/gdb/testsuite/gdb.xml/tdesc-reload.exp
@@ -68,11 +68,7 @@
# 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 0b1104b..97841ca 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1313,7 +1313,8 @@
}
-# 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 @@
# 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.
