From patchwork Thu Sep 19 11:13:23 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: 34589 Received: (qmail 23680 invoked by alias); 19 Sep 2019 11:13:29 -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 23671 invoked by uid 89); 19 Sep 2019 11:13:29 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, SPF_PASS autolearn=ham version=3.3.1 spammy=drawback 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, 19 Sep 2019 11:13:27 +0000 Received: from relay2.suse.de (unknown [195.135.220.254]) by mx1.suse.de (Postfix) with ESMTP id 1BCA1AFCC for ; Thu, 19 Sep 2019 11:13:25 +0000 (UTC) Date: Thu, 19 Sep 2019 13:13:23 +0200 From: Tom de Vries To: gdb-patches@sourceware.org Subject: [PATCH][gdb/testsuite] Introduce gdb_test_ext Message-ID: <20190919111322.GA29391@delia> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.10.1 (2018-07-13) X-IsSubscribed: yes Hi, In commit 25e5c20918 "[gdb/testsuite] Allow some tests in gdb.base/store.exp to be unsupported" we replace a gdb_test: ... gdb_test "print l" " = ${l}" \ "${prefix}; print old l, expecting ${l}" ... with a gdb_test_multiple: ... set supported 1 set test "${prefix}; print old l, expecting ${l}" gdb_test_multiple "print l" "$test" { -re " = \r\n$gdb_prompt $" { unsupported $test set supported 0 } -re " = ${l}\r\n$gdb_prompt $" { pass $test } } ... in order to handle the UNSUPPORTED case. This has the drawback that we have to be explicit about the gdb_prompt, and move the gdb_test arguments around to fit the gdb_test_multiple format. Introduce a new proc gdb_test_ext that behaves as gdb_test, but also allows extension, allowing us to rewrite the gdb_test_multiple above in a form resembling the original gdb_test: ... set supported 1 gdb_test_ext "print l" " = ${l}" \ "${prefix}; print old l, expecting ${l}" \ -- [list "unsupported" " = " "set supported 0"] ... Tested on x86_64-linux. OK for trunk? Thanks, - Tom [gdb/testsuite] Introduce gdb_test_ext gdb/testsuite/ChangeLog: 2019-09-19 Tom de Vries * lib/gdb.exp (gdb_test_ext): New proc. * gdb.base/store.exp: Use gdb_test_ext. --- gdb/testsuite/gdb.base/store.exp | 24 +++---------- gdb/testsuite/lib/gdb.exp | 77 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 81 insertions(+), 20 deletions(-) diff --git a/gdb/testsuite/gdb.base/store.exp b/gdb/testsuite/gdb.base/store.exp index 9c19ce15a7..d97b4cb962 100644 --- a/gdb/testsuite/gdb.base/store.exp +++ b/gdb/testsuite/gdb.base/store.exp @@ -56,16 +56,8 @@ proc check_set { t l r new add } { } set supported 1 - set test "${prefix}; print old l, expecting ${l}" - gdb_test_multiple "print l" "$test" { - -re " = \r\n$gdb_prompt $" { - unsupported $test - set supported 0 - } - -re " = ${l}\r\n$gdb_prompt $" { - pass $test - } - } + gdb_test_ext "print l" " = ${l}" "${prefix}; print old l, expecting ${l}" \ + -- [list "unsupported" " = " "set supported 0"] if { $supported } { gdb_test "print r" " = ${r}" \ "${prefix}; print old r, expecting ${r}" @@ -102,16 +94,8 @@ proc up_set { t l r new } { "${prefix}; up" set supported 1 - set test "${prefix}; print old l, expecting ${l}" - gdb_test_multiple "print l" "$test" { - -re " = \r\n$gdb_prompt $" { - unsupported $test - set supported 0 - } - -re " = ${l}\r\n$gdb_prompt $" { - pass $test - } - } + gdb_test_ext "print l" " = ${l}" "${prefix}; print old l, expecting ${l}" \ + -- [list "unsupported" " = " "set supported 0"] if { $supported } { gdb_test "print r" " = ${r}" \ "${prefix}; print old r, expecting ${r}" diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index acbeb01376..dc990b370e 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -1103,6 +1103,83 @@ proc gdb_test { args } { }] } +# As gdb_test, but with additional parameters, listed after a "--" separator. +# Handled extra parameters: +# - [list "unsupported" []] +# The idea is to prevent the need to rewrite gdb_test into gdb_test_multiple +# if some modification is needed. +proc gdb_test_ext { args } { + global gdb_prompt + upvar timeout timeout + + # Find the '--' separator. + set pos -1 + set index 0 + while { $index < [llength $args] } { + if { [lindex $args $index] == "--" } { + set pos $index + break + } + set index [expr $index + 1] + } + if { $pos == -1 } { + error "No -- argument found" + } + + if { $pos > 2 } then { + set message [lindex $args 2] + } else { + set message [lindex $args 0] + } + set command [lindex $args 0] + set pattern [lindex $args 1] + + set user_code {} + lappend user_code { + -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" { + if ![string match "" $message] then { + pass "$message" + } + } + } + + if { $pos == 5 } { + set question_string [lindex $args 3] + set response_string [lindex $args 4] + lappend user_code { + -re "(${question_string})$" { + send_gdb "$response_string\n" + exp_continue + } + } + } + + set index [expr $pos + 1] + while { $index < [llength $args] } { + set arg [lindex $args $index] + set index [expr $index + 1] + set kind [lindex $arg 0] + switch $kind { + "unsupported" { + set unsupported_pattern [lindex $arg 1] + set unsupported_code [lindex $arg 2] + if { $unsupported_code == "" } { + set unsupported_code "expr true" + } + lappend user_code { + -re "\[\r\n\]*(?:$unsupported_pattern)\[\r\n\]+$gdb_prompt $" { + unsupported $message + eval uplevel $unsupported_code + } + } + } + } + } + + set user_code [join $user_code " "] + return [gdb_test_multiple $command $message $user_code] +} + # Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR. proc version_at_least { major minor at_least_major at_least_minor} { if { $major > $at_least_major } {