diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/apply.test | 34 | ||||
| -rw-r--r-- | tests/namespace-old.test | 16 | ||||
| -rw-r--r-- | tests/namespace.test | 36 | ||||
| -rw-r--r-- | tests/obj.test | 3 | ||||
| -rw-r--r-- | tests/upvar.test | 8 |
5 files changed, 45 insertions, 52 deletions
diff --git a/tests/apply.test b/tests/apply.test index 93c77a2..894aad3 100644 --- a/tests/apply.test +++ b/tests/apply.test @@ -12,10 +12,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: apply.test,v 1.10 2007/03/29 19:22:08 msofer Exp $ +# RCS: @(#) $Id: apply.test,v 1.11 2007/09/09 19:28:31 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2.2 namespace import -force ::tcltest::* } @@ -79,32 +79,26 @@ test apply-2.5 {malformed lambda} { # Tests for runtime errors in the lambda expression -test apply-3.1 {non-existing namespace} { - set lambda [list x {set x 1} ::NONEXIST::FOR::SURE] - set res [catch {apply $lambda x} msg] - list $res $msg -} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}} -test apply-3.2 {non-existing namespace} { +test apply-3.1 {non-existing namespace} -body { + apply [list x {set x 1} ::NONEXIST::FOR::SURE] x +} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} +test apply-3.2 {non-existing namespace} -body { namespace eval ::NONEXIST::FOR::SURE {} set lambda [list x {set x 1} ::NONEXIST::FOR::SURE] apply $lambda x namespace delete ::NONEXIST - set res [catch {apply $lambda x} msg] - list $res $msg -} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}} -test apply-3.3 {non-existing namespace} { - set lambda [list x {set x 1} NONEXIST::FOR::SURE] - set res [catch {apply $lambda x} msg] - list $res $msg -} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}} -test apply-3.4 {non-existing namespace} { + apply $lambda x +} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} +test apply-3.3 {non-existing namespace} -body { + apply [list x {set x 1} NONEXIST::FOR::SURE] x +} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} +test apply-3.4 {non-existing namespace} -body { namespace eval ::NONEXIST::FOR::SURE {} set lambda [list x {set x 1} NONEXIST::FOR::SURE] apply $lambda x namespace delete ::NONEXIST - set res [catch {apply $lambda x} msg] - list $res $msg -} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}} + apply $lambda x +} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} test apply-4.1 {error in arguments to lambda expression} { set lambda [list x {set x 1}] diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 7bfea61..1b0757e 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -14,10 +14,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace-old.test,v 1.11 2006/11/23 15:35:31 dkf Exp $ +# RCS: @(#) $Id: namespace-old.test,v 1.12 2007/09/09 19:28:31 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2.2 namespace import -force ::tcltest::* } @@ -336,9 +336,9 @@ test namespace-old-5.9 {usage for "namespace children"} { list [catch {namespace children test_ns_hier1 y z} msg] $msg } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}} -test namespace-old-5.10 {command "namespace children" must get valid namespace} { - list [catch {namespace children xyzzy} msg] $msg -} {1 {unknown namespace "xyzzy" in namespace children command}} +test namespace-old-5.10 {command "namespace children" must get valid namespace} -body { + namespace children xyzzy +} -returnCodes error -result {namespace "xyzzy" not found in "::"} test namespace-old-5.11 {querying namespace children} { lsort [namespace children :: test_ns_hier*] @@ -372,9 +372,9 @@ test namespace-old-5.18 {usage for "namespace parent"} { list [catch {namespace parent x y} msg] $msg } {1 {wrong # args: should be "namespace parent ?name?"}} -test namespace-old-5.19 {command "namespace parent" must get valid namespace} { - list [catch {namespace parent xyzzy} msg] $msg -} {1 {unknown namespace "xyzzy" in namespace parent command}} +test namespace-old-5.19 {command "namespace parent" must get valid namespace} -body { + namespace parent xyzzy +} -returnCodes error -result {namespace "xyzzy" not found in "::"} test namespace-old-5.20 {querying namespace parent} { list [namespace eval :: {namespace parent}] \ diff --git a/tests/namespace.test b/tests/namespace.test index 3228d72..3ef1e35 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.67 2007/06/12 12:34:04 dkf Exp $ +# RCS: @(#) $Id: namespace.test,v 1.68 2007/09/09 19:28:31 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -232,7 +232,7 @@ test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { [namespace children test_ns_1] \ [catch {namespace children test_ns_1::test_ns_2} msg] $msg \ [info commands test_ns_1::test_ns_2::test_ns_3a::*] -} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}} +} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}} test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} { catch {namespace delete {*}[namespace children :: test_ns_*]} namespace eval test_ns_export { @@ -572,7 +572,7 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} { list [catch {set ::test_ns_777::v} msg] $msg \ [catch {namespace children test_ns_777} msg] $msg } -} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}} +} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} test namespace-14.3 {TclGetNamespaceForQualName, relative names} { namespace eval test_ns_1 { list $v $test_ns_2::v @@ -586,7 +586,7 @@ test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up onl list [namespace children test_ns_2] \ [catch {namespace children test_ns_1} msg] $msg } -} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}} +} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval ::test_ns_2 { namespace eval bar {} @@ -604,7 +604,7 @@ test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up onl list [namespace children test_ns_2] \ [catch {namespace children test_ns_1} msg] $msg } -} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}} +} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} { namespace children test_ns_1::: } {::test_ns_1::test_ns_2} @@ -867,11 +867,11 @@ test namespace-19.2 {GetNamespaceFromObj, relative name found} { namespace children test_ns_2 } } {} -test namespace-19.3 {GetNamespaceFromObj, name not found} { +test namespace-19.3 {GetNamespaceFromObj, name not found} -body { namespace eval test_ns_1 { - list [catch {namespace children test_ns_99} msg] $msg + namespace children test_ns_99 } -} {1 {unknown namespace "test_ns_99" in namespace children command}} +} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"} test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} { namespace eval test_ns_1 { proc foo {} { @@ -1148,9 +1148,9 @@ test namespace-29.1 {NamespaceInscopeCmd, bad args} { test namespace-29.2 {NamespaceInscopeCmd, bad args} { list [catch {namespace inscope ::} msg] $msg } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} -test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} { - list [catch {namespace inscope test_ns_1 {set v}} msg] $msg -} {1 {unknown namespace "test_ns_1" in inscope namespace command}} +test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body { + namespace inscope test_ns_1 {set v} +} -returnCodes error -result {namespace "test_ns_1" not found in "::"} test namespace-29.4 {NamespaceInscopeCmd, simple case} { namespace eval test_ns_1 { variable v 747 @@ -1220,9 +1220,9 @@ test namespace-31.3 {NamespaceParentCmd, namespace specified} { [namespace parent test_ns_1::test_ns_2] \ [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}] } {{} ::test_ns_1 ::test_ns_1} -test namespace-31.4 {NamespaceParentCmd, bad namespace specified} { - list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg -} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}} +test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body { + namespace parent test_ns_1::test_ns_foo +} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"} test namespace-32.1 {NamespaceQualifiersCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} @@ -1368,11 +1368,11 @@ test namespace-37.1 {SetNsNameFromAny, ns name found} { namespace children ::test_ns_1 } } {::test_ns_1::test_ns_2} -test namespace-37.2 {SetNsNameFromAny, ns name not found} { +test namespace-37.2 {SetNsNameFromAny, ns name not found} -body { namespace eval test_ns_1 { - list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg + namespace children ::test_ns_1::test_ns_foo } -} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}} +} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found} test namespace-38.1 {UpdateStringOfNsName} { catch {namespace delete {*}[namespace children :: test_ns_*]} @@ -2334,7 +2334,7 @@ test namespace-51.10 {name resolution path control} -body { namespace eval ::test_ns_1 { namespace path does::not::exist } -} -returnCodes error -result {unknown namespace "does::not::exist"} -cleanup { +} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup { catch {namespace delete ::test_ns_1} } test namespace-51.11 {name resolution path control} -body { diff --git a/tests/obj.test b/tests/obj.test index 51c9e43..949128d 100644 --- a/tests/obj.test +++ b/tests/obj.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: obj.test,v 1.19 2005/10/08 14:42:54 dgp Exp $ +# RCS: @(#) $Id: obj.test,v 1.20 2007/09/09 19:28:31 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -31,7 +31,6 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes cmdName dict end-offset - nsName regexp string } { diff --git a/tests/upvar.test b/tests/upvar.test index 59d55a9..8cb9f36 100644 --- a/tests/upvar.test +++ b/tests/upvar.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: upvar.test,v 1.14 2006/11/03 00:34:53 hobbs Exp $ +# RCS: @(#) $Id: upvar.test,v 1.15 2007/09/09 19:28:32 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -455,7 +455,7 @@ test upvar-NS-1.3 {nsupvar links to correct variable} \ set w } } \ - -result {namespace "test_ns_0" does not exist} \ + -result {namespace "test_ns_0" not found in "::test_ns_1"} \ -returnCodes error \ -cleanup {namespace delete test_ns_1} @@ -469,7 +469,7 @@ test upvar-NS-1.4 {nsupvar links to correct variable} \ return [a] } } \ - -result {namespace "test_ns_0" does not exist} \ + -result {namespace "test_ns_0" not found in "::test_ns_1"} \ -returnCodes error \ -cleanup {namespace delete test_ns_1} @@ -540,7 +540,7 @@ test upvar-NS-1.9 {nsupvar links to correct variable} \ return [a] } } \ - -result {namespace "test_ns_0" does not exist} \ + -result {namespace "test_ns_0" not found in "::test_ns_1"} \ -returnCodes error \ -cleanup {namespace delete test_ns_1} |