merge trunkinitsubsystems

1 files changed, 119 insertions, 51 deletions

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