This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[committed][gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1
- From: Tom de Vries <tdevries at suse dot de>
- To: gdb-patches at sourceware dot org
- Cc: Tom Tromey <tom at tromey dot com>
- Date: Thu, 1 Aug 2019 10:58:02 +0200
- Subject: [committed][gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1
Hi,
With gdb.base/structs.exp and check-read1 we get:
...
FAIL: gdb.base/structs.exp: p chartest (timeout)
...
Fix this by using gdb_test_sequence.
Tested on x86_64-linux.
Committed to trunk.
Thanks,
- Tom
[gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1
gdb/testsuite/ChangeLog:
2019-07-31 Tom de Vries <tdevries@suse.de>
PR testsuite/24863
* gdb.base/structs.exp: Fix check-read1 timeout using
gdb_test_sequence.
* lib/gdb.exp (tcl_version_at_least, lrepeat): New proc.
---
gdb/testsuite/gdb.base/structs.exp | 6 +++++-
gdb/testsuite/lib/gdb.exp | 32 ++++++++++++++++++++++++++++++++
2 files changed, 37 insertions(+), 1 deletion(-)
diff --git a/gdb/testsuite/gdb.base/structs.exp b/gdb/testsuite/gdb.base/structs.exp
index b73cbd7509..0e9b8d2e02 100644
--- a/gdb/testsuite/gdb.base/structs.exp
+++ b/gdb/testsuite/gdb.base/structs.exp
@@ -102,7 +102,11 @@ proc start_structs_test { types } {
# Verify $anychar_re can match all the values of `char' type.
gdb_breakpoint [gdb_get_line_number "chartest-done"]
gdb_continue_to_breakpoint "chartest-done" ".*chartest-done.*"
- gdb_test "p chartest" "= {({c = ${anychar_re}}, ){255}{c = ${anychar_re}}}"
+ gdb_test_sequence "p chartest" "" \
+ [concat \
+ [list "= \{"] \
+ [lrepeat 255 "^\{c = ${anychar_re}\}, "] \
+ [list "^\{c = ${anychar_re}\}\}"]]
}
# check that at the struct containing all the relevant types is correct
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 68e94346de..9ca34d8b15 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1103,6 +1103,38 @@ proc gdb_test { args } {
}]
}
+# Return 1 if tcl version used is at least MAJOR.MINOR
+proc tcl_version_at_least { major minor } {
+ global tcl_version
+ regexp {^([0-9]+)\.([0-9]+)$} $tcl_version \
+ dummy tcl_version_major tcl_version_minor
+ if { $tcl_version_major > $major } {
+ return 1
+ } elseif { $tcl_version_major == $major \
+ && $tcl_version_major >= $minor } {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+if { [tcl_version_at_least 8 5] == 0 } {
+ # lrepeat was added in tcl 8.5. Only add if missing.
+ proc lrepeat { n element } {
+ if { [string is integer -strict $n] == 0 } {
+ error "expected integer but got \"$n\""
+ }
+ if { $n < 0 } {
+ error "bad count \"$n\": must be integer >= 0"
+ }
+ set res [list]
+ for {set i 0} {$i < $n} {incr i} {
+ lappend res $element
+ }
+ return $res
+ }
+}
+
# gdb_test_no_output COMMAND MESSAGE
# Send a command to GDB and verify that this command generated no output.
#