From patchwork Thu Aug 1 08:58:02 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tom de Vries X-Patchwork-Id: 33887 Received: (qmail 116019 invoked by alias); 1 Aug 2019 08:58:07 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 116011 invoked by uid 89); 1 Aug 2019 08:58:07 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_NUMSUBJECT, SPF_PASS autolearn=ham version=3.3.1 spammy= X-HELO: mx1.suse.de Received: from mx2.suse.de (HELO mx1.suse.de) (195.135.220.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 01 Aug 2019 08:58:05 +0000 Received: from relay2.suse.de (unknown [195.135.220.254]) by mx1.suse.de (Postfix) with ESMTP id E1ECAB61C; Thu, 1 Aug 2019 08:58:03 +0000 (UTC) Date: Thu, 1 Aug 2019 10:58:02 +0200 From: Tom de Vries To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [committed][gdb/testsuite] Fix gdb.base/structs.exp timeout with check-read1 Message-ID: <20190801085800.GA30177@delia> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.10.1 (2018-07-13) X-IsSubscribed: yes 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 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. #