[committed][gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1

Tom de Vries tdevries@suse.de
Thu Aug 1 08:58:00 GMT 2019


Hi,

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.

Committed to trunk.

Thanks,
- Tom

[gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1

gdb/testsuite/ChangeLog:

2019-07-31  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/gdb.base/structs.exp |  6 +++++-
 gdb/testsuite/lib/gdb.exp          | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 1 deletion(-)

diff --git a/gdb/testsuite/gdb.base/structs.exp b/gdb/testsuite/gdb.base/structs.exp
index b73cbd7509..0e9b8d2e02 100644
--- 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 68e94346de..9ca34d8b15 100644
--- 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.
 #



More information about the Gdb-patches mailing list