summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/fileSystem.test18
-rw-r--r--tests/load.test8
-rw-r--r--tests/unload.test25
3 files changed, 46 insertions, 5 deletions
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 9937618..071b63f 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -619,7 +619,7 @@ if {[testConstraint testfilesystem]} {
while {![catch {testfilesystem 0}]} {}
}
-test filesystem-7.1 {load from vfs} -setup {
+test filesystem-7.1.1 {load from vfs} -setup {
set dir [pwd]
} -constraints {win testsimplefilesystem} -body {
# This may cause a crash on exit
@@ -634,6 +634,22 @@ test filesystem-7.1 {load from vfs} -setup {
} -cleanup {
cd $dir
} -result ok
+test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
+ set dir [pwd]
+} -constraints {win testsimplefilesystem} -body {
+ # This may cause a crash on exit
+ cd [file dirname [info nameof]]
+ set reg [lindex [glob tclreg*[info sharedlib]] 0]
+ testsimplefilesystem 1
+ # This loads reg via a complex copy-to-temp operation
+ load simplefs:/$reg Registry
+ unload simplefs:/$reg
+ testsimplefilesystem 0
+ return ok
+ # The real result of this test is what happens when Tcl exits.
+} -cleanup {
+ cd $dir
+} -result ok
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
diff --git a/tests/load.test b/tests/load.test
index 8ecdaf5..711b919 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: load.test,v 1.20 2010/02/07 08:03:11 dkf Exp $
+# RCS: @(#) $Id: load.test,v 1.21 2010/04/02 21:21:06 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -77,8 +77,10 @@ test load-2.2 {loading into a safe interpreter, with package name conversion} \
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
- list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
-} -match glob -result {1 {*couldn't find procedure Foo_Init}}
+ list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
+} -match glob \
+ -result [list 1 {cannot find symbol "Foo_Init"*} \
+ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
diff --git a/tests/unload.test b/tests/unload.test
index b61e4cc..bf704c7 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: unload.test,v 1.8 2008/07/21 21:25:22 nijtmans Exp $
+# RCS: @(#) $Id: unload.test,v 1.9 2010/04/02 21:21:06 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -40,6 +40,10 @@ set alreadyTotalLoaded [info loaded]
# Certain tests require the 'teststaticpkg' command from tcltest
testConstraint teststaticpkg [llength [info commands teststaticpkg]]
+# Certain tests need the 'testsimplefilsystem' in tcltest
+testConstraint testsimplefilesystem \
+ [llength [info commands testsimplefilesystem]]
+
# Basic tests: parameter testing...
test unload-1.1 {basic errors} -returnCodes error -body {
unload
@@ -213,9 +217,28 @@ test unload-4.6 {basic unloading of unloadable package from a safe interpreter,
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} {{. {} {}} {} {} {. . .}}
+test unload-5.1 {unload a module loaded from vfs} \
+ -constraints [list $dll $loaded testsimplefilesystem] \
+ -setup {
+ set dir [pwd]
+ cd $testDir
+ testsimplefilesystem 1
+ load simplefs:/pkgua$ext pkgua
+ } \
+ -body {
+ list [catch {unload simplefs:/pkgua$ext} msg] $msg
+ } \
+ -result {0 {}}
+
+
+
# cleanup
interp delete child
interp delete child-trusted
unset ext
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: