diff options
| author | Tom de Vries <tdevries@suse.de> | 2019-08-01 10:48:11 +0200 |
|---|---|---|
| committer | Tom de Vries <tdevries@suse.de> | 2019-08-01 10:48:11 +0200 |
| commit | 2a3ad588e0758bc2c753dfa216c344036e5a22bc (patch) | |
| tree | 52ee93595102ac3ce0ce201802f1cb5d61773e1d /gdb | |
| parent | 117eb594228cf5447e49475e4fb33480c1f717a7 (diff) | |
| download | binutils-gdb-2a3ad588e0758bc2c753dfa216c344036e5a22bc.tar.gz | |
[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/ChangeLog | 7 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.base/structs.exp | 6 | ||||
| -rw-r--r-- | gdb/testsuite/lib/gdb.exp | 32 |
3 files changed, 44 insertions, 1 deletions
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index d8b4c766bb6..09921e02968 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 b73cbd75099..0e9b8d2e02c 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 68e94346dee..9ca34d8b153 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. # |