aboutsummaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
authorTom de Vries <tdevries@suse.de>2019-08-01 10:48:11 +0200
committerTom de Vries <tdevries@suse.de>2019-08-01 10:48:11 +0200
commit2a3ad588e0758bc2c753dfa216c344036e5a22bc (patch)
tree52ee93595102ac3ce0ce201802f1cb5d61773e1d /gdb
parent117eb594228cf5447e49475e4fb33480c1f717a7 (diff)
downloadgdb-2a3ad588e0758bc2c753dfa216c344036e5a22bc.zip
gdb-2a3ad588e0758bc2c753dfa216c344036e5a22bc.tar.gz
gdb-2a3ad588e0758bc2c753dfa216c344036e5a22bc.tar.bz2
[gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1
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. gdb/testsuite/ChangeLog: 2019-08-01 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.
Diffstat (limited to 'gdb')
-rw-r--r--gdb/testsuite/ChangeLog7
-rw-r--r--gdb/testsuite/gdb.base/structs.exp6
-rw-r--r--gdb/testsuite/lib/gdb.exp32
3 files changed, 44 insertions, 1 deletions
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index d8b4c76..09921e0 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,6 +1,13 @@
2019-08-01 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.
+
+2019-08-01 Tom de Vries <tdevries@suse.de>
+
+ PR testsuite/24863
* gdb.base/break-interp.exp: Use exp_continue after each "info files"
line.
diff --git a/gdb/testsuite/gdb.base/structs.exp b/gdb/testsuite/gdb.base/structs.exp
index b73cbd7..0e9b8d2 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 68e9434..9ca34d8 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.
#