[gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1
authorTom de Vries <tdevries@suse.de>
Thu, 1 Aug 2019 08:48:11 +0000 (10:48 +0200)
committerTom de Vries <tdevries@suse.de>
Thu, 1 Aug 2019 08:48:11 +0000 (10:48 +0200)
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.

gdb/testsuite/ChangeLog
gdb/testsuite/gdb.base/structs.exp
gdb/testsuite/lib/gdb.exp

index d8b4c766bb6bf52c3d36252657dff8e22bfc4286..09921e0296837271aad83e8733d595d4aad91514 100644 (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
index b73cbd7509922bf15a18a3e81554b23c8c7247ad..0e9b8d2e02c81f8cbc491b4622400303c28120e7 100644 (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
index 68e94346dee8f50b862756fabcd26feb3fed6c07..9ca34d8b153f448250bb1de33c56572e27050716 100644 (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.
 #