[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

diff --git a/gdb/testsuite/gdb.base/hbreak-unmapped.exp b/gdb/testsuite/gdb.base/hbreak-unmapped.exp
index ccb4b20c458e8e222df80464e98c21a084820230..b28af6d9b01e2e5b6392e7005b0236224eb505c3 100644 (file)
--- 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 7543d98ffc954769f1858a1a65b923e55ed79cb8..20e2bb8b6a73651427f7e94f9015d1812d032286 100644 (file)
--- 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 bfe839d3339e2b9305ec2991343bb8958f9613d7..86e7b57260ab2e14473fde6433ecaf16564e1ad4 100644 (file)
--- 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 ba6ff5a0f8f10a65f511ec264b00f45ce4baf69d..270dbc15e83fc0d2312a5f7431a492d1c5ab71eb 100644 (file)
--- 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 fdfdd05efe37676fba86be66d0956de7de552598..dba784707f2a699656b0f67a62844201c2d48c39 100644 (file)
--- 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 99dbab4ce5af124c34b413cde5ba6962035e06ef..4358c181509de048d0cf6cc3e5b98ac7b809791e 100644 (file)
--- 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 ee4bc26078c639c70146fede439fcf9b887af7f1..a8a77ac0d4a92f997e37de1fa8ee93c855b1c026 100644 (file)
--- 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 e27f0ecb26a6de985e6b457c2a9a2cfeac38202d..6097c024daf21c56de4afbbe2dc64509ac7c406c 100644 (file)
--- 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 19ad67afd0f631b00e20fdcf1166b4ed844b51e8..7239ef7a41e1fe32725623f48ac062621f7f93e0 100644 (file)
--- 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 c993f48fd347ed09f40438b66188b99d7646a6d7..7d8d4138f6940d214609a751df3f6c5a674d8c60 100644 (file)
--- 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 a79b133fa4f721c8beffb81bbc1e1c58cad0a5d0..38321379721592bfea8f9a7e3e1e0fdb83ee8969 100644 (file)
--- 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]