aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gdb/testsuite/gdb.dlang/watch-loc.exp2
-rw-r--r--gdb/testsuite/gdb.dwarf2/dw2-ranges-base.exp6
-rw-r--r--gdb/testsuite/gdb.dwarf2/frame-inlined-in-outer-frame.exp2
-rw-r--r--gdb/testsuite/gdb.dwarf2/template-specification-full-name.exp2
-rw-r--r--gdb/testsuite/gdb.testsuite/parse_options_args.exp59
-rw-r--r--gdb/testsuite/lib/dwarf.exp31
-rw-r--r--gdb/testsuite/lib/gdb.exp104
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 6e8b26e..e13400e 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 e65b4c8..d55b7fd 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 ff12cd7..f95558d 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 5c59777..6e736f2 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 0000000..ce14fc3
--- /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 120fa41..7fb3561 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 0933927..3aea7ba 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.
generated by cgit v1.1 at 2024-11-16 02:00:55 +0000