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

[Tom de Vries <tdevries@suse.de>]

[-- Attachment #1: Type: text/plain, Size: 1464 bytes --]

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?

Thanks,
- Tom

[-- Attachment #2: 0001-gdb-testsuite-Improve-argument-syntax-of-proc-arange.patch --]
[-- Type: text/x-patch, Size: 7740 bytes --]

[gdb/testsuite] Improve argument syntax of proc arange

---
 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/lib/dwarf.exp                        | 30 ++++++--------
 gdb/testsuite/lib/gdb.exp                          | 46 ++++++++++++++++------
 6 files changed, 53 insertions(+), 35 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/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index 120fa418201..48fcbb0af78 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,21 +2275,12 @@ 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 }
 	}
 
 	if { [is_64_target] } {
@@ -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
 	}
 
 	# End label.
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 093392709b4..4ea11d4fd3f 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.
@@ -7308,10 +7308,10 @@ proc using_fission { } {
 #
 # 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}} "-"
 #    # ...
 # }
 # myproc ABC -bar -baz DEF peanut butter
@@ -7319,34 +7319,38 @@ 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 } {
+    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"]
+            set result [lsearch -exact $args "$prefix$argument"]
+
             if {$result != -1} then {
-                uplevel 1 [list set $argument 1]
+		set value 1
                 set args [lreplace $args $result $result]
             } else {
-                uplevel 1 [list set $argument 0]
+		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 result [lsearch -exact $args "-[lindex $arg 0]"]
+
+            set result [lsearch -exact $args "$prefix[lindex $arg 0]"]
             if {$result != -1} then {
-                uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
+		set value [lindex $args [expr $result+1]]
                 set args [lreplace $args $result [expr $result+1]]
             } else {
-                uplevel 1 [list set $arg [lindex $argument 1]]
+		set value [lindex $argument 1]
             }
+	    uplevel $level [list set $arg $value]
         } else {
             error "Badly formatted argument \"$argument\" in argument set"
         }
@@ -7356,6 +7360,24 @@ proc parse_args { argset } {
     # number of items expected to be passed into the procedure...
 }
 
+# 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 "-"
+}
+
+# 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 ""
+    upvar 1 options options
+    if { [llength $options] != 0 } {
+	error "Option left unparsed $options"
+    }
+}
+
 # Capture the output of COMMAND in a string ignoring PREFIX (a regexp);
 # return that string.