From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp-out1.suse.de (smtp-out1.suse.de [195.135.220.28]) by sourceware.org (Postfix) with ESMTPS id A3099385841C for ; Mon, 30 Aug 2021 08:35:23 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org A3099385841C Received: from imap1.suse-dmz.suse.de (imap1.suse-dmz.suse.de [192.168.254.73]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-521) server-digest SHA512) (No client certificate requested) by smtp-out1.suse.de (Postfix) with ESMTPS id DAFFF21DC1; Mon, 30 Aug 2021 08:35:22 +0000 (UTC) Received: from imap1.suse-dmz.suse.de (imap1.suse-dmz.suse.de [192.168.254.73]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-521) server-digest SHA512) (No client certificate requested) by imap1.suse-dmz.suse.de (Postfix) with ESMTPS id BF38D1365C; Mon, 30 Aug 2021 08:35:22 +0000 (UTC) Received: from dovecot-director2.suse.de ([192.168.254.65]) by imap1.suse-dmz.suse.de with ESMTPSA id jrOKLUqYLGHVJgAAGKfGzw (envelope-from ); Mon, 30 Aug 2021 08:35:22 +0000 Subject: Re: [PATCH][gdb/testsuite] Support .debug_aranges in dwarf assembly To: Simon Marchi , Tom Tromey , Tom de Vries via Gdb-patches References: <20210826115625.GA22715@delia> <87eeafovsa.fsf@tromey.com> <40b7d95e-cc02-38c7-5406-0fc83a2a1b28@polymtl.ca> <3ece042f-2e05-66dd-2f18-0ba2555a76dd@polymtl.ca> <27d5091f-19e7-1f7f-8f0c-06e841c29d79@polymtl.ca> From: Tom de Vries Message-ID: <3164430f-f7fc-e202-6958-c1fa244ea686@suse.de> Date: Mon, 30 Aug 2021 10:35:22 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.12.0 MIME-Version: 1.0 In-Reply-To: Content-Type: multipart/mixed; boundary="------------402FE314508EF4DD4E7D8BD2" Content-Language: en-US X-Spam-Status: No, score=-12.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, NICE_REPLY_A, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 30 Aug 2021 08:35:34 -0000 This is a multi-part message in MIME format. --------------402FE314508EF4DD4E7D8BD2 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 7bit On 8/29/21 9:54 PM, Simon Marchi wrote: >> OK, I've integrated the subst bit (and made it conditional, that was >> still missing). Also added the subst part for the default arguments, >> and added a proper log message. Any further comments? > > LGTM. > I ended up committing this version. Changes: - added test-case - allow parse_options { { foo } } (previously, only parse_options { {foo} } would work) - documented ENUM in parse_list comment - fixed name of _seg_size options for proc aranges to seg_size Thanks, - Tom --------------402FE314508EF4DD4E7D8BD2 Content-Type: text/x-patch; charset=UTF-8; name="0001-gdb-testsuite-Improve-argument-syntax-of-proc-arange.patch" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename*0="0001-gdb-testsuite-Improve-argument-syntax-of-proc-arange.pa"; filename*1="tch" [gdb/testsuite] Improve argument syntax of proc arange The current syntax of proc arange is: ... proc arange { arange_start arange_length {comment ""} {seg_sel ""} } { ... and a typical call looks like: ... arange $start $len ... This style is somewhat annoying because if you want to specify the last parameter, you need to give the default values of all the other optional ones before as well: ... arange $start $len "" $seg_sel ... Update the syntax to: ... proc arange { options arange_start arange_length } { parse_options { { comment "" } { seg_sel "" } } ... such that a typical call looks like: ... arange {} $start $len ... and a call using seg_sel looks like: ... arange { seg_sel $seg_sel } $start $len ... Also update proc aranges, which already has an options argument, to use the new proc parse_options. Tested on x86_64-linux. Co-Authored-By: Simon Marchi --- gdb/testsuite/gdb.dlang/watch-loc.exp | 2 +- gdb/testsuite/gdb.dwarf2/dw2-ranges-base.exp | 6 +- .../gdb.dwarf2/frame-inlined-in-outer-frame.exp | 2 +- .../template-specification-full-name.exp | 2 +- gdb/testsuite/gdb.testsuite/parse_options_args.exp | 59 ++++++++++++ gdb/testsuite/lib/dwarf.exp | 31 +++--- gdb/testsuite/lib/gdb.exp | 104 ++++++++++++++------- 7 files changed, 150 insertions(+), 56 deletions(-) diff --git a/gdb/testsuite/gdb.dlang/watch-loc.exp b/gdb/testsuite/gdb.dlang/watch-loc.exp index 6e8b26e3109..e13400ed479 100644 --- a/gdb/testsuite/gdb.dlang/watch-loc.exp +++ b/gdb/testsuite/gdb.dlang/watch-loc.exp @@ -68,7 +68,7 @@ Dwarf::assemble $asm_file { } aranges {} cu_start { - arange $dmain_start $dmain_length + arange {} $dmain_start $dmain_length } } diff --git a/gdb/testsuite/gdb.dwarf2/dw2-ranges-base.exp b/gdb/testsuite/gdb.dwarf2/dw2-ranges-base.exp index e65b4c8610a..d55b7fd150e 100644 --- a/gdb/testsuite/gdb.dwarf2/dw2-ranges-base.exp +++ b/gdb/testsuite/gdb.dwarf2/dw2-ranges-base.exp @@ -125,9 +125,9 @@ Dwarf::assemble $asm_file { } aranges {} cu_label { - arange [lindex $main_func 0] [lindex $main_func 1] - arange [lindex $frame2_func 0] [lindex $frame2_func 1] - arange [lindex $frame3_func 0] [lindex $frame3_func 1] + arange {} [lindex $main_func 0] [lindex $main_func 1] + arange {} [lindex $frame2_func 0] [lindex $frame2_func 1] + arange {} [lindex $frame3_func 0] [lindex $frame3_func 1] } } diff --git a/gdb/testsuite/gdb.dwarf2/frame-inlined-in-outer-frame.exp b/gdb/testsuite/gdb.dwarf2/frame-inlined-in-outer-frame.exp index ff12cd79f19..f95558dffef 100644 --- a/gdb/testsuite/gdb.dwarf2/frame-inlined-in-outer-frame.exp +++ b/gdb/testsuite/gdb.dwarf2/frame-inlined-in-outer-frame.exp @@ -95,7 +95,7 @@ Dwarf::assemble $dwarf_asm { } aranges {} cu_label { - arange __cu_low_pc __cu_high_pc + arange {} __cu_low_pc __cu_high_pc } } diff --git a/gdb/testsuite/gdb.dwarf2/template-specification-full-name.exp b/gdb/testsuite/gdb.dwarf2/template-specification-full-name.exp index 5c59777e1b6..6e736f2c8ef 100644 --- a/gdb/testsuite/gdb.dwarf2/template-specification-full-name.exp +++ b/gdb/testsuite/gdb.dwarf2/template-specification-full-name.exp @@ -69,7 +69,7 @@ Dwarf::assemble $asm_file { } aranges {} cu_start { - arange "$main_start" "$main_length" + arange {} "$main_start" "$main_length" } } diff --git a/gdb/testsuite/gdb.testsuite/parse_options_args.exp b/gdb/testsuite/gdb.testsuite/parse_options_args.exp new file mode 100644 index 00000000000..ce14fc3cd7c --- /dev/null +++ b/gdb/testsuite/gdb.testsuite/parse_options_args.exp @@ -0,0 +1,59 @@ +# Copyright 2021 Free Software Foundation, Inc. +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# Testsuite self-tests for parse_options and parse_args. + +with_test_prefix parse_options { + proc test1 { options a b } { + set v2 "defval2" + parse_options { + { opt1 defval1 } + { opt2 $v2 } + { opt3 } + { opt4 } + } + + gdb_assert { [string equal $a "vala"] } + gdb_assert { [string equal $b "valb"] } + gdb_assert { [string equal $opt1 "val1"] } + gdb_assert { [string equal $opt2 "defval2"] } + gdb_assert { $opt3 == 1 } + gdb_assert { $opt4 == 0 } + } + + set v1 "val1" + test1 { opt1 $v1 opt3 } "vala" "valb" +} + +with_test_prefix parse_args { + proc test2 { args } { + parse_args { + { opt1 defval1 } + { opt2 defval2 } + { opt3 } + { opt4 } + } + gdb_assert { [llength $args] == 2 } + lassign $args a b + gdb_assert { [string equal $a "vala"] } + gdb_assert { [string equal $b "valb"] } + gdb_assert { [string equal $opt1 "val1"] } + gdb_assert { [string equal $opt2 "defval2"] } + gdb_assert { $opt3 == 1 } + gdb_assert { $opt4 == 0 } + } + + set v1 "val1" + test2 -opt1 $v1 -opt3 "vala" "valb" +} diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp index 120fa418201..7fb3561a443 100644 --- a/gdb/testsuite/lib/dwarf.exp +++ b/gdb/testsuite/lib/dwarf.exp @@ -2212,7 +2212,12 @@ namespace eval Dwarf { # Emit a DWARF .debug_aranges entry. - proc arange { arange_start arange_length {comment ""} {seg_sel ""} } { + proc arange { options arange_start arange_length } { + parse_options { + { comment "" } + { seg_sel "" } + } + if { $comment != "" } { # Wrap set comment " ($comment)" @@ -2270,22 +2275,14 @@ namespace eval Dwarf { variable _addr_size variable _seg_size - # Establish the defaults. - set is_64 0 - set cu_is_64 0 - set section_version 2 - set _seg_size 0 - # Handle options. - foreach { name value } $options { - switch -exact -- $name { - is_64 { set is_64 $value } - cu_is_64 { set cu_is_64 $value } - section_version {set section_version $value } - seg_size { set _seg_size $value } - default { error "unknown option $name" } - } + parse_options { + { is_64 0 } + { cu_is_64 0 } + { section_version 2 } + { seg_size 0 } } + set _seg_size $seg_size if { [is_64_target] } { set _addr_size 8 @@ -2354,9 +2351,9 @@ namespace eval Dwarf { # Terminator tuple. set comment "Terminator" if { $_seg_size == 0 } { - arange 0 0 $comment + arange {comment $comment} 0 0 } else { - arange 0 0 $comment 0 + arange {comment $comment seg_sel 0} 0 0 } # End label. diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 093392709b4..3aea7baaab0 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -7293,8 +7293,8 @@ proc using_fission { } { return [regexp -- "-gsplit-dwarf" $debug_flags] } -# Search the caller's ARGS list and set variables according to the list of -# valid options described by ARGSET. +# Search LISTNAME in uplevel LEVEL caller and set variables according to the +# list of valid options with prefix PREFIX described by ARGSET. # # The first member of each one- or two-element list in ARGSET defines the # name of a variable that will be added to the caller's scope. @@ -7305,13 +7305,15 @@ proc using_fission { } { # # If two elements are given, the second element is the default value of # the variable. This is then overwritten if the option exists in ARGS. +# If EVAL, then subst is called on the value, which allows variables +# to be used. # # Any parse_args elements in (the caller's) ARGS will be removed, leaving # any optional components. - +# # Example: # proc myproc {foo args} { -# parse_args {{bar} {baz "abc"} {qux}} +# parse_list args 1 {{bar} {baz "abc"} {qux}} "-" false # # ... # } # myproc ABC -bar -baz DEF peanut butter @@ -7319,43 +7321,79 @@ proc using_fission { } { # foo (=ABC), bar (=1), baz (=DEF), and qux (=0) # args will be the list {peanut butter} -proc parse_args { argset } { - upvar args args +proc parse_list { level listname argset prefix eval } { + upvar $level $listname args foreach argument $argset { - if {[llength $argument] == 1} { - # No default specified, so we assume that we should set - # the value to 1 if the arg is present and 0 if it's not. - # It is assumed that no value is given with the argument. - set result [lsearch -exact $args "-$argument"] - if {$result != -1} then { - uplevel 1 [list set $argument 1] - set args [lreplace $args $result $result] - } else { - uplevel 1 [list set $argument 0] - } - } elseif {[llength $argument] == 2} { - # There are two items in the argument. The second is a - # default value to use if the item is not present. - # Otherwise, the variable is set to whatever is provided - # after the item in the args. - set arg [lindex $argument 0] - set result [lsearch -exact $args "-[lindex $arg 0]"] - if {$result != -1} then { - uplevel 1 [list set $arg [lindex $args [expr $result+1]]] - set args [lreplace $args $result [expr $result+1]] - } else { - uplevel 1 [list set $arg [lindex $argument 1]] - } - } else { - error "Badly formatted argument \"$argument\" in argument set" - } + if {[llength $argument] == 1} { + # Normalize argument, strip leading/trailing whitespace. + # Allows us to treat {foo} and { foo } the same. + set argument [string trim $argument] + + # No default specified, so we assume that we should set + # the value to 1 if the arg is present and 0 if it's not. + # It is assumed that no value is given with the argument. + set pattern "$prefix$argument" + set result [lsearch -exact $args $pattern] + + if {$result != -1} then { + set value 1 + set args [lreplace $args $result $result] + } else { + set value 0 + } + uplevel $level [list set $argument $value] + } elseif {[llength $argument] == 2} { + # There are two items in the argument. The second is a + # default value to use if the item is not present. + # Otherwise, the variable is set to whatever is provided + # after the item in the args. + set arg [lindex $argument 0] + set pattern "$prefix[lindex $arg 0]" + set result [lsearch -exact $args $pattern] + + if {$result != -1} then { + set value [lindex $args [expr $result+1]] + if { $eval } { + set value [uplevel [expr $level + 1] [list subst $value]] + } + set args [lreplace $args $result [expr $result+1]] + } else { + set value [lindex $argument 1] + if { $eval } { + set value [uplevel $level [list subst $value]] + } + } + uplevel $level [list set $arg $value] + } else { + error "Badly formatted argument \"$argument\" in argument set" + } } +} + +# Search the caller's args variable and set variables according to the list of +# valid options described by ARGSET. + +proc parse_args { argset } { + parse_list 2 args $argset "-" false # The remaining args should be checked to see that they match the # number of items expected to be passed into the procedure... } +# Process the caller's options variable and set variables according +# to the list of valid options described by OPTIONSET. + +proc parse_options { optionset } { + parse_list 2 options $optionset "" true + + # Require no remaining options. + upvar 1 options options + if { [llength $options] != 0 } { + error "Options left unparsed: $options" + } +} + # Capture the output of COMMAND in a string ignoring PREFIX (a regexp); # return that string. --------------402FE314508EF4DD4E7D8BD2--