diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2016-07-17 11:56:28 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2016-07-17 11:56:28 (GMT) |
commit | 812e86e692342eea4435ae5eb01bce552c7350e2 (patch) | |
tree | a60622f6b4b68a813e9fcb8f0587bef53e3175c0 /tests | |
parent | 9015a7b063d96172512c54d84395d2b260d4d330 (diff) | |
download | tcl-812e86e692342eea4435ae5eb01bce552c7350e2.zip tcl-812e86e692342eea4435ae5eb01bce552c7350e2.tar.gz tcl-812e86e692342eea4435ae5eb01bce552c7350e2.tar.bz2 |
[77d58e3a7a] Test case independence: unload.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/tcltest.test | 7 | ||||
-rw-r--r-- | tests/unload.test | 170 |
2 files changed, 125 insertions, 52 deletions
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 |