[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:
Tom de Vries 2019-08-01 10:48:11 +02:00
parent 117eb59422
commit 2a3ad588e0
3 changed files with 44 additions and 1 deletions

View File

@ -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

View File

@ -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

View File

@ -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.
#