From: Tom de Vries <tdevries@suse.de>
Date: Thu, 1 Aug 2019 08:48:11 +0000 (+0200)
Subject: [gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1
X-Git-Tag: binutils-2_33~358
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=2a3ad588e0758bc2c753dfa216c344036e5a22bc;p=external%2Fbinutils.git

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