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

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

[Tom de Vries]

Hi,

Add a proc aranges such that we can generate .debug_aranges sections in dwarf
assembly using:
...
  cu { label cu_label } {
  ...
  }

  aranges {} cu_label {
    arange -c <comment> $addr $len
  }
...

Tested on x86_64-linux.

Any comments?

Thanks,
- Tom

[gdb/testsuite] Support .debug_aranges in dwarf assembly

---
 gdb/testsuite/lib/dwarf.exp | 173 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 173 insertions(+)

diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index 8dda798ddf8..32b110b3f3e 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -2208,6 +2208,179 @@ namespace eval Dwarf {
 	define_label $unit_end_label
     }
 
+    # Emit a DWARF .debug_aranges unit.
+    #
+    # OPTIONS is a list with an even number of elements containing
+    # option-name and option-value pairs.
+    # Current options are:
+    # is_64 0|1    - boolean indicating if you want to emit 64-bit DWARF
+    #                default = 0 (32-bit)
+    # cu_is_64 0|1 - boolean indicating if LABEL refers to a 64-bit DWARF CU
+    #                default = 0 (32-bit)
+    # section_version n
+    #                - section version number to emit
+    #                default = 2
+    # seg_size n   - the size of the adress selector in bytes: 0, 4, or 8
+    #                default = 0
+    #
+    # LABEL is the label of the corresponding CU.
+    #
+    # BODY is Tcl code that emits the parts which make up the body of
+    # the aranges unit.  It is evaluated in the caller's context.  The
+    # following commands are available for the BODY section:
+    #
+    #   arange [-c <comment>] [<segment selector>] <start> <length>
+    #     -- adds an address range.
+
+    proc aranges { options label body } {
+	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" }
+	    }
+	}
+
+	if { [is_64_target] } {
+	    set _addr_size 8
+	} else {
+	    set _addr_size 4
+	}
+
+	# Switch to .debug_aranges section.
+	_section .debug_aranges
+
+	# Keep track of offset from start of section entry to determine
+	# padding amount.
+	set offset 0
+
+	# Initial length.
+	declare_labels aranges_start aranges_end
+	set length "$aranges_end - $aranges_start"
+	set comment "Length"
+	if { $is_64 } {
+	    _op .4byte 0xffffffff
+	    _op .8byte $length $comment
+	    incr offset 12
+	} else {
+	    _op .4byte $length $comment
+	    incr offset 4
+	}
+
+	# Start label.
+	aranges_start:
+
+	# Section version.
+	_op .2byte $section_version "Section version"
+	incr offset 2
+
+	# Offset into .debug_info.
+	upvar $label my_label
+	if { $cu_is_64 } {
+	    _op .8byte $my_label "Offset into .debug_info"
+	    incr offset 8
+	} else {
+	    _op .4byte $my_label "Offset into .debug_info"
+	    incr offset 4
+	}
+
+	# Address size.
+	_op .byte $_addr_size "Address size"
+	incr offset
+
+	# Segment selector size.
+	_op .byte $_seg_size "Segment selector size"
+	incr offset
+
+	# Padding.
+	set tuple_size [expr 2 * $_addr_size + $_seg_size]
+	while { 1 } {
+	    if { [expr $offset % $tuple_size] == 0 } {
+		break
+	    }
+	    _op .byte 0 "Pad to $tuple_size byte boundary"
+	    incr offset
+	}
+
+	proc arange { args } {
+	    set nargs [llength $args]
+
+	    # Handle optional -c <comment>.
+	    if { $nargs >= 2 && [lindex $args 0] == "-c" } {
+		set comment [lindex $args 1]
+		# Wrap
+		set comment " ($comment)"
+		# Shift 2.
+		set args [lrange $args 2 end]
+		set nargs [llength $args]
+	    } else {
+		set comment ""
+	    }
+
+	    # Handle optional seg_sel.
+	    if { $nargs == 2 } {
+		set seg_sel ""
+	    } elseif { $nargs == 3 } {
+		set seg_sel [lindex $args 0]
+		# Shift 1.
+		set args [lrange $args 1 end]
+	    } else {
+		error "Incorrect number of args"
+	    }
+
+	    set arange_start [lindex $args 0]
+	    set arange_length [lindex $args 1]
+
+	    if { $seg_sel != "" } {
+		variable _seg_size
+		if { $_seg_size == 8 } {
+		    set seg_op .8byte
+		} elseif { $_segsize_size == 4 } {
+		    set seg_op .4byte
+		} else {
+		    error [join "Don't know how to handle" \
+			       "segment selector size $_seg_size"]
+		}
+		_op $seg_op $seg_sel "Address range segment selector$comment"
+	    }
+
+	    variable _addr_size
+	    if { $_addr_size == 8 } {
+		set addr_op .8byte
+	    } elseif { $_addr_size == 4 } {
+		set addr_op .4byte
+	    }
+
+	    _op $addr_op $arange_start "Address range start$comment"
+	    _op $addr_op $arange_length "Address range length$comment"
+	}
+
+	# Range tuples.
+	uplevel $body
+
+	# Terminator tuple.
+	if { $_seg_size == 0 } {
+	    arange -c terminator 0 0
+	} else {
+	    arange -c terminator 0 0 0
+	}
+
+	# End label.
+	aranges_end:
+    }
+
     proc _empty_array {name} {
 	upvar $name the_array
 

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

[Tom Tromey]

>>>>> "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.

Tom> +	proc arange { args } {

This is nested in 'aranges', but that's weird style in Tcl.
It redefines the proc every time 'aranges' is invoked.
I think it's better to just namespace scope this.

Tom

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

[Tom de Vries]

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

On 8/27/21 3:35 PM, 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.
> 

Done.

> Tom> +	proc arange { args } {
> 
> This is nested in 'aranges', but that's weird style in Tcl.
> It redefines the proc every time 'aranges' is invoked.
> I think it's better to just namespace scope this.

Done.

Committed as attached.

Thanks,
- Tom


[-- Attachment #2: 0002-gdb-testsuite-Support-.debug_aranges-in-dwarf-assembly.patch --]
[-- Type: text/x-patch, Size: 4601 bytes --]

[gdb/testsuite] Support .debug_aranges in dwarf assembly

Add a proc aranges such that we can generate .debug_aranges sections in dwarf
assembly using:
...
  cu { label cu_label } {
  ...
  }

  aranges {} cu_label {
    arange $addr $len [<comment>] [$segment_selector]
  }
...

Tested on x86_64-linux.

---
 gdb/testsuite/lib/dwarf.exp | 153 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 153 insertions(+)

diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index 3aef58e8560..a058a78df2e 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -2210,6 +2210,159 @@ namespace eval Dwarf {
 	define_label $unit_end_label
     }
 
+    # Emit a DWARF .debug_aranges entry.
+
+    proc arange { arange_start arange_length {comment ""} {seg_sel ""} } {
+	if { $comment != "" } {
+	    # Wrap
+	    set comment " ($comment)"
+	}
+
+	if { $seg_sel != "" } {
+	    variable _seg_size
+	    if { $_seg_size == 8 } {
+		set seg_op .8byte
+	    } elseif { $_seg_size == 4 } {
+		set seg_op .4byte
+	    } else {
+		error \
+		    "Don't know how to handle segment selector size $_seg_size"
+	    }
+	    _op $seg_op $seg_sel "Address range segment selector$comment"
+	}
+
+	variable _addr_size
+	if { $_addr_size == 8 } {
+	    set addr_op .8byte
+	} elseif { $_addr_size == 4 } {
+	    set addr_op .4byte
+	}
+
+	_op $addr_op $arange_start "Address range start$comment"
+	_op $addr_op $arange_length "Address range length$comment"
+    }
+
+    # Emit a DWARF .debug_aranges unit.
+    #
+    # OPTIONS is a list with an even number of elements containing
+    # option-name and option-value pairs.
+    # Current options are:
+    # is_64 0|1    - boolean indicating if you want to emit 64-bit DWARF
+    #                default = 0 (32-bit)
+    # cu_is_64 0|1 - boolean indicating if LABEL refers to a 64-bit DWARF CU
+    #                default = 0 (32-bit)
+    # section_version n
+    #                - section version number to emit
+    #                default = 2
+    # seg_size n   - the size of the adress selector in bytes: 0, 4, or 8
+    #                default = 0
+    #
+    # LABEL is the label of the corresponding CU.
+    #
+    # BODY is Tcl code that emits the parts which make up the body of
+    # the aranges unit.  It is evaluated in the caller's context.  The
+    # following commands are available for the BODY section:
+    #
+    #   arange [-c <comment>] [<segment selector>] <start> <length>
+    #     -- adds an address range.
+
+    proc aranges { options label body } {
+	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" }
+	    }
+	}
+
+	if { [is_64_target] } {
+	    set _addr_size 8
+	} else {
+	    set _addr_size 4
+	}
+
+	# Switch to .debug_aranges section.
+	_section .debug_aranges
+
+	# Keep track of offset from start of section entry to determine
+	# padding amount.
+	set offset 0
+
+	# Initial length.
+	declare_labels aranges_start aranges_end
+	set length "$aranges_end - $aranges_start"
+	set comment "Length"
+	if { $is_64 } {
+	    _op .4byte 0xffffffff
+	    _op .8byte $length $comment
+	    incr offset 12
+	} else {
+	    _op .4byte $length $comment
+	    incr offset 4
+	}
+
+	# Start label.
+	aranges_start:
+
+	# Section version.
+	_op .2byte $section_version "Section version"
+	incr offset 2
+
+	# Offset into .debug_info.
+	upvar $label my_label
+	if { $cu_is_64 } {
+	    _op .8byte $my_label "Offset into .debug_info"
+	    incr offset 8
+	} else {
+	    _op .4byte $my_label "Offset into .debug_info"
+	    incr offset 4
+	}
+
+	# Address size.
+	_op .byte $_addr_size "Address size"
+	incr offset
+
+	# Segment selector size.
+	_op .byte $_seg_size "Segment selector size"
+	incr offset
+
+	# Padding.
+	set tuple_size [expr 2 * $_addr_size + $_seg_size]
+	while { 1 } {
+	    if { [expr $offset % $tuple_size] == 0 } {
+		break
+	    }
+	    _op .byte 0 "Pad to $tuple_size byte boundary"
+	    incr offset
+	}
+
+	# Range tuples.
+	uplevel $body
+
+	# Terminator tuple.
+	set comment "Terminator"
+	if { $_seg_size == 0 } {
+	    arange 0 0 $comment
+	} else {
+	    arange 0 0 $comment 0
+	}
+
+	# End label.
+	aranges_end:
+    }
+
     proc _empty_array {name} {
 	upvar $name the_array
 

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

[Simon Marchi]

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.

> Tom> +	proc arange { args } {
> 
> This is nested in 'aranges', but that's weird style in Tcl.
> It redefines the proc every time 'aranges' is invoked.
> I think it's better to just namespace scope this.

But doing it this way makes it so that you can only invoke arange when
you are in aranges' body, isn't that useful?  I guess the downside to
redefining the proc everytime is performance, but that's really not a
concern here (it runs quickly enough).

Simon

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

[Keith Seitz]

On 8/27/21 8:09 AM, 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.

The test suite also contains the convenience proc parse_args which allows
the use of optional arguments using flag-like syntax and default values.

    proc arange {start length args} {

        parse_args {{comment ""} {seg_sel ""}}

        # ...
    }

    arange $start $end -comment "a comment"

See the definition in testsuite/lib/gdb.exp for usage examples.

Keith

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

[Tom Tromey]

>>>>> "Simon" == Simon Marchi <simon.marchi@polymtl.ca> writes:

Simon> Could we consistently use the
Simon> "options" pattern, such as the one used by aranges and cu?

Yeah, that would be fine by me.

>> This is nested in 'aranges', but that's weird style in Tcl.
>> It redefines the proc every time 'aranges' is invoked.
>> I think it's better to just namespace scope this.

Simon> But doing it this way makes it so that you can only invoke arange when
Simon> you are in aranges' body, isn't that useful?  I guess the downside to
Simon> redefining the proc everytime is performance, but that's really not a
Simon> concern here (it runs quickly enough).

To do that, it also have to delete the 'arange' proc after evaluating
the body.  I suppose that would be alright by me.

Tom

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

[Simon Marchi]

On 2021-08-27 12:14 p.m., Tom Tromey wrote:
>>>>>> "Simon" == Simon Marchi <simon.marchi@polymtl.ca> writes:
> 
> Simon> Could we consistently use the
> Simon> "options" pattern, such as the one used by aranges and cu?
> 
> Yeah, that would be fine by me.
> 
>>> This is nested in 'aranges', but that's weird style in Tcl.
>>> It redefines the proc every time 'aranges' is invoked.
>>> I think it's better to just namespace scope this.
> 
> Simon> But doing it this way makes it so that you can only invoke arange when
> Simon> you are in aranges' body, isn't that useful?  I guess the downside to
> Simon> redefining the proc everytime is performance, but that's really not a
> Simon> concern here (it runs quickly enough).
> 
> To do that, it also have to delete the 'arange' proc after evaluating
> the body.  I suppose that would be alright by me.

Really?  This technique is used in proc rnglists, and that doesn't seem
to cause a problem.

Simon

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

[Tom Tromey]

Simon> But doing it this way makes it so that you can only invoke arange when
Simon> you are in aranges' body, isn't that useful?  I guess the downside to
Simon> redefining the proc everytime is performance, but that's really not a
Simon> concern here (it runs quickly enough).

>> To do that, it also have to delete the 'arange' proc after evaluating
>> the body.  I suppose that would be alright by me.

Simon> Really?  This technique is used in proc rnglists, and that doesn't seem
Simon> to cause a problem.

AFAIK Tcl doesn't have any kind of lexical scoping for procs.
So, after "proc arange" is evaluated, the binding stays around.

This contradicts the what you were saying: "you can only invoke arange
when you are in aranges' body".  I think that's not the case, you can
invoke arange any time after any aranges call in the current invocation
of runtest.

I'm not concerned about the performance, I guess.  It's just
un-idiomatic to define a proc in a proc, normally this would only be
used for tricky things like changing a proc body at runtime.  So when I
see this sort of thing, I start looking for the trick.  There's nothing
incorrect, it's just less clear than it could be.

Tom

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

[Simon Marchi]

On 2021-08-27 1:10 p.m., Tom Tromey wrote:
> Simon> But doing it this way makes it so that you can only invoke arange when
> Simon> you are in aranges' body, isn't that useful?  I guess the downside to
> Simon> redefining the proc everytime is performance, but that's really not a
> Simon> concern here (it runs quickly enough).
> 
>>> To do that, it also have to delete the 'arange' proc after evaluating
>>> the body.  I suppose that would be alright by me.
> 
> Simon> Really?  This technique is used in proc rnglists, and that doesn't seem
> Simon> to cause a problem.
> 
> AFAIK Tcl doesn't have any kind of lexical scoping for procs.
> So, after "proc arange" is evaluated, the binding stays around.
> 
> This contradicts the what you were saying: "you can only invoke arange
> when you are in aranges' body".  I think that's not the case, you can
> invoke arange any time after any aranges call in the current invocation
> of runtest.

Ah, I didn't know, I said that without actually trying it.  I assumed it
worked like all other languages :).

> I'm not concerned about the performance, I guess.  It's just
> un-idiomatic to define a proc in a proc, normally this would only be
> used for tricky things like changing a proc body at runtime.  So when I
> see this sort of thing, I start looking for the trick.  There's nothing
> incorrect, it's just less clear than it could be.

So, defining the proc inside another is not useful then.

Simon

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

[Tom de Vries]

[-- 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.
 

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

[Simon Marchi]

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?

Simon

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

[Simon Marchi]

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

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

[Tom de Vries]

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

On 8/28/21 11:28 PM, Simon Marchi wrote:
> 
> 
> 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):
> 

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?

[ FWIW, a bit of bike-shedding.  I could imagine a pattern where you
pair a proc <name> and <name>_ like this:
...
  proc arange_ { options start len } {
    ...
  }
  proc arange { start len } {
    arange_ {} start len
  }
...
to be able to do:
...
  arange $start $len
...
and:
...
  arange_ { comment "bla" } $start $len
...
which would be slightly less annoying that having to specify empty
options. ]

Thanks,
- Tom


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

[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 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 <simon.marchi@polymtl.ca>

---
 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                          | 52 +++++++++++++++++-----
 6 files changed, 59 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..e248183d96a 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 {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..b1f90fcafbb 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,44 @@ 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"]
+            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]]
+		if { $eval } {
+		    set value [uplevel [expr $level + 1] [list subst $value]]
+		}
                 set args [lreplace $args $result [expr $result+1]]
             } else {
-                uplevel 1 [list set $arg [lindex $argument 1]]
+		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"
         }
@@ -7356,6 +7366,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 "-" 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 "" true
+    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.
 

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

[Simon Marchi]

> 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.

> [ FWIW, a bit of bike-shedding.  I could imagine a pattern where you
> pair a proc <name> and <name>_ like this:
> ...
>   proc arange_ { options start len } {
>     ...
>   }
>   proc arange { start len } {
>     arange_ {} start len
>   }
> ...
> to be able to do:
> ...
>   arange $start $len
> ...
> and:
> ...
>   arange_ { comment "bla" } $start $len
> ...
> which would be slightly less annoying that having to specify empty
> options. ]

I don't mind either way.  Even nicer would be to allow both:

  arange $start $len
  arange { comment "bla" } $start $len

But that would probably require going back to using args, which breaks
the purpose of what you're doing here.

Just to understand how we can do this in a systematic and predictable
way, would you do it just for "arange" or would you do it for all procs
of this style, like "cu"?  In some cases (like cu), the case of having
options is more common than the case of not having options.  So would
you still have "cu" without options and "cu_" with options?

Simon

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

[Tom de Vries]

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.
> 
>> [ FWIW, a bit of bike-shedding.  I could imagine a pattern where you
>> pair a proc <name> and <name>_ like this:
>> ...
>>   proc arange_ { options start len } {
>>     ...
>>   }
>>   proc arange { start len } {
>>     arange_ {} start len
>>   }
>> ...
>> to be able to do:
>> ...
>>   arange $start $len
>> ...
>> and:
>> ...
>>   arange_ { comment "bla" } $start $len
>> ...
>> which would be slightly less annoying that having to specify empty
>> options. ]
> 
> I don't mind either way.  Even nicer would be to allow both:
> 
>   arange $start $len
>   arange { comment "bla" } $start $len
> 
> But that would probably require going back to using args,

Yes, actually that is my much preferred option, and roughly what I
started out with, but apparently it's not good tcl style.

> which breaks
> the purpose of what you're doing here.
> 
> Just to understand how we can do this in a systematic and predictable
> way, would you do it just for "arange" or would you do it for all procs
> of this style, like "cu"?

I'd do it for all such procs.

> In some cases (like cu), the case of having
> options is more common than the case of not having options.  So would
> you still have "cu" without options and "cu_" with options?

Yes, cu_ or cu_1 or cu_o (where o stands for with options) or some such.

I think this should either be done everywhere (well, in lib/dwarf.exp at
least) or not at all.  I suspect it's one of those tricks that is easy
to pick up if you see it everywhere, but if it's used in just one
location it's easy to overlook or misunderstand.

Thanks,
- Tom

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

[Tom de Vries]

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

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

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

[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 <simon.marchi@polymtl.ca>

---
 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 <http://www.gnu.org/licenses/>.
+
+# 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.