Re: [PATCH][gdb/testsuite] Support .debug_aranges in dwarf assembly

[Simon Marchi via Gdb-patches <gdb-patches@sourceware.org>]

On 2021-08-28 4:29 p.m., Simon Marchi via Gdb-patches wrote:
> 
> 
> On 2021-08-28 11:31 a.m., Tom de Vries wrote:
>> On 8/27/21 5:09 PM, Simon Marchi via Gdb-patches wrote:
>>>
>>>
>>> On 2021-08-27 9:35 a.m., Tom Tromey wrote:
>>>>>>>>> "Tom" == Tom de Vries via Gdb-patches <gdb-patches@sourceware.org> writes:
>>>>
>>>> Tom> +    #   arange [-c <comment>] [<segment selector>] <start> <length>
>>>> Tom> +    #     -- adds an address range.
>>>>
>>>> I wonder if there's a way to make this more tcl-ish, say by rearranging
>>>> the order of arguments so that things can be defaulted.  I think the
>>>> "args"-parsing style should normally be a last resort.
>>>
>>> I personally don't like this style
>>>
>>>     proc arange { arange_start arange_length {comment ""} {seg_sel ""} }
>>>
>>> ... because if you want to specify the last parameter, you need to give
>>> all the other optional ones before.
>>>
>>> I also agree that just having:
>>>
>>>     proc arange { args }
>>>
>>> is not great, since we have to do the argument parsing by hand, and it's
>>> a bit opaque what the proc accepts.  Could we consistently use the
>>> "options" pattern, such as the one used by aranges and cu?
>>>
>>>    proc arange { options arange_start arange_length }
>>>
>>> The callers would look like:
>>>
>>>     arange {} $start $length
>>>     arange {
>>>        comment $comment
>>>        seg_sel $seg_sel
>>>     } $start $length
>>>
>>> I think that's a good compromise.  I could re-do the rnglists procs this
>>> way, if you'd like.
>>>
>>
>> This patch implements that approach, using a new proc parse_options
>> similar to parse_args.
>>
>> WDYT?
> 
> Here:
> 
> @@ -2354,9 +2350,9 @@ namespace eval Dwarf {
>  	# Terminator tuple.
>  	set comment "Terminator"
>  	if { $_seg_size == 0 } {
> -	    arange 0 0 $comment
> +	    arange [list comment $comment] 0 0
>  	} else {
> -	    arange 0 0 $comment 0
> +	    arange [list comment $comment seg_sel 0] 0 0
>  	}
>  
> 
> Could we apply some magic so that we are able to use { } instead of
> list?
> 
>   arange {
>     comment $comment
>     set_seg 0
>   } { ... }
> 
> ... instead of having to use [list ...]?  I suppose doing an "eval" or
> something of the option value in the caller's context?

Here's a patch that does it using subst (as well as changes rnglists and
loclists to use parse_options, but that should be in a separate patch):

From 3e841bf9351200980f004cdce40db7349095e558 Mon Sep 17 00:00:00 2001
From: Simon Marchi <simon.marchi@polymtl.ca>
Date: Sat, 28 Aug 2021 16:53:04 -0400
Subject: [PATCH] hey

Change-Id: I63e60d17ae16a020ce4d6de44baf3d152ea42a1a
---
 gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp   |  2 +-
 .../gdb.dwarf2/loclists-multiple-cus.exp      |  2 +-
 .../gdb.dwarf2/loclists-sec-offset.exp        |  2 +-
 .../gdb.dwarf2/loclists-start-end.exp         |  2 +-
 .../gdb.dwarf2/rnglists-multiple-cus.exp      |  2 +-
 .../gdb.dwarf2/rnglists-sec-offset.exp        |  2 +-
 gdb/testsuite/lib/dwarf.exp                   | 38 ++++++-------------
 gdb/testsuite/lib/gdb.exp                     |  7 ++--
 8 files changed, 22 insertions(+), 35 deletions(-)

diff --git a/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp b/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp
index e43f59ea1ad1..834e204237a7 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp
@@ -81,7 +81,7 @@ foreach_with_prefix ranges_sect {ranges rnglists} {
 		}
 	    }
 
-	    rnglists {
+	    rnglists {} {
 		table {
 		    rnglists_label: list_ {
 			start_end 0 1
diff --git a/gdb/testsuite/gdb.dwarf2/loclists-multiple-cus.exp b/gdb/testsuite/gdb.dwarf2/loclists-multiple-cus.exp
index 6b4f5c8cbb87..4c09b779f8e9 100644
--- a/gdb/testsuite/gdb.dwarf2/loclists-multiple-cus.exp
+++ b/gdb/testsuite/gdb.dwarf2/loclists-multiple-cus.exp
@@ -87,7 +87,7 @@ foreach_with_prefix is_64 {false true} {
 	    }
 	}
 
-	loclists -is-64 $is_64 {
+	loclists { is-64 $is_64 } {
 	    # This table is unused, but exists so that the used table is not at
 	    # the beginning of the section.
 	    table {
diff --git a/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp b/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp
index 573324af3d17..a34798c60a5f 100644
--- a/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp
+++ b/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp
@@ -165,7 +165,7 @@ foreach_with_prefix is_64 {false true} {
 	    }
 	}
 
-	loclists -is-64 $is_64 {
+	loclists { is-64 $is_64 } {
 	    # The lists in this table are accessed by direct offset
 	    # (DW_FORM_sec_offset).
 	    table {
diff --git a/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp b/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp
index bce3fb239791..b28262a2c7d5 100644
--- a/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp
+++ b/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp
@@ -78,7 +78,7 @@ foreach_with_prefix is_64 {false true} {
 	    }
 	}
 
-	loclists -is-64 $is_64 {
+	loclists { is-64 $is_64 } {
 	    # This table is unused, but exists so that the used table is not at
 	    # the beginning of the section.
 	    table {
diff --git a/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp b/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp
index e09cd4e8fe73..f5d6c82c9084 100644
--- a/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp
+++ b/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp
@@ -63,7 +63,7 @@ foreach_with_prefix is_64 {false true} {
 	    }
 	}
 
-	rnglists -is-64 $is_64 {
+	rnglists { is-64 $is_64 } {
 	    # This table is unused, but exists so that the used table is not at
 	    # the beginning of the section.
 	    table {
diff --git a/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp b/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp
index 0733e90abc74..0f9490b05054 100644
--- a/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp
+++ b/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp
@@ -90,7 +90,7 @@ foreach_with_prefix is_64 {false true} {
 	    }
 	}
 
-	rnglists -is-64 $is_64 {
+	rnglists { is-64 $is_64 } {
 	    # The lists in this table are accessed by direct offset
 	    # (DW_FORM_sec_offset).
 	    table {
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index 48fcbb0af780..dafb4107e3e0 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -1542,27 +1542,20 @@ namespace eval Dwarf {
     #
     # The target address size is based on the current target's address size.
     #
-    # There is one mandatory positional argument, BODY, which must be Tcl code
-    # that emits the content of the section.  It is evaluated in the caller's
-    # context.
+    # BODY must be Tcl code that emits the content of the section.  It is
+    # evaluated in the caller's context.
     #
     # The following option can be used:
     #
-    #  - -is-64 true|false: Whether to use 64-bit DWARF instead of 32-bit DWARF.
-    #                       The default is 32-bit.
+    #  - is-64 true|false: Whether to use 64-bit DWARF instead of 32-bit DWARF.
+    #                      The default is 32-bit.
 
-    proc rnglists { args } {
+    proc rnglists { options body } {
 	variable _debug_rnglists_addr_size
 	variable _debug_rnglists_offset_size
 	variable _debug_rnglists_is_64_dwarf
 
-	parse_args {{"is-64" "false"}}
-
-	if { [llength $args] != 1 } {
-	    error "rnglists proc expects one positional argument (body)"
-	}
-
-	lassign $args body
+	parse_options {{"is-64" "false"}}
 
 	if [is_64_target] {
 	    set _debug_rnglists_addr_size 8
@@ -1729,27 +1722,20 @@ namespace eval Dwarf {
     #
     # The target address size is based on the current target's address size.
     #
-    # There is one mandatory positional argument, BODY, which must be Tcl code
-    # that emits the content of the section.  It is evaluated in the caller's
-    # context.
+    # BODY must be Tcl code that emits the content of the section.  It is
+    # evaluated in the caller's context.
     #
     # The following option can be used:
     #
-    #  - -is-64 true|false: Whether to use 64-bit DWARF instead of 32-bit DWARF.
-    #                       The default is 32-bit.
+    #  - is-64 true|false: Whether to use 64-bit DWARF instead of 32-bit DWARF.
+    #                      The default is 32-bit.
 
-    proc loclists { args } {
+    proc loclists { options body } {
 	variable _debug_loclists_addr_size
 	variable _debug_loclists_offset_size
 	variable _debug_loclists_is_64_dwarf
 
-	parse_args {{"is-64" "false"}}
-
-	if { [llength $args] != 1 } {
-	    error "loclists proc expects one positional argument (body)"
-	}
-
-	lassign $args body
+	parse_options {{"is-64" "false"}}
 
 	if [is_64_target] {
 	    set _debug_loclists_addr_size 8
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 4ea11d4fd3f6..3be0948d562b 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -7319,7 +7319,7 @@ proc using_fission { } {
 # foo (=ABC), bar (=1), baz (=DEF), and qux (=0)
 # args will be the list {peanut butter}
 
-proc parse_list { level listname argset prefix } {
+proc parse_list { level listname argset prefix eval } {
     upvar $level $listname args
 
     foreach argument $argset {
@@ -7346,6 +7346,7 @@ proc parse_list { level listname argset prefix } {
             set result [lsearch -exact $args "$prefix[lindex $arg 0]"]
             if {$result != -1} then {
 		set value [lindex $args [expr $result+1]]
+		set value [uplevel [expr $level + 1] [list subst $value]]
                 set args [lreplace $args $result [expr $result+1]]
             } else {
 		set value [lindex $argument 1]
@@ -7364,14 +7365,14 @@ proc parse_list { level listname argset prefix } {
 # valid options described by ARGSET.
 
 proc parse_args { argset } {
-    parse_list 2 args $argset "-"
+    parse_list 2 args $argset "-" false
 }
 
 # 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 ""
+    parse_list 2 options $optionset "" true
     upvar 1 options options
     if { [llength $options] != 0 } {
 	error "Option left unparsed $options"
-- 
2.33.0