summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/info.test3
-rw-r--r--tests/namespace.test389
2 files changed, 388 insertions, 4 deletions
diff --git a/tests/info.test b/tests/info.test
index 3441a3b..7295750 100644
--- a/tests/info.test
+++ b/tests/info.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: info.test,v 1.30 2005/05/25 16:13:17 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.31 2005/05/30 00:04:48 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -151,6 +151,7 @@ catch {rename _t2_ {}}
test info-4.5 {info commands option} {
list [catch {info commands a b} msg] $msg
} {1 {wrong # args: should be "info commands ?pattern?"}}
+# Also some tests in namespace.test
test info-5.1 {info complete option} {
list [catch {info complete} msg] $msg
diff --git a/tests/namespace.test b/tests/namespace.test
index 9341ecf..c611e9c 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.43 2004/10/29 15:39:10 dkf Exp $
+# RCS: @(#) $Id: namespace.test,v 1.44 2005/05/30 00:04:49 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -838,7 +838,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
list [catch {namespace wombat {}} msg] $msg
-} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
namespace ch :: test_ns_*
} {}
@@ -945,7 +945,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} {
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
test namespace-25.2 {NamespaceEvalCmd, bad args} {
list [catch {namespace test_ns_1} msg] $msg
-} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}}
catch {unset v}
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
set v 123
@@ -1956,6 +1956,389 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
rename a {}
}
+test namespace-51.1 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ proc pathtestA {} {
+ ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
+ }
+ proc pathtestC {} {
+ ::return 2
+ }
+ }
+ proc pathtestB {} {
+ return 1
+ }
+ proc pathtestC {} {
+ return 1
+ }
+ namespace path ::test_ns_1
+ }
+ proc ::pathtestB {} {
+ return global
+ }
+ proc ::pathtestD {} {
+ return global
+ }
+ test_ns_1::test_ns_2::pathtestA
+} -result "global,2,global," -cleanup {
+ namespace delete ::test_ns_1
+ catch {rename ::pathtestB {}}
+ catch {rename ::pathtestD {}}
+}
+test namespace-51.2 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ namespace path ::test_ns_1
+ proc pathtestA {} {
+ ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
+ }
+ proc pathtestC {} {
+ ::return 2
+ }
+ }
+ proc pathtestB {} {
+ return 1
+ }
+ proc pathtestC {} {
+ return 1
+ }
+ }
+ proc ::pathtestB {} {
+ return global
+ }
+ proc ::pathtestD {} {
+ return global
+ }
+ ::test_ns_1::test_ns_2::pathtestA
+} -result "1,2,global,::test_ns_1" -cleanup {
+ namespace delete ::test_ns_1
+ catch {rename ::pathtestB {}}
+ catch {rename ::pathtestD {}}
+}
+test namespace-51.3 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ proc pathtestA {} {
+ ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
+ }
+ proc pathtestC {} {
+ ::return 2
+ }
+ }
+ proc pathtestB {} {
+ return 1
+ }
+ proc pathtestC {} {
+ return 1
+ }
+ }
+ proc ::pathtestB {} {
+ return global
+ }
+ proc ::pathtestD {} {
+ return global
+ }
+ set result [::test_ns_1::test_ns_2::pathtestA]
+ namespace eval ::test_ns_1::test_ns_2 {
+ namespace path ::test_ns_1
+ }
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+ rename ::test_ns_1::pathtestB {}
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global,::test_ns_1" -cleanup {
+ namespace delete ::test_ns_1
+ catch {rename ::pathtestB {}}
+ catch {rename ::pathtestD {}}
+}
+test namespace-51.4 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ proc pathtestA {} {
+ ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
+ }
+ proc pathtestC {} {
+ ::return 2
+ }
+ }
+ proc pathtestB {} {
+ return 1
+ }
+ proc pathtestC {} {
+ return 1
+ }
+ }
+ proc ::pathtestB {} {
+ return global
+ }
+ proc ::pathtestD {} {
+ return global
+ }
+ set result [::test_ns_1::test_ns_2::pathtestA]
+ namespace eval ::test_ns_1::test_ns_2 {
+ namespace path ::test_ns_1
+ }
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+ namespace eval ::test_ns_1::test_ns_2 {
+ namespace path {}
+ }
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global," -cleanup {
+ namespace delete ::test_ns_1
+ catch {rename ::pathtestB {}}
+ catch {rename ::pathtestD {}}
+}
+test namespace-51.5 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ proc pathtestA {} {
+ ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
+ }
+ proc pathtestC {} {
+ ::return 2
+ }
+ namespace path ::test_ns_1
+ }
+ proc pathtestB {} {
+ return 1
+ }
+ proc pathtestC {} {
+ return 1
+ }
+ proc pathtestD {} {
+ return 1
+ }
+ }
+ proc ::pathtestB {} {
+ return global
+ }
+ proc ::pathtestD {} {
+ return global
+ }
+ set result [::test_ns_1::test_ns_2::pathtestA]
+ namespace eval ::test_ns_1::test_ns_2 {
+ namespace path {:: ::test_ns_1}
+ }
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+ rename ::test_ns_1::test_ns_2::pathtestC {}
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1}" -cleanup {
+ namespace delete ::test_ns_1
+ catch {rename ::pathtestB {}}
+ catch {rename ::pathtestD {}}
+}
+test namespace-51.6 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ proc pathtestA {} {
+ ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
+ }
+ proc pathtestC {} {
+ ::return 2
+ }
+ namespace path ::test_ns_1
+ }
+ proc pathtestB {} {
+ return 1
+ }
+ proc pathtestC {} {
+ return 1
+ }
+ proc pathtestD {} {
+ return 1
+ }
+ }
+ proc ::pathtestB {} {
+ return global
+ }
+ proc ::pathtestD {} {
+ return global
+ }
+ set result [::test_ns_1::test_ns_2::pathtestA]
+ namespace eval ::test_ns_1::test_ns_2 {
+ namespace path {:: ::test_ns_1}
+ }
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+ rename ::test_ns_1::test_ns_2::pathtestC {}
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+ proc ::pathtestC {} {
+ return global
+ }
+ lappend result [::test_ns_1::test_ns_2::pathtestA]
+} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1} {global,global,global,:: ::test_ns_1}" -cleanup {
+ namespace delete ::test_ns_1
+ catch {rename ::pathtestB {}}
+ catch {rename ::pathtestD {}}
+}
+test namespace-51.7 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ }
+ namespace eval ::test_ns_2 {
+ namespace path ::test_ns_1
+ proc getpath {} {namespace path}
+ }
+ list [::test_ns_2::getpath] [namespace delete ::test_ns_1] [::test_ns_2::getpath]
+} -result {::test_ns_1 {} {}} -cleanup {
+ catch {namespace delete ::test_ns_1}
+ namespace delete ::test_ns_2
+}
+test namespace-51.8 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ }
+ namespace eval ::test_ns_2 {
+ }
+ namespace eval ::test_ns_3 {
+ }
+ namespace eval ::test_ns_4 {
+ namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3}
+ proc getpath {} {namespace path}
+ }
+ list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [::test_ns_4::getpath]
+} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {::test_ns_1 ::test_ns_3}} -cleanup {
+ catch {namespace delete ::test_ns_1}
+ catch {namespace delete ::test_ns_2}
+ catch {namespace delete ::test_ns_3}
+ catch {namespace delete ::test_ns_4}
+}
+test namespace-51.9 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ }
+ namespace eval ::test_ns_2 {
+ }
+ namespace eval ::test_ns_3 {
+ }
+ namespace eval ::test_ns_4 {
+ namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3}
+ proc getpath {} {namespace path}
+ }
+ list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [namespace eval ::test_ns_2 {}] [::test_ns_4::getpath]
+} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {} {::test_ns_1 ::test_ns_3}} -cleanup {
+ catch {namespace delete ::test_ns_1}
+ catch {namespace delete ::test_ns_2}
+ catch {namespace delete ::test_ns_3}
+ catch {namespace delete ::test_ns_4}
+}
+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 {
+ catch {namespace delete ::test_ns_1}
+}
+test namespace-51.11 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ proc foo {} {return 1}
+ }
+ namespace eval ::test_ns_2 {
+ proc foo {} {return 2}
+ }
+ namespace eval ::test_ns_3 {
+ namespace path ::test_ns_1
+ }
+ namespace eval ::test_ns_4 {
+ namespace path {::test_ns_3 ::test_ns_2}
+ foo
+ }
+} -result 2 -cleanup {
+ catch {namespace delete ::test_ns_1}
+ catch {namespace delete ::test_ns_2}
+ catch {namespace delete ::test_ns_3}
+ catch {namespace delete ::test_ns_4}
+}
+test namespace-51.12 {name resolution path control} -body {
+ namespace eval ::test_ns_1 {
+ proc foo {} {return 1}
+ }
+ namespace eval ::test_ns_2 {
+ proc foo {} {return 2}
+ }
+ namespace eval ::test_ns_3 {
+ namespace path ::test_ns_1
+ }
+ namespace eval ::test_ns_4 {
+ namespace path {::test_ns_3 ::test_ns_2}
+ list [foo] [namespace delete ::test_ns_3] [foo]
+ }
+} -result {2 {} 2} -cleanup {
+ catch {namespace delete ::test_ns_1}
+ catch {namespace delete ::test_ns_2}
+ catch {namespace delete ::test_ns_3}
+ catch {namespace delete ::test_ns_4}
+}
+# Fails right now due to unrelated bug...
+test namespace-51.13 {name resolution path control} -constraints knownBug -body {
+ set ::result {}
+ namespace eval ::test_ns_1 {
+ proc foo {} {lappend ::result 1}
+ }
+ namespace eval ::test_ns_2 {
+ proc foo {} {lappend ::result 2}
+ trace add command foo delete {namespace eval ::test_ns_3 foo;#}
+ }
+ namespace eval ::test_ns_3 {
+ proc foo {} {
+ lappend ::result 3
+ namespace delete [namespace current]
+ ::test_ns_4::bar
+ }
+ }
+ namespace eval ::test_ns_4 {
+ namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1}
+ proc bar {} {
+ list [foo] [namespace delete ::test_ns_2] [foo]
+ }
+ bar
+ }
+ # Should the result be "2 {} {2 3 1 1}" instead?
+} -result {2 {} {2 3 2 1}} -cleanup {
+ catch {namespace delete ::test_ns_1}
+ catch {namespace delete ::test_ns_2}
+ catch {namespace delete ::test_ns_3}
+ catch {namespace delete ::test_ns_4}
+}
+test namespace-51.14 {name resolution path control} -body {
+ proc foo0 {} {}
+ namespace eval ::test_ns_1 {
+ proc foo1 {} {}
+ }
+ namespace eval ::test_ns_2 {
+ proc foo2 {} {}
+ }
+ namespace eval ::test_ns_3 {
+ variable result {}
+ lappend result [info commands foo*]
+ namespace path {::test_ns_1 ::test_ns_2}
+ lappend result [info commands foo*]
+ proc foo2 {} {}
+ lappend result [info commands foo*]
+ rename foo2 {}
+ lappend result [info commands foo*]
+ namespace delete ::test_ns_1
+ lappend result [info commands foo*]
+ }
+} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup {
+ catch {namespace delete ::test_ns_1}
+ catch {namespace delete ::test_ns_2}
+ catch {namespace delete ::test_ns_3}
+}
+test namespace-51.15 {namespace resolution path control} -body {
+ namespace eval ::test_ns_2 {
+ proc foo {} {return 2}
+ }
+ namespace eval ::test_ns_1 {
+ namespace eval test_ns_2 {
+ proc foo {} {return 1_2}
+ }
+ namespace eval test_ns_3 {
+ namespace path ::test_ns_1
+ test_ns_2::foo
+ }
+ }
+} -result 1_2 -cleanup {
+ namespace delete ::test_ns_1
+ namespace delete ::test_ns_2
+}
+
# cleanup
catch {rename cmd1 {}}
catch {unset l}
generated by cgit v0.12 at 2024-11-29 21:16:16 (GMT)