summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-07-18 16:50:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-07-18 16:50:22 (GMT)
commitb40d7eb1f9fd438d96313292e9ff667799c7e911 (patch)
tree3762476e74c48c880cd6ab66a29d7202b771a124 /tests
parent9cc388df3d06570e47d68f284a74f4fa26b45426 (diff)
parent3766e26550a1315f09945ab1162d78d0143d32a2 (diff)
downloadtcl-b40d7eb1f9fd438d96313292e9ff667799c7e911.zip
tcl-b40d7eb1f9fd438d96313292e9ff667799c7e911.tar.gz
tcl-b40d7eb1f9fd438d96313292e9ff667799c7e911.tar.bz2
[104f2885bb] Rework the "chan" Tcl_ObjType to properly validate cached channel name lookups.
Also merge backlog of test suite & doc improvements.
Diffstat (limited to 'tests')
-rw-r--r--tests/chanio.test23
-rw-r--r--tests/cmdAH.test15
-rw-r--r--tests/env.test12
-rw-r--r--tests/fileName.test4
-rw-r--r--tests/history.test5
-rw-r--r--tests/interp.test47
-rw-r--r--tests/io.test35
-rw-r--r--tests/load.test54
-rw-r--r--tests/msgcat.test9
-rw-r--r--tests/namespace.test13
-rw-r--r--tests/safe.test20
-rw-r--r--tests/tcltest.test7
-rw-r--r--tests/unload.test170
-rw-r--r--tests/var.test6
14 files changed, 298 insertions, 122 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index 3017e81..075b64e 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -4160,12 +4160,20 @@ test chan-io-33.4 {Tcl_Gets with long line} -setup {
} -cleanup {
chan close $f
} -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test chan-io-33.5 {Tcl_Gets with long line} {
+test chan-io-33.5 {Tcl_Gets with long line} -setup {
+ set f [open $path(test3) w]
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ close $f
+} -body {
set f [open $path(test3)]
set x [chan gets $f y]
chan close $f
list $x $y
-} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+} -result {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.6 {Tcl_Gets and end of file} -setup {
file delete $path(test3)
set x {}
@@ -6765,7 +6773,12 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
chan close $out
file size $path(utf8-fcopy.txt)
} 5
-test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
+test chan-io-52.11 {TclCopyChannel & encodings} -setup {
+ set f [open $path(utf8-fcopy.txt) w]
+ fconfigure $f -encoding utf-8
+ puts $f "\u0410\u0410"
+ close $f
+} -constraints {fcopy} -body {
# binary to encoding => the input has to be in utf-8 to make sense to the
# encoder
set in [open $path(utf8-fcopy.txt) r]
@@ -6777,7 +6790,9 @@ test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
chan close $in
chan close $out
file size $path(kyrillic.txt)
-} 3
+} -cleanup {
+ file delete $path(utf8-fcopy.txt)
+} -result 3
test chan-io-53.1 {CopyData} -setup {
file delete $path(test1)
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index ef933cb..b4ef605 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,9 +141,13 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
} -cleanup {
cd $dir
} -result {/}
-test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
+ set dir [pwd]
+} -returnCodes error -body {
cd .\0
-} -result "couldn't change working directory to \".\0\": no such file or directory"
+} -cleanup {
+ cd $dir
+} -match glob -result "couldn't change working directory to \".\0\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
@@ -878,9 +882,10 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
} 1
test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
# On pc, must be a .exe, .com, etc.
- set x [file exe $gorpfile]
+ set x {}
set gorpexes {}
- foreach ext {exe com cmd bat ps1} {
+ foreach ext {exe com cmd bat} {
+ lappend x [file exe nosuchfile.$ext]
set gorpexe [makeFile foo gorp.$ext]
lappend gorpexes $gorpexe
lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
@@ -890,7 +895,7 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
foreach gorpexe $gorpexes {
removeFile $gorpexe
}
-} -result {0 1 1 1 1 1 1 1 1 1 1}
+} -result {0 1 1 0 1 1 0 1 1 0 1 1}
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
# Directories are always executable.
file exe $dirfile
diff --git a/tests/env.test b/tests/env.test
index 9f59fbc..0dd4f98 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Some tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
-
+
#
# These tests will run on any platform (and indeed crashed on the Mac). So put
# them before you test for the existance of exec.
@@ -147,6 +147,7 @@ test env-2.2 {adding environment variables} -setup {
} -result {NAME1=test string}
test env-2.3 {adding environment variables} -setup {
encoding system iso8859-1
+ set env(NAME1) "test string"
} -constraints {exec} -body {
set env(NAME2) "more"
getenv
@@ -156,6 +157,8 @@ test env-2.3 {adding environment variables} -setup {
NAME2=more}
test env-2.4 {adding environment variables} -setup {
encoding system iso8859-1
+ set env(NAME1) "test string"
+ set env(NAME2) "more"
} -constraints {exec} -body {
set env(XYZZY) "garbage"
getenv
@@ -165,7 +168,9 @@ test env-2.4 {adding environment variables} -setup {
NAME2=more
XYZZY=garbage}
+set env(NAME1) "test string"
set env(NAME2) "new value"
+set env(XYZZY) "garbage"
test env-3.1 {changing environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
@@ -177,6 +182,7 @@ test env-3.1 {changing environment variables} -setup {
} -result {NAME1=test string
NAME2=new value
XYZZY=garbage}
+unset -nocomplain env(NAME2)
test env-4.1 {unsetting environment variables: default} -setup {
encoding system iso8859-1
@@ -195,6 +201,7 @@ test env-4.2 {unsetting environment variables} -setup {
unset env(XYZZY)
encoding system $sysenc
} -result {XYZZY=garbage}
+unset -nocomplain env(NAME1) env(XYZZY)
test env-4.3 {setting international environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
@@ -213,6 +220,7 @@ test env-4.4 {changing international environment variables} -setup {
} -result {\u00a7=\u00a7}
test env-4.5 {unsetting international environment variables} -setup {
encoding system iso8859-1
+ set env(\ua7) \ua7
} -body {
set env(\ub6) \ua7
unset env(\ua7)
@@ -323,7 +331,7 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
return [info exists ::env(test7_3)]
}}
} -result 1
-
+
# Restore the environment variables at the end of the test.
foreach name [array names env] {
diff --git a/tests/fileName.test b/tests/fileName.test
index a19bd1e..387d844 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1468,7 +1468,7 @@ if {[testConstraint testsetplatform]} {
}
test filename-17.2 {windows specific glob with executable} -body {
makeDirectory execglob
- foreach ext {exe com cmd bat ps1 notexecutable} {
+ foreach ext {exe com cmd bat notexecutable} {
makeFile contents execglob/abc.$ext
}
lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *]
@@ -1477,7 +1477,7 @@ test filename-17.2 {windows specific glob with executable} -body {
removeFile execglob/abc.$ext
}
removeDirectory execglob
-} -result {abc.bat abc.cmd abc.com abc.exe abc.ps1}
+} -result {abc.bat abc.cmd abc.com abc.exe}
test filename-17.3 {Bug 2571597} win {
set p /a
file pathtype $p
diff --git a/tests/history.test b/tests/history.test
index 1a255a4..c2d2124 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -233,6 +233,7 @@ if {[testConstraint history]} {
test history-8.1 {clear option} history {catch {history clear junk}} 1
test history-8.2 {clear option} history {history clear} {}
if {[testConstraint history]} {
+ history clear
history add "Testing"
}
test history-8.3 {clear option} history {history} { 1 Testing}
@@ -248,3 +249,7 @@ test history-9.2 {miscellaneous} history {
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/interp.test b/tests/interp.test
index 6c9fb56..34b5bf9 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -71,9 +71,11 @@ test interp-2.2 {basic interpreter creation} {
test interp-2.3 {basic interpreter creation} {
catch {interp create -safe}
} 0
-test interp-2.4 {basic interpreter creation} {
- list [catch {interp create a} msg] $msg
-} {1 {interpreter named "a" already exists, cannot create}}
+test interp-2.4 {basic interpreter creation} -setup {
+ catch {interp create a}
+} -returnCodes error -body {
+ interp create a
+} -result {interpreter named "a" already exists, cannot create}
test interp-2.5 {basic interpreter creation} {
interp create b -safe
} b
@@ -89,11 +91,13 @@ test interp-2.8 {basic interpreter creation} {
test interp-2.9 {basic interpreter creation} {
interp create -safe -- -froboz1
} -froboz1
-test interp-2.10 {basic interpreter creation} {
+test interp-2.10 {basic interpreter creation} -setup {
+ catch {interp create a}
+} -body {
interp create {a x1}
interp create {a x2}
interp create {a x3} -safe
-} {a x3}
+} -result {a x3}
test interp-2.11 {anonymous interps vs existing procs} {
set x [interp create]
regexp "interp(\[0-9]+)" $x dummy thenum
@@ -140,19 +144,26 @@ test interp-3.5 {testing interp exists and interp slaves} -body {
test interp-3.6 {testing interp exists and interp slaves} {
interp exists
} 1
-test interp-3.7 {testing interp exists and interp slaves} {
+test interp-3.7 {testing interp exists and interp slaves} -setup {
+ catch {interp create a}
+} -body {
interp slaves
-} a
+} -result a
test interp-3.8 {testing interp exists and interp slaves} -body {
interp slaves a b c
} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
-test interp-3.9 {testing interp exists and interp slaves} {
+test interp-3.9 {testing interp exists and interp slaves} -setup {
+ catch {interp create a}
+} -body {
interp create {a a2} -safe
expr {"a2" in [interp slaves a]}
-} 1
-test interp-3.10 {testing interp exists and interp slaves} {
+} -result 1
+test interp-3.10 {testing interp exists and interp slaves} -setup {
+ catch {interp create a}
+ catch {interp create {a a2}}
+} -body {
interp exists {a a2}
-} 1
+} -result 1
# Part 3: Testing "interp delete"
test interp-3.11 {testing interp delete} {
@@ -222,6 +233,7 @@ test interp-6.3 {testing eval} {
a eval {proc foo {} {expr 3 + 5}}
a eval foo
} 8
+catch {a eval {proc foo {} {expr 3 + 5}}}
test interp-6.4 {testing eval} {
interp eval a foo
} 8
@@ -230,6 +242,7 @@ test interp-6.5 {testing eval} {
interp eval {a x2} {proc frob {} {expr 4 * 9}}
interp eval {a x2} frob
} 36
+catch {interp create {a x2}}
test interp-6.6 {testing eval} -returnCodes error -body {
interp eval {a x2} foo
} -result {invalid command name "foo"}
@@ -243,9 +256,11 @@ proc in_master {args} {
test interp-7.1 {testing basic alias creation} {
a alias foo in_master
} foo
+catch {a alias foo in_master}
test interp-7.2 {testing basic alias creation} {
a alias bar in_master a1 a2 a3
} bar
+catch {a alias bar in_master a1 a2 a3}
# Test 6.3 has been deleted.
test interp-7.3 {testing basic alias creation} {
a alias foo
@@ -476,9 +491,13 @@ test interp-13.4 {testing issafe arg checking} {
} {1 {wrong # args: should be "a issafe"}}
# part 14: testing interp aliases
-test interp-14.1 {testing interp aliases} {
- interp aliases
-} ""
+test interp-14.1 {testing interp aliases} -setup {
+ interp create abc
+} -body {
+ interp eval abc {interp aliases}
+} -cleanup {
+ interp delete abc
+} -result ""
test interp-14.2 {testing interp aliases} {
catch {interp delete a}
interp create a
diff --git a/tests/io.test b/tests/io.test
index 46856b6..2084991 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -44,6 +44,7 @@ testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+testConstraint testobj [llength [info commands testobj]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -4285,6 +4286,13 @@ test io-33.4 {Tcl_Gets with long line} {
close $f
set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+set f [open $path(test3) w]
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+close $f
test io-33.5 {Tcl_Gets with long line} {
set f [open $path(test3)]
set x [gets $f y]
@@ -7141,7 +7149,12 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} {
file size $path(utf8-fcopy.txt)
} 5
-test io-52.11 {TclCopyChannel & encodings} {fcopy} {
+test io-52.11 {TclCopyChannel & encodings} -setup {
+ set out [open $path(utf8-fcopy.txt) w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "\u0410\u0410"
+ close $out
+} -constraints {fcopy} -body {
# binary to encoding => the input has to be
# in utf-8 to make sense to the encoder
@@ -7157,7 +7170,7 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} {
close $out
file size $path(kyrillic.txt)
-} 3
+} -result 3
test io-52.12 {coverage of -translation auto} {
file delete $path(test1) $path(test2)
@@ -8626,6 +8639,24 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
removeFile io-73.5
} -result [list 1 1 more\u00a0data 1]
+test io-74.1 {[104f2885bb] improper cache validity check} -setup {
+ set fn [makeFile {} io-74.1]
+ set rfd [open $fn r]
+ testobj freeallvars
+ interp create slave
+} -constraints testobj -body {
+ teststringobj set 1 [string range $rfd 0 end]
+ read [teststringobj get 1]
+ testobj duplicate 1 2
+ interp transfer {} $rfd slave
+ catch {read [teststringobj get 1]}
+ read [teststringobj get 2]
+} -cleanup {
+ interp delete slave
+ testobj freeallvars
+ removeFile io-74.1
+} -returnCodes error -match glob -result {can not find channel named "*"}
+
# ### ### ### ######### ######### #########
# cleanup
diff --git a/tests/load.test b/tests/load.test
index 9536271..7c4b47f 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -124,9 +124,11 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
-test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
- list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
-} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""]
+test load-4.2 {reloading package into same interpreter} -setup {
+ catch {load [file join $testDir pkga$ext] pkga}
+} -constraints [list $dll $loaded] -returnCodes error -body {
+ load [file join $testDir pkga$ext] pkgb
+} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
test load-5.1 {file name not specified and no static package: pick default} \
[list $dll $loaded] {
@@ -169,26 +171,40 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
load {} More
set x
} {not loaded}
-test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
- [list teststaticpkg $dll $loaded] {
- teststaticpkg Double 0 1
- teststaticpkg Double 0 1
- info loaded
- } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
+catch {load [file join $testDir pkga$ext] pkga}
+catch {load [file join $testDir pkgb$ext] pkgb}
+catch {load [file join $testDir pkge$ext] pkge}
+set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
+test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
+ teststaticpkg Test 1 0
+ teststaticpkg Another 0 0
+ teststaticpkg More 0 1
+} -constraints [list teststaticpkg $dll $loaded] -body {
+ teststaticpkg Double 0 1
+ teststaticpkg Double 0 1
+ info loaded
+} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
+teststaticpkg Test 1 1
+teststaticpkg Another 0 1
+teststaticpkg More 0 1
+teststaticpkg Double 0 1
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
- info loaded
-} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
-test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] {
- list [catch {info loaded gorp} msg] $msg
-} {1 {could not find interpreter "gorp"}}
-test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
- list [info loaded {}] [info loaded child]
-} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
+ lsort -index 1 [info loaded]
+} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
+test load-8.2 {TclGetLoadedPackages procedure} -body {
+ info loaded gorp
+} -returnCodes error -result {could not find interpreter "gorp"}
+test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+ lsort -index 1 [info loaded {}]
+} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
+test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+ lsort -index 1 [info loaded child]
+} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
load [file join $testDir pkgb$ext] pkgb
- list [info loaded {}] [lsort [info commands pkgb_*]]
-} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}]
+ list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
+} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child
test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
diff --git a/tests/msgcat.test b/tests/msgcat.test
index f50ebfb..e69220e 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -68,6 +68,7 @@ namespace eval ::msgcat::test {
set result c
}
}
+
test msgcat-0.$count [list \
locale initialization from environment variables $setVars \
] -setup {
@@ -974,6 +975,9 @@ namespace eval ::msgcat::test {
set bgerrorsaved [interp bgerror {}]
interp bgerror {} [namespace code callbackproc]
+ variable locale
+ if {![info exist locale]} { set locale [mclocale] }
+
test msgcat-14.1 {invokation loadcmd} -setup {
mcforgetpackage
mclocale $locale
@@ -1068,7 +1072,7 @@ namespace eval ::msgcat::test {
mc k1
} -returnCodes 1\
-result {fail}
-
+
interp bgerror {} $bgerrorsaved
cleanupTests
@@ -1076,3 +1080,6 @@ namespace eval ::msgcat::test {
namespace delete ::msgcat::test
return
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/namespace.test b/tests/namespace.test
index 0bbf2f7..f6f817b 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -846,6 +846,7 @@ test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
set ::x
}
} -result {314159}
+variable ::x 314159
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
namespace eval test_ns_1 {
variable x 777
@@ -889,23 +890,25 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
} -result {777}
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
namespace eval test_ns_1 {
+ variable x 777
unset x
set x ;# must be global x now
}
} {314159}
-test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
+test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
namespace eval test_ns_1 {
- list [catch {set wuzzat} msg] $msg
+ set wuzzat
}
-} {1 {can't read "wuzzat": no such variable}}
+} -returnCodes error -result {can't read "wuzzat": no such variable}
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
namespace eval test_ns_1 {
variable a hello
}
set test_ns_1::a
} {hello}
-test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
+test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
namespace eval test_ns_1 {}
+} -body {
proc test_ns {} {
set ::test_ns_1::a 0
}
@@ -916,7 +919,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
namespace eval test_ns_1 set a 1
namespace delete test_ns_1
return $a
-} 1
+} -result 1
catch {unset a}
catch {unset x}
diff --git a/tests/safe.test b/tests/safe.test
index 94c1755..6c9c6c9 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -211,8 +211,8 @@ test safe-7.3 {check that safe subinterpreters work} {
} {ok {} 0}
# test source control on file name
+set i "a"
test safe-8.1 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
@@ -221,7 +221,6 @@ test safe-8.1 {safe source control on file} -setup {
safe::interpDelete $i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.2 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
@@ -230,7 +229,6 @@ test safe-8.2 {safe source control on file} -setup {
safe::interpDelete $i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.3 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {lappend ::log $str}
@@ -245,7 +243,6 @@ test safe-8.3 {safe source control on file} -setup {
safe::interpDelete $i
} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
test safe-8.4 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -260,7 +257,6 @@ test safe-8.4 {safe source control on file} -setup {
safe::interpDelete $i
} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
test safe-8.5 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -279,7 +275,6 @@ test safe-8.5 {safe source control on file} -setup {
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
test safe-8.6 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -296,7 +291,6 @@ test safe-8.6 {safe source control on file} -setup {
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
test safe-8.7 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -315,7 +309,6 @@ test safe-8.7 {safe source control on file} -setup {
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} -setup {
- set i "a"
catch {safe::interpDelete $i}
safe::interpCreate $i
} -body {
@@ -349,8 +342,8 @@ test safe-8.10 {safe source and return} -setup {
removeFile $returnScript
} -result ok
+set i "a"
test safe-9.1 {safe interps' deleteHook} -setup {
- set i "a"
catch {safe::interpDelete $i}
set res {}
} -body {
@@ -365,7 +358,6 @@ test safe-9.1 {safe interps' deleteHook} -setup {
list [interp eval $i exit] $res
} -result {{} {arg1 arg2 a}}
test safe-9.2 {safe interps' error in deleteHook} -setup {
- set i "a"
catch {safe::interpDelete $i}
set res {}
set log {}
@@ -531,14 +523,14 @@ test safe-11.7.1 {testing safe encoding} -setup {
} -body {
catch {interp eval $i encoding convertfrom} m o
dict get $o -errorinfo
-} -returnCodes ok -cleanup {
+} -returnCodes ok -match glob -cleanup {
unset -nocomplain m o
safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
while executing
"encoding convertfrom"
invoked from within
-"::interp invokehidden interp1 encoding convertfrom"
+"::interp invokehidden interp* encoding convertfrom"
invoked from within
"encoding convertfrom"
invoked from within
@@ -555,14 +547,14 @@ test safe-11.8.1 {testing safe encoding} -setup {
} -body {
catch {interp eval $i encoding convertto} m o
dict get $o -errorinfo
-} -returnCodes ok -cleanup {
+} -returnCodes ok -match glob -cleanup {
unset -nocomplain m o
safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"
while executing
"encoding convertto"
invoked from within
-"::interp invokehidden interp1 encoding convertto"
+"::interp invokehidden interp* encoding convertto"
invoked from within
"encoding convertto"
invoked from within
diff --git a/tests/tcltest.test b/tests/tcltest.test
index e66678b..728a018 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -46,6 +46,7 @@ makeFile {
cd [temporaryDirectory]
testConstraint exec [llength [info commands exec]]
+
# test -help
# Child processes because -help [exit]s.
test tcltest-1.1 {tcltest -help} {exec} {
@@ -1824,9 +1825,13 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
---- errorInfo: body error
*
---- errorInfo(cleanup): cleanup error*}
-
+
cleanupTests
}
namespace delete ::tcltest::test
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/unload.test b/tests/unload.test
index 5a374c4..73f1091 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -45,6 +45,14 @@ testConstraint teststaticpkg [llength [info commands teststaticpkg]]
testConstraint testsimplefilesystem \
[llength [info commands testsimplefilesystem]]
+proc loadIfNotPresent {pkg args} {
+ global testDir ext
+ set loaded [lmap x [info loaded {*}$args] {lindex $x 1}]
+ if {[string totitle $pkg] ni $loaded} {
+ load [file join $testDir $pkg$ext]
+ }
+}
+
# Basic tests: parameter testing...
test unload-1.1 {basic errors} -returnCodes error -body {
unload
@@ -73,7 +81,7 @@ set pkgua_detached {}
set pkgua_unloaded {}
# Tests for loading/unloading in trusted (non-safe) interpreters...
test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] {
- load [file join $testDir pkga$ext]
+ loadIfNotPresent pkga
list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
@@ -82,28 +90,43 @@ test unload-2.2 {basic loading of unloadable package, with guess for package nam
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
-test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] {
- list [catch {unload [file join $testDir pkga$ext]} msg] \
- [string map [list [file join $testDir pkga$ext] file] $msg]
-} {1 {file "file" cannot be unloaded under a trusted interpreter}}
-test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] {
+test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} -setup {
+ loadIfNotPresent pkga
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+ unload [file join $testDir pkga$ext]
+} -result {file "*" cannot be unloaded under a trusted interpreter}
+test unload-2.4 {basic unloading of unloadable package, with guess for package name} -setup {
+ loadIfNotPresent pkgua
+} -constraints [list $dll $loaded] -body {
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
[unload [file join $testDir pkgua$ext]] \
[info commands pkgua_*] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {. {} {} {} {} . . .}
-test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] {
+} -result {. {} {} {} {} . . .}
+test unload-2.5 {reloading of unloaded package, with guess for package name} -setup {
+ if {$pkgua_loaded eq ""} {
+ loadIfNotPresent pkgua
+ unload [file join $testDir pkgua$ext]
+ }
+} -constraints [list $dll $loaded] -body {
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
[load [file join $testDir pkgua$ext]] \
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
-test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] {
+} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
+test unload-2.6 {basic unloading of re-loaded package, with guess for package name} -setup {
+ # Establish expected state
+ if {$pkgua_loaded eq ""} {
+ loadIfNotPresent pkgua
+ unload [file join $testDir pkgua$ext]
+ load [file join $testDir pkgua$ext]
+ }
+} -constraints [list $dll $loaded] -body {
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
[unload [file join $testDir pkgua$ext]] \
[info commands pkgua_*] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {.. . . {} {} .. .. ..}
+} -result {.. . . {} {} .. .. ..}
# Tests for loading/unloading in safe interpreters...
interp create -safe child
@@ -127,38 +150,52 @@ test unload-3.2 {basic loading of unloadable package in a safe interpreter, with
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
-test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} \
- [list $dll $loaded] {
- list [catch {unload [file join $testDir pkga$ext] {} child} msg] \
- [string map [list [file join $testDir pkga$ext] file] $msg]
-} {1 {file "file" has never been loaded in this interpreter}}
-test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
- list [catch {unload [file join $testDir pkgb$ext] {} child} msg] \
- [string map [list [file join $testDir pkgb$ext] file] $msg]
-} {1 {file "file" cannot be unloaded under a safe interpreter}}
-test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
+ loadIfNotPresent pkga
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+ unload [file join $testDir pkga$ext] {} child
+} -result {file "*" has never been loaded in this interpreter}
+test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {[lsearch -index 1 [info loaded child] Pkgb] == -1} {
+ load [file join $testDir pkgb$ext] pKgB child
+ }
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+ unload [file join $testDir pkgb$ext] {} child
+} -result {file "*" cannot be unloaded under a safe interpreter}
+test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {[lsearch -index 1 [info loaded child] Pkgua] == -1} {
+ load [file join $testDir pkgua$ext] pkgua child
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] {} child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. {} {}} {} {} {. . .}}
-test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+} -result {{. {} {}} {} {} {. . .}}
+test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} -setup {
+ if {[child eval set pkgua_loaded] eq ""} {
+ load [file join $testDir pkgua$ext] {} child
+ unload [file join $testDir pkgua$ext] {} child
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] {} child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
-test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} \
- [list $dll $loaded] {
+} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
+test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} -setup {
+ if {[child eval set pkgua_loaded] eq ""} {
+ load [file join $testDir pkgua$ext] {} child
+ unload [file join $testDir pkgua$ext] {} child
+ load [file join $testDir pkgua$ext] {} child
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] pKgUa child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{.. . .} {} {} {.. .. ..}}
+} -result {{.. . .} {} {} {.. .. ..}}
# Tests for loading/unloading of a package among multiple interpreters...
interp create child-trusted
@@ -167,56 +204,89 @@ child-trusted eval {
set pkgua_detached {}
set pkgua_unloaded {}
}
+array set load {M 0 C 0 T 0}
## Load package in main trusted interpreter...
-test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} -setup {
+ set pkgua_loaded ""
+ set pkgua_detached ""
+ set pkgua_unloaded ""
+ incr load(M)
+} -constraints [list $dll $loaded] -body {
list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
[load [file join $testDir pkgua$ext]] \
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
[list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
-} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-safe interpreter...
-test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
- [list $dll $loaded] {
+test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup {
+ child eval {
+ set pkgua_loaded ""
+ set pkgua_detached ""
+ set pkgua_unloaded ""
+ }
+ incr load(C)
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pKgUA child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-trusted interpreter...
-test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \
- [list $dll $loaded] {
+test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup {
+ incr load(T)
+} -constraints [list $dll $loaded] -body {
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pkguA child-trusted] \
[child-trusted eval pkgua_eq abc def] \
[lsort [child-trusted eval info commands pkgua_*]] \
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Unload the package from the main trusted interpreter...
-test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup {
+ if {!$load(M)} {
+ load [file join $testDir pkgua$ext]
+ }
+ if {!$load(C)} {
+ load [file join $testDir pkgua$ext] {} child
+ incr load(C)
+ }
+ if {!$load(T)} {
+ load [file join $testDir pkgua$ext] {} child-trusted
+ incr load(T)
+ }
+} -constraints [list $dll $loaded] -body {
list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
[unload [file join $testDir pkgua$ext]] \
[info commands pkgua_*] \
[list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
-} {{... .. ..} {} {} {... ... ..}}
+} -result {{. {} {}} {} {} {. . {}}}
## Unload the package from the child safe interpreter...
-test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {!$load(C)} {
+ load [file join $testDir pkgua$ext] {} child
+ }
+ if {!$load(T)} {
+ load [file join $testDir pkgua$ext] {} child-trusted
+ incr load(T)
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] {} child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{... .. ..} {} {} {... ... ..}}
+} -result {{. {} {}} {} {} {. . {}}}
## Unload the package from the child trusted interpreter...
-test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {!$load(T)} {
+ load [file join $testDir pkgua$ext] {} child-trusted
+ }
+} -constraints [list $dll $loaded] -body {
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] {} child-trusted] \
[child-trusted eval info commands pkgua_*] \
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. {} {}} {} {} {. . .}}
+} -result {{. {} {}} {} {} {. . .}}
test unload-5.1 {unload a module loaded from vfs} \
-constraints [list $dll $loaded testsimplefilesystem] \
@@ -230,9 +300,7 @@ test unload-5.1 {unload a module loaded from vfs} \
list [catch {unload simplefs:/pkgua$ext} msg] $msg
} \
-result {0 {}}
-
-
-
+
# cleanup
interp delete child
interp delete child-trusted
diff --git a/tests/var.test b/tests/var.test
index 803bbda..44e671a 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -184,7 +184,9 @@ test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array:
set result
}
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
-test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
+test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
+ unset -nocomplain test_ns_var::x
+} -body {
namespace eval test_ns_var {
variable result {}
variable x
@@ -196,7 +198,7 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
namespace delete [namespace current]
set result
}
-} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
[format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}