summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-11-08 18:28:56 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-11-08 18:28:56 (GMT)
commit50aa9cf6430fa3273369544087dea5fdf761e7a4 (patch)
tree0ec2a14e4ecc1b7e7511316b20a49da68dd4f7fe /tests
parentb896a6e4fe8cb265e2149fddf237aaec9f9c9c80 (diff)
downloadtcl-50aa9cf6430fa3273369544087dea5fdf761e7a4.zip
tcl-50aa9cf6430fa3273369544087dea5fdf761e7a4.tar.gz
tcl-50aa9cf6430fa3273369544087dea5fdf761e7a4.tar.bz2
* generic/tclPkg.c: Corrected inconsistencies in the value returned
* tests/pkg.test: by Tcl_PkgRequire(Ex) so that the returned values will always agree with what is stored in the package database. This way repeated calls to Tcl_PkgRequire(Ex) have the same results. Thanks to Hemang Lavana. [Bug 1162286]. * tests/namespace.test (25.7,8): Backport test of knownBug.
Diffstat (limited to 'tests')
-rw-r--r--tests/namespace.test14
-rw-r--r--tests/pkg.test223
2 files changed, 213 insertions, 24 deletions
diff --git a/tests/namespace.test b/tests/namespace.test
index 311f3af..9887ddc 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: namespace.test,v 1.21.2.6 2005/07/05 17:27:09 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.21.2.7 2005/11/08 18:28:56 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -961,6 +961,18 @@ test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
(in namespace eval "::test_ns_1" script line 1)
invoked from within
"namespace eval test_ns_1 {xxxx}"}}
+test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
+ list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
+} {1 foo {bar
+ (in namespace eval "::test_ns_1" script line 1)
+ invoked from within
+"namespace eval test_ns_1 {error foo bar baz}"}}
+test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} knownBug {
+ list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
+} {1 foo {bar
+ (in namespace eval "::test_ns_1" script line 1)
+ invoked from within
+"namespace eval test_ns_1 error foo bar baz"}}
catch {unset v}
test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
diff --git a/tests/pkg.test b/tests/pkg.test
index 9dd0784..74f91be 100644
--- a/tests/pkg.test
+++ b/tests/pkg.test
@@ -10,10 +10,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: pkg.test,v 1.9 2001/08/06 19:13:29 dgp Exp $
+# RCS: @(#) $Id: pkg.test,v 1.9.12.1 2005/11/08 18:28:56 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -21,7 +21,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# package list
set i [interp create]
interp eval $i [list set argv $argv]
-interp eval $i [list package require tcltest]
+interp eval $i [list package require tcltest 2]
interp eval $i [list namespace import -force ::tcltest::*]
interp eval $i {
@@ -130,22 +130,22 @@ test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
package unknown {}
list [catch {package require t} msg] $msg
} {1 {can't find package t}}
-test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} {
+test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
package forget t
package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
list [catch {package require t 2.1} msg] $msg $errorInfo
-} {1 {ifneeded test} {ifneeded test
+} -match glob -result {1 {ifneeded test} {ifneeded test
while executing
"error "ifneeded test""
- ("package ifneeded" script)
+ ("package ifneeded*" script)
invoked from within
"package require t 2.1"}}
-test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} {
+test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body {
package forget t
package ifneeded t 2.1 "set x invoked"
set x xxx
list [catch {package require t 2.1} msg] $msg $x
-} {1 {can't find package t 2.1} invoked}
+} -match glob -result {1 * invoked}
test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
package forget t
package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
@@ -261,6 +261,194 @@ test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
package provide t 2.3
list [catch {package require -exact t 2.2} msg] $msg
} {1 {version conflict for package "t": have 2.3, need 2.2}}
+test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
+ package forget t
+ package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
+ list [catch {package require t 2.1} msg] $msg $errorInfo
+} -match glob -result {1 {ifneeded test} {EI
+ ("package ifneeded*" script)
+ invoked from within
+"package require t 2.1"}} -constraints knownBug
+test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
+ package forget t
+ package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
+ list [catch {package require t 2.1} msg] $msg $errorInfo
+} -match glob -result {1 {ifneeded test} {EI
+ ("foreach" body line 1)
+ invoked from within
+"foreach x 1 {error "ifneeded test" EI}"
+ ("package ifneeded*" script)
+ invoked from within
+"package require t 2.1"}}
+test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package require foo 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {circular package dependency:*}
+test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package require foo 2}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {circular package dependency:*}
+test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+ package forget bar
+} -body {
+ package ifneeded foo 1 {package require bar 1; package provide foo 1}
+ package ifneeded bar 1 {package require foo 1; package provide bar 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package forget bar
+} -returnCodes error -match glob -result {circular package dependency:*}
+test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup {
+ package forget foo
+ package forget bar
+} -body {
+ package ifneeded foo 1 {package require bar 1; package provide foo 1}
+ package ifneeded foo 2 {package provide foo 2}
+ package ifneeded bar 1 {package require foo 2; package provide bar 1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package forget bar
+} -returnCodes error -match glob -result {circular package dependency:*}
+test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 1; error foo}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result foo
+test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 1; error foo}
+ catch {package require foo 1}
+ package provide foo
+} -cleanup {
+ package forget foo
+} -result {}
+test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 2}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {package provide foo 1.1}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {break}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {continue}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {return}
+ package require foo 1
+} -cleanup {
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+} -body {
+ package ifneeded foo 1 {proc x {} {return -code 10}; x}
+ package require foo 1
+} -cleanup {
+ rename x {}
+ package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {package provide foo 2 ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result *
+test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {break ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {continue ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ package unknown {return ;#}
+} -body {
+ package require foo 1
+} -cleanup {
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+ package forget foo
+ set saveUnknown [package unknown]
+ proc x args {return -code 10}
+ package unknown x
+} -body {
+ package require foo 1
+} -cleanup {
+ rename x {}
+ package forget foo
+ package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
test pkg-3.1 {Tcl_PackageCmd procedure} {
list [catch {package} msg] $msg
@@ -510,7 +698,7 @@ test pkg-4.1 {TclFreePackageInfo procedure} {
}
interp delete foo
} {}
-test pkg-4.2 {TclFreePackageInfo procedure} {
+test pkg-4.2 {TclFreePackageInfo procedure} -body {
interp create foo
foo eval {
package ifneeded t 2.3 x
@@ -522,8 +710,8 @@ test pkg-4.2 {TclFreePackageInfo procedure} {
proc kill {} {
interp delete foo
}
- list [catch {foo eval package require x 3.1} msg] $msg
-} {1 {can't find package x 3.1}}
+ foo eval package require x 3.1
+} -returnCodes error -match glob -result *
test pkg-5.1 {CheckVersion procedure} {
list [catch {package vcompare 1 2.1} msg] $msg
@@ -645,21 +833,10 @@ set auto_path $oldPath
package unknown $oldPkgUnknown
concat
+cleanupTests
}
# cleanup
interp delete $i
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-