From: Tom de Vries <tdevries@suse.de>
Date: Mon, 30 Aug 2021 08:30:26 +0000 (+0200)
Subject: [gdb/testsuite] Improve argument syntax of proc arange
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=590d3faada8a12bf0937bbf68413956dc6a339a9;p=binutils-gdb.git

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

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.