[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.

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index d8b4c76..09921e0 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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.
 #