[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.
This commit is contained in:
parent
117eb59422
commit
2a3ad588e0
|
@ -1,3 +1,10 @@
|
|||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
#
|
||||
|
|
Loading…
Reference in New Issue