[gdb/testsuite] Make parse_args error out on remaining args

I noticed that introducing a typo here in gdb.mi/mi-breakpoint-changed.exp:
...
     set bp_re [mi_make_breakpoint \
-		   -number $bp_nr \
+		   -nunber $bp_nr \
 		   -type dprintf \
 		   -func marker \
 		   -script [string_to_regexp {["printf \"arg\" \""]}]]
...
didn't make the test fail.

Proc mi_make_breakpoint uses parse_args, but does not check the remaining args
as parse_args suggests:
...
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
}
...

We could add the missing check in mi_make_breakpoint, but I think the problem
is likely to occur again because the name parse_args does not suggest that
further action is required.

Fix this instead by:
- copying proc parse_args to new proc parse_some_args,
- adding new proc check_no_args_left, and
- calling check_no_args_left in parse_args.

Also be more strict in a few places where we do lassign for remaining args:
...
    lassign $args a b
...

There may be more arguments left in $args, so check that that's not the case
using check_no_args_left:
...
    set args [lassign $args a b]
    check_no_args_left
...

Fix a few test-cases that trigger on the stricter checking.

Tested on x86_64-linux.

Reviewed-By: Alexandra Petlanova Hajkova <ahajkova@redhat.com>

PR testsuite/32129
Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=32129

11 files changed, 46 insertions, 26 deletions

diff --git a/gdb/testsuite/gdb.base/hbreak-unmapped.exp b/gdb/testsuite/gdb.base/hbreak-unmapped.exp
index ccb4b20c458..b28af6d9b01 100644
--- a/gdb/testsuite/gdb.base/hbreak-unmapped.exp
+++ b/gdb/testsuite/gdb.base/hbreak-unmapped.exp
@@ -68,8 +68,7 @@ gdb_test "hbreak *0" "Hardware assisted breakpoint \[0-9\]+ at 0x0"
 gdb_test "info break" "hw breakpoint.*y.*0x0\+\[ \t\]\+" \
     "info break shows hw breakpoint"
 
-gdb_test_no_output "delete \$bpnum" "" "delete" \
-    "delete hw breakpoint"
+gdb_test_no_output "delete \$bpnum" "delete hw breakpoint"
 
 gdb_test "info break" "No breakpoints, watchpoints, tracepoints, or catchpoints\." \
     "info break shows no breakpoints, watchpoints, tracepoints, or catchpoints"
diff --git a/gdb/testsuite/gdb.mi/mi-break-qualified.exp b/gdb/testsuite/gdb.mi/mi-break-qualified.exp
index 7543d98ffc9..20e2bb8b6a7 100644
--- a/gdb/testsuite/gdb.mi/mi-break-qualified.exp
+++ b/gdb/testsuite/gdb.mi/mi-break-qualified.exp
@@ -69,7 +69,7 @@ proc test_break_qualified {} {
 		  -enabled "y" \
 		  -func "$func" \
 		  -file ".*mi-break-qualified.cc" \
-		  -line="$line_no"]
+		  -line $line_no]
     }
 
     set loc1 [make_loc_re "NS::func\\(int\\)" $loc_ns_func_line]
