summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/load.test133
1 files changed, 72 insertions, 61 deletions
diff --git a/tests/load.test b/tests/load.test
index db2d073..bd480b9 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.10 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: load.test,v 1.11 2003/02/01 23:37:29 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -41,22 +41,28 @@ set alreadyLoaded [info loaded]
set alreadyTotalLoaded [info loaded]
-test load-1.1 {basic errors} [list $dll $loaded] {
+# Certain tests require the 'teststaticpkg' command from tcltest
+
+::tcltest::testConstraint teststaticpkg \
+ [string compare {} [info commands teststaticpkg]]
+
+
+test load-1.1 {basic errors} {} {
list [catch {load} msg] $msg
-} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
-test load-1.2 {basic errors} [list $dll $loaded] {
+} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
+test load-1.2 {basic errors} {} {
list [catch {load a b c d} msg] $msg
-} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
-test load-1.3 {basic errors} [list $dll $loaded] {
+} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
+test load-1.3 {basic errors} {} {
list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
-test load-1.4 {basic errors} [list $dll $loaded] {
+test load-1.4 {basic errors} {} {
list [catch {load {}} msg] $msg
} {1 {must specify either file name or package name}}
-test load-1.5 {basic errors} [list $dll $loaded] {
+test load-1.5 {basic errors} {} {
list [catch {load {} {}} msg] $msg
} {1 {must specify either file name or package name}}
-test load-1.6 {basic errors} [list $dll $loaded] {
+test load-1.6 {basic errors} {} {
list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
@@ -133,63 +139,68 @@ test load-6.1 {errors loading file} [list $dll $loaded nonPortable] {
catch {load foo foo}
} {1}
-if {[info command teststaticpkg] != ""} {
- test load-7.1 {Tcl_StaticPackage procedure} [list $dll $loaded] {
- set x "not loaded"
- teststaticpkg Test 1 0
- load {} Test
- load {} Test child
- list [set x] [child eval set x]
- } {loaded loaded}
- test load-7.2 {Tcl_StaticPackage procedure} [list $dll $loaded] {
- set x "not loaded"
- teststaticpkg Another 0 0
- load {} Another
- child eval {set x "not loaded"}
- list [catch {load {} Another child} msg] $msg \
- [child eval set x] [set x]
- } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
- test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] {
- set x "not loaded"
- teststaticpkg More 0 1
- load {} More
- set x
- } {not loaded}
- test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
- [list $dll $loaded] {
+test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] {
+ set x "not loaded"
+ teststaticpkg Test 1 0
+ load {} Test
+ load {} Test child
+ list [set x] [child eval set x]
+} {loaded loaded}
+test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
+ set x "not loaded"
+ teststaticpkg Another 0 0
+ load {} Another
+ child eval {set x "not loaded"}
+ list [catch {load {} Another child} msg] $msg \
+ [child eval set x] [set x]
+} {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
+test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
+ set x "not loaded"
+ teststaticpkg More 0 1
+ load {} More
+ set x
+} {not loaded}
+test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
+ [list teststaticpkg $dll $loaded] {
teststaticpkg Double 0 1
teststaticpkg Double 0 1
info loaded
} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
- test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] {
- info loaded
- } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
- test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
- list [catch {info loaded gorp} msg] $msg
- } {1 {could not find interpreter "gorp"}}
- test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] {
- list [info loaded {}] [info loaded child]
- } [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
- test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] {
- load [file join $testDir pkgb$ext] pkgb
- list [info loaded {}] [lsort [info commands pkgb_*]]
- } [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}]
- interp delete child
-}
-
+test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+ info loaded
+} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
+test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] {
+ list [catch {info loaded gorp} msg] $msg
+} {1 {could not find interpreter "gorp"}}
+test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+ list [info loaded {}] [info loaded child]
+} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
+test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
+ load [file join $testDir pkgb$ext] pkgb
+ list [info loaded {}] [lsort [info commands pkgb_*]]
+} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}]
+interp delete child
+
+test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
+ -constraints {teststaticpkg} \
+ -setup {
+ interp create child1
+ interp create child2
+ load {} Tcltest child1
+ load {} Tcltest child2
+ } \
+ -body {
+ child1 eval { teststaticpkg Loadninepointone 0 1 }
+ child2 eval { teststaticpkg Loadninepointone 0 1 }
+ list \
+ [child1 eval { info loaded {} }] \
+ [child2 eval { info loaded {} }]
+ } \
+ -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \
+ -cleanup { interp delete child1 ; interp delete child2 }
+
+
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-