diff options
author | Simon Marchi <simon.marchi@polymtl.ca> | 2021-08-30 11:20:58 -0400 |
---|---|---|
committer | Simon Marchi <simon.marchi@polymtl.ca> | 2021-09-30 22:21:52 -0400 |
commit | c5dfcc218832f26e7ecefa6c44a2b350c605148f (patch) | |
tree | 33f3415c2b03071d53e5f512dab8ce077ab10b39 | |
parent | 33d16dd987d16fe1eb289853e5a444192bb31d9e (diff) | |
download | gdb-c5dfcc218832f26e7ecefa6c44a2b350c605148f.zip gdb-c5dfcc218832f26e7ecefa6c44a2b350c605148f.tar.gz gdb-c5dfcc218832f26e7ecefa6c44a2b350c605148f.tar.bz2 |
gdb/testsuite/dwarf: don't define nested procs for rnglists/loclists
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
-rw-r--r-- | gdb/testsuite/lib/dwarf.exp | 541 | ||||
-rw-r--r-- | gdb/testsuite/lib/gdb.exp | 19 |
2 files changed, 301 insertions, 259 deletions
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp index c248296..87c8a13 100644 --- a/gdb/testsuite/lib/dwarf.exp +++ b/gdb/testsuite/lib/dwarf.exp @@ -1593,137 +1593,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 - lassign $args body + parse_args { + {post-header-label ""} + {with-offset-array true} + } - # 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_ { - # ... - # } + if { [llength $args] != 1 } { + error "table proc expects one positional argument (body)" + } - proc list_ { body } { - variable _debug_rnglists_list_count + lassign $args body - # 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 + # Count of lists in the table. + variable _debug_rnglists_list_count 0 - # Emit a DW_RLE_start_end entry. + # 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 + } + }] - proc start_end { start end } { - variable _debug_rnglists_addr_size + 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"] - _op .byte 0x06 "DW_RLE_start_end" - _op .${_debug_rnglists_addr_size}byte $start "start" - _op .${_debug_rnglists_addr_size}byte $end "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" + } - uplevel $body + define_label $post_unit_len_label - # Emit end of list. - _op .byte 0x00 "DW_RLE_end_of_list" + _op .2byte 5 "dwarf version" + _op .byte $_debug_rnglists_addr_size "address size" + _op .byte 0 "segment selector size" - incr _debug_rnglists_list_count - } + if { ${with-offset-array} } { + _op .4byte "$_debug_rnglists_list_count" "offset entry count" + } else { + _op .4byte 0 "offset entry count" + } - # Count of lists in the table. - variable _debug_rnglists_list_count 0 + 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" + # 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_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. @@ -1780,192 +1793,212 @@ 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 + with_override Dwarf::table Dwarf::_loclists_table { + uplevel $body + } + } - parse_args { - {post-header-label ""} - {with-offset-array true} - } + # 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. - if { [llength $args] != 1 } { - error "table proc expects one positional argument (body)" - } + 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 + + parse_args { + {post-header-label ""} + {with-offset-array true} + } + + if { [llength $args] != 1 } { + error "table proc expects one positional argument (body)" + } + + lassign $args 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_ { - # ... - # } + # Count of lists in the table. + variable _debug_loclists_list_count 0 - proc list_ { body } { - variable _debug_loclists_list_count + # 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 + } + }] - # Count the location descriptions in this list. - variable _debug_loclists_locdesc_count 0 + 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"] - # 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 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" + } + + define_label $post_unit_len_label - # Emit a DW_LLE_start_length entry. + _op .2byte 5 "DWARF version" + _op .byte $_debug_loclists_addr_size "address size" + _op .byte 0 "segment selector size" - 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 + if { ${with-offset-array} } { + _op .4byte "$_debug_loclists_list_count" "offset entry count" + } else { + _op .4byte 0 "offset entry count" + } - set locdesc [uplevel [list subst $locdesc]] + define_label $post_header_label - _op .byte 0x08 "DW_LLE_start_length" + # Define the user post-header label, if provided. + if { ${post-header-label} != "" } { + define_label ${post-header-label} + } - # Start and end of the address range. - _op .${_debug_loclists_addr_size}byte $start "start" - _op .uleb128 $length "length" + # 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" + } + } - # 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" + # Emit the actual list data. + _emit "$lists_ops" - 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 + define_label $table_end_label - incr _debug_loclists_locdesc_count - } + incr _debug_loclists_table_count + } - # Emit a DW_LLE_start_end entry. + # 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_ { + # ... + # } - 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_list { body } { + variable _debug_loclists_list_count - set locdesc [uplevel [list subst $locdesc]] + # Count the location descriptions in this list. + variable _debug_loclists_locdesc_count 0 - _op .byte 0x07 "DW_LLE_start_end" + # 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 - # Start and end of the address range. - _op .${_debug_loclists_addr_size}byte $start "start" - _op .${_debug_loclists_addr_size}byte $end "end" + with_override Dwarf::start_length Dwarf::_loclists_start_length { + with_override Dwarf::start_end Dwarf::_loclists_start_end { + uplevel $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" + # Emit end of list. + _op .byte 0x00 "DW_LLE_end_of_list" - 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_list_count + } - incr _debug_loclists_locdesc_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. - uplevel $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 - # Emit end of list. - _op .byte 0x00 "DW_LLE_end_of_list" + set locdesc [uplevel [list subst $locdesc]] - incr _debug_loclists_list_count - } + _op .byte 0x08 "DW_LLE_start_length" - # Count of lists in the table. - variable _debug_loclists_list_count 0 + # Start and end of the address range. + _op .${_debug_loclists_addr_size}byte $start "start" + _op .uleb128 $length "length" - # 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" - } + # 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 $post_unit_len_label + 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 - _op .2byte 5 "DWARF version" - _op .byte $_debug_loclists_addr_size "address size" - _op .byte 0 "segment selector size" + incr _debug_loclists_locdesc_count + } - if { ${with-offset-array} } { - _op .4byte "$_debug_loclists_list_count" "offset entry count" - } else { - _op .4byte 0 "offset entry 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. - define_label $post_header_label + 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 - # Define the user post-header label, if provided. - if { ${post-header-label} != "" } { - define_label ${post-header-label} - } + set locdesc [uplevel [list subst $locdesc]] - # 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" - } - } + _op .byte 0x07 "DW_LLE_start_end" - # Emit the actual list data. - _emit "$lists_ops" + # Start and end of the address range. + _op .${_debug_loclists_addr_size}byte $start "start" + _op .${_debug_loclists_addr_size}byte $end "end" - define_label $table_end_label + # 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" - incr _debug_loclists_table_count - } + 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 - uplevel $body + 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 6de49c1..5642db4 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -8017,9 +8017,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] @@ -8029,8 +8034,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 } { |