[PATCH 08/11] [gdb/testsuite] Refactor exception handling in gdb_test_multiple

[Tom de Vries <tdevries@suse.de>]

Simplify gdb_test_multiple using return -options and try/finally.

In the process, we also try to fix PR34553.

I've added a test to verify this, but it'll be only useful after remote_expect
gets fixed [1].

Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=34552
Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=34553

[1] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=81691
---
 gdb/testsuite/gdb.testsuite/gdb-test.exp | 51 ++++++++++++++++++++++++
 gdb/testsuite/lib/gdb.exp                | 37 +++++++++--------
 2 files changed, 69 insertions(+), 19 deletions(-)

diff --git a/gdb/testsuite/gdb.testsuite/gdb-test.exp b/gdb/testsuite/gdb.testsuite/gdb-test.exp
index dab65f21bdb..231f0755f58 100644
--- a/gdb/testsuite/gdb.testsuite/gdb-test.exp
+++ b/gdb/testsuite/gdb.testsuite/gdb-test.exp
@@ -49,6 +49,57 @@ with_test_prefix "cmd with trailing control code" {
     }
 }
 
+foreach_with_prefix variant {0 1 2} {
+    proc level_2_inner {} {
+	if {$::variant == 0} {
+	    return -level 2 "return_level_2"
+	} elseif {$::variant == 1} {
+	    send_gdb "print 1\n"
+	    set prompt_re [string_to_regexp "(gdb) "]
+	    remote_expect host 10 {
+		-re " = 1\r\n$prompt_re$" {
+		    return -level 2 "return_level_2"
+		}
+	    }
+	} else {
+	    gdb_test_multiple "print 1" "" {
+		-re -wrap " = 1" {
+		    return -level 2 "return_level_2"
+		}
+	    }
+	}
+	return "inner"
+    }
+
+    proc level_2_outer {} {
+	level_2_inner
+	return "outer"
+    }
+
+    try {
+	set res "initial"
+	set res [level_2_outer]
+    } finally {
+	if {$variant == 0} {
+	    # trivial case.
+	    gdb_assert {$res == "return_level_2"}
+	} elseif {$variant == 1} {
+	    # Remove_expect case.
+	    if {$res == "outer"} {
+		# Dejagnu bug.
+		# https://debbugs.gnu.org/cgi/bugreport.cgi?bug=81691
+		setup_xfail *-*-*
+	    }
+	    gdb_assert {$res == "return_level_2"}
+	    set variant1_res $res
+	} else {
+	    # Gdb_test_multiple case. This should work if the remote_expect
+	    # case works.
+	    gdb_assert {$res == $variant1_res}
+	}
+    }
+}
+
 # Change the prompt.
 set prompt "(GDB) "
 set prompt_re "\\(GDB\\) $"
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 479d1229142..99468ac3ef3 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1369,7 +1369,6 @@ proc gdb_test_multiple { command message args } {
 	send_user "Message is \"$message\"\n"
     }
 
-    set result -1
     set string "${command}\n"
     if { $command != "" } {
 	set multi_line_re "\[\r\n\] *>"
@@ -1574,25 +1573,25 @@ proc gdb_test_multiple { command message args } {
     }
     set gdb_test_name "$message"
 
-    set result 0
-    set code [catch {gdb_expect $code} string]
-
-    # Clean up the gdb_test_name variable.  If we had a
-    # previous value then restore it, otherwise, delete the variable
-    # from the parent scope.
-    if { [info exists gdb_test_name_old] } {
-	set gdb_test_name "$gdb_test_name_old"
-    } else {
-	unset gdb_test_name
-    }
-
-    if {$code == 1} {
-	global errorInfo errorCode
-	return -code error -errorinfo $errorInfo -errorcode $errorCode $string
-    } elseif {$code > 1} {
-	return -code $code $string
+    try {
+	if {[info exists result]} {
+	    error "result set but not used"
+	}
+	set result 0
+	if {[catch {gdb_expect $code} string opts] == 0} {
+	    return $result
+	}
+	return -options [dict incr opts -level] $string
+    } finally {
+	# Clean up the gdb_test_name variable.  If we had a
+	# previous value then restore it, otherwise, delete the variable
+	# from the parent scope.
+	if { [info exists gdb_test_name_old] } {
+	    set gdb_test_name "$gdb_test_name_old"
+	} else {
+	    unset gdb_test_name
+	}
     }
-    return $result
 }
 
 # Usage: gdb_test_multiline NAME INPUT RESULT {INPUT RESULT} ...
-- 
2.51.0