From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from simark.ca by simark.ca with LMTP id GVNZDvJOjGqWVTwAWB0awg (envelope-from ) for ; Mon, 24 Aug 2026 10:02:26 -0400 Authentication-Results: simark.ca; dkim=pass (1024-bit key; unprotected) header.d=suse.de header.i=@suse.de header.a=rsa-sha256 header.s=susede2_rsa header.b=HcTB9KNJ; dkim=pass header.d=suse.de header.i=@suse.de header.a=ed25519-sha256 header.s=susede2_ed25519 header.b=KZSM4Tgl; dkim=pass (1024-bit key) header.d=suse.de header.i=@suse.de header.a=rsa-sha256 header.s=susede2_rsa header.b=YBc1d7RS; dkim=neutral header.d=suse.de header.i=@suse.de header.a=ed25519-sha256 header.s=susede2_ed25519 header.b=D/GqQh7G; dkim-atps=neutral Received: by simark.ca (Postfix, from userid 112) id 33F5B1E0A3; Mon, 24 Aug 2026 10:02:26 -0400 (EDT) X-Spam-Checker-Version: SpamAssassin 4.0.1 (2024-03-25) on simark.ca X-Spam-Level: X-Spam-Status: No, score=-5.4 required=5.0 tests=ARC_SIGNED,ARC_VALID,BAYES_00, DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,MAILING_LIST_MULTI, RCVD_IN_DNSWL_MED autolearn=ham autolearn_force=no version=4.0.1 Received: from vm01.sourceware.org (vm01.sourceware.org [IPv6:2620:52:6:3111::32]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange x25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by simark.ca (Postfix) with ESMTPS id 9460C1E033 for ; Mon, 24 Aug 2026 10:02:24 -0400 (EDT) Received: from vm01.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6BC3E4BA9019 for ; Mon, 24 Aug 2026 14:02:23 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6BC3E4BA9019 Authentication-Results: sourceware.org; dkim=pass (1024-bit key, unprotected) header.d=suse.de header.i=@suse.de header.a=rsa-sha256 header.s=susede2_rsa header.b=HcTB9KNJ; dkim=pass header.d=suse.de header.i=@suse.de header.a=ed25519-sha256 header.s=susede2_ed25519 header.b=KZSM4Tgl; dkim=pass (1024-bit key) header.d=suse.de header.i=@suse.de header.a=rsa-sha256 header.s=susede2_rsa header.b=YBc1d7RS; dkim=neutral header.d=suse.de header.i=@suse.de header.a=ed25519-sha256 header.s=susede2_ed25519 header.b=D/GqQh7G Received: from smtp-out1.suse.de (smtp-out1.suse.de [195.135.223.130]) by sourceware.org (Postfix) with ESMTPS id 657054BA79A5 for ; Mon, 24 Aug 2026 13:59:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 657054BA79A5 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=suse.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=suse.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 657054BA79A5 Authentication-Results: sourceware.org; arc=none smtp.remote-ip=195.135.223.130 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1787579953; cv=none; b=Qnjspt3uHIvPypqJryhWP7ajKnIaYUvVznUTgwgzPli9t9496beocODfQbXaEBO2ap1zFK90SvFnHbvkU2SoZSVWUWb81L0AJKoXR6nDaZhNPRuXp2zT05SJgaCtzwozKfgFL+Q+zxRBThjyuM/7qBrRyGN52nSB6R9k/u6El7Q= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1787579953; c=relaxed/simple; bh=AGLRQ18OIE2nmmUAbU0D6Kb++du0UGIjD/ByTHxqw3g=; h=DKIM-Signature:DKIM-Signature:DKIM-Signature:DKIM-Signature:From: To:Subject:Date:Message-ID:MIME-Version; b=RLvXrFzSy+o2IIjfuSVNxR2zZDC+lbZznMVLKyZoo1v8ugNxMiwrX2/n50Em7WZ4GKnHuhvznN3TV6J9QGDNv8/hBj5movlfcjlBs4FLjvXugSZKygOvsRkJA+upEuRcKhnvDGjHDRn6s9Y4Eyzn/PaBNVB0HJYYLomVhE5Hd+o= ARC-Authentication-Results: i=1; sourceware.org; dkim=pass (1024-bit key, unprotected) header.d=suse.de header.i=@suse.de header.a=rsa-sha256 header.s=susede2_rsa header.b=HcTB9KNJ; dkim=pass header.d=suse.de header.i=@suse.de header.a=ed25519-sha256 header.s=susede2_ed25519 header.b=KZSM4Tgl; dkim=pass (1024-bit key) header.d=suse.de header.i=@suse.de header.a=rsa-sha256 header.s=susede2_rsa header.b=YBc1d7RS; dkim=neutral header.d=suse.de header.i=@suse.de header.a=ed25519-sha256 header.s=susede2_ed25519 header.b=D/GqQh7G DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 657054BA79A5 Received: from imap1.dmz-prg2.suse.org (unknown [10.150.64.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by smtp-out1.suse.de (Postfix) with ESMTPS id 34AAA867E1 for ; Mon, 24 Aug 2026 13:59:04 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=suse.de; s=susede2_rsa; t=1787579948; h=from:from:reply-to:date:date:message-id:message-id:to:to:cc: mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=slZx9EEEhtbo/TPPWBIglF5rBK/0uXokXqreXGcOAOc=; b=HcTB9KNJF+7UtJeV6OieKXMq98Jmyob5CVPp8pvqtO39BAtdkwrf6F0gLrmzD4rvnLJKXM gRtE+7m84HAa7jVXyZgO5LqidSlEPqKVLBF2r1/4JXnF8YfVs1W5ew1XXSTjsalKoBYpNe nSIU5iISRgSFakzWXQ3m3vRmAxMoM9o= DKIM-Signature: v=1; a=ed25519-sha256; c=relaxed/relaxed; d=suse.de; s=susede2_ed25519; t=1787579948; h=from:from:reply-to:date:date:message-id:message-id:to:to:cc: mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=slZx9EEEhtbo/TPPWBIglF5rBK/0uXokXqreXGcOAOc=; b=KZSM4TglvvjF8RN2cWS5v2cGOUItTIRoEyL++G8UQvILxQ50I/P9DC+H3AjLwBSQEz+bwt sl/xcjiOr4NZFGCA== Authentication-Results: smtp-out1.suse.de; none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=suse.de; s=susede2_rsa; t=1787579944; h=from:from:reply-to:date:date:message-id:message-id:to:to:cc: mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=slZx9EEEhtbo/TPPWBIglF5rBK/0uXokXqreXGcOAOc=; b=YBc1d7RSL4NHOuudUZZDr3LQ9rsX3/hiMVVHB3QXBf2BZ/tvLACJ1Rsn+4iN47MG/cVSuJ Da/wQnBMmNT5I7qcMFkQGnOAh0y45D0Hkconn0nB6SkPny7dUKpGAf5EtBHPYtk8U86S0P xIrzMNn9awXSQUXbJdC001L5JeKk4C4= DKIM-Signature: v=1; a=ed25519-sha256; c=relaxed/relaxed; d=suse.de; s=susede2_ed25519; t=1787579944; h=from:from:reply-to:date:date:message-id:message-id:to:to:cc: mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=slZx9EEEhtbo/TPPWBIglF5rBK/0uXokXqreXGcOAOc=; b=D/GqQh7GKBTgcD7NpdZ9IKyQVJjGLSsyeyACaztgT+sY4zGqSNzA20Z0K284myPyf6aV4F +kmyzIXOmFgCBbCQ== Received: from imap1.dmz-prg2.suse.org (localhost [127.0.0.1]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by imap1.dmz-prg2.suse.org (Postfix) with ESMTPS id 7021C133F3 for ; Mon, 24 Aug 2026 13:58:56 +0000 (UTC) Received: from dovecot-director2.suse.de ([2a07:de40:b281:106:10:150:64:167]) by imap1.dmz-prg2.suse.org with ESMTPSA id YHsyGiBOjGo+eQAAD6G6ig (envelope-from ) for ; Mon, 24 Aug 2026 13:58:56 +0000 From: Tom de Vries To: gdb-patches@sourceware.org Subject: [PATCH 06/11] [gdb/testsuite] Refactor exception handling Date: Mon, 24 Aug 2026 15:58:50 +0200 Message-ID: <20260824135855.1195963-7-tdevries@suse.de> X-Mailer: git-send-email 2.51.0 In-Reply-To: <20260824135855.1195963-1-tdevries@suse.de> References: <20260824135855.1195963-1-tdevries@suse.de> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spamd-Result: default: False [-2.80 / 50.00]; BAYES_HAM(-3.00)[100.00%]; MID_CONTAINS_FROM(1.00)[]; NEURAL_HAM_LONG(-1.00)[-1.000]; R_MISSING_CHARSET(0.50)[]; NEURAL_HAM_SHORT(-0.20)[-1.000]; MIME_GOOD(-0.10)[text/plain]; ARC_NA(0.00)[]; RCPT_COUNT_ONE(0.00)[1]; RCVD_VIA_SMTP_AUTH(0.00)[]; MIME_TRACE(0.00)[0:+]; DKIM_SIGNED(0.00)[suse.de:s=susede2_rsa,suse.de:s=susede2_ed25519]; PREVIOUSLY_DELIVERED(0.00)[gdb-patches@sourceware.org]; FROM_EQ_ENVFROM(0.00)[]; FROM_HAS_DN(0.00)[]; DBL_BLOCKED_OPENRESOLVER(0.00)[imap1.dmz-prg2.suse.org:helo,suse.de:mid]; RCVD_COUNT_TWO(0.00)[2]; TO_MATCH_ENVRCPT_ALL(0.00)[]; TO_DN_NONE(0.00)[]; RCVD_TLS_ALL(0.00)[] X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gdb-patches-bounces~public-inbox=simark.ca@sourceware.org Use try/finally and transparent_uplevel to refactor exception handling. Most procs use both try/finally and transparent_uplevel. The two exceptions are: - target_compile_ada_from_dir (only uses try/finally) - with_ansi_styling_terminal (only uses transparent_uplevel) Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=34552 Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=34553 --- gdb/testsuite/lib/ada.exp | 14 +- gdb/testsuite/lib/dwarf.exp | 15 +- gdb/testsuite/lib/gdb-utils.exp | 17 +- gdb/testsuite/lib/gdb.exp | 298 ++++++++++++-------------------- gdb/testsuite/lib/tuiterm.exp | 15 +- 5 files changed, 136 insertions(+), 223 deletions(-) diff --git a/gdb/testsuite/lib/ada.exp b/gdb/testsuite/lib/ada.exp index 086866aca99..2dcd8a06f3f 100644 --- a/gdb/testsuite/lib/ada.exp +++ b/gdb/testsuite/lib/ada.exp @@ -67,18 +67,16 @@ proc target_compile_ada_from_dir {builddir source dest type options} { set_board_info multilib_flags "$multilib_flag" } - catch { + try { with_cwd $builddir { return [target_compile $source $dest $type $options] } - } result options - - if { $save_multilib_flag != "" } { - unset_board_info "multilib_flags" - set_board_info multilib_flags $save_multilib_flag + } finally { + if { $save_multilib_flag != "" } { + unset_board_info "multilib_flags" + set_board_info multilib_flags $save_multilib_flag + } } - - return -options $options $result } # Compile some Ada code. Return "" if the compile was successful. diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp index 839c5174265..1323c2dfd83 100644 --- a/gdb/testsuite/lib/dwarf.exp +++ b/gdb/testsuite/lib/dwarf.exp @@ -324,18 +324,11 @@ proc shared_gdb_end_use {} { proc with_shared_gdb { body } { shared_gdb_enable - set code [catch { uplevel 1 $body } result] - shared_gdb_disable - - # Return as appropriate. - if { $code == 1 } { - global errorInfo errorCode - return -code error -errorinfo $errorInfo -errorcode $errorCode $result - } elseif { $code > 1 } { - return -code $code $result + try { + transparent_uplevel $body + } finally { + shared_gdb_disable } - - return $result } # Return a list of expressions about function FUNC's address and length. diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp index cabeb7aa1ed..1f04a626cbc 100644 --- a/gdb/testsuite/lib/gdb-utils.exp +++ b/gdb/testsuite/lib/gdb-utils.exp @@ -235,17 +235,12 @@ proc with_lock { lock_file body } { set lock_rc [lock_file_acquire $lock_file] } - set code [catch {uplevel 1 $body} result] - - if {[info exists ::GDB_PARALLEL]} { - lock_file_release $lock_rc - } - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + if {[info exists ::GDB_PARALLEL]} { + lock_file_release $lock_rc + } } } diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 853b45f4a53..2cd2603e39f 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -148,22 +148,15 @@ proc load_lib { file } { set known_globals($varname) 1 } - set code [catch {saved_load_lib $file} result] - - foreach varname [info globals] { - if { ![info exists known_globals($varname)] } { - gdb_persistent_global_no_decl $varname - } - } - - if {$code == 1} { - global errorInfo errorCode - return -code error -errorinfo $errorInfo -errorcode $errorCode $result - } elseif {$code > 1} { - return -code $code $result + try { + saved_load_lib $file + } finally { + foreach varname [info globals] { + if { ![info exists known_globals($varname)] } { + gdb_persistent_global_no_decl $varname + } + } } - - return $result } # Tcl 9.0 changed the default channel encoding profile to "strict". @@ -3341,10 +3334,11 @@ proc with_test_prefix { prefix body } { set saved $pf_prefix append pf_prefix " " $prefix ":" - catch {uplevel 1 $body} result opts - set pf_prefix $saved - - return -options [dict incr opts -level 1] $result + try { + transparent_uplevel $body + } finally { + set pf_prefix $saved + } } # Wrapper for foreach that calls with_test_prefix on each iteration, @@ -3440,26 +3434,21 @@ proc save_vars { vars body } { } } - set code [catch {uplevel 1 $body} result] - - foreach {var value} [array get saved_scalars] { - uplevel 1 [list set $var $value] - } - - foreach {var value} [array get saved_arrays] { - uplevel 1 [list unset $var] - uplevel 1 [list array set $var $value] - } + try { + transparent_uplevel $body + } finally { + foreach {var value} [array get saved_scalars] { + uplevel 1 [list set $var $value] + } - foreach var $unset_vars { - uplevel 1 [list unset -nocomplain $var] - } + foreach {var value} [array get saved_arrays] { + uplevel 1 [list unset $var] + uplevel 1 [list array set $var $value] + } - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + foreach var $unset_vars { + uplevel 1 [list unset -nocomplain $var] + } } } @@ -3491,22 +3480,17 @@ proc save_target_board_info { vars body } { } } - set code [catch {uplevel 1 $body} result] - - foreach {var value} [array get saved_target_board_info] { - unset_board_info $var - set_board_info $var $value - } - - foreach var $unset_target_board_info { - unset_board_info $var - } + try { + transparent_uplevel $body + } finally { + foreach {var value} [array get saved_target_board_info] { + unset_board_info $var + set_board_info $var $value + } - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + foreach var $unset_target_board_info { + unset_board_info $var + } } } @@ -3522,16 +3506,11 @@ proc with_cwd { dir body } { verbose -log "Switching to directory $dir (saved CWD: $saved_dir)." cd $dir - set code [catch {uplevel 1 $body} result] - - verbose -log "Switching back to $saved_dir." - cd $saved_dir - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + verbose -log "Switching back to $saved_dir." + cd $saved_dir } } @@ -3606,42 +3585,37 @@ proc with_gdb_cwd { dir body } { return } - set code [catch {uplevel 1 $body} result] - - verbose -log "Switching back to $saved_dir." - if {![gdb_cd $saved_dir]} { - return - } - - # Check that GDB is still alive. If GDB crashed in the above code - # then any corefile will have been left in DIR, not the root - # testsuite directory. As a result the corefile will not be - # brought to the users attention. Instead, if GDB crashed, then - # this check should cause a FAIL, which should be enough to alert - # the user. - set saw_result false - gdb_test_multiple "p 123" "" { - -re "p 123\r\n" { - exp_continue + try { + transparent_uplevel $body + } finally { + verbose -log "Switching back to $saved_dir." + if {![gdb_cd $saved_dir]} { + return } - -re "^${::valnum_re} = 123\r\n" { - set saw_result true - exp_continue - } + # Check that GDB is still alive. If GDB crashed in the above code + # then any corefile will have been left in DIR, not the root + # testsuite directory. As a result the corefile will not be + # brought to the users attention. Instead, if GDB crashed, then + # this check should cause a FAIL, which should be enough to alert + # the user. + set saw_result false + gdb_test_multiple "p 123" "" { + -re "p 123\r\n" { + exp_continue + } - -re "^$::gdb_prompt $" { - if { !$saw_result } { - fail "check gdb is alive in with_gdb_cwd" + -re "^${::valnum_re} = 123\r\n" { + set saw_result true + exp_continue } - } - } - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + -re "^$::gdb_prompt $" { + if { !$saw_result } { + fail "check gdb is alive in with_gdb_cwd" + } + } + } } } @@ -3682,17 +3656,12 @@ proc with_gdb_prompt { prompt body } { set gdb_prompt $prompt gdb_test_no_output "set prompt $prompt " "" - set code [catch {uplevel 1 $body} result] - - verbose -log "Restoring gdb prompt to \"$saved \"." - set gdb_prompt $saved - gdb_test_no_output "set prompt $saved " "" - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + verbose -log "Restoring gdb prompt to \"$saved \"." + set gdb_prompt $saved + gdb_test_no_output "set prompt $saved " "" } } @@ -3717,15 +3686,10 @@ proc with_target_charset { target_charset body } { gdb_test_no_output -nopass "set target-charset $target_charset" - set code [catch {uplevel 1 $body} result] - - gdb_test_no_output -nopass "set target-charset $saved" - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + gdb_test_no_output -nopass "set target-charset $saved" } } @@ -3747,15 +3711,10 @@ proc with_max_value_size { size body } { gdb_test_no_output -nopass "set max-value-size $size" - set code [catch {uplevel 1 $body} result] - - gdb_test_no_output -nopass "set max-value-size $saved" - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + gdb_test_no_output -nopass "set max-value-size $saved" } } @@ -3793,19 +3752,14 @@ proc with_spawn_id { spawn_id body } { switch_gdb_spawn_id $spawn_id - set code [catch {uplevel 1 $body} result] - - if {[info exists saved_spawn_id]} { - switch_gdb_spawn_id $saved_spawn_id - } else { - clear_gdb_spawn_id - } - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + if {[info exists saved_spawn_id]} { + switch_gdb_spawn_id $saved_spawn_id + } else { + clear_gdb_spawn_id + } } } @@ -3860,14 +3814,10 @@ proc with_timeout_factor { factor body } { set savedtimeout $timeout set timeout [expr {[get_largest_timeout] * $factor}] - set code [catch {uplevel 1 $body} result] - - set timeout $savedtimeout - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + set timeout $savedtimeout } } @@ -8281,24 +8231,19 @@ proc with_set { var val body } { } } - set code [catch {uplevel 1 $body} result] - - # Restore saved setting. - if { $save != "" } { - gdb_test_multiple "set $var $save" "" { - -re -wrap "^" { - } - -re -wrap "is set to \"?$save\"?( \\(\[^)\]*\\))?\\." { + try { + transparent_uplevel $body + } finally { + # Restore saved setting. + if { $save != "" } { + gdb_test_multiple "set $var $save" "" { + -re -wrap "^" { + } + -re -wrap "is set to \"?$save\"?( \\(\[^)\]*\\))?\\." { + } } } } - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result - } } # @@ -11334,25 +11279,17 @@ proc with_override { name override body } { proc $name $new_args $new_body # Execute body. - set code [catch {uplevel 1 $body} result] - - # Restore old proc if it existed on entry, else delete it. - if { $existed } { - # tclint-disable-next-line command-args - proc $name $old_args $old_body - } else { - rename $name "" - } - - # Return as appropriate. - if { $code == 1 } { - global errorInfo errorCode - return -code error -errorinfo $errorInfo -errorcode $errorCode $result - } elseif { $code > 1 } { - return -code $code $result + try { + transparent_uplevel $body + } finally { + # Restore old proc if it existed on entry, else delete it. + if { $existed } { + # tclint-disable-next-line command-args + proc $name $old_args $old_body + } else { + rename $name "" + } } - - return $result } # Run BODY after setting the TERM environment variable to 'ansi', and @@ -11368,14 +11305,7 @@ proc with_ansi_styling_terminal { body } { unset -nocomplain ::env(NO_COLOR) unset -nocomplain ::env(COLORTERM) - set code [catch {uplevel 1 $body} result] - } - - if {$code == 1} { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + transparent_uplevel $body } } diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp index d23e29d1a6d..e0ba8510d6e 100644 --- a/gdb/testsuite/lib/tuiterm.exp +++ b/gdb/testsuite/lib/tuiterm.exp @@ -56,15 +56,12 @@ proc Term::_log_cur { what body } { set orig_cur_row $_cur_row set orig_cur_col $_cur_col - set code [catch {uplevel $body} result] - - _log "$what, cursor: ($orig_cur_row, $orig_cur_col) -> ($_cur_row, $_cur_col)" - - if { $code == 1 } { - global errorInfo errorCode - return -code $code -errorinfo $errorInfo -errorcode $errorCode $result - } else { - return -code $code $result + try { + transparent_uplevel $body + } finally { + set before "($orig_cur_row, $orig_cur_col)" + set after "($_cur_row, $_cur_col)" + _log "$what, cursor: $before -> $after" } } -- 2.51.0