* [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists
@ 2021-08-30 15:20 Simon Marchi
2021-08-30 15:20 ` [PATCH 2/2] gdb/testsuite/dwarf: use options for rnglists/loclists procs Simon Marchi
2021-10-01 2:27 ` [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists Simon Marchi
0 siblings, 2 replies; 3+ messages in thread
From: Simon Marchi @ 2021-08-30 15:20 UTC (permalink / raw)
To: gdb-patches
When I wrote support for rnglists and loclists in the testsuite's DWARF
assembler, I made it with nested procs, for example proc "table" inside
proc "rnglists". The intention was that this proc "table" could only be
used by the user while inside proc "rnglists"'s body. I had chosen very
simple names, thinking there was no chance of name clashes. I recently
learned that this is not how TCL works. This ends up defining a proc
"table" in the current namespace ("Dwarf" in this case).
Things still work if you generate rnglists and loclists in the same
file, as each redefines its own procedures when executing. But if a
user of the assembler happened to define a convenience "table" or
"start_end" procedure, for example, it would get overriden.
I'd like to change how this works to reduce the chances of a name clash.
- Move the procs out of each other, so they are not defined in a nested
fashion.
- Prefix them with "_rnglists_" or "_loclists_".
- While calling $body in the various procs, temporarily make the procs
available under their "short" name. For example, while in rngllists'
body, make _rnglists_table available as just "table". This allows
existing code to keep working and keeps it not too verbose.
- Modify with_override to allow the overriden proc to not exist. In
that case, the temporary proc is deleted on exit.
Note the non-conforming indentation when calling with_override in
_loclists_list. This is on purpose: as we implement more loclists (and
rnglists) entry types, the indentation would otherwise get larger and
larger without much value for readability. So I think it's reasonable
here to put them on the same level.
Change-Id: I7bb48d26fcb0dba1ae4dada05c0c837212424328
---
gdb/testsuite/lib/dwarf.exp | 561 +++++++++++++++++++-----------------
gdb/testsuite/lib/gdb.exp | 19 +-
2 files changed, 311 insertions(+), 269 deletions(-)
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index 7fb3561a4436..fbe93207c7a5 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -1592,137 +1592,150 @@ namespace eval Dwarf {
return ".Lrnglists_table_${_debug_rnglists_table_count}_list_${list_idx}"
}
- # Generate one table (header + offset array + range lists).
- #
- # Accepts one positional argument, BODY. BODY may call the LIST_
- # procedure to generate rnglists.
- #
- # The -post-header-label option can be used to define a label just after
- # the header of the table. This is the label that a DW_AT_rnglists_base
- # attribute will usually refer to.
- #
- # The `-with-offset-array true|false` option can be used to control
- # whether the headers of the location list tables have an array of
- # offset. The default is true.
-
- proc table { args } {
- variable _debug_rnglists_table_count
- variable _debug_rnglists_addr_size
- variable _debug_rnglists_offset_size
- variable _debug_rnglists_is_64_dwarf
+ with_override Dwarf::table Dwarf::_rnglists_table {
+ uplevel $body
+ }
+ }
- parse_args {
- {post-header-label ""}
- {with-offset-array true}
- }
+ # Generate one rnglists table (header + offset array + range lists).
+ #
+ # This proc is meant to be used within proc rnglists' body. It is made
+ # available as `table` while inside proc rnglists' body.
+ #
+ # Accepts one positional argument, BODY. BODY may call the LIST_ procedure
+ # to generate rnglists.
+ #
+ # The -post-header-label option can be used to define a label just after
+ # the header of the table. This is the label that a DW_AT_rnglists_base
+ # attribute will usually refer to.
+ #
+ # The `-with-offset-array true|false` option can be used to control whether
+ # the headers of the location list tables have an array of offset. The
+ # default is true.
- if { [llength $args] != 1 } {
- error "table proc expects one positional argument (body)"
- }
+ proc _rnglists_table { args } {
+ variable _debug_rnglists_table_count
+ variable _debug_rnglists_addr_size
+ variable _debug_rnglists_offset_size
+ variable _debug_rnglists_is_64_dwarf
+
+ parse_args {
+ {post-header-label ""}
+ {with-offset-array true}
+ }
- lassign $args body
+ if { [llength $args] != 1 } {
+ error "table proc expects one positional argument (body)"
+ }
- # Generate one range list.
- #
- # BODY may call the various procs defined below to generate list entries.
- # They correspond to the range list entry kinds described in section 2.17.3
- # of the DWARF 5 spec.
- #
- # To define a label pointing to the beginning of the list, use
- # the conventional way of declaring and defining labels:
- #
- # declare_labels the_list
- #
- # the_list: list_ {
- # ...
- # }
+ lassign $args body
- proc list_ { body } {
- variable _debug_rnglists_list_count
+ # Count of lists in the table.
+ variable _debug_rnglists_list_count 0
- # Define a label for this list. It is used to build the offset
- # array later.
- set list_label [_compute_list_label $_debug_rnglists_list_count]
- define_label $list_label
+ # Generate the lists ops first, because we need to know how many
+ # lists there are to generate the header and offset table.
+ set lists_ops [_defer_to_string {
+ with_override Dwarf::list_ Dwarf::_rnglists_list {
+ uplevel $body
+ }
+ }]
- # Emit a DW_RLE_start_end entry.
+ set post_unit_len_label \
+ [_compute_label "rnglists_table_${_debug_rnglists_table_count}_post_unit_len"]
+ set post_header_label \
+ [_compute_label "rnglists_table_${_debug_rnglists_table_count}_post_header"]
+ set table_end_label \
+ [_compute_label "rnglists_table_${_debug_rnglists_table_count}_end"]
- proc start_end { start end } {
- variable _debug_rnglists_addr_size
+ # Emit the table header.
+ if { $_debug_rnglists_is_64_dwarf } {
+ _op .4byte 0xffffffff "unit length 1/2"
+ _op .8byte "$table_end_label - $post_unit_len_label" "unit length 2/2"
+ } else {
+ _op .4byte "$table_end_label - $post_unit_len_label" "unit length"
+ }
- _op .byte 0x06 "DW_RLE_start_end"
- _op .${_debug_rnglists_addr_size}byte $start "start"
- _op .${_debug_rnglists_addr_size}byte $end "end"
- }
+ define_label $post_unit_len_label
- uplevel $body
+ _op .2byte 5 "dwarf version"
+ _op .byte $_debug_rnglists_addr_size "address size"
+ _op .byte 0 "segment selector size"
- # Emit end of list.
- _op .byte 0x00 "DW_RLE_end_of_list"
+ if { ${with-offset-array} } {
+ _op .4byte "$_debug_rnglists_list_count" "offset entry count"
+ } else {
+ _op .4byte 0 "offset entry count"
+ }
- incr _debug_rnglists_list_count
- }
+ define_label $post_header_label
- # Count of lists in the table.
- variable _debug_rnglists_list_count 0
+ # Define the user post-header label, if provided.
+ if { ${post-header-label} != "" } {
+ define_label ${post-header-label}
+ }
- # Generate the lists ops first, because we need to know how many
- # lists there are to generate the header and offset table.
- set lists_ops [_defer_to_string {
- uplevel $body
- }]
-
- set post_unit_len_label \
- [_compute_label "rnglists_table_${_debug_rnglists_table_count}_post_unit_len"]
- set post_header_label \
- [_compute_label "rnglists_table_${_debug_rnglists_table_count}_post_header"]
- set table_end_label \
- [_compute_label "rnglists_table_${_debug_rnglists_table_count}_end"]
-
- # Emit the table header.
- if { $_debug_rnglists_is_64_dwarf } {
- _op .4byte 0xffffffff "unit length 1/2"
- _op .8byte "$table_end_label - $post_unit_len_label" "unit length 2/2"
- } else {
- _op .4byte "$table_end_label - $post_unit_len_label" "unit length"
+ # Emit the offset array.
+ if { ${with-offset-array} } {
+ for {set list_idx 0} {$list_idx < $_debug_rnglists_list_count} {incr list_idx} {
+ set list_label [_compute_list_label $list_idx]
+ _op .${_debug_rnglists_offset_size}byte "$list_label - $post_header_label" "offset of list $list_idx"
}
+ }
- define_label $post_unit_len_label
+ # Emit the actual list data.
+ _emit "$lists_ops"
- _op .2byte 5 "dwarf version"
- _op .byte $_debug_rnglists_addr_size "address size"
- _op .byte 0 "segment selector size"
+ define_label $table_end_label
- if { ${with-offset-array} } {
- _op .4byte "$_debug_rnglists_list_count" "offset entry count"
- } else {
- _op .4byte 0 "offset entry count"
- }
+ incr _debug_rnglists_table_count
+ }
- define_label $post_header_label
+ # Generate one rnglists range list.
+ #
+ # This proc is meant to be used within proc _rnglists_table's body. It is
+ # made available as `list_` while inside proc _rnglists_table's body.
+ #
+ # BODY may call the various procs defined below to generate list entries.
+ # They correspond to the range list entry kinds described in section 2.17.3
+ # of the DWARF 5 spec.
+ #
+ # To define a label pointing to the beginning of the list, use the
+ # conventional way of declaring and defining labels:
+ #
+ # declare_labels the_list
+ #
+ # the_list: list_ { ... }
- # Define the user post-header label, if provided.
- if { ${post-header-label} != "" } {
- define_label ${post-header-label}
- }
+ proc _rnglists_list { body } {
+ variable _debug_rnglists_list_count
- # Emit the offset array.
- if { ${with-offset-array} } {
- for {set list_idx 0} {$list_idx < $_debug_rnglists_list_count} {incr list_idx} {
- set list_label [_compute_list_label $list_idx]
- _op .${_debug_rnglists_offset_size}byte "$list_label - $post_header_label" "offset of list $list_idx"
- }
- }
+ # Define a label for this list. It is used to build the offset
+ # array later.
+ set list_label [_compute_list_label $_debug_rnglists_list_count]
+ define_label $list_label
- # Emit the actual list data.
- _emit "$lists_ops"
+ with_override Dwarf::start_end Dwarf::_rnglists_start_end {
+ uplevel $body
+ }
- define_label $table_end_label
+ # Emit end of list.
+ _op .byte 0x00 "DW_RLE_end_of_list"
- incr _debug_rnglists_table_count
- }
+ incr _debug_rnglists_list_count
+ }
- uplevel $body
+ # Emit a rnglists DW_RLE_start_end entry.
+ #
+ # This proc is meant to be used within proc _rnglists_list's body. It is
+ # made available as `start_end` while inside proc _rnglists_list's body.
+
+ proc _rnglists_start_end { start end } {
+ variable _debug_rnglists_addr_size
+
+ _op .byte 0x06 "DW_RLE_start_end"
+ _op .${_debug_rnglists_addr_size}byte $start "start"
+ _op .${_debug_rnglists_addr_size}byte $end "end"
}
# Emit a DWARF .debug_loclists section.
@@ -1779,188 +1792,208 @@ namespace eval Dwarf {
return ".Lloclists_table_${_debug_loclists_table_count}_list_${list_idx}"
}
- # Generate one table (header + offset array + location lists).
- #
- # Accepts one position argument, BODY. BODY may call the LIST_
- # procedure to generate loclists.
- #
- # The -post-header-label option can be used to define a label just after the
- # header of the table. This is the label that a DW_AT_loclists_base
- # attribute will usually refer to.
- #
- # The `-with-offset-array true|false` option can be used to control
- # whether the headers of the location list tables have an array of
- # offset. The default is true.
-
- proc table { args } {
- variable _debug_loclists_table_count
- variable _debug_loclists_addr_size
- variable _debug_loclists_offset_size
- variable _debug_loclists_is_64_dwarf
-
- parse_args {
- {post-header-label ""}
- {with-offset-array true}
- }
-
- if { [llength $args] != 1 } {
- error "table proc expects one positional argument (body)"
- }
-
- lassign $args body
-
- # Generate one location list.
- #
- # BODY may call the various procs defined below to generate list
- # entries. They correspond to the location list entry kinds
- # described in section 2.6.2 of the DWARF 5 spec.
- #
- # To define a label pointing to the beginning of the list, use
- # the conventional way of declaring and defining labels:
- #
- # declare_labels the_list
- #
- # the_list: list_ {
- # ...
- # }
-
- proc list_ { body } {
- variable _debug_loclists_list_count
-
- # Count the location descriptions in this list.
- variable _debug_loclists_locdesc_count 0
-
- # Define a label for this list. It is used to build the offset
- # array later.
- set list_label [_compute_list_label $_debug_loclists_list_count]
- define_label $list_label
-
- # Emit a DW_LLE_start_length entry.
-
- proc start_length { start length locdesc } {
- variable _debug_loclists_is_64_dwarf
- variable _debug_loclists_addr_size
- variable _debug_loclists_offset_size
- variable _debug_loclists_table_count
- variable _debug_loclists_list_count
- variable _debug_loclists_locdesc_count
-
- _op .byte 0x08 "DW_LLE_start_length"
-
- # Start and end of the address range.
- _op .${_debug_loclists_addr_size}byte $start "start"
- _op .uleb128 $length "length"
-
- # Length of location description.
- set locdesc_start_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_start"
- set locdesc_end_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_end"
- _op .uleb128 "$locdesc_end_label - $locdesc_start_label" "locdesc length"
-
- define_label $locdesc_start_label
- set dwarf_version 5
- _location $locdesc $dwarf_version $_debug_loclists_addr_size $_debug_loclists_offset_size
- define_label $locdesc_end_label
-
- incr _debug_loclists_locdesc_count
- }
+ with_override Dwarf::table Dwarf::_loclists_table {
+ uplevel $body
+ }
+ }
- # Emit a DW_LLE_start_end entry.
+ # Generate one loclists table (header + offset array + location lists).
+ #
+ # This proc is meant to be used within proc loclists' body. It is made
+ # available as `table` while inside proc rnglists' body.
+ #
+ # Accepts one position argument, BODY. BODY may call the LIST_
+ # procedure to generate loclists.
+ #
+ # The -post-header-label option can be used to define a label just after the
+ # header of the table. This is the label that a DW_AT_loclists_base
+ # attribute will usually refer to.
+ #
+ # The `-with-offset-array true|false` option can be used to control
+ # whether the headers of the location list tables have an array of
+ # offset. The default is true.
- proc start_end { start end locdesc } {
- variable _debug_loclists_is_64_dwarf
- variable _debug_loclists_addr_size
- variable _debug_loclists_offset_size
- variable _debug_loclists_table_count
- variable _debug_loclists_list_count
- variable _debug_loclists_locdesc_count
+ proc _loclists_table { args } {
+ variable _debug_loclists_table_count
+ variable _debug_loclists_addr_size
+ variable _debug_loclists_offset_size
+ variable _debug_loclists_is_64_dwarf
- _op .byte 0x07 "DW_LLE_start_end"
+ parse_args {
+ {post-header-label ""}
+ {with-offset-array true}
+ }
- # Start and end of the address range.
- _op .${_debug_loclists_addr_size}byte $start "start"
- _op .${_debug_loclists_addr_size}byte $end "end"
+ if { [llength $args] != 1 } {
+ error "table proc expects one positional argument (body)"
+ }
- # Length of location description.
- set locdesc_start_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_start"
- set locdesc_end_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_end"
- _op .uleb128 "$locdesc_end_label - $locdesc_start_label" "locdesc length"
+ lassign $args body
- define_label $locdesc_start_label
- set dwarf_version 5
- _location $locdesc $dwarf_version $_debug_loclists_addr_size $_debug_loclists_offset_size
- define_label $locdesc_end_label
- incr _debug_loclists_locdesc_count
- }
+ # Count of lists in the table.
+ variable _debug_loclists_list_count 0
+ # Generate the lists ops first, because we need to know how many
+ # lists there are to generate the header and offset table.
+ set lists_ops [_defer_to_string {
+ with_override Dwarf::list_ Dwarf::_loclists_list {
uplevel $body
+ }
+ }]
- # Emit end of list.
- _op .byte 0x00 "DW_LLE_end_of_list"
+ set post_unit_len_label \
+ [_compute_label "loclists_table_${_debug_loclists_table_count}_post_unit_len"]
+ set post_header_label \
+ [_compute_label "loclists_table_${_debug_loclists_table_count}_post_header"]
+ set table_end_label \
+ [_compute_label "loclists_table_${_debug_loclists_table_count}_end"]
- incr _debug_loclists_list_count
- }
+ # Emit the table header.
+ if { $_debug_loclists_is_64_dwarf } {
+ _op .4byte 0xffffffff "unit length 1/2"
+ _op .8byte "$table_end_label - $post_unit_len_label" "unit length 2/2"
+ } else {
+ _op .4byte "$table_end_label - $post_unit_len_label" "unit length"
+ }
- # Count of lists in the table.
- variable _debug_loclists_list_count 0
+ define_label $post_unit_len_label
- # Generate the lists ops first, because we need to know how many
- # lists there are to generate the header and offset table.
- set lists_ops [_defer_to_string {
- uplevel $body
- }]
-
- set post_unit_len_label \
- [_compute_label "loclists_table_${_debug_loclists_table_count}_post_unit_len"]
- set post_header_label \
- [_compute_label "loclists_table_${_debug_loclists_table_count}_post_header"]
- set table_end_label \
- [_compute_label "loclists_table_${_debug_loclists_table_count}_end"]
-
- # Emit the table header.
- if { $_debug_loclists_is_64_dwarf } {
- _op .4byte 0xffffffff "unit length 1/2"
- _op .8byte "$table_end_label - $post_unit_len_label" "unit length 2/2"
- } else {
- _op .4byte "$table_end_label - $post_unit_len_label" "unit length"
- }
+ _op .2byte 5 "DWARF version"
+ _op .byte $_debug_loclists_addr_size "address size"
+ _op .byte 0 "segment selector size"
- define_label $post_unit_len_label
+ if { ${with-offset-array} } {
+ _op .4byte "$_debug_loclists_list_count" "offset entry count"
+ } else {
+ _op .4byte 0 "offset entry count"
+ }
- _op .2byte 5 "DWARF version"
- _op .byte $_debug_loclists_addr_size "address size"
- _op .byte 0 "segment selector size"
+ define_label $post_header_label
- if { ${with-offset-array} } {
- _op .4byte "$_debug_loclists_list_count" "offset entry count"
- } else {
- _op .4byte 0 "offset entry count"
+ # Define the user post-header label, if provided.
+ if { ${post-header-label} != "" } {
+ define_label ${post-header-label}
+ }
+
+ # Emit the offset array.
+ if { ${with-offset-array} } {
+ for {set list_idx 0} {$list_idx < $_debug_loclists_list_count} {incr list_idx} {
+ set list_label [_compute_list_label $list_idx]
+ _op .${_debug_loclists_offset_size}byte "$list_label - $post_header_label" "offset of list $list_idx"
}
+ }
- define_label $post_header_label
+ # Emit the actual list data.
+ _emit "$lists_ops"
- # Define the user post-header label, if provided.
- if { ${post-header-label} != "" } {
- define_label ${post-header-label}
- }
+ define_label $table_end_label
- # Emit the offset array.
- if { ${with-offset-array} } {
- for {set list_idx 0} {$list_idx < $_debug_loclists_list_count} {incr list_idx} {
- set list_label [_compute_list_label $list_idx]
- _op .${_debug_loclists_offset_size}byte "$list_label - $post_header_label" "offset of list $list_idx"
- }
- }
+ incr _debug_loclists_table_count
+ }
+
+ # Generate one loclists location list.
+ #
+ # This proc is meant to be used within proc _loclists_table's body. It is
+ # made available as `list_` while inside proc _loclists_table's body.
+ #
+ # BODY may call the various procs defined below to generate list
+ # entries. They correspond to the location list entry kinds
+ # described in section 2.6.2 of the DWARF 5 spec.
+ #
+ # To define a label pointing to the beginning of the list, use
+ # the conventional way of declaring and defining labels:
+ #
+ # declare_labels the_list
+ #
+ # the_list: list_ {
+ # ...
+ # }
- # Emit the actual list data.
- _emit "$lists_ops"
+ proc _loclists_list { body } {
+ variable _debug_loclists_list_count
- define_label $table_end_label
+ # Count the location descriptions in this list.
+ variable _debug_loclists_locdesc_count 0
- incr _debug_loclists_table_count
- }
+ # Define a label for this list. It is used to build the offset
+ # array later.
+ set list_label [_compute_list_label $_debug_loclists_list_count]
+ define_label $list_label
- uplevel $body
+ with_override Dwarf::start_length Dwarf::_loclists_start_length {
+ with_override Dwarf::start_end Dwarf::_loclists_start_end {
+ uplevel $body
+ }}
+
+ # Emit end of list.
+ _op .byte 0x00 "DW_LLE_end_of_list"
+
+ incr _debug_loclists_list_count
+ }
+
+ # Emit a DW_LLE_start_length entry.
+ #
+ # This proc is meant to be used within proc _loclists_list's body. It is
+ # made available as `start_length` while inside proc _loclists_list's body.
+
+ proc _loclists_start_length { start length locdesc } {
+ variable _debug_loclists_is_64_dwarf
+ variable _debug_loclists_addr_size
+ variable _debug_loclists_offset_size
+ variable _debug_loclists_table_count
+ variable _debug_loclists_list_count
+ variable _debug_loclists_locdesc_count
+
+ _op .byte 0x08 "DW_LLE_start_length"
+
+ # Start and end of the address range.
+ _op .${_debug_loclists_addr_size}byte $start "start"
+ _op .uleb128 $length "length"
+
+ # Length of location description.
+ set locdesc_start_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_start"
+ set locdesc_end_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_end"
+ _op .uleb128 "$locdesc_end_label - $locdesc_start_label" "locdesc length"
+
+ define_label $locdesc_start_label
+ set dwarf_version 5
+ _location $locdesc $dwarf_version $_debug_loclists_addr_size $_debug_loclists_offset_size
+ define_label $locdesc_end_label
+
+ incr _debug_loclists_locdesc_count
+ }
+
+ # Emit a DW_LLE_start_end entry.
+ #
+ # This proc is meant to be used within proc _loclists_list's body. It is
+ # made available as `start_end` while inside proc _loclists_list's body.
+
+ proc _loclists_start_end { start end locdesc } {
+ variable _debug_loclists_is_64_dwarf
+ variable _debug_loclists_addr_size
+ variable _debug_loclists_offset_size
+ variable _debug_loclists_table_count
+ variable _debug_loclists_list_count
+ variable _debug_loclists_locdesc_count
+
+ _op .byte 0x07 "DW_LLE_start_end"
+
+ # Start and end of the address range.
+ _op .${_debug_loclists_addr_size}byte $start "start"
+ _op .${_debug_loclists_addr_size}byte $end "end"
+
+ # Length of location description.
+ set locdesc_start_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_start"
+ set locdesc_end_label ".Lloclists_table_${_debug_loclists_table_count}_list_${_debug_loclists_list_count}_locdesc_${_debug_loclists_locdesc_count}_end"
+ _op .uleb128 "$locdesc_end_label - $locdesc_start_label" "locdesc length"
+
+ define_label $locdesc_start_label
+ set dwarf_version 5
+ _location $locdesc $dwarf_version $_debug_loclists_addr_size $_debug_loclists_offset_size
+ define_label $locdesc_end_label
+
+ incr _debug_loclists_locdesc_count
}
# Emit a DWARF .debug_line unit.
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 3aea7baaab09..6ce2f64581d8 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -7927,9 +7927,14 @@ proc with_override { name override body } {
# the override
# So, we use this more elaborate but cleaner mechanism.
- # Save the old proc.
- set old_args [info args $name]
- set old_body [info body $name]
+ # Save the old proc, if it exists.
+ if { [info procs $name] != "" } {
+ set old_args [info args $name]
+ set old_body [info body $name]
+ set existed true
+ } else {
+ set existed false
+ }
# Install the override.
set new_args [info args $override]
@@ -7939,8 +7944,12 @@ proc with_override { name override body } {
# Execute body.
set code [catch {uplevel 1 $body} result]
- # Restore old proc.
- eval proc $name {$old_args} {$old_body}
+ # Restore old proc if it existed on entry, else delete it.
+ if { $existed } {
+ eval proc $name {$old_args} {$old_body}
+ } else {
+ rename $name ""
+ }
# Return as appropriate.
if { $code == 1 } {
--
2.33.0
^ permalink raw reply [flat|nested] 3+ messages in thread
* [PATCH 2/2] gdb/testsuite/dwarf: use options for rnglists/loclists procs
2021-08-30 15:20 [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists Simon Marchi
@ 2021-08-30 15:20 ` Simon Marchi
2021-10-01 2:27 ` [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists Simon Marchi
1 sibling, 0 replies; 3+ messages in thread
From: Simon Marchi @ 2021-08-30 15:20 UTC (permalink / raw)
To: gdb-patches
Change how rnglists and loclists procs to align them with how procs for
aranges (and other things in the DWARF assembler) work. Instead of
using "args" (variable number of parameters in TCL) and command-line
style option arguments, use one leading "option" parameters, used as a
kind of key/value dictionary of options parsed using `parse_options`.
Change-Id: I63e60d17ae16a020ce4d6de44baf3d152ea42a1a
---
gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp | 4 +-
.../gdb.dwarf2/loclists-multiple-cus.exp | 6 +-
.../gdb.dwarf2/loclists-sec-offset.exp | 8 +-
.../gdb.dwarf2/loclists-start-end.exp | 6 +-
.../gdb.dwarf2/rnglists-multiple-cus.exp | 6 +-
.../gdb.dwarf2/rnglists-sec-offset.exp | 8 +-
gdb/testsuite/lib/dwarf.exp | 83 ++++++-------------
7 files changed, 46 insertions(+), 75 deletions(-)
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp b/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp
index e43f59ea1ad1..305f4050d662 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-zero-range.exp
@@ -81,8 +81,8 @@ foreach_with_prefix ranges_sect {ranges rnglists} {
}
}
- rnglists {
- table {
+ 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..d74f3da8700e 100644
--- a/gdb/testsuite/gdb.dwarf2/loclists-multiple-cus.exp
+++ b/gdb/testsuite/gdb.dwarf2/loclists-multiple-cus.exp
@@ -87,17 +87,17 @@ 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 {
+ table {} {
list_ {
start_length 0x1000 0x1000 { DW_OP_addr 0x100000 }
}
}
# The lists in this table are accessed by index (DW_FORM_rnglistx).
- table -post-header-label cu_table {
+ table {post-header-label cu_table} {
# This list is unused, but exists to offset the next ones.
list_ {
start_length 0x1000 0x1000 { DW_OP_addr 0x100000 }
diff --git a/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp b/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp
index 573324af3d17..288b18f86bab 100644
--- a/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp
+++ b/gdb/testsuite/gdb.dwarf2/loclists-sec-offset.exp
@@ -165,10 +165,10 @@ 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 {
+ table {} {
foo_location_list: list_ {
start_length $func1_addr $func1_len {
DW_OP_constu 0x123456
@@ -182,7 +182,7 @@ foreach_with_prefix is_64 {false true} {
}
}
- table -post-header-label cu2_table {
+ table {post-header-label cu2_table} {
bar_location_list: list_ {
start_length $func3_addr $func3_len {
DW_OP_constu 0x345678
@@ -196,7 +196,7 @@ foreach_with_prefix is_64 {false true} {
}
}
- table -with-offset-array false {
+ table {with-offset-array false} {
baz_location_list: list_ {
start_length $func5_addr $func5_len {
DW_OP_constu 0x567890
diff --git a/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp b/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp
index 43ddefcf61de..9302e4878bd3 100644
--- a/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp
+++ b/gdb/testsuite/gdb.dwarf2/loclists-start-end.exp
@@ -78,17 +78,17 @@ 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 {
+ table {} {
list_ {
start_end 0x1000 0x2000 { DW_OP_addr 0x100000 }
}
}
# The lists in this table are accessed by index (DW_FORM_rnglistx).
- table -post-header-label cu_table {
+ table {post-header-label cu_table} {
# This list is unused, but exists to offset the next ones.
list_ {
start_end 0x1000 0x2000 { DW_OP_addr 0x100000 }
diff --git a/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp b/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp
index e09cd4e8fe73..2e83b37de66e 100644
--- a/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp
+++ b/gdb/testsuite/gdb.dwarf2/rnglists-multiple-cus.exp
@@ -63,17 +63,17 @@ 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 {
+ table {} {
list_ {
start_end 0x1000 0x2000
}
}
# The lists in this table are accessed by index (DW_FORM_rnglistx).
- table -post-header-label cu_table {
+ table {post-header-label cu_table} {
# This list is unused, but exists to offset the next ones.
list_ {
start_end 0x2000 0x3000
diff --git a/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp b/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp
index 0733e90abc74..e5ae7772e954 100644
--- a/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp
+++ b/gdb/testsuite/gdb.dwarf2/rnglists-sec-offset.exp
@@ -90,10 +90,10 @@ 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 {
+ table {} {
# For the first CU.
cu1_range_list: list_ {
start_end 0x4000 0x5000
@@ -105,7 +105,7 @@ foreach_with_prefix is_64 {false true} {
}
}
- table -post-header-label cu2_table {
+ table {post-header-label cu2_table} {
# For the second CU.
cu2_range_list: list_ {
start_end 0x5000 0x6000
@@ -117,7 +117,7 @@ foreach_with_prefix is_64 {false true} {
}
}
- table -with-offset-array false {
+ table {with-offset-array false} {
# For the third CU.
cu3_range_list: list_ {
start_end 0x6000 0x7000
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index fbe93207c7a5..ac405f970935 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -1542,27 +1542,18 @@ 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.
+ # The `is-64 true|false` options tells 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
@@ -1602,34 +1593,29 @@ namespace eval Dwarf {
# This proc is meant to be used within proc rnglists' body. It is made
# available as `table` while inside proc rnglists' body.
#
- # Accepts one positional argument, BODY. BODY may call the LIST_ procedure
- # to generate rnglists.
+ # BODY must be Tcl code that emits the content of the table. It may call
+ # the LIST_ procedure to generate rnglists. It is evaluated in the
+ # caller's context.
#
- # The -post-header-label option can be used to define a label just after
+ # The `post-header-label` option can be used to define a label just after
# the header of the table. This is the label that a DW_AT_rnglists_base
# attribute will usually refer to.
#
- # The `-with-offset-array true|false` option can be used to control whether
+ # The `with-offset-array true|false` option can be used to control whether
# the headers of the location list tables have an array of offset. The
# default is true.
- proc _rnglists_table { args } {
+ proc _rnglists_table { options body } {
variable _debug_rnglists_table_count
variable _debug_rnglists_addr_size
variable _debug_rnglists_offset_size
variable _debug_rnglists_is_64_dwarf
- parse_args {
+ parse_options {
{post-header-label ""}
{with-offset-array true}
}
- if { [llength $args] != 1 } {
- error "table proc expects one positional argument (body)"
- }
-
- lassign $args body
-
# Count of lists in the table.
variable _debug_rnglists_list_count 0
@@ -1742,27 +1728,18 @@ 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.
- #
- # The following option can be used:
+ # BODY must be Tcl code that emits the content of the section. It is
+ # evaluated in the caller's context.
#
- # - -is-64 true|false: Whether to use 64-bit DWARF instead of 32-bit DWARF.
- # The default is 32-bit.
+ # The `is-64 true|false` options tells 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
@@ -1802,35 +1779,29 @@ namespace eval Dwarf {
# This proc is meant to be used within proc loclists' body. It is made
# available as `table` while inside proc rnglists' body.
#
- # Accepts one position argument, BODY. BODY may call the LIST_
- # procedure to generate loclists.
+ # BODY must be Tcl code that emits the content of the table. It may call
+ # the LIST_ procedure to generate rnglists. It is evaluated in the
+ # caller's context.
#
- # The -post-header-label option can be used to define a label just after the
- # header of the table. This is the label that a DW_AT_loclists_base
+ # The `post-header-label` option can be used to define a label just after
+ # the header of the table. This is the label that a DW_AT_loclists_base
# attribute will usually refer to.
#
- # The `-with-offset-array true|false` option can be used to control
+ # The `with-offset-array true|false` option can be used to control
# whether the headers of the location list tables have an array of
# offset. The default is true.
- proc _loclists_table { args } {
+ proc _loclists_table { options body } {
variable _debug_loclists_table_count
variable _debug_loclists_addr_size
variable _debug_loclists_offset_size
variable _debug_loclists_is_64_dwarf
- parse_args {
+ parse_options {
{post-header-label ""}
{with-offset-array true}
}
- if { [llength $args] != 1 } {
- error "table proc expects one positional argument (body)"
- }
-
- lassign $args body
-
-
# Count of lists in the table.
variable _debug_loclists_list_count 0
--
2.33.0
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists
2021-08-30 15:20 [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists Simon Marchi
2021-08-30 15:20 ` [PATCH 2/2] gdb/testsuite/dwarf: use options for rnglists/loclists procs Simon Marchi
@ 2021-10-01 2:27 ` Simon Marchi
1 sibling, 0 replies; 3+ messages in thread
From: Simon Marchi @ 2021-10-01 2:27 UTC (permalink / raw)
To: gdb-patches
On 2021-08-30 11:20, Simon Marchi wrote:
> When I wrote support for rnglists and loclists in the testsuite's DWARF
> assembler, I made it with nested procs, for example proc "table" inside
> proc "rnglists". The intention was that this proc "table" could only be
> used by the user while inside proc "rnglists"'s body. I had chosen very
> simple names, thinking there was no chance of name clashes. I recently
> learned that this is not how TCL works. This ends up defining a proc
> "table" in the current namespace ("Dwarf" in this case).
>
> Things still work if you generate rnglists and loclists in the same
> file, as each redefines its own procedures when executing. But if a
> user of the assembler happened to define a convenience "table" or
> "start_end" procedure, for example, it would get overriden.
>
> I'd like to change how this works to reduce the chances of a name clash.
>
> - Move the procs out of each other, so they are not defined in a nested
> fashion.
> - Prefix them with "_rnglists_" or "_loclists_".
> - While calling $body in the various procs, temporarily make the procs
> available under their "short" name. For example, while in rngllists'
> body, make _rnglists_table available as just "table". This allows
> existing code to keep working and keeps it not too verbose.
> - Modify with_override to allow the overriden proc to not exist. In
> that case, the temporary proc is deleted on exit.
>
> Note the non-conforming indentation when calling with_override in
> _loclists_list. This is on purpose: as we implement more loclists (and
> rnglists) entry types, the indentation would otherwise get larger and
> larger without much value for readability. So I think it's reasonable
> here to put them on the same level.
>
> Change-Id: I7bb48d26fcb0dba1ae4dada05c0c837212424328
I pushed these two patches.
Simon
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2021-10-01 2:27 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-30 15:20 [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists Simon Marchi
2021-08-30 15:20 ` [PATCH 2/2] gdb/testsuite/dwarf: use options for rnglists/loclists procs Simon Marchi
2021-10-01 2:27 ` [PATCH 1/2] gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists Simon Marchi
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).