+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
# 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
}]
}
+# 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.
#