diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/fileSystem.test | 18 | ||||
| -rw-r--r-- | tests/load.test | 8 | ||||
| -rw-r--r-- | tests/unload.test | 25 |
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: |