From e6194d69361ea15a381a0b5e9f8da21bd9e21309 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 9 Dec 2010 10:47:52 +0000
Subject: 	* tests/append.test, tests/appendComp.test: Clean up tests so
 that 	they don't leave things in the global environment (detected when doing
 	-singleproc testing).

---
 ChangeLog             |   6 +++
 tests/append.test     |  95 ++++++++++++++++++----------------
 tests/appendComp.test | 138 ++++++++++++++++++++++++++------------------------
 3 files changed, 131 insertions(+), 108 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index f09a2d5..ff6cd40 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2010-12-09  Donal K. Fellows  <dkf@users.sf.net>
+
+	* tests/append.test, tests/appendComp.test: Clean up tests so that
+	they don't leave things in the global environment (detected when doing
+	-singleproc testing).
+
 2010-12-07  Donal K. Fellows  <dkf@users.sf.net>
 
 	* tests/fCmd.test, tests/safe.test, tests/uplevel.test,
diff --git a/tests/append.test b/tests/append.test
index 3c000df..d053516 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -11,16 +11,16 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: append.test,v 1.12 2010/09/01 20:35:33 andreas_kupries Exp $
+# RCS: @(#) $Id: append.test,v 1.13 2010/12/09 10:47:53 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
-catch {unset x}
-
+unset -nocomplain x
+
 test append-1.1 {append command} {
-    catch {unset x}
+    unset -nocomplain x
     list [append x 1 2 abc "long string"] $x
 } {{12abclong string} {12abclong string}}
 test append-1.2 {append command} {
@@ -52,12 +52,12 @@ test append-3.2 {append errors} -returnCodes error -body {
     append x(0) 44
 } -result {can't set "x(0)": variable isn't array}
 test append-3.3 {append errors} -returnCodes error -body {
-    catch {unset x}
+    unset -nocomplain x
     append x
 } -result {can't read "x": no such variable}
 
 test append-4.1 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     list [lappend x 1 2 abc "long string"] $x
 } {{1 2 abc {long string}} {1 2 abc {long string}}}
 test append-4.2 {lappend command} {
@@ -128,19 +128,19 @@ test append-4.16 {lappend command} {
     lappend x abc
 } "x abc"
 test append-4.17 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x
 } {}
 test append-4.18 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x {}
 } {{}}
 test append-4.19 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x(0)
 } {}
 test append-4.20 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x(0) abc
 } {abc}
 unset -nocomplain x
@@ -154,7 +154,7 @@ test append-4.22 {lappend command} -returnCodes error -body {
 } -result {unmatched open quote in list}
 
 test append-5.1 {long lappends} -setup {
-    catch {unset x}
+    unset -nocomplain x
     proc check {var size} {
 	set l [llength $var]
 	if {$l != $size} {
@@ -188,7 +188,7 @@ test append-6.2 {lappend errors} -returnCodes error -body {
 
 test append-7.1 {lappend-created var and error in trace on that var} -setup {
     catch {rename foo ""}
-    catch {unset x}
+    unset -nocomplain x
 } -body {
     trace variable x w foo
     proc foo {} {global x; unset x}
@@ -200,8 +200,8 @@ test append-7.1 {lappend-created var and error in trace on that var} -setup {
     list [info exists x] [catch {set x} msg] $msg
 } -result {0 1 {can't read "x": no such variable}}
 test append-7.2 {lappend var triggers read trace} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
@@ -209,8 +209,8 @@ test append-7.2 {lappend var triggers read trace} -setup {
     return $::result
 } -result {myvar {} r}
 test append-7.3 {lappend var triggers read trace, array var} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     # The behavior of read triggers on lappend changed in 8.0 to not trigger
     # them, and was changed back in 8.4.
@@ -220,8 +220,8 @@ test append-7.3 {lappend var triggers read trace, array var} -setup {
     return $::result
 } -result {myvar b r}
 test append-7.4 {lappend var triggers read trace, array var exists} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     set myvar(0) 1
     trace variable myvar r foo
@@ -230,8 +230,8 @@ test append-7.4 {lappend var triggers read trace, array var exists} -setup {
     return $::result
 } -result {myvar b r}
 test append-7.5 {append var does not trigger read trace} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
@@ -239,15 +239,16 @@ test append-7.5 {append var does not trigger read trace} -setup {
     info exists ::result
 } -result {0}
 
+# THERE ARE NO append-8.* TESTS
 
+# New tests for bug 3057639 to show off the more consistent behaviour of
+# lappend in both direct-eval and bytecompiled code paths (see appendComp.test
+# for the compiled variants). lappend now behaves like append. 9.0/1 lappend -
+# 9.2/3 append
 
-# New tests for bug 3057639 to show off the more consistent behaviour
-# of lappend in both direct-eval and bytecompiled code paths (see
-# appendComp.test for the compiled variants). lappend now behaves like
-# append. 9.0/1 lappend - 9.2/3 append
-
-test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} {
-    catch {unset myvar}
+test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
+} -body {
     array set myvar {}
     proc nonull {var key val} {
 	upvar 1 $var lvar
@@ -259,17 +260,19 @@ test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing ar
     list [catch {
 	lappend myvar(key) "new value"
     } msg] $msg
-} {0 {{new value}}}
-
-test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {{new value}}}
+test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     list [catch {
 	lappend ::env(__DUMMY__) "new value"
     } msg] $msg
-} {0 {{new value}}}
-
-test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} {
-    catch {unset myvar}
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {{new value}}}
+test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
+} -body {
     array set myvar {}
     proc nonull {var key val} {
 	upvar 1 $var lvar
@@ -281,19 +284,25 @@ test append-9.2 {bug 3057639, append direct eval, read trace on non-existing arr
     list [catch {
 	append myvar(key) "new value"
     } msg] $msg
-} {0 {new value}}
-
-test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {new value}}
+test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     list [catch {
 	append ::env(__DUMMY__) "new value"
     } msg] $msg
-} {0 {new value}}
-
-
-catch {unset i x result y}
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
+unset -nocomplain i x result y
 catch {rename foo ""}
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/appendComp.test b/tests/appendComp.test
index 9523d2d..d8eee8c 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -11,19 +11,20 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: appendComp.test,v 1.13 2010/09/01 20:35:33 andreas_kupries Exp $
+# RCS: @(#) $Id: appendComp.test,v 1.14 2010/12/09 10:47:53 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 catch {unset x}
-
-test appendComp-1.1 {append command} {
-    catch {unset x}
+
+test appendComp-1.1 {append command} -setup {
+    unset -nocomplain x
+} -body {
     proc foo {} {append ::x 1 2 abc "long string"}
     list [foo] $x
-} {{12abclong string} {12abclong string}}
+} -result {{12abclong string} {12abclong string}}
 test appendComp-1.2 {append command} {
     proc foo {} {
 	set x ""
@@ -67,7 +68,7 @@ test appendComp-3.2 {append errors} -returnCodes error -body {
 } -result {can't set "x(0)": variable isn't array}
 test appendComp-3.3 {append errors} -returnCodes error -body {
     proc foo {} {
-	catch {unset x}
+	unset -nocomplain x
 	append x
     }
     foo
@@ -76,7 +77,7 @@ test appendComp-3.3 {append errors} -returnCodes error -body {
 test appendComp-4.1 {lappend command} {
     proc foo {} {
 	global x
-	catch {unset x}
+	unset -nocomplain x
 	lappend x 1 2 abc "long string"
     }
     list [foo] $x
@@ -207,27 +208,31 @@ test appendComp-4.20 {lappend command} {
     foo
 } {abc}
 
-proc check {var size} {
-    set l [llength $var]
-    if {$l != $size} {
-	return "length mismatch: should have been $size, was $l"
-    }
-    for {set i 0} {$i < $size} {set i [expr $i+1]} {
-	set j [lindex $var $i]
-	if {$j != "item $i"} {
-	    return "element $i should have been \"item $i\", was \"$j\""
+test appendComp-5.1 {long lappends} -setup {
+    unset -nocomplain x
+    proc check {var size} {
+	set l [llength $var]
+	if {$l != $size} {
+	    return "length mismatch: should have been $size, was $l"
 	}
+	for {set i 0} {$i < $size} {incr i} {
+	    set j [lindex $var $i]
+	    if {$j ne "item $i"} {
+		return "element $i should have been \"item $i\", was \"$j\""
+	    }
+	}
+	return ok
     }
-    return ok
-}
-test appendComp-5.1 {long lappends} {
-    catch {unset x}
+} -body {
     set x ""
     for {set i 0} {$i < 300} {set i [expr $i+1]} {
 	lappend x "item $i"
     }
     check $x 300
-} ok
+} -cleanup {
+    unset -nocomplain x
+    catch {rename check ""}
+} -result ok
 
 test appendComp-6.1 {lappend errors} -returnCodes error -body {
     proc foo {} {lappend}
@@ -243,7 +248,7 @@ test appendComp-6.2 {lappend errors} -returnCodes error -body {
 
 test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
     catch {rename foo ""}
-    catch {unset x}
+    unset -nocomplain x
 } -body {
     proc bar {} {
 	global x
@@ -259,7 +264,7 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} -se
     bar
 } -result {0 1 {can't read "x": no such variable}}
 test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable myvar r foo
@@ -282,7 +287,7 @@ test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
     bar
 } -result {::myvar {} r} -constraints {bug-3057639}
 test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     # The behavior of read triggers on lappend changed in 8.0 to not trigger
     # them. Maybe not correct, but been there a while.
@@ -295,7 +300,7 @@ test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
     bar
 } -result {myvar b r} -constraints {bug-3057639}
 test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     # The behavior of read triggers on lappend changed in 8.0 to not trigger
     # them. Maybe not correct, but been there a while.
@@ -308,7 +313,7 @@ test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
     bar
 } -result {myvar b r}
 test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	set myvar(0) 1
@@ -320,8 +325,8 @@ test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
     bar
 } -result {myvar b r} -constraints {bug-3057639}
 test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
-    catch {unset ::myvar}
-    catch {unset ::result}
+    unset -nocomplain ::myvar
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable ::myvar r foo
@@ -332,8 +337,8 @@ test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
     bar
 } -result {::myvar b r} -constraints {bug-3057639}
 test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
-    catch {unset ::myvar}
-    catch {unset ::result}
+    unset -nocomplain ::myvar
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable ::myvar r foo
@@ -344,7 +349,7 @@ test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
     bar
 } -result {::myvar b r}
 test appendComp-7.9 {append var does not trigger read trace} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable myvar r foo
@@ -369,25 +374,24 @@ test appendComp-8.1 {defer error to runtime} -setup {
     interp delete slave
 } -result {}
 
+# New tests for bug 3057639 to show off the more consistent behaviour of
+# lappend in both direct-eval and bytecompiled code paths (see append.test for
+# the direct-eval variants). lappend now behaves like append. 9.0/1 lappend -
+# 9.2/3 append.
 
-# New tests for bug 3057639 to show off the more consistent behaviour
-# of lappend in both direct-eval and bytecompiled code paths (see
-# append.test for the direct-eval variants). lappend now behaves like
-# append. 9.0/1 lappend - 9.2/3 append.
-
-# Note also the tests above now constrained by bug-3057639, these
-# changed behaviour with the triggering of read traces in bc mode
-# gone.
+# Note also the tests above now constrained by bug-3057639, these changed
+# behaviour with the triggering of read traces in bc mode gone.
 
-# Going back to the tests below. The direct-eval tests are ok before
-# and after patch (no read traces run for lappend, append). The
-# compiled tests are failing for lappend (9.0/1) before the patch,
-# showing how it invokes read traces in the compiled path. The append
-# tests are good (9.2/3). After the patch the failues are gone.
+# Going back to the tests below. The direct-eval tests are ok before and after
+# patch (no read traces run for lappend, append). The compiled tests are
+# failing for lappend (9.0/1) before the patch, showing how it invokes read
+# traces in the compiled path. The append tests are good (9.2/3). After the
+# patch the failues are gone.
 
-test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} {
-    catch {unset myvar}
+test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
     array set myvar {}
+} -body {
     proc nonull {var key val} {
 	upvar 1 $var lvar
 	if {![info exists lvar($key)]} {
@@ -399,22 +403,21 @@ test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing a
 	lappend ::myvar(key) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {{new value}}}
-
-
-test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {{new value}}}
+test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     proc foo {} {
 	lappend ::env(__DUMMY__) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {{new value}}}
-
-
-
-test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} {
-    catch {unset myvar}
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {{new value}}}
+test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
     array set myvar {}
+} -body {
     proc nonull {var key val} {
 	upvar 1 $var lvar
 	if {![info exists lvar($key)]} {
@@ -426,18 +429,18 @@ test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing ar
 	append ::myvar(key) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {new value}}
-
-
-test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {new value}}
+test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     proc foo {} {
 	append ::env(__DUMMY__) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {new value}}
-
-
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
 catch {unset i x result y}
 catch {rename foo ""}
 catch {rename bar ""}
@@ -447,3 +450,8 @@ catch {rename bar {}}
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
-- 
cgit v0.12