1# Commands covered: unload 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1995 Sun Microsystems, Inc. 8# Copyright © 1998-1999 Scriptics Corporation. 9# Copyright © 2003-2004 Georgios Petasis 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 14if {"::tcltest" ni [namespace children]} { 15 package require tcltest 2.5 16 namespace import -force ::tcltest::* 17} 18 19::tcltest::loadTestedCommands 20catch [list package require -exact tcl::test [info patchlevel]] 21 22# Figure out what extension is used for shared libraries on this 23# platform. 24if {![info exists ext]} { 25 set ext [info sharedlibextension] 26} 27 28# Tests require the existence of one of the DLLs in the dltest directory. 29set testDir [file join [file dirname [info nameofexecutable]] dltest] 30set x [file join $testDir pkgua$ext] 31set dll "[file tail $x]Required" 32testConstraint $dll [file readable $x] 33 34# Tests also require that this DLL has not already been loaded. 35set loaded "[file tail $x]Loaded" 36set alreadyLoaded [info loaded] 37testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}] 38 39set alreadyTotalLoaded [info loaded] 40 41# Certain tests need the 'testsimplefilsystem' in tcltest 42testConstraint testsimplefilesystem \ 43 [llength [info commands testsimplefilesystem]] 44 45proc loadIfNotPresent {pkg args} { 46 global testDir ext 47 set loaded [lmap x [info loaded {*}$args] {lindex $x 1}] 48 if {[string totitle $pkg] ni $loaded} { 49 load [file join $testDir $pkg$ext] 50 } 51} 52 53# Basic tests: parameter testing... 54test unload-1.1 {basic errors} -returnCodes error -body { 55 unload 56} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"} 57test unload-1.2 {basic errors} -returnCodes error -body { 58 unload a b c d 59} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"} 60test unload-1.3 {basic errors} -returnCodes error -body { 61 unload a b foobar 62} -result {could not find interpreter "foobar"} 63test unload-1.4 {basic errors} -returnCodes error -body { 64 unload {} 65} -result {must specify either file name or prefix} 66test unload-1.5 {basic errors} -returnCodes error -body { 67 unload {} {} 68} -result {must specify either file name or prefix} 69test unload-1.6 {basic errors} -returnCodes error -body { 70 unload {} Unknown 71} -result {library with prefix "Unknown" is loaded statically and cannot be unloaded} 72test unload-1.7 {-nocomplain switch} { 73 unload -nocomplain {} Unknown 74} {} 75 76set pkgua_loaded {} 77set pkgua_detached {} 78set pkgua_unloaded {} 79# Tests for loading/unloading in trusted (non-safe) interpreters... 80test unload-2.1 {basic loading of non-unloadable package, with guess for prefix} [list $dll $loaded] { 81 loadIfNotPresent pkga 82 list [pkga_eq abc def] [lsort [info commands pkga_*]] 83} {0 {pkga_eq pkga_quote}} 84test unload-2.2 {basic loading of unloadable package, with guess for prefix} [list $dll $loaded] { 85 list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ 86 [load [file join $testDir pkgua$ext]] \ 87 [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ 88 $pkgua_loaded $pkgua_detached $pkgua_unloaded 89} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}} 90test unload-2.3 {basic unloading of non-unloadable package, with guess for prefix} -setup { 91 loadIfNotPresent pkga 92} -constraints [list $dll $loaded] -returnCodes error -match glob -body { 93 unload [file join $testDir pkga$ext] 94} -result {file "*" cannot be unloaded under a trusted interpreter} 95test unload-2.4 {basic unloading of unloadable package, with guess for prefix} -setup { 96 loadIfNotPresent pkgua 97} -constraints [list $dll $loaded] -body { 98 list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ 99 [unload [file join $testDir pkgua$ext]] \ 100 [info commands pkgua_*] \ 101 $pkgua_loaded $pkgua_detached $pkgua_unloaded 102} -result {. {} {} {} {} . . .} 103test unload-2.5 {reloading of unloaded package, with guess for prefix} -setup { 104 if {$pkgua_loaded eq ""} { 105 loadIfNotPresent pkgua 106 unload [file join $testDir pkgua$ext] 107 } 108} -constraints [list $dll $loaded] -body { 109 list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ 110 [load [file join $testDir pkgua$ext]] \ 111 [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ 112 $pkgua_loaded $pkgua_detached $pkgua_unloaded 113} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} 114test unload-2.6 {basic unloading of re-loaded package, with guess for prefix} -setup { 115 # Establish expected state 116 if {$pkgua_loaded eq ""} { 117 loadIfNotPresent pkgua 118 unload [file join $testDir pkgua$ext] 119 load [file join $testDir pkgua$ext] 120 } 121} -constraints [list $dll $loaded] -body { 122 list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ 123 [unload [file join $testDir pkgua$ext]] \ 124 [info commands pkgua_*] \ 125 $pkgua_loaded $pkgua_detached $pkgua_unloaded 126} -result {.. . . {} {} .. .. ..} 127 128# Tests for loading/unloading in safe interpreters... 129interp create -safe child 130child eval { 131 set pkgua_loaded {} 132 set pkgua_detached {} 133 set pkgua_unloaded {} 134} 135test unload-3.1 {basic loading of non-unloadable package in a safe interpreter} \ 136 [list $dll $loaded] { 137 catch {rename pkgb_sub {}} 138 load [file join $testDir pkgb$ext] Pkgb child 139 list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ 140 [catch {pkgb_sub 12 10} msg2] $msg2 141} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} 142test unload-3.2 {basic loading of unloadable package in a safe interpreter} \ 143 [list $dll $loaded] { 144 list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 145 [load [file join $testDir pkgua$ext] pkgua child] \ 146 [child eval pkgua_eq abc def] \ 147 [lsort [child eval info commands pkgua_*]] \ 148 [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 149} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} 150test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup { 151 loadIfNotPresent pkga 152} -constraints [list $dll $loaded] -returnCodes error -match glob -body { 153 unload [file join $testDir pkga$ext] {} child 154} -result {file "*" has never been loaded in this interpreter} 155test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for prefix} -setup { 156 if {[lsearch -index 1 [info loaded child] Pkgb] < 0} { 157 load [file join $testDir pkgb$ext] Pkgb child 158 } 159} -constraints [list $dll $loaded] -returnCodes error -match glob -body { 160 unload [file join $testDir pkgb$ext] {} child 161} -result {file "*" cannot be unloaded under a safe interpreter} 162test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for prefix} -setup { 163 if {[lsearch -index 1 [info loaded child] Pkgua] < 0} { 164 load [file join $testDir pkgua$ext] Pkgua child 165 } 166} -constraints [list $dll $loaded] -body { 167 list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 168 [unload [file join $testDir pkgua$ext] {} child] \ 169 [child eval info commands pkgua_*] \ 170 [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 171} -result {{. {} {}} {} {} {. . .}} 172test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for prefix} -setup { 173 if {[child eval set pkgua_loaded] eq ""} { 174 load [file join $testDir pkgua$ext] {} child 175 unload [file join $testDir pkgua$ext] {} child 176 } 177} -constraints [list $dll $loaded] -body { 178 list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 179 [load [file join $testDir pkgua$ext] {} child] \ 180 [child eval pkgua_eq abc def] \ 181 [lsort [child eval info commands pkgua_*]] \ 182 [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 183} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}} 184test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with prefix conversion} -setup { 185 if {[child eval set pkgua_loaded] eq ""} { 186 load [file join $testDir pkgua$ext] {} child 187 unload [file join $testDir pkgua$ext] {} child 188 load [file join $testDir pkgua$ext] {} child 189 } 190} -constraints [list $dll $loaded] -body { 191 list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 192 [unload [file join $testDir pkgua$ext] pKgUa child] \ 193 [child eval info commands pkgua_*] \ 194 [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 195} -result {{.. . .} {} {} {.. .. ..}} 196 197# Tests for loading/unloading of a package among multiple interpreters... 198interp create child-trusted 199child-trusted eval { 200 set pkgua_loaded {} 201 set pkgua_detached {} 202 set pkgua_unloaded {} 203} 204array set load {M 0 C 0 T 0} 205## Load package in main trusted interpreter... 206test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for prefix} -setup { 207 set pkgua_loaded "" 208 set pkgua_detached "" 209 set pkgua_unloaded "" 210 incr load(M) 211} -constraints [list $dll $loaded] -body { 212 list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ 213 [load [file join $testDir pkgua$ext]] \ 214 [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ 215 [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] 216} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} 217## Load package in child-safe interpreter... 218test unload-4.2 {basic loading of unloadable package in a safe interpreter} -setup { 219 child eval { 220 set pkgua_loaded "" 221 set pkgua_detached "" 222 set pkgua_unloaded "" 223 } 224 incr load(C) 225} -constraints [list $dll $loaded] -body { 226 list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 227 [load [file join $testDir pkgua$ext] pkgua child] \ 228 [child eval pkgua_eq abc def] \ 229 [lsort [child eval info commands pkgua_*]] \ 230 [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 231} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} 232## Load package in child-trusted interpreter... 233test unload-4.3 {basic loading of unloadable package in a second trusted interpreter} -setup { 234 incr load(T) 235} -constraints [list $dll $loaded] -body { 236 list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 237 [load [file join $testDir pkgua$ext] pkgua child-trusted] \ 238 [child-trusted eval pkgua_eq abc def] \ 239 [lsort [child-trusted eval info commands pkgua_*]] \ 240 [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 241} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} 242## Unload the package from the main trusted interpreter... 243test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for prefix} -setup { 244 if {!$load(M)} { 245 load [file join $testDir pkgua$ext] 246 } 247 if {!$load(C)} { 248 load [file join $testDir pkgua$ext] {} child 249 incr load(C) 250 } 251 if {!$load(T)} { 252 load [file join $testDir pkgua$ext] {} child-trusted 253 incr load(T) 254 } 255} -constraints [list $dll $loaded] -body { 256 list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ 257 [unload [file join $testDir pkgua$ext]] \ 258 [info commands pkgua_*] \ 259 [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] 260} -result {{. {} {}} {} {} {. . {}}} 261## Unload the package from the child safe interpreter... 262test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup { 263 if {!$load(C)} { 264 load [file join $testDir pkgua$ext] {} child 265 } 266 if {!$load(T)} { 267 load [file join $testDir pkgua$ext] {} child-trusted 268 incr load(T) 269 } 270} -constraints [list $dll $loaded] -body { 271 list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 272 [unload [file join $testDir pkgua$ext] {} child] \ 273 [child eval info commands pkgua_*] \ 274 [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 275} -result {{. {} {}} {} {} {. . {}}} 276## Unload the package from the child trusted interpreter... 277test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup { 278 if {!$load(T)} { 279 load [file join $testDir pkgua$ext] {} child-trusted 280 } 281} -constraints [list $dll $loaded] -body { 282 list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ 283 [unload [file join $testDir pkgua$ext] {} child-trusted] \ 284 [child-trusted eval info commands pkgua_*] \ 285 [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] 286} -result {{. {} {}} {} {} {. . .}} 287 288test unload-5.1 {unload a module loaded from vfs} \ 289 -constraints [list $dll $loaded testsimplefilesystem] \ 290 -setup { 291 set dir [pwd] 292 cd $testDir 293 testsimplefilesystem 1 294 load simplefs:/pkgua$ext pkgua 295 } \ 296 -body { 297 list [catch {unload simplefs:/pkgua$ext} msg] $msg 298 } \ 299 -result {0 {}} 300 301# cleanup 302interp delete child 303interp delete child-trusted 304unset ext 305::tcltest::cleanupTests 306return 307 308# Local Variables: 309# mode: tcl 310# End: 311