diff --git a/gdb/testsuite/gdb.mi/mi-break.exp b/gdb/testsuite/gdb.mi/mi-break.exp
index bfe839d3339..86e7b57260a 100644
--- a/gdb/testsuite/gdb.mi/mi-break.exp
+++ b/gdb/testsuite/gdb.mi/mi-break.exp
@@ -313,7 +313,7 @@ proc_with_prefix test_explicit_breakpoints {} {
 
     mi_create_breakpoint "-c \"intarg == 3\" --function callee2" \
 	"insert explicit conditional breakpoint in callee2" \
-	-func callee2 ".*$srcfile" -line $line_callee2_body \
+	-func callee2 -file ".*$srcfile" -line $line_callee2_body \
 	-cond "intarg == 3"
 
     # mi_create_breakpoint cannot deal with displaying canonical
@@ -357,7 +357,7 @@ proc_with_prefix test_forced_conditions {} {
 	"dprintf with forced condition"
 
     # Define a plain breakpoint first, and a condition later.
-    mi_create_breakpoint "callme" "define a bp" ""
+    mi_create_breakpoint "callme" "define a bp"
     mi_gdb_test "-break-condition --force 16 bad == 42" \
 	"${warning}\\^done" \
 	"invalid condition is forced"
diff --git a/gdb/testsuite/gdb.mi/mi-nsmoribund.exp b/gdb/testsuite/gdb.mi/mi-nsmoribund.exp
index ba6ff5a0f8f..270dbc15e83 100644
--- a/gdb/testsuite/gdb.mi/mi-nsmoribund.exp
+++ b/gdb/testsuite/gdb.mi/mi-nsmoribund.exp
@@ -50,7 +50,7 @@ set bkpt_line [gdb_get_line_number "set breakpoint here"]
 
 mi_create_breakpoint "$srcfile:$bkpt_line" \
     "breakpoint at thread_function" \
-    -number 2 -function thread_function
+    -number 2 -func thread_function
 
 mi_send_resuming_command "exec-continue --all" "resume all"
 for {set i 0} {$i < $nthreads} {incr i} {
diff --git a/gdb/testsuite/gdb.mi/mi-nsthrexec.exp b/gdb/testsuite/gdb.mi/mi-nsthrexec.exp
index fdfdd05efe3..dba784707f2 100644
--- a/gdb/testsuite/gdb.mi/mi-nsthrexec.exp
+++ b/gdb/testsuite/gdb.mi/mi-nsthrexec.exp
@@ -47,7 +47,7 @@ if { [mi_runto_main] < 0 } {
 
 mi_create_breakpoint thread_execler \
     "breakpoint at thread_execler" \
-    -number 2 -function thread_execler
+    -number 2 -func thread_execler
 
 # All threads should stop, except the main thread.
 mi_send_resuming_command "exec-continue --all" "resume all"
diff --git a/gdb/testsuite/gdb.mi/mi-pending.exp b/gdb/testsuite/gdb.mi/mi-pending.exp
index 99dbab4ce5a..4358c181509 100644
--- a/gdb/testsuite/gdb.mi/mi-pending.exp
+++ b/gdb/testsuite/gdb.mi/mi-pending.exp
@@ -66,8 +66,8 @@ mi_create_breakpoint_pending "-f pendfunc1" \
 mi_gdb_test "-break-commands 1 \"print 1\" \"print 2\" \"print 3\""\
     "\\^done" \
     "set breakpoint commands on pending breakpoint"
-set bp [mi_make_breakpoint_pending -number 1 -disp keep -func pendfunc1 \
-	    -disp keep -enabled y -original-location pendfunc1 \
+set bp [mi_make_breakpoint_pending -number 1 -disp keep \
+	    -enabled y -original-location pendfunc1 \
 	    -script {\["print 1","print 2","print 3"\]}]
 mi_gdb_test "-break-info 1" \
     "\\^done,[mi_make_breakpoint_table [list $bp]]" \
diff --git a/gdb/testsuite/gdb.mi/mi-vla-c99.exp b/gdb/testsuite/gdb.mi/mi-vla-c99.exp
index ee4bc26078c..a8a77ac0d4a 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-c99.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-c99.exp
@@ -37,7 +37,7 @@ set bp_lineno [gdb_get_line_number "vla-filled"]
 
 mi_create_breakpoint "-t vla.c:$bp_lineno" \
     "insert breakpoint at line $bp_lineno after vla is filled" \
-    -function func -line $bp_lineno -file ".*vla.c" -disp del
+    -func func -line $bp_lineno -file ".*vla.c" -disp del
 
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "func" "\{name=\"n\",value=\"5\"\}" \
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index e27f0ecb26a..6097c024daf 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -41,7 +41,7 @@ if {[mi_clean_restart $binfile]} {
 set bp_lineno [gdb_get_line_number "vla1-not-allocated"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno (vla not allocated)" \
-    -number 1 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 1 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -67,7 +67,7 @@ mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
 set bp_lineno [gdb_get_line_number "vla1-allocated"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno (vla allocated)" \
-    -number 2 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 2 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -92,7 +92,7 @@ mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
 set bp_lineno [gdb_get_line_number "vla1-filled"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno" \
-    -number 3 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 3 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -103,7 +103,7 @@ mi_gdb_test "520-data-evaluate-expression vla1" \
 set bp_lineno [gdb_get_line_number "vla1-modified"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno" \
-    -number 4 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 4 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -120,7 +120,7 @@ mi_gdb_test "560-data-evaluate-expression vla1(4)" \
 set bp_lineno [gdb_get_line_number "vla1-deallocated"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno" \
-    -number 5 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 5 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -131,7 +131,7 @@ mi_gdb_test "570-data-evaluate-expression vla1" \
 set bp_lineno [gdb_get_line_number "pvla2-not-associated"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno" \
-    -number 6 -disp "del" -func "vla" ".*vla.f90" $bp_lineno $hex
+    -number 6 -disp "del" -func "vla"
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -172,7 +172,7 @@ gdb_expect {
 set bp_lineno [gdb_get_line_number "pvla2-associated"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno" \
-    -number 7 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 7 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
@@ -196,7 +196,7 @@ mi_gdb_test "593-var-evaluate-expression pvla2_associated" \
 set bp_lineno [gdb_get_line_number "pvla2-set-to-null"]
 mi_create_breakpoint "-t vla.f90:$bp_lineno" \
     "insert breakpoint at line $bp_lineno" \
-    -number 8 -disp del -func vla ".*vla.f90" $bp_lineno $hex
+    -number 8 -disp del -func vla
 mi_run_cmd
 mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
   { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
diff --git a/gdb/testsuite/gdb.testsuite/parse_options_args.exp b/gdb/testsuite/gdb.testsuite/parse_options_args.exp
index 19ad67afd0f..7239ef7a41e 100644
--- a/gdb/testsuite/gdb.testsuite/parse_options_args.exp
+++ b/gdb/testsuite/gdb.testsuite/parse_options_args.exp
@@ -38,7 +38,7 @@ with_test_prefix parse_options {
 
 with_test_prefix parse_args {
     proc test2 { args } {
-	parse_args {
+	parse_some_args {
 	    { opt1 defval1 }
 	    { opt2 defval2 }
 	    { opt3 }
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index c993f48fd34..7d8d4138f69 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1559,7 +1559,7 @@ proc gdb_test { args } {
     global gdb_prompt
     upvar timeout timeout
 
-    parse_args {
+    parse_some_args {
 	{prompt ""}
 	{no-prompt-anchor}
 	{lbl}
@@ -1567,7 +1567,8 @@ proc gdb_test { args } {
 	{nonl}
     }
 
-    lassign $args command pattern message question response
+    set args [lassign $args command pattern message question response]
+    check_no_args_left
 
     # Can't have a question without a response.
     if { $question != "" && $response == "" || [llength $args] > 5 } {
@@ -1741,13 +1742,14 @@ if { [tcl_version_at_least 8 6 2] == 0 } {
 proc gdb_test_no_output { args } {
     global gdb_prompt
 
-    parse_args {
+    parse_some_args {
 	{prompt ""}
 	{no-prompt-anchor}
 	{nopass}
     }
 
-    lassign $args command message
+    set args [lassign $args command message]
+    check_no_args_left
 
     set prompt [fill_in_default_prompt $prompt [expr !${no-prompt-anchor}]]
 
@@ -1789,7 +1791,7 @@ proc gdb_test_no_output { args } {
 proc gdb_test_sequence { args } {
     global gdb_prompt
 
-    parse_args {{prompt ""}}
+    parse_some_args {{prompt ""}}
 
     if { $prompt == "" } {
 	set prompt "$gdb_prompt $"
@@ -9351,13 +9353,32 @@ proc parse_list { level listname argset prefix eval } {
 # Search the caller's args variable and set variables according to the list of
 # valid options described by ARGSET.
 
-proc parse_args { argset } {
+proc parse_some_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...
 }
 
+# Check that the caller's args variable is empty.
+
+proc check_no_args_left {} {
+    # Require no remaining args.
+    upvar 1 args args
+    if { [llength $args] != 0 } {
+	error "Args left unparsed: $args"
+    }
+}
+
+# As parse_some_args, but check that no args remain after parsing.
+
+proc parse_args { argset } {
+    uplevel parse_some_args [list $argset]
+
+    # Require no remaining args.
+    uplevel check_no_args_left
+}
+
 # Process the caller's options variable and set variables according
 # to the list of valid options described by OPTIONSET.
 
diff --git a/gdb/testsuite/lib/mi-support.exp b/gdb/testsuite/lib/mi-support.exp
index a79b133fa4f..38321379721 100644
--- a/gdb/testsuite/lib/mi-support.exp
+++ b/gdb/testsuite/lib/mi-support.exp
@@ -2680,7 +2680,7 @@ proc mi_make_info_frame_regexp {args} {
 # build the regexp for matching against the -stack-info-frame output.
 
 proc mi_info_frame { test args } {
-    parse_args {{frame ""} {thread ""}}
+    parse_some_args {{frame ""} {thread ""}}
 
     set re [eval mi_make_info_frame_regexp $args]