From 6a5870cea1620f9309c730a1dd97afac8ca2f8ed Mon Sep 17 00:00:00 2001
From: Pedro Alves <palves@redhat.com>
Date: Tue, 21 Feb 2012 21:55:39 +0000
Subject: [PATCH] 2012-02-21  Pedro Alves  <palves@redhat.com> 	    Tom Tromey
  <tromey@redhat.com>

	* lib/gdb.exp: Add description of test prefixes.
	(with_test_prefix): New procedure.
	* gdb.arch/altivec-abi.exp: Use with_test_prefix.
	* gdb.base/attach-pie-misread.exp: Use with_test_prefix.
	* gdb.base/break-interp.exp: Use with_test_prefix.  Use append
	instead of lappend to append to pf_prefix.
	* gdb.base/catch-load.exp: Use with_test_prefix.
	* gdb.base/disp-step-syscall.exp: Use with_test_prefix.
	* gdb.base/jit-so.exp: Use with_test_prefix.
	* gdb.base/jit.exp: Use with_test_prefix.
	* gdb.base/return-nodebug.exp (do_test): Use append instead of
	lappend to append to pf_prefix.
	* gdb.base/sepdebug.exp: Use with_test_prefix.
	* gdb.base/solib-display.exp: Use with_test_prefix.
	* gdb.base/solib-overlap.exp: Use with_test_prefix.
	* gdb.base/watch-cond-infcall.exp: Use with_test_prefix.
	* gdb.base/watchpoint.exp: Use with_test_prefix.
	* gdb.dwarf2/dw2-noloc.exp: Use with_test_prefix.
	* gdb.mi/mi-watch.exp: Use with_test_prefix.
	* gdb.mi/mi2-watch.exp: Use with_test_prefix.
	* gdb.threads/non-ldr-exc-1.exp: Use with_test_prefix.
	* gdb.threads/non-ldr-exc-2.exp: Use with_test_prefix.
	* gdb.threads/non-ldr-exc-3.exp: Use with_test_prefix.
	* gdb.threads/non-ldr-exc-4.exp: Use with_test_prefix.
	* gdb.threads/watchpoint-fork.exp: Use with_test_prefix.  Use
	append instead of lappend to append to pf_prefix.
	* gdb.threads/watchthreads-reorder.exp: Use with_test_prefix.
	* gdb.trace/change-loc.exp: Use with_test_prefix.
	* gdb.trace/pending.exp: Use with_test_prefix.
	* gdb.trace/status-stop.exp: Use with_test_prefix.
	* gdb.trace/strace.exp: Use with_test_prefix.
	* gdb.trace/trace-break.exp: Use with_test_prefix.
	* gdb.trace/unavailable.exp: Use with_test_prefix.  Use append
	instead of lappend to append to pf_prefix.
---
 gdb/testsuite/ChangeLog                            | 38 +++++++++
 gdb/testsuite/gdb.arch/altivec-abi.exp             | 27 +++----
 gdb/testsuite/gdb.base/attach-pie-misread.exp      |  8 +-
 gdb/testsuite/gdb.base/break-interp.exp            | 36 +++------
 gdb/testsuite/gdb.base/catch-load.exp              | 12 +--
 gdb/testsuite/gdb.base/disp-step-syscall.exp       | 11 +--
 gdb/testsuite/gdb.base/jit-so.exp                  | 10 +--
 gdb/testsuite/gdb.base/jit.exp                     | 12 +--
 gdb/testsuite/gdb.base/return-nodebug.exp          |  2 +-
 gdb/testsuite/gdb.base/sepdebug.exp                |  9 +--
 gdb/testsuite/gdb.base/solib-display.exp           |  9 +--
 gdb/testsuite/gdb.base/solib-overlap.exp           |  9 +--
 gdb/testsuite/gdb.base/watch-cond-infcall.exp      | 12 +--
 gdb/testsuite/gdb.base/watchpoint.exp              | 10 +--
 gdb/testsuite/gdb.dwarf2/dw2-noloc.exp             |  9 +--
 gdb/testsuite/gdb.mi/mi-watch.exp                  | 10 +--
 gdb/testsuite/gdb.mi/mi2-watch.exp                 | 10 +--
 gdb/testsuite/gdb.threads/non-ldr-exc-1.exp        | 11 +--
 gdb/testsuite/gdb.threads/non-ldr-exc-2.exp        | 11 +--
 gdb/testsuite/gdb.threads/non-ldr-exc-3.exp        | 11 +--
 gdb/testsuite/gdb.threads/non-ldr-exc-4.exp        | 11 +--
 gdb/testsuite/gdb.threads/watchpoint-fork.exp      | 20 ++---
 gdb/testsuite/gdb.threads/watchthreads-reorder.exp | 10 +--
 gdb/testsuite/gdb.trace/change-loc.exp             | 23 +-----
 gdb/testsuite/gdb.trace/pending.exp                | 89 ++++++----------------
 gdb/testsuite/gdb.trace/status-stop.exp            | 35 ++-------
 gdb/testsuite/gdb.trace/strace.exp                 | 43 +++--------
 gdb/testsuite/gdb.trace/trace-break.exp            | 77 ++++++-------------
 gdb/testsuite/gdb.trace/unavailable.exp            | 51 ++++---------
 gdb/testsuite/lib/gdb.exp                          | 86 +++++++++++++++++++++
 30 files changed, 279 insertions(+), 433 deletions(-)

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 133bc26..c8b9857 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,41 @@
+2012-02-21  Pedro Alves  <palves@redhat.com>
+	    Tom Tromey  <tromey@redhat.com>
+
+	* lib/gdb.exp: Add description of test prefixes.
+	(with_test_prefix): New procedure.
+	* gdb.arch/altivec-abi.exp: Use with_test_prefix.
+	* gdb.base/attach-pie-misread.exp: Use with_test_prefix.
+	* gdb.base/break-interp.exp: Use with_test_prefix.  Use append
+	instead of lappend to append to pf_prefix.
+	* gdb.base/catch-load.exp: Use with_test_prefix.
+	* gdb.base/disp-step-syscall.exp: Use with_test_prefix.
+	* gdb.base/jit-so.exp: Use with_test_prefix.
+	* gdb.base/jit.exp: Use with_test_prefix.
+	* gdb.base/return-nodebug.exp (do_test): Use append instead of
+	lappend to append to pf_prefix.
+	* gdb.base/sepdebug.exp: Use with_test_prefix.
+	* gdb.base/solib-display.exp: Use with_test_prefix.
+	* gdb.base/solib-overlap.exp: Use with_test_prefix.
+	* gdb.base/watch-cond-infcall.exp: Use with_test_prefix.
+	* gdb.base/watchpoint.exp: Use with_test_prefix.
+	* gdb.dwarf2/dw2-noloc.exp: Use with_test_prefix.
+	* gdb.mi/mi-watch.exp: Use with_test_prefix.
+	* gdb.mi/mi2-watch.exp: Use with_test_prefix.
+	* gdb.threads/non-ldr-exc-1.exp: Use with_test_prefix.
+	* gdb.threads/non-ldr-exc-2.exp: Use with_test_prefix.
+	* gdb.threads/non-ldr-exc-3.exp: Use with_test_prefix.
+	* gdb.threads/non-ldr-exc-4.exp: Use with_test_prefix.
+	* gdb.threads/watchpoint-fork.exp: Use with_test_prefix.  Use
+	append instead of lappend to append to pf_prefix.
+	* gdb.threads/watchthreads-reorder.exp: Use with_test_prefix.
+	* gdb.trace/change-loc.exp: Use with_test_prefix.
+	* gdb.trace/pending.exp: Use with_test_prefix.
+	* gdb.trace/status-stop.exp: Use with_test_prefix.
+	* gdb.trace/strace.exp: Use with_test_prefix.
+	* gdb.trace/trace-break.exp: Use with_test_prefix.
+	* gdb.trace/unavailable.exp: Use with_test_prefix.  Use append
+	instead of lappend to append to pf_prefix.
+
 2012-02-20  Jan Kratochvil  <jan.kratochvil@redhat.com>
 
 	Fix racy FAILs.
diff --git a/gdb/testsuite/gdb.arch/altivec-abi.exp b/gdb/testsuite/gdb.arch/altivec-abi.exp
index 9bbe33f..fd069b2 100644
--- a/gdb/testsuite/gdb.arch/altivec-abi.exp
+++ b/gdb/testsuite/gdb.arch/altivec-abi.exp
@@ -36,7 +36,7 @@ if [get_compiler_info $binfile] {
     return -1
 }
 
-proc altivec_abi_tests { extra_flags force_abi } {
+proc altivec_abi_tests { prefix extra_flags force_abi } { with_test_prefix $prefix {
     global testfile binfile srcfile srcdir subdir
     global gdb_prompt
 
@@ -144,13 +144,10 @@ proc altivec_abi_tests { extra_flags force_abi } {
     gdb_test "p matrix\[1\]" ".*= .11, 12, 13, 14, 15, 16, 17, 18." "print second vector"
     gdb_test "p matrix\[2\]" ".*= .21, 22, 23, 24, 25, 26, 27, 28." "print third vector"
     gdb_test "p matrix\[3\]" ".*= .31, 32, 33, 34, 35, 36, 37, 38." "print fourth vector"
-}
+}}
 
 if [test_compiler_info gcc*] {
-    set saved_prefix $pf_prefix
-
-    set pf_prefix "${saved_prefix} default ABI, auto:"
-    altivec_abi_tests "additional_flags=-maltivec" "auto"
+    altivec_abi_tests " default ABI, auto:" "additional_flags=-maltivec" "auto"
 
     # On GNU/Linux, we can mix -mabi=no-altivec and -mabi=altivec.
     # So test some combinations.
@@ -159,24 +156,24 @@ if [test_compiler_info gcc*] {
 	# was broken, so skip those tests there.
 	if { ![is_lp64_target] || ![test_compiler_info "gcc-4-\[12\]-*"] } {
 	    set binfile ${objdir}/${subdir}/${testfile}-ge-ge
-	    set pf_prefix "${saved_prefix} generic ABI, forced:"
-	    altivec_abi_tests "additional_flags=-maltivec additional_flags=-mabi=no-altivec" "generic"
+	    altivec_abi_tests " generic ABI, forced:" \
+		"additional_flags=-maltivec additional_flags=-mabi=no-altivec" "generic"
 
 	    set binfile ${objdir}/${subdir}/${testfile}-ge-auto
-	    set pf_prefix "${saved_prefix} generic ABI, auto:"
-	    altivec_abi_tests "additional_flags=-maltivec additional_flags=-mabi=no-altivec" "auto"
+	    altivec_abi_tests " generic ABI, auto:" \
+		"additional_flags=-maltivec additional_flags=-mabi=no-altivec" "auto"
 	}
 
 	set binfile ${objdir}/${subdir}/${testfile}-av-av
-	set pf_prefix "${saved_prefix} AltiVec ABI, forced:"
-	altivec_abi_tests "additional_flags=-maltivec additional_flags=-mabi=altivec" "altivec"
+	altivec_abi_tests " AltiVec ABI, forced:" \
+	    "additional_flags=-maltivec additional_flags=-mabi=altivec" "altivec"
 
 	set binfile ${objdir}/${subdir}/${testfile}-av-auto
-	set pf_prefix "${saved_prefix} AltiVec ABI, auto:"
-	altivec_abi_tests "additional_flags=-maltivec additional_flags=-mabi=altivec" "auto"
+	altivec_abi_tests " AltiVec ABI, auto:" \
+	    "additional_flags=-maltivec additional_flags=-mabi=altivec" "auto"
     }
 } elseif [test_compiler_info xlc*] {
-    altivec_abi_tests "additional_flags=-qaltivec" "auto"
+    altivec_abi_tests "" "additional_flags=-qaltivec" "auto"
 } else {
     warning "unknown compiler"
     return -1
diff --git a/gdb/testsuite/gdb.base/attach-pie-misread.exp b/gdb/testsuite/gdb.base/attach-pie-misread.exp
index 65477a9..de1055e 100644
--- a/gdb/testsuite/gdb.base/attach-pie-misread.exp
+++ b/gdb/testsuite/gdb.base/attach-pie-misread.exp
@@ -152,9 +152,7 @@ gdb_expect {
 }
 
 # Due to alignments it was reproducible with 1 on x86_64 but 2 on i686.
-foreach align_mult {1 2} {
-    set old_ldprefix $pf_prefix
-    lappend pf_prefix "shift-by-$align_mult:"
+foreach align_mult {1 2} { with_test_prefix " shift-by-$align_mult:" {
 
     # FIXME: We believe there is enough room under FIRST_OFFSET.
     set shifted_offset [format 0x%x [expr "$first_offset - $align_mult * $align_max"]]
@@ -198,8 +196,6 @@ foreach align_mult {1 2} {
     }
 
     gdb_test "detach" "Detaching from program: .*"
-
-    set pf_prefix $old_ldprefix
-}
+}}
 
 remote_exec host "kill -9 $pid"
diff --git a/gdb/testsuite/gdb.base/break-interp.exp b/gdb/testsuite/gdb.base/break-interp.exp
index 575e8f0..d6267ac 100644
--- a/gdb/testsuite/gdb.base/break-interp.exp
+++ b/gdb/testsuite/gdb.base/break-interp.exp
@@ -185,16 +185,12 @@ proc reach_1 {func command displacement} {
 # displacement of 0 bytes to be present, "NONZERO" for displacement of non-0
 # bytes to be present and "PRESENT" if both "ZERO" and "NONZERO" are valid.
 proc reach {func command displacement} {
-    global pf_prefix
-    set old_ldprefix $pf_prefix
-    lappend pf_prefix "reach-$func:"
-
-    reach_1 $func $command $displacement
-
-    set pf_prefix $old_ldprefix
+    with_test_prefix " reach-$func:" {
+	reach_1 $func $command $displacement
+    }
 }
 
-proc test_core {file displacement} {
+proc test_core {file displacement} { with_test_prefix " core:" {
     global srcdir subdir gdb_prompt expect_out
 
     set corefile [core_find $file {} "segv"]
@@ -202,10 +198,6 @@ proc test_core {file displacement} {
 	return
     }
 
-    global pf_prefix
-    set old_ldprefix $pf_prefix
-    lappend pf_prefix "core:"
-
     gdb_exit
     gdb_start
     # Clear it to never find any separate debug infos in $debug_root.
@@ -245,17 +237,11 @@ proc test_core {file displacement} {
     }
 
     gdb_test "bt" "#\[0-9\]+ +\[^\r\n\]*\\mlibfunc\\M\[^\r\n\]*\r\n#\[0-9\]+ +\[^\r\n\]*\\mmain\\M.*" "core main bt"
+}}
 
-    set pf_prefix $old_ldprefix
-}
-
-proc test_attach_gdb {file pid displacement prefix} {
+proc test_attach_gdb {file pid displacement prefix} { with_test_prefix " $prefix:" {
     global gdb_prompt expect_out
 
-    global pf_prefix
-    set old_ldprefix $pf_prefix
-    lappend pf_prefix "$prefix:"
-
     gdb_exit
     gdb_start
 
@@ -300,9 +286,7 @@ proc test_attach_gdb {file pid displacement prefix} {
 
     gdb_test "bt" "#\[0-9\]+ +\[^\r\n\]*\\mlibfunc\\M\[^\r\n\]*\r\n#\[0-9\]+ +\[^\r\n\]*\\mmain\\M.*" "attach main bt"
     gdb_exit
-
-    set pf_prefix $old_ldprefix
-}
+}}
 
 proc test_attach {file displacement {relink_args ""}} {
     global board_info
@@ -429,7 +413,7 @@ proc test_ld {file ifmain trynosym displacement} {
 
     global pf_prefix
     set old_ldprefix $pf_prefix
-    lappend pf_prefix "symbol-less:"
+    append pf_prefix " symbol-less:"
 
     # Test also `exec-file'-command loaded $FILE - therefore without symbols.
     # SYMBOL_OBJFILE is not available and only EXEC_BFD must be used.
@@ -544,7 +528,7 @@ foreach ldprelink {NO YES} {
 	set interp_saved ${interp}-saved
 
 	set pf_prefix $old_ldprefix
-	lappend pf_prefix "$ldname:"
+	append pf_prefix " $ldname:"
 
 	if {$ldsepdebug == "NO"} {
 	    file_copy $interp_system $interp
@@ -626,7 +610,7 @@ foreach ldprelink {NO YES} {
 		    set exec $binprefix-$binname
 
 		    set pf_prefix $old_binprefix
-		    lappend pf_prefix "$binname:"
+		    append pf_prefix " $binname:"
 
 		    set opts "ldflags=-Wl,$binfile_lib,-rpath,[file dirname $binfile_lib]"
 		    if {$binsepdebug != "NO"} {
diff --git a/gdb/testsuite/gdb.base/catch-load.exp b/gdb/testsuite/gdb.base/catch-load.exp
index 2b3112f..e17a563 100644
--- a/gdb/testsuite/gdb.base/catch-load.exp
+++ b/gdb/testsuite/gdb.base/catch-load.exp
@@ -46,20 +46,16 @@ if { [gdb_compile_shlib "${srcdir}/${subdir}/${srcfile2}" ${binfile2} {debug}] !
 # names.
 # KIND is passed to the "catch" command.
 # MATCH is a boolean saying whether we expect the catchpoint to be hit.
-proc one_catch_load_test {scenario kind match sostop} {
+proc one_catch_load_test {scenario kind match sostop} { with_test_prefix "${scenario}:" {
     global verbose testfile testfile2 binfile2_dlopen
-    global pf_prefix srcfile
+    global srcfile
     global decimal gdb_prompt
 
-    set saved_prefix $pf_prefix
-    append pf_prefix "${scenario}:"
-
     clean_restart $testfile
     gdb_load_shlibs $binfile2_dlopen
 
     if {![runto_main]} {
 	fail "can't run to main"
-	set pf_prefix $saved_prefix
 	return
     }
 
@@ -97,9 +93,7 @@ proc one_catch_load_test {scenario kind match sostop} {
 	    fail "continue"
 	}
     }
-
-    set pf_prefix $saved_prefix
-}
+}}
 
 one_catch_load_test "plain load" "load" 1 0
 one_catch_load_test "plain load with stop-on-solib-events" "load" 1 1
diff --git a/gdb/testsuite/gdb.base/disp-step-syscall.exp b/gdb/testsuite/gdb.base/disp-step-syscall.exp
index 1f23399..61de211 100644
--- a/gdb/testsuite/gdb.base/disp-step-syscall.exp
+++ b/gdb/testsuite/gdb.base/disp-step-syscall.exp
@@ -30,10 +30,9 @@ if { [istarget "i\[34567\]86-*-linux*"] || [istarget "x86_64-*-linux*"] } {
     return -1
 }
 
-proc disp_step_cross_syscall { syscall } {
+proc disp_step_cross_syscall { syscall } { with_test_prefix " $syscall:" {
     global syscall_insn
     global gdb_prompt
-    global pf_prefix
 
     set testfile "disp-step-$syscall"
 
@@ -47,9 +46,6 @@ proc disp_step_cross_syscall { syscall } {
 	return
     }
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$syscall:"
-
     # Delete the breakpoint on main.
     gdb_test_no_output "delete break 1"
 
@@ -94,7 +90,6 @@ proc disp_step_cross_syscall { syscall } {
 
     if {$see_syscall_insn == 0} then {
 	fail "find syscall insn in $syscall"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -130,9 +125,7 @@ proc disp_step_cross_syscall { syscall } {
 
     gdb_test "continue" "Continuing\\..*Breakpoint \[0-9\]+, marker \\(\\) at.*" \
 	"continue to marker ($syscall)"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 disp_step_cross_syscall "fork"
 disp_step_cross_syscall "vfork"
diff --git a/gdb/testsuite/gdb.base/jit-so.exp b/gdb/testsuite/gdb.base/jit-so.exp
index b28f903..b595774 100644
--- a/gdb/testsuite/gdb.base/jit-so.exp
+++ b/gdb/testsuite/gdb.base/jit-so.exp
@@ -63,11 +63,8 @@ if { [gdb_compile_shlib ${solib_srcfile} ${solib_binfile} {}] != "" } {
 
 set solib_binfile_target [gdb_download ${solib_binfile}]
 
-proc one_jit_test {count match_str} {
-    global verbose testfile srcfile2 binfile2 binfile2_dlopen solib_binfile_target solib_binfile_test_msg pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "one_jit_test-$count:"
+proc one_jit_test {count match_str} { with_test_prefix " one_jit_test-$count:" {
+    global verbose testfile srcfile2 binfile2 binfile2_dlopen solib_binfile_target solib_binfile_test_msg
 
     clean_restart $testfile
     gdb_load_shlibs $binfile2
@@ -114,8 +111,7 @@ proc one_jit_test {count match_str} {
     # All jit librares must have been unregistered
     gdb_test "info function jit_function" \
 	"All functions matching regular expression \"jit_function\":"
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 one_jit_test 1 "${hex}  jit_function_0000"
 one_jit_test 2 "${hex}  jit_function_0000\[\r\n\]+${hex}  jit_function_0001"
diff --git a/gdb/testsuite/gdb.base/jit.exp b/gdb/testsuite/gdb.base/jit.exp
index a1aa351..4b8059f 100644
--- a/gdb/testsuite/gdb.base/jit.exp
+++ b/gdb/testsuite/gdb.base/jit.exp
@@ -51,11 +51,8 @@ if { [gdb_compile_shlib ${solib_srcfile} ${solib_binfile} {-fPIC}] != "" } {
 
 set solib_binfile_target [gdb_download ${solib_binfile}]
 
-proc one_jit_test {count match_str} {
-    global verbose testfile solib_binfile_target solib_binfile_test_msg pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "one_jit_test-$count:"
+proc one_jit_test {count match_str} { with_test_prefix " one_jit_test-$count:" {
+    global verbose testfile solib_binfile_target solib_binfile_test_msg
 
     clean_restart $testfile
 
@@ -93,9 +90,8 @@ proc one_jit_test {count match_str} {
     gdb_continue_to_breakpoint "break here 2"
     # All jit librares must have been unregistered
     gdb_test "info function jit_function" \
-	"All functions matching regular expression \"jit_function\":" 
-    set pf_prefix $old_pf_prefix
-}
+	"All functions matching regular expression \"jit_function\":"
+}}
 
 one_jit_test 1 "${hex}  jit_function_0000"
 one_jit_test 2 "${hex}  jit_function_0000\[\r\n\]+${hex}  jit_function_0001"
diff --git a/gdb/testsuite/gdb.base/return-nodebug.exp b/gdb/testsuite/gdb.base/return-nodebug.exp
index 1058088..44b415b 100644
--- a/gdb/testsuite/gdb.base/return-nodebug.exp
+++ b/gdb/testsuite/gdb.base/return-nodebug.exp
@@ -18,7 +18,7 @@ proc do_test {type} {
 
     global pf_prefix
     set old_prefix $pf_prefix
-    lappend pf_prefix "$typenospace:"
+    append pf_prefix " $typenospace:"
 
     if {[runto "func"]} {
 	# Verify that we do not crash when using "return" from a function with
diff --git a/gdb/testsuite/gdb.base/sepdebug.exp b/gdb/testsuite/gdb.base/sepdebug.exp
index 4010d33..cb1bd00 100644
--- a/gdb/testsuite/gdb.base/sepdebug.exp
+++ b/gdb/testsuite/gdb.base/sepdebug.exp
@@ -650,14 +650,10 @@ test_next_with_recursion
 
 #********
 
-proc test_different_dir {type test_different_dir xfail} {
+proc test_different_dir {type test_different_dir xfail} { with_test_prefix " $type:" {
     global srcdir subdir objdir binfile srcfile timeout gdb_prompt
-    global pf_prefix
     global bp_location6 decimal hex
 
-    set old_pf_prefix $pf_prefix
-    append pf_prefix " $type:"
-
     gdb_exit
     gdb_start
     gdb_reinitialize_dir $srcdir/$subdir
@@ -747,9 +743,8 @@ proc test_different_dir {type test_different_dir xfail} {
 	gdb_test_no_output "set args main"
     }
 
-    set pf_prefix $old_pf_prefix
 # proc test_different_dir
-}
+}}
 
 
 # now move the .debug file to a different location so that we can test
diff --git a/gdb/testsuite/gdb.base/solib-display.exp b/gdb/testsuite/gdb.base/solib-display.exp
index c1a653d..6886e04 100644
--- a/gdb/testsuite/gdb.base/solib-display.exp
+++ b/gdb/testsuite/gdb.base/solib-display.exp
@@ -48,12 +48,8 @@ if [get_compiler_info ${binfile}] {
     return -1
 }
 
-set save_pf_prefix $pf_prefix
 # SEP must be last for the possible `unsupported' error path.
-foreach libsepdebug {NO IN SEP} {
-
-    set pf_prefix $save_pf_prefix
-    lappend pf_prefix "$libsepdebug:"
+foreach libsepdebug {NO IN SEP} { with_test_prefix " $libsepdebug:" {
 
     set sep_lib_flags $lib_flags
     if {$libsepdebug != "NO"} {
@@ -135,5 +131,4 @@ foreach libsepdebug {NO IN SEP} {
     gdb_test "break [gdb_get_line_number "break here" ${testfile}.c]" \
 	    ".*Breakpoint.* at .*" 
     gdb_test "continue" "6: a_static = 46\\r\\n5: a_local = 45\\r\\n4: main_global = 44\\r\\n.*"
-}
-set pf_prefix $save_pf_prefix
+}}
diff --git a/gdb/testsuite/gdb.base/solib-overlap.exp b/gdb/testsuite/gdb.base/solib-overlap.exp
index b83a99c..048e6cf 100644
--- a/gdb/testsuite/gdb.base/solib-overlap.exp
+++ b/gdb/testsuite/gdb.base/solib-overlap.exp
@@ -52,12 +52,9 @@ set srcfile ${srcdir}/${subdir}/${testfile}.c
 # false PASS.
 # Prelink first lib1 at 0x40000000 and lib2 at 0x41000000.
 # During second pass try lib1 at 0x50000000 and lib2 at 0x51000000.
-foreach prelink_lib1 {0x40000000 0x50000000} {
+foreach prelink_lib1 {0x40000000 0x50000000} { with_test_prefix " $prelink_lib1:" {
     set prelink_lib2 [format "0x%x" [expr $prelink_lib1 + 0x01000000]]
 
-    set old_prefix $pf_prefix
-    lappend pf_prefix "$prelink_lib1:"
-
     # Library file.
     set binfile_lib1 ${objdir}/${subdir}/${libname}1-${prelink_lib1}.so
     set binfile_lib1_test_msg OBJDIR/${subdir}/${libname}1-${prelink_lib1}.so
@@ -137,6 +134,4 @@ foreach prelink_lib1 {0x40000000 0x50000000} {
     sleep 5
 
     remote_exec build "kill -9 ${testpid}"
-
-    set pf_prefix $old_prefix
-}
+}}
diff --git a/gdb/testsuite/gdb.base/watch-cond-infcall.exp b/gdb/testsuite/gdb.base/watch-cond-infcall.exp
index 8b81453..383ce89 100644
--- a/gdb/testsuite/gdb.base/watch-cond-infcall.exp
+++ b/gdb/testsuite/gdb.base/watch-cond-infcall.exp
@@ -25,12 +25,8 @@ if { [build_executable ${testfile}.exp ${testfile} ${testfile}.c {debug}] } {
     return -1
 }
 
-proc test_watchpoint { hw teststr } {
+proc test_watchpoint { hw } {
     global testfile
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$teststr:"
 
     clean_restart ${testfile}
 
@@ -50,12 +46,10 @@ proc test_watchpoint { hw teststr } {
     gdb_test "continue" \
 	"atchpoint \[0-9\]+: var\r\n\r\nOld value = 0\r\nNew value = 1\r\n.*watchpoint-stop.*" \
 	"continue"
-
-    set pf_prefix $old_pf_prefix
 }
 
 if { ![target_info exists gdb,no_hardware_watchpoints] } {
-    test_watchpoint 1 "hw"
+    with_test_prefix " hw:" { test_watchpoint 1 }
 }
 
-test_watchpoint 0 "sw"
+with_test_prefix " sw:" { test_watchpoint 0 }
diff --git a/gdb/testsuite/gdb.base/watchpoint.exp b/gdb/testsuite/gdb.base/watchpoint.exp
index 381c26e..7a252bb 100644
--- a/gdb/testsuite/gdb.base/watchpoint.exp
+++ b/gdb/testsuite/gdb.base/watchpoint.exp
@@ -894,12 +894,10 @@ proc do_tests {} {
 
 do_tests
 if ![target_info exists gdb,no_hardware_watchpoints] {
-    set save_pf_prefix $pf_prefix
-    lappend pf_prefix "no-hw:"
-
-    set no_hw 1
-    do_tests
-    set pf_prefix $save_pf_prefix
+    with_test_prefix " no-hw:" {
+	set no_hw 1
+	do_tests
+    }
 }
 
 # Restore old timeout
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-noloc.exp b/gdb/testsuite/gdb.dwarf2/dw2-noloc.exp
index 9b29b14..ecb99ef 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-noloc.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-noloc.exp
@@ -33,10 +33,7 @@ if { [prepare_for_testing dw2-noloc.exp "dw2-noloc" {dw2-noloc-main.c dw2-noloc.
 # unresolvable: .symtab entry does not exist for this symbol name.
 # DW_AT_declaration is not present in any of these DIEs.
 
-proc file_symbols {type} {
-    global pf_prefix
-    set old_prefix $pf_prefix
-    lappend pf_prefix "$type:"
+proc file_symbols {type} { with_test_prefix " $type:" {
 
     global gdb_prompt
 
@@ -78,9 +75,7 @@ proc file_symbols {type} {
     # As DW_AT_declaration is not present in this DIE
     # it should print <optimized out>.  As usefulness of such DIE is not
     # clear its resolution is not being tested.
-
-    set pf_prefix $old_prefix
-}
+}}
 
 file_symbols no-run
 
diff --git a/gdb/testsuite/gdb.mi/mi-watch.exp b/gdb/testsuite/gdb.mi/mi-watch.exp
index bce4e88..972fdb2 100644
--- a/gdb/testsuite/gdb.mi/mi-watch.exp
+++ b/gdb/testsuite/gdb.mi/mi-watch.exp
@@ -147,15 +147,11 @@ proc test_watchpoint_triggering {type} {
     clear_xfail *-*-*
 }
 
-proc test_watchpoint_all {type} {
-    global pf_prefix
+proc test_watchpoint_all {type} { with_test_prefix " $type:" {
     upvar srcdir srcdir
     upvar subdir subdir
     upvar binfile binfile
 
-    set old_prefix $pf_prefix
-    lappend pf_prefix "$type:"
-
     mi_delete_breakpoints
     mi_gdb_reinitialize_dir $srcdir/$subdir
     mi_gdb_load ${binfile}
@@ -165,9 +161,7 @@ proc test_watchpoint_all {type} {
     #test_rwatch_creation_and_listing $type
     #test_awatch_creation_and_listing $type
     test_watchpoint_triggering $type
-
-    set pf_prefix $old_prefix
-}
+}}
 
 # Run the tests twice, once using software watchpoints...
 mi_gdb_test "567-gdb-set can-use-hw-watchpoints 0" \
diff --git a/gdb/testsuite/gdb.mi/mi2-watch.exp b/gdb/testsuite/gdb.mi/mi2-watch.exp
index 3324ba8..37a919f 100644
--- a/gdb/testsuite/gdb.mi/mi2-watch.exp
+++ b/gdb/testsuite/gdb.mi/mi2-watch.exp
@@ -146,15 +146,11 @@ proc test_watchpoint_triggering {type} {
     clear_xfail *-*-*
 }
 
-proc test_watchpoint_all {type} {
-    global pf_prefix
+proc test_watchpoint_all {type} { with_test_prefix " $type:" {
     upvar srcdir srcdir
     upvar subdir subdir
     upvar binfile binfile
 
-    set old_prefix $pf_prefix
-    lappend pf_prefix "$type:"
-
     mi_delete_breakpoints
     mi_gdb_reinitialize_dir $srcdir/$subdir
     mi_gdb_load ${binfile}
@@ -164,9 +160,7 @@ proc test_watchpoint_all {type} {
     #test_rwatch_creation_and_listing $type
     #test_awatch_creation_and_listing $type
     test_watchpoint_triggering $type
-
-    set pf_prefix $old_prefix
-}
+}}
 
 # Run the tests twice, once using software watchpoints...
 mi_gdb_test "567-gdb-set can-use-hw-watchpoints 0" \
diff --git a/gdb/testsuite/gdb.threads/non-ldr-exc-1.exp b/gdb/testsuite/gdb.threads/non-ldr-exc-1.exp
index 8a14129..c6ced8e 100644
--- a/gdb/testsuite/gdb.threads/non-ldr-exc-1.exp
+++ b/gdb/testsuite/gdb.threads/non-ldr-exc-1.exp
@@ -30,17 +30,12 @@ if {[gdb_compile_pthreads "${srcdir}/${subdir}/${srcfile}" "${binfile}" executab
     return -1
 }
 
-proc do_test { lock_sched } {
-    global pf_prefix
+proc do_test { lock_sched } { with_test_prefix " lock-sched$lock_sched:" {
     global executable
 
-    set save_pf_prefix $pf_prefix
-    lappend pf_prefix "lock-sched$lock_sched:"
-
     clean_restart ${executable}
 
     if ![runto_main] {
-	set pf_prefix $save_pf_prefix
 	return -1
     }
 
@@ -57,9 +52,7 @@ proc do_test { lock_sched } {
     gdb_test "continue" \
 	".*is executing new program.*Breakpoint 1, main.* at .*" \
 	"continue over exec"
-
-    set pf_prefix $save_pf_prefix
-}
+}}
 
 do_test 0
 do_test 1
diff --git a/gdb/testsuite/gdb.threads/non-ldr-exc-2.exp b/gdb/testsuite/gdb.threads/non-ldr-exc-2.exp
index 5404ef4..66f090a 100644
--- a/gdb/testsuite/gdb.threads/non-ldr-exc-2.exp
+++ b/gdb/testsuite/gdb.threads/non-ldr-exc-2.exp
@@ -31,17 +31,12 @@ if {[gdb_compile_pthreads "${srcdir}/${subdir}/${srcfile}" "${binfile}" executab
     return -1
 }
 
-proc do_test { lock_sched } {
-    global pf_prefix
+proc do_test { lock_sched } { with_test_prefix " lock-sched$lock_sched:" {
     global executable
 
-    set save_pf_prefix $pf_prefix
-    lappend pf_prefix "lock-sched$lock_sched:"
-
     clean_restart ${executable}
 
     if ![runto_main] {
-	set pf_prefix $save_pf_prefix
 	return -1
     }
 
@@ -62,9 +57,7 @@ proc do_test { lock_sched } {
     gdb_test "continue" \
 	".*is executing new program.*Breakpoint 1, main.* at .*" \
 	"continue over exec"
-
-    set pf_prefix $save_pf_prefix
-}
+}}
 
 do_test 0
 do_test 1
diff --git a/gdb/testsuite/gdb.threads/non-ldr-exc-3.exp b/gdb/testsuite/gdb.threads/non-ldr-exc-3.exp
index 9c82c2a..83d243f 100644
--- a/gdb/testsuite/gdb.threads/non-ldr-exc-3.exp
+++ b/gdb/testsuite/gdb.threads/non-ldr-exc-3.exp
@@ -33,17 +33,12 @@ if {[gdb_compile_pthreads "${srcdir}/${subdir}/${srcfile}" "${binfile}" executab
     return -1
 }
 
-proc do_test { lock_sched } {
-    global pf_prefix
+proc do_test { lock_sched } { with_test_prefix " lock-sched$lock_sched:" {
     global executable
 
-    set save_pf_prefix $pf_prefix
-    lappend pf_prefix "lock-sched$lock_sched:"
-
     clean_restart ${executable}
 
     if ![runto_main] {
-	set pf_prefix $save_pf_prefix
 	return -1
     }
 
@@ -60,9 +55,7 @@ proc do_test { lock_sched } {
     gdb_test "continue" \
 	".*is executing new program.*Breakpoint 1, main.* at .*" \
 	"continue over exec"
-
-    set pf_prefix $save_pf_prefix
-}
+}}
 
 do_test 0
 do_test 1
diff --git a/gdb/testsuite/gdb.threads/non-ldr-exc-4.exp b/gdb/testsuite/gdb.threads/non-ldr-exc-4.exp
index 943b077..7fce0ef 100644
--- a/gdb/testsuite/gdb.threads/non-ldr-exc-4.exp
+++ b/gdb/testsuite/gdb.threads/non-ldr-exc-4.exp
@@ -32,17 +32,12 @@ if {[gdb_compile_pthreads "${srcdir}/${subdir}/${srcfile}" "${binfile}" executab
     return -1
 }
 
-proc do_test { lock_sched } {
-    global pf_prefix
+proc do_test { lock_sched } { with_test_prefix " lock-sched$lock_sched:" {
     global executable
 
-    set save_pf_prefix $pf_prefix
-    lappend pf_prefix "lock-sched$lock_sched:"
-
     clean_restart ${executable}
 
     if ![runto_main] {
-	set pf_prefix $save_pf_prefix
 	return -1
     }
 
@@ -59,9 +54,7 @@ proc do_test { lock_sched } {
     gdb_test "continue" \
 	".*is executing new program.*Breakpoint 1, main.* at .*" \
 	"continue over exec"
-
-    set pf_prefix $save_pf_prefix
-}
+}}
 
 do_test 0
 do_test 1
diff --git a/gdb/testsuite/gdb.threads/watchpoint-fork.exp b/gdb/testsuite/gdb.threads/watchpoint-fork.exp
index 814fb02..db05e1f 100644
--- a/gdb/testsuite/gdb.threads/watchpoint-fork.exp
+++ b/gdb/testsuite/gdb.threads/watchpoint-fork.exp
@@ -22,21 +22,15 @@ if [is_remote target] {
     return
 }
 
-proc test {type symbol} {
-    global testfile objdir subdir srcdir gdb_prompt
-
-    global pf_prefix
-    set prefix_test $pf_prefix
-    lappend pf_prefix "$type:"
-    set prefix_mt $pf_prefix
+proc test {type symbol} { with_test_prefix " $type:" {
+    global testfile objdir subdir srcdir gdb_prompt pf_prefix
 
     set srcfile_type ${srcdir}/${subdir}/${testfile}-${type}.c
 
-
     # no threads
 
-    set pf_prefix $prefix_mt
-    lappend pf_prefix "singlethreaded:"
+    set prefix_test $pf_prefix
+    append pf_prefix " singlethreaded:"
 
     set executable ${testfile}-${type}-st
     set srcfile_main ${srcdir}/${subdir}/${testfile}-st.c
@@ -98,8 +92,8 @@ proc test {type symbol} {
 	return
     }
 
-    set pf_prefix $prefix_mt
-    lappend pf_prefix "multithreaded:"
+    set pf_prefix $prefix_test
+    append pf_prefix " multithreaded:"
 
     set executable ${testfile}-${type}-mt
     set srcfile_main ${srcdir}/${subdir}/${testfile}-mt.c
@@ -151,7 +145,7 @@ proc test {type symbol} {
 
     # cleanup
     set pf_prefix $prefix_test
-}
+}}
 
 test parent FOLLOW_PARENT
 
diff --git a/gdb/testsuite/gdb.threads/watchthreads-reorder.exp b/gdb/testsuite/gdb.threads/watchthreads-reorder.exp
index f620c07..ab4cd5f 100644
--- a/gdb/testsuite/gdb.threads/watchthreads-reorder.exp
+++ b/gdb/testsuite/gdb.threads/watchthreads-reorder.exp
@@ -38,11 +38,7 @@ if {[gdb_compile_pthreads "${srcdir}/${subdir}/${srcfile}" ${binfile} executable
     return -1
 }
 
-foreach reorder {0 1} {
-
-    global pf_prefix
-    set prefix_test $pf_prefix
-    lappend pf_prefix "reorder$reorder:"
+foreach reorder {0 1} { with_test_prefix " reorder$reorder:" {
 
     clean_restart $testfile
 
@@ -97,6 +93,4 @@ foreach reorder {0 1} {
     gdb_test "set debug infrun 1"
 
     gdb_continue_to_breakpoint "break-at-exit" ".*break-at-exit.*"
-
-    set pf_prefix $prefix_test
-}
+}}
diff --git a/gdb/testsuite/gdb.trace/change-loc.exp b/gdb/testsuite/gdb.trace/change-loc.exp
index 451a0e1..91cdb11 100644
--- a/gdb/testsuite/gdb.trace/change-loc.exp
+++ b/gdb/testsuite/gdb.trace/change-loc.exp
@@ -71,20 +71,15 @@ if [is_amd64_regs_target] {
 
 # Set tracepoint during tracing experiment.
 
-proc tracepoint_change_loc_1 { trace_type } {
+proc tracepoint_change_loc_1 { trace_type } { with_test_prefix " 1 $trace_type:" {
     global testfile
     global srcfile
     global pcreg
     global gdb_prompt
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 1 $trace_type:"
 
     clean_restart ${testfile}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
     gdb_test_no_output "delete break 1"
@@ -120,7 +115,6 @@ proc tracepoint_change_loc_1 { trace_type } {
 	}
 	-re ".*$gdb_prompt $" {
 	    kfail "gdb/13392" "continue to marker 2"
-	    set pf_prefix $old_pf_prefix
 	    return
 	}
     }
@@ -143,23 +137,17 @@ proc tracepoint_change_loc_1 { trace_type } {
 
     gdb_test "tfind" "Found trace frame 0, tracepoint 4.*" "tfind frame 0"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Set pending tracepoint.
 
-proc tracepoint_change_loc_2 { trace_type } {
+proc tracepoint_change_loc_2 { trace_type } { with_test_prefix " 2 $trace_type:" {
     global srcdir
     global srcfile
     global subdir
     global pcreg
     global binfile
     global gdb_prompt
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 2 $trace_type:"
 
     gdb_exit
     gdb_start
@@ -218,7 +206,6 @@ proc tracepoint_change_loc_2 { trace_type } {
 	}
 	-re ".*$gdb_prompt $" {
 	    kfail "gdb/13392" "continue to marker 1"
-	    set pf_prefix $old_pf_prefix
 	    return
 	}
     }
@@ -247,9 +234,7 @@ proc tracepoint_change_loc_2 { trace_type } {
     gdb_test "tfind" "Found trace frame 1, tracepoint 1.*" "tfind frame 1"
     gdb_test "tfind" "Found trace frame 2, tracepoint 1.*" "tfind frame 2"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 tracepoint_change_loc_1 "trace"
 tracepoint_change_loc_2 "trace"
diff --git a/gdb/testsuite/gdb.trace/pending.exp b/gdb/testsuite/gdb.trace/pending.exp
index 9dc8706..7a9d01d 100644
--- a/gdb/testsuite/gdb.trace/pending.exp
+++ b/gdb/testsuite/gdb.trace/pending.exp
@@ -60,16 +60,12 @@ if ![gdb_target_supports_trace] {
 
 # Verify pending tracepoint is resolved to running to main.
 
-proc pending_tracepoint_resolved { trace_type } {
+proc pending_tracepoint_resolved { trace_type } { with_test_prefix " $trace_type resolved:" {
     global srcdir
     global subdir
     global binfile
     global srcfile
     global lib_sl1
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "resolved:"
 
     # Start with a fresh gdb.
     gdb_exit
@@ -101,22 +97,16 @@ proc pending_tracepoint_resolved { trace_type } {
 	"Num     Type\[ \]+Disp Enb Address\[ \]+What.*
 \[0-9\]+\[\t \]+\(fast |\)tracepoint\[ \]+keep y.*pendfunc.*" \
 	"single tracepoint info"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Verify pending tracepoint is resolved and works as expected.
 
-proc pending_tracepoint_works { trace_type } {
+proc pending_tracepoint_works { trace_type } { with_test_prefix " $trace_type works:" {
     global executable
     global srcfile
     global lib_sl1
-    global pf_prefix
     global gdb_prompt
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "works:"
-
     # Restart with a fresh gdb.
     clean_restart $executable
 
@@ -150,7 +140,6 @@ proc pending_tracepoint_works { trace_type } {
 	}
 	-re ".*$gdb_prompt $" {
 	    kfail "gdb/13392" "continue to marker"
-	    set pf_prefix $old_pf_prefix
 	    return
 	}
     }
@@ -161,27 +150,22 @@ proc pending_tracepoint_works { trace_type } {
     gdb_test "tfind" "Found trace frame 1, tracepoint 1.*" "tfind test frame 1"
     gdb_test "tfind" "Found trace frame 2, tracepoint 1.*" "tfind test frame 2"
     gdb_test "tfind" "Target failed to find requested trace frame..*" "tfind test frame"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Verify pending tracepoint is resolved during trace.
 
-proc pending_tracepoint_resolved_during_trace { trace_type } {
+proc pending_tracepoint_resolved_during_trace { trace_type } \
+{ with_test_prefix " $trace_type resolved_in_trace:" \
+{
     global executable
     global srcfile
     global gdb_prompt
     global lib_sl1
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "resolved_in_trace:"
 
     # Start with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -211,7 +195,6 @@ proc pending_tracepoint_resolved_during_trace { trace_type } {
 	}
 	-re ".*$gdb_prompt $" {
 	    kfail "gdb/13392" "continue to marker 2"
-	    set pf_prefix $old_pf_prefix
 	    return
 	}
     }
@@ -226,28 +209,23 @@ proc pending_tracepoint_resolved_during_trace { trace_type } {
 
     gdb_test "tfind start" "#0 .*" "tfind test frame 0"
     gdb_test "tfind" "Target failed to find requested trace frame..*" "tfind test frame"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Verify pending tracepoint is resolved and installed during trace.
 
-proc pending_tracepoint_installed_during_trace { trace_type } {
+proc pending_tracepoint_installed_during_trace { trace_type } \
+{ with_test_prefix " $trace_type installed_in_trace:" \
+{
     global executable
     global srcfile
     global lib_sl1
     global gdb_prompt
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "installed_in_trace:"
-
     # Start with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -281,7 +259,6 @@ proc pending_tracepoint_installed_during_trace { trace_type } {
 	}
 	-re ".*$gdb_prompt $" {
 	    kfail "gdb/13392" "continue to marker 2"
-	    set pf_prefix $old_pf_prefix
 	    return
 	}
     }
@@ -296,28 +273,23 @@ proc pending_tracepoint_installed_during_trace { trace_type } {
 
     gdb_test "tfind start" "#0  $hex in pendfunc2 .*" "tfind test frame 0"
     gdb_test "tfind" "Target failed to find requested trace frame..*" "tfind test frame"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 
 # Verify pending tracepoint will no longer work if we disconnect during tracing.
 
-proc pending_tracepoint_disconnect_during_trace { trace_type } {
+proc pending_tracepoint_disconnect_during_trace { trace_type } \
+{ with_test_prefix " $trace_type disconn:" \
+{
     global executable
     global srcfile
     global lib_sl1
-    global pf_prefix
     global gdb_prompt
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "disconn:"
-
     # Start with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -349,28 +321,23 @@ proc pending_tracepoint_disconnect_during_trace { trace_type } {
 	   }
        }
     }
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 
 # Verify disconnect after pending tracepoint has been resolved.
 
-proc pending_tracepoint_disconnect_after_resolved { trace_type } {
+proc pending_tracepoint_disconnect_after_resolved { trace_type } \
+{ with_test_prefix " $trace_type disconn_resolved:" \
+{
     global executable
     global srcfile
     global lib_sl1
     global gdb_prompt
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "disconn_resolved:"
 
     # Start with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -407,27 +374,22 @@ proc pending_tracepoint_disconnect_after_resolved { trace_type } {
 	    pass "$test"
 	}
     }
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Verify action works properly in resolved tracepoint.
 
-proc pending_tracepoint_with_action_resolved { trace_type } {
+proc pending_tracepoint_with_action_resolved { trace_type } \
+{ with_test_prefix " $trace_type action_resolved:" \
+{
     global executable
     global srcfile
     global lib_sl1
     global gdb_prompt
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "$trace_type" "action_resolved:"
 
     # Start with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -467,7 +429,6 @@ proc pending_tracepoint_with_action_resolved { trace_type } {
 	}
 	-re ".*$gdb_prompt $" {
 	    kfail "gdb/13392" "continue to marker 2"
-	    set pf_prefix $old_pf_prefix
 	    return
 	}
     }
@@ -483,9 +444,7 @@ proc pending_tracepoint_with_action_resolved { trace_type } {
     gdb_test "tfind start" "#0 .*" "tfind test frame 0"
     gdb_test "tdump" "Data collected at tracepoint .*, trace frame \[0-9\]:.*\\$${pcreg} = .*"
     gdb_test "tfind" "Target failed to find requested trace frame..*" "tfind test frame"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 pending_tracepoint_resolved "trace"
 
diff --git a/gdb/testsuite/gdb.trace/status-stop.exp b/gdb/testsuite/gdb.trace/status-stop.exp
index 9c7e915..859e9cc 100644
--- a/gdb/testsuite/gdb.trace/status-stop.exp
+++ b/gdb/testsuite/gdb.trace/status-stop.exp
@@ -39,19 +39,14 @@ if ![gdb_target_supports_trace] {
 
 # Verify that the sequence of commands "tstart tstop tstart" works well.
 
-proc test_tstart_tstop_tstart { } {
+proc test_tstart_tstop_tstart { } { with_test_prefix " tstart_tstop_tstart:" {
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix tstart_tstop_tstart:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
         fail "Can't run to main"
-        set pf_prefix $old_pf_prefix
         return -1
     }
 
@@ -64,25 +59,18 @@ proc test_tstart_tstop_tstart { } {
     gdb_test_no_output "tstop"
 
     gdb_test_no_output "tstart"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Verify the sequence of commands "tstart tstart" works well.
 
-proc test_tstart_tstart { } {
+proc test_tstart_tstart { } { with_test_prefix " tstart_tstart:" {
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix tstart_tstart:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
         fail "Can't run to main"
-        set pf_prefix $old_pf_prefix
         return -1
     }
 
@@ -90,25 +78,18 @@ proc test_tstart_tstart { } {
     gdb_test_no_output "tstart"
 
     gdb_test "tstart" "" "tstart again" "A trace is running already.  Start a new run\\? \\(y or n\\) " "y"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Verify that trace stops clearly when trace buffer is full.
 
-proc test_buffer_full_tstart { } {
+proc test_buffer_full_tstart { } { with_test_prefix " buffer_full_tstart:" {
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix buffer_full_tstart:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
         fail "Can't run to main"
-        set pf_prefix $old_pf_prefix
         return -1
     }
 
@@ -123,12 +104,10 @@ proc test_buffer_full_tstart { } {
 
     gdb_test "tstatus" ".*buffer was full.*"
     gdb_test_no_output "tstart"
-
-    set old_pf_prefix $pf_prefix
-}
+}}
 
 test_tstart_tstop_tstart
 
 test_tstart_tstart
 
-test_buffer_full_tstart
\ No newline at end of file
+test_buffer_full_tstart
diff --git a/gdb/testsuite/gdb.trace/strace.exp b/gdb/testsuite/gdb.trace/strace.exp
index c9947dc..54f96a3 100644
--- a/gdb/testsuite/gdb.trace/strace.exp
+++ b/gdb/testsuite/gdb.trace/strace.exp
@@ -52,19 +52,14 @@ if { ![gdb_target_supports_trace] } then {
 
 gdb_load_shlibs $libipa
 
-proc strace_info_marker { } {
+proc strace_info_marker { } { with_test_prefix " info_marker" {
     global executable
-    global pf_prefix
     global gdb_prompt
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "info_marker"
-
     # Restart with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -79,24 +74,18 @@ proc strace_info_marker { } {
 	    pass "info threads"
 	}
     }
-    set pf_prefix $old_pf_prefix
-}
+}}
 
-proc strace_probe_marker { } {
+proc strace_probe_marker { } { with_test_prefix " probe_marker" {
     global executable
-    global pf_prefix
     global expect_out
     global gdb_prompt
     global hex
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "probe_marker"
-
     # Restart with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -114,25 +103,18 @@ proc strace_probe_marker { } {
     gdb_test "tfind" "Found trace frame 0, tracepoint .*" "tfind frame 0"
     gdb_test "tfind" "Found trace frame 1, tracepoint .*" "tfind frame 1"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
+}}
 
-    set pf_prefix $old_pf_prefix
-}
-
-proc strace_trace_on_same_addr { type } {
+proc strace_trace_on_same_addr { type } { with_test_prefix " trace_same_addr $type" {
     global executable
-    global pf_prefix
     global expect_out
     global gdb_prompt
     global hex
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "trace_same_addr" "$type"
-
     # Restart with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -211,24 +193,19 @@ proc strace_trace_on_same_addr { type } {
 	gdb_test "tfind" "Found trace frame 3, tracepoint .*" "tfind frame 3"
 	gdb_test "tfind" "Target failed to find requested trace frame\\..*"
     }
-    set pf_prefix $old_pf_prefix
-}
+}}
+
+proc strace_trace_on_diff_addr { } { with_test_prefix " trace_diff_addr" {
 
-proc strace_trace_on_diff_addr { } {
     global executable
-    global pf_prefix
     global expect_out
     global gdb_prompt
     global hex
 
-    set old_pf_prefix $pf_prefix
-    lappend pf_prefix "trace_diff_addr"
-
     # Restart with a fresh gdb.
     clean_restart $executable
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -269,9 +246,7 @@ proc strace_trace_on_diff_addr { } {
     gdb_test "tfind" "Found trace frame 0, tracepoint .*" "tfind frame 0"
     gdb_test "tfind" "Found trace frame 1, tracepoint .*" "tfind frame 1"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 strace_info_marker
 strace_probe_marker
diff --git a/gdb/testsuite/gdb.trace/trace-break.exp b/gdb/testsuite/gdb.trace/trace-break.exp
index 1c372d4..5fcc1ac 100644
--- a/gdb/testsuite/gdb.trace/trace-break.exp
+++ b/gdb/testsuite/gdb.trace/trace-break.exp
@@ -55,19 +55,16 @@ if [is_amd64_regs_target] {
 
 # Set breakpoint and tracepoint at the same address.
 
-proc break_trace_same_addr_1 { trace_type option } {
+proc break_trace_same_addr_1 { trace_type option } \
+{ with_test_prefix " 1 $trace_type $option:" \
+{
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 1 $trace_type $option:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -87,25 +84,20 @@ proc break_trace_same_addr_1 { trace_type option } {
 
     gdb_test "tfind" "Found trace frame 0, tracepoint .*" "tfind frame 0"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Set multiple tracepoints at the same address.
 
-proc break_trace_same_addr_2 { trace_type1 trace_type2 option } {
+proc break_trace_same_addr_2 { trace_type1 trace_type2 option } \
+{ with_test_prefix " 2 $trace_type1 $trace_type2 $option:" \
+{
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 2 $trace_type1 $trace_type2 $option:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -129,26 +121,21 @@ proc break_trace_same_addr_2 { trace_type1 trace_type2 option } {
     gdb_test "tfind" "Found trace frame 0, tracepoint .*" "tfind frame 0"
     gdb_test "tfind" "Found trace frame 1, tracepoint .*" "tfind frame 1"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Set breakpoint and tracepoint at the same address.  Delete breakpoint, and verify
 # that tracepoint still works.
 
-proc break_trace_same_addr_3 { trace_type option } {
+proc break_trace_same_addr_3 { trace_type option } \
+{ with_test_prefix " 3 $trace_type $option:" \
+{
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 3 $trace_type $option:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -169,26 +156,22 @@ proc break_trace_same_addr_3 { trace_type option } {
 
     gdb_test "tfind" "Found trace frame 0, tracepoint .*" "tfind frame 0"
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Set breakpoint and tracepoint at the same address.  Delete tracepoint, and verify
 # that breakpoint still works.
 
-proc break_trace_same_addr_4 { trace_type option } {
+proc break_trace_same_addr_4 { trace_type option } \
+{ with_test_prefix " 4 $trace_type $option:" \
+{
     global executable
-    global pf_prefix
     global hex
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 4 $trace_type $option:"
 
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -210,31 +193,26 @@ proc break_trace_same_addr_4 { trace_type option } {
     gdb_test "tstop" "Trace is not running.*"
 
     gdb_test "tfind" "Target failed to find requested trace frame\\..*"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Set two tracepoints TRACE1 and TRACE2 at two locations, and start tracing.
 # Then, set tracepoint TRACE3 at either of these two locations.
 # TRACE3_AT_FIRST_LOC is a boolean variable to decide insert TRACE3 at which
 # of two locations.  Verify  these tracepoints work as expected.
 
-proc break_trace_same_addr_5 { trace1 trace2 trace3 trace3_at_first_loc } {
+proc break_trace_same_addr_5 { trace1 trace2 trace3 trace3_at_first_loc } \
+{ with_test_prefix " 5 $trace1 $trace2 ${trace3}@${trace3_at_first_loc}:" \
+{
     global executable
-    global pf_prefix
     global hex
     global fpreg
     global spreg
     global pcreg
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 5 $trace1 $trace2 ${trace3}@${trace3_at_first_loc}:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -289,29 +267,24 @@ proc break_trace_same_addr_5 { trace1 trace2 trace3 trace3_at_first_loc } {
     gdb_test "tdump" \
 	"Data collected at tracepoint .*, trace frame \[0-9\]:.*\\$${fpreg} = .*" \
 	"tdump 3"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 # Set two tracepoints at the same address, and enable/disable them.  Verify
 # tracepoints work as expect.
 
-proc break_trace_same_addr_6 { trace1 enable1 trace2 enable2 } {
+proc break_trace_same_addr_6 { trace1 enable1 trace2 enable2 } \
+{ with_test_prefix " 6 $trace1 $enable1 $trace2 $enable2:" \
+{
     global executable
-    global pf_prefix
     global hex
     global gdb_prompt
     global spreg
     global pcreg
 
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix 6 $trace1 $enable1 $trace2 $enable2:"
-
     # Start with a fresh gdb.
     clean_restart ${executable}
     if ![runto_main] {
 	fail "Can't run to main"
-	set pf_prefix $old_pf_prefix
 	return -1
     }
 
@@ -362,9 +335,7 @@ proc break_trace_same_addr_6 { trace1 enable1 trace2 enable2 } {
 	gdb_test "tfind tracepoint 5" "Target failed to find requested trace frame.*" \
 	    "tfind test frame of tracepoint 5"
     }
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 
 foreach break_always_inserted { "on" "off" } {
diff --git a/gdb/testsuite/gdb.trace/unavailable.exp b/gdb/testsuite/gdb.trace/unavailable.exp
index 87af860..199e219 100644
--- a/gdb/testsuite/gdb.trace/unavailable.exp
+++ b/gdb/testsuite/gdb.trace/unavailable.exp
@@ -136,13 +136,9 @@ proc test_maybe_regvar_display { var } {
 # Test procs
 #
 
-proc gdb_collect_args_test {} {
+proc gdb_collect_args_test {} { with_test_prefix " unavailable arguments:" {
     global cr
     global gdb_prompt
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix unavailable arguments:"
 
     prepare_for_trace_test
 
@@ -205,17 +201,11 @@ proc gdb_collect_args_test {} {
     gdb_test "tfind none" \
 	"#0  end .*" \
 	"cease trace debugging"
+}}
 
-    set pf_prefix $old_pf_prefix
-}
-
-proc gdb_collect_locals_test { func msg } {
+proc gdb_collect_locals_test { func msg } { with_test_prefix " unavailable locals: $msg:" {
     global cr
     global gdb_prompt
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix unavailable locals: $msg:"
 
     prepare_for_trace_test
 
@@ -262,18 +252,12 @@ proc gdb_collect_locals_test { func msg } {
     gdb_test "tfind none" \
 	"#0  end .*" \
 	"cease trace debugging"
+}}
 
-    set pf_prefix $old_pf_prefix
-}
-
-proc gdb_unavailable_registers_test { } {
+proc gdb_unavailable_registers_test { } { with_test_prefix " unavailable registers:" {
     global gdb_prompt
     global spreg
     global pcreg
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix unavailable registers:"
 
     prepare_for_trace_test
 
@@ -319,19 +303,13 @@ proc gdb_unavailable_registers_test { } {
 	"info registers \$$spreg reports not available"
 
     gdb_test "tfind none" "#0  end .*" "cease trace debugging"
+}}
 
-    set pf_prefix $old_pf_prefix
-}
-
-proc gdb_collect_globals_test { } {
+proc gdb_collect_globals_test { } { with_test_prefix " collect globals:" {
     global ws
     global cr
     global gdb_prompt
     global hex
-    global pf_prefix
-
-    set old_pf_prefix $pf_prefix
-    set pf_prefix "$pf_prefix collect globals:"
 
     prepare_for_trace_test
 
@@ -518,8 +496,9 @@ proc gdb_collect_globals_test { } {
 
     gdb_test_no_output "set print object on"
 
-    set old_pf_prefix_2 $pf_prefix
-    set pf_prefix "$pf_prefix print object on:"
+    global pf_prefix
+    set old_pf_prefix $pf_prefix
+    append pf_prefix " print object on:"
 
     # With print object on, printing a pointer may need to fetch the
     # pointed-to object, to check its run-time type.  Make sure that
@@ -539,11 +518,11 @@ proc gdb_collect_globals_test { } {
     gdb_test "print derived_whole" \
 	" = \\(Derived\\) {<Middle> = {<Base> = {x = 2}, _vptr.Middle = $hex, y = 3}, _vptr.Derived = $hex, z = 4}"
 
-    set pf_prefix $old_pf_prefix_2
+    set pf_prefix $old_pf_prefix
 
     gdb_test_no_output "set print object off"
 
-    set pf_prefix "$pf_prefix print object off:"
+    append pf_prefix " print object off:"
 
     gdb_test "print virtualp" " = \\(Virtual \\*\\) <unavailable>"
 
@@ -559,7 +538,7 @@ proc gdb_collect_globals_test { } {
     gdb_test "print derived_whole" \
 	" = {<Middle> = {<Base> = {x = 2}, _vptr.Middle = $hex, y = 3}, _vptr.Derived = $hex, z = 4}"
 
-    set pf_prefix $old_pf_prefix_2
+    set pf_prefix $old_pf_prefix
 
     # An instance of a virtual class where we collected everything but
     # the vptr.
@@ -569,9 +548,7 @@ proc gdb_collect_globals_test { } {
     gdb_test "tfind none" \
 	"#0  end .*" \
 	"cease trace debugging"
-
-    set pf_prefix $old_pf_prefix
-}
+}}
 
 proc gdb_trace_collection_test {} {
     gdb_collect_globals_test
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 00fe71c..3a43f95 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1481,6 +1481,92 @@ proc skip_shlib_tests {} {
     return 1
 }
 
+# Test files shall make sure all the test result lines in gdb.sum are
+# unique in a test run, so that comparing the gdb.sum files of two
+# test runs gives correct results.  Test files that exercise
+# variations of the same tests more than once, shall prefix the
+# different test invocations with different identifying strings in
+# order to make them unique.
+#
+# About test prefixes:
+#
+# $pf_prefix is the string that dejagnu prints after the result (FAIL,
+# PASS, etc.), and before the test message/name in gdb.sum.  E.g., the
+# underlined substring in
+#
+#  PASS: gdb.base/mytest.exp: some test
+#        ^^^^^^^^^^^^^^^^^^^^
+#
+# is $pf_prefix.
+#
+# The easiest way to adjust the test prefix is to append a test
+# variation prefix to the $pf_prefix, using the with_test_prefix
+# procedure.  E.g.,
+#
+# proc do_tests {} {
+#   gdb_test ... ... "test foo"
+#   gdb_test ... ... "test bar"
+#
+#   with_test_prefix " subvariation a:" {
+#     gdb_test ... ... "test x"
+#   }
+#
+#   with_test_prefix " subvariation b:" {
+#     gdb_test ... ... "test x"
+#   }
+# }
+#
+# with_test_prefix " variation1:" {
+#   ...do setup for variation 1...
+#   do_tests
+# }
+#
+# with_test_prefix " variation2:" {
+#   ...do setup for variation 2...
+#   do_tests
+# }
+#
+# Results in:
+#
+#  PASS: gdb.base/mytest.exp: variation1: test foo
+#  PASS: gdb.base/mytest.exp: variation1: test bar
+#  PASS: gdb.base/mytest.exp: variation1: subvariation a: test x
+#  PASS: gdb.base/mytest.exp: variation1: subvariation b: test x
+#  PASS: gdb.base/mytest.exp: variation2: test foo
+#  PASS: gdb.base/mytest.exp: variation2: test bar
+#  PASS: gdb.base/mytest.exp: variation2: subvariation a: test x
+#  PASS: gdb.base/mytest.exp: variation2: subvariation b: test x
+#
+# If for some reason more flexibility is necessary, one can also
+# manipulate the pf_prefix global directly, treating it as a string.
+# E.g.,
+#
+#   global pf_prefix
+#   set saved_pf_prefix
+#   append pf_prefix "${foo} bar"
+#   ... actual tests ...
+#   set pf_prefix $saved_pf_prefix
+#
+
+# Run BODY in the context of the caller, with the current test prefix
+# (pf_prefix) appended with PREFIX.  Returns the result of BODY.
+#
+proc with_test_prefix { prefix body } {
+  global pf_prefix
+
+  set saved $pf_prefix
+  append pf_prefix $prefix
+  set code [catch {uplevel 1 $body} result]
+  set pf_prefix $saved
+
+  if {$code == 1} {
+      global errorInfo errorCode
+      return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+  } else {
+      return -code $code $result
+  }
+}
+
 # Return 1 if _Complex types are supported, otherwise, return 0.
 
 proc support_complex_tests {} {
-- 
2.7.4