diff options
| -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 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. # |