diff options
Diffstat (limited to 'tests/unload.test')
| -rw-r--r-- | tests/unload.test | 261 |
1 files changed, 85 insertions, 176 deletions
diff --git a/tests/unload.test b/tests/unload.test index 75cbcde..9e34bce 100644 --- a/tests/unload.test +++ b/tests/unload.test @@ -4,21 +4,18 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1995 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. -# Copyright © 2003-2004 Georgios Petasis +# Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2003-2004 by Georgios Petasis # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] - # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { @@ -38,92 +35,68 @@ testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] -# Certain tests need the 'testsimplefilsystem' in tcltest -testConstraint testsimplefilesystem \ - [llength [info commands testsimplefilesystem]] +# Certain tests require the 'teststaticpkg' command from tcltest +testConstraint teststaticpkg [llength [info commands teststaticpkg]] -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 -} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"} -test unload-1.2 {basic errors} -returnCodes error -body { - unload a b c d -} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"} -test unload-1.3 {basic errors} -returnCodes error -body { - unload a b foobar -} -result {could not find interpreter "foobar"} -test unload-1.4 {basic errors} -returnCodes error -body { - unload {} -} -result {must specify either file name or prefix} -test unload-1.5 {basic errors} -returnCodes error -body { - unload {} {} -} -result {must specify either file name or prefix} -test unload-1.6 {basic errors} -returnCodes error -body { - unload {} Unknown -} -result {library with prefix "Unknown" is loaded statically and cannot be unloaded} -test unload-1.7 {-nocomplain switch} { - unload -nocomplain {} Unknown -} {} +test unload-1.1 {basic errors} {} { + list [catch {unload} msg] $msg +} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}" +test unload-1.2 {basic errors} {} { + list [catch {unload a b c d} msg] $msg +} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}" +test unload-1.3 {basic errors} {} { + list [catch {unload a b foobar} msg] $msg +} {1 {could not find interpreter "foobar"}} +test unload-1.4 {basic errors} {} { + list [catch {unload {}} msg] $msg +} {1 {must specify either file name or package name}} +test unload-1.5 {basic errors} {} { + list [catch {unload {} {}} msg] $msg +} {1 {must specify either file name or package name}} +test unload-1.6 {basic errors} {} { + list [catch {unload {} Unknown} msg] $msg +} {1 {package "Unknown" is loaded statically and cannot be unloaded}} +test unload-1.7 {-nocomplain switch} {} { + list [unload -nocomplain {} Unknown] +} {{}} set pkgua_loaded {} 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 prefix} [list $dll $loaded deprecated] { - loadIfNotPresent pkga +test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] { + load [file join $testDir pkga$ext] 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 prefix} [list $dll $loaded deprecated] { +test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] { 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.3 {basic unloading of non-unloadable package, with guess for prefix} -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 prefix} -setup { - loadIfNotPresent pkgua -} -constraints [list $dll $loaded] -body { +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] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ [unload [file join $testDir pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded -} -result {. {} {} {} {} . . .} -test unload-2.5 {reloading of unloaded package, with guess for prefix} -setup { - if {$pkgua_loaded eq ""} { - loadIfNotPresent pkgua - unload [file join $testDir pkgua$ext] - } -} -constraints [list $dll $loaded deprecated] -body { +} {. {} {} {} {} . . .} +test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] { 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 -} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} -test unload-2.6 {basic unloading of re-loaded package, with guess for prefix} -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 deprecated] -body { +} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} +test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] { 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 @@ -132,67 +105,53 @@ child eval { set pkgua_detached {} set pkgua_unloaded {} } -test unload-3.1 {basic loading of non-unloadable package in a safe interpreter} \ +test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \ [list $dll $loaded] { catch {rename pkgb_sub {}} - load [file join $testDir pkgb$ext] Pkgb child + load [file join $testDir pkgb$ext] pKgB child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} -test unload-3.2 {basic loading of unloadable package in a safe interpreter} \ - [list $dll $loaded deprecated] { +test unload-3.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \ + [list $dll $loaded] { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] pkgua child] \ + [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} {. {} {}}} -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 prefix} -setup { - if {[lsearch -index 1 [info loaded child] Pkgb] < 0} { - 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 prefix} -setup { - if {[lsearch -index 1 [info loaded child] Pkgua] < 0} { - load [file join $testDir pkgua$ext] Pkgua child - } -} -constraints [list $dll $loaded] -body { +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] { 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 {{. {} {}} {} {} {. . .}} -test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for prefix} -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 deprecated] -body { +} {{. {} {}} {} {} {. . .}} +test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \ + [list $dll $loaded] { 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}] -} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}} -test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with prefix 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 deprecated] -body { +} {{. . .} {} 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] { 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 @@ -201,110 +160,60 @@ 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 prefix} -setup { - set pkgua_loaded "" - set pkgua_detached "" - set pkgua_unloaded "" - incr load(M) -} -constraints [list $dll $loaded deprecated] -body { +test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \ + [list $dll $loaded] { 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] -} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} +} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}} ## Load package in child-safe interpreter... -test unload-4.2 {basic loading of unloadable package in a safe interpreter} -setup { - child eval { - set pkgua_loaded "" - set pkgua_detached "" - set pkgua_unloaded "" - } - incr load(C) -} -constraints [list $dll $loaded deprecated] -body { +test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \ + [list $dll $loaded] { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] pkgua child] \ + [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}] -} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} +} {{.. .. ..} {} 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} -setup { - incr load(T) -} -constraints [list $dll $loaded deprecated] -body { +test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \ + [list $dll $loaded] { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] pkgua child-trusted] \ + [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}] -} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} +} {{{} {} {}} {} 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 prefix} -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 deprecated] -body { +test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \ + [list $dll $loaded] { 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 prefix} -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 deprecated] -body { +test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \ + [list $dll $loaded] { 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 prefix} -setup { - if {!$load(T)} { - load [file join $testDir pkgua$ext] {} child-trusted - } -} -constraints [list $dll $loaded] -body { +test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \ + [list $dll $loaded] { 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] \ - -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: |