Fix Tcl quoting in gdb_assert
authorTom Tromey <tromey@adacore.com>
Wed, 15 Feb 2023 21:57:10 +0000 (14:57 -0700)
committerTom Tromey <tromey@adacore.com>
Thu, 23 Feb 2023 19:50:30 +0000 (12:50 -0700)
The gdb_assert proc under-quotes the expression that is passed in.
This leads to weird code in a couple of spots that tries to
compensate:

    gdb_assert {{$all_regs eq $completed_regs}} ...

The fix is to add a bit of quoting when evaluating the expression.

gdb/testsuite/gdb.base/completion.exp
gdb/testsuite/gdb.base/step-over-no-symbols.exp
gdb/testsuite/lib/gdb.exp

index 1533acbf4f912ee297b4e781b9715f97edee69ae..4686e6f8f340591142f09a9f171b1b383ab54014 100644 (file)
@@ -159,7 +159,7 @@ foreach {-> reg} [regexp -all -inline -line {^info registers (\w+\S*)} $regs_out
     lappend completed_regs $reg
 }
 set completed_regs [join [lsort $completed_regs]]
-gdb_assert {{$all_regs eq $completed_regs}} "complete 'info registers '"
+gdb_assert {$all_regs eq $completed_regs} "complete 'info registers '"
 
 # Tests below are about tab-completion, which doesn't work if readline
 # library isn't used.  Check it first.
index 00b32deacf7c3297ce59ff0c50e8c450b28c1970..1136b47571b185db1f890f68a62c6b8d406a8725 100644 (file)
@@ -76,9 +76,9 @@ proc test_step_over { displaced } {
 
     set after_addr [get_pc "get after PC"]
 
-    gdb_assert {{[regexp "^${hex}$" $before_addr] \
-                && [regexp "^${hex}$" $after_addr] \
-                && $before_addr != $after_addr}} "advanced"
+    gdb_assert {[regexp "^${hex}$" $before_addr] \
+                   && [regexp "^${hex}$" $after_addr] \
+                   && $before_addr != $after_addr} "advanced"
 }
 
 foreach displaced { "off" "on" "auto" } {
index 66a5d31d9ad539eb33fc31322d90db9b656972c1..669a5f606d6a76cd3eb62889515a973099cdbbfd 100644 (file)
@@ -1942,7 +1942,7 @@ proc gdb_assert { condition {message ""} } {
        set message $condition
     }
 
-    set code [catch {uplevel 1 expr $condition} res]
+    set code [catch {uplevel 1 [list expr $condition]} res]
     if {$code == 1} {
        # If code is 1 (TCL_ERROR), it means evaluation failed and res contains
        # an error message.  Print the error message, and set res to 0 since we