sl@0: # Functionality covered: this file contains slightly modified versions of
sl@0: # the original tests written by Mike McLennan of Lucent Technologies for
sl@0: # the procedures in tclNamesp.c that implement Tcl's basic support for
sl@0: # namespaces. Other namespace-related tests appear in namespace.test
sl@0: # and variable.test.
sl@0: #
sl@0: # Sourcing this file into Tcl runs the tests and generates output for
sl@0: # errors. No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1997 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1997 Lucent Technologies
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: namespace-old.test,v 1.6 2001/04/07 02:11:19 msofer Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: # Clear out any namespaces called test_ns_*
sl@0: catch {eval namespace delete [namespace children :: test_ns_*]}
sl@0: 
sl@0: test namespace-old-1.1 {usage for "namespace" command} {
sl@0:     list [catch {namespace} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
sl@0: 
sl@0: test namespace-old-1.2 {global namespace's name is "::" or {}} {
sl@0:     list [namespace current] [namespace eval {} {namespace current}]
sl@0: } {:: ::}
sl@0: 
sl@0: test namespace-old-1.3 {usage for "namespace eval"} {
sl@0:     list [catch {namespace eval} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
sl@0: 
sl@0: test namespace-old-1.4 {create new namespaces} {
sl@0:     list [lsort [namespace children :: test_ns_simple*]] \
sl@0: 	 [namespace eval test_ns_simple {}] \
sl@0: 	 [namespace eval test_ns_simple2 {}] \
sl@0:          [lsort [namespace children :: test_ns_simple*]]
sl@0: } {{} {} {} {::test_ns_simple ::test_ns_simple2}}
sl@0: 
sl@0: test namespace-old-1.5 {access a new namespace} {
sl@0:     namespace eval test_ns_simple { namespace current }
sl@0: } {::test_ns_simple}
sl@0: 
sl@0: test namespace-old-1.6 {usage for "namespace eval"} {
sl@0:     list [catch {namespace eval} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
sl@0: 
sl@0: test namespace-old-1.7 {usage for "namespace eval"} {
sl@0:     list [catch {namespace eval test_ns_xyzzy} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
sl@0: 
sl@0: test namespace-old-1.8 {command "namespace eval" concatenates args} {
sl@0:     namespace eval test_ns_simple namespace current
sl@0: } {::test_ns_simple}
sl@0: 
sl@0: test namespace-old-1.9 {add elements to a namespace} {
sl@0:     namespace eval test_ns_simple {
sl@0:         variable test_ns_x 0
sl@0:         proc test {test_ns_x} {
sl@0:             return "test: $test_ns_x"
sl@0:         }
sl@0:     }
sl@0: } {}
sl@0: 
sl@0: test namespace-old-1.10 {commands in a namespace} {
sl@0:     namespace eval test_ns_simple { info commands [namespace current]::*}
sl@0: } {::test_ns_simple::test}
sl@0: 
sl@0: test namespace-old-1.11 {variables in a namespace} {
sl@0:     namespace eval test_ns_simple { info vars [namespace current]::* }
sl@0: } {::test_ns_simple::test_ns_x}
sl@0: 
sl@0: test namespace-old-1.12 {global vars are separate from locals vars} {
sl@0:     list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
sl@0: } {{test: 123} 0}
sl@0: 
sl@0: test namespace-old-1.13 {add to an existing namespace} {
sl@0:     namespace eval test_ns_simple {
sl@0:         variable test_ns_y 123
sl@0:         proc _backdoor {cmd} {
sl@0:             eval $cmd
sl@0:         }
sl@0:     }
sl@0: } ""
sl@0: 
sl@0: test namespace-old-1.14 {commands in a namespace} {
sl@0:     lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
sl@0: } {::test_ns_simple::_backdoor ::test_ns_simple::test}
sl@0: 
sl@0: test namespace-old-1.15 {variables in a namespace} {
sl@0:     lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
sl@0: } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0: test namespace-old-1.16 {variables in a namespace} {
sl@0:     lsort [info vars test_ns_simple::*]
sl@0: } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0: 
sl@0: test namespace-old-1.17 {commands in a namespace are hidden} {
sl@0:     list [catch "_backdoor {return yes!}" msg] $msg
sl@0: } {1 {invalid command name "_backdoor"}}
sl@0: test namespace-old-1.18 {using namespace qualifiers} {
sl@0:     list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
sl@0: } {0 yes!}
sl@0: test namespace-old-1.19 {using absolute namespace qualifiers} {
sl@0:     list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
sl@0: } {0 yes!}
sl@0: 
sl@0: test namespace-old-1.20 {variables in a namespace are hidden} {
sl@0:     list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
sl@0: } {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
sl@0: test namespace-old-1.21 {using namespace qualifiers} {
sl@0:     list [catch "set test_ns_simple::test_ns_x" msg] $msg \
sl@0:          [catch "set test_ns_simple::test_ns_y" msg] $msg
sl@0: } {0 0 0 123}
sl@0: test namespace-old-1.22 {using absolute namespace qualifiers} {
sl@0:     list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
sl@0:          [catch "set ::test_ns_simple::test_ns_y" msg] $msg
sl@0: } {0 0 0 123}
sl@0: test namespace-old-1.23 {variables can be accessed within a namespace} {
sl@0:     test_ns_simple::_backdoor {
sl@0:         variable test_ns_x
sl@0:         variable test_ns_y
sl@0:         return "$test_ns_x $test_ns_y"
sl@0:     }
sl@0: } {0 123}
sl@0: 
sl@0: test namespace-old-1.24 {setting global variables} {
sl@0:     test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
sl@0:     namespace eval test_ns_simple {set test_ns_x}
sl@0: } {new val}
sl@0: 
sl@0: test namespace-old-1.25 {qualified variables don't need a global declaration} {
sl@0:     namespace eval test_ns_another { variable test_ns_x 456 }
sl@0:     set cmd {set ::test_ns_another::test_ns_x}
sl@0:     list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
sl@0:          [eval $cmd]
sl@0: } {0 some-value some-value}
sl@0: 
sl@0: test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
sl@0:     namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
sl@0:     set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
sl@0:     list [test_ns_simple::_backdoor $cmd] [eval $cmd]
sl@0: } {{12 34} {12 34}}
sl@0: 
sl@0: test namespace-old-1.27 {can create commands with null names} {
sl@0:     proc test_ns_simple:: {args} {return $args}
sl@0: } {}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: using "info" in namespace contexts
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-2.1 {querying:  info commands} {
sl@0:     lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
sl@0: } {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
sl@0: 
sl@0: test namespace-old-2.2 {querying:  info procs} {
sl@0:     lsort [test_ns_simple::_backdoor {info procs}]
sl@0: } {{} _backdoor test}
sl@0: 
sl@0: test namespace-old-2.3 {querying:  info vars} {
sl@0:     lsort [info vars test_ns_simple::*]
sl@0: } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0: 
sl@0: test namespace-old-2.4 {querying:  info vars} {
sl@0:     lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
sl@0: } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0: 
sl@0: test namespace-old-2.5 {querying:  info locals} {
sl@0:     lsort [test_ns_simple::_backdoor {info locals}]
sl@0: } {cmd}
sl@0: 
sl@0: test namespace-old-2.6 {querying:  info exists} {
sl@0:     test_ns_simple::_backdoor {info exists test_ns_x}
sl@0: } {0}
sl@0: 
sl@0: test namespace-old-2.7 {querying:  info exists} {
sl@0:     test_ns_simple::_backdoor {info exists cmd}
sl@0: } {1}
sl@0: 
sl@0: test namespace-old-2.8 {querying:  info args} {
sl@0:     info args test_ns_simple::_backdoor
sl@0: } {cmd}
sl@0: 
sl@0: test namespace-old-2.9 {querying:  info body} {
sl@0:     string trim [info body test_ns_simple::test]
sl@0: } {return "test: $test_ns_x"}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: namespace qualifiers, namespace tail
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-3.1 {usage for "namespace qualifiers"} {
sl@0:     list [catch "namespace qualifiers" msg] $msg
sl@0: } {1 {wrong # args: should be "namespace qualifiers string"}}
sl@0: 
sl@0: test namespace-old-3.2 {querying:  namespace qualifiers} {
sl@0:     list [namespace qualifiers ""] \
sl@0:          [namespace qualifiers ::] \
sl@0:          [namespace qualifiers x] \
sl@0:          [namespace qualifiers ::x] \
sl@0:          [namespace qualifiers foo::x] \
sl@0:          [namespace qualifiers ::foo::bar::xyz]
sl@0: } {{} {} {} {} foo ::foo::bar}
sl@0: 
sl@0: test namespace-old-3.3 {usage for "namespace tail"} {
sl@0:     list [catch "namespace tail" msg] $msg
sl@0: } {1 {wrong # args: should be "namespace tail string"}}
sl@0: 
sl@0: test namespace-old-3.4 {querying:  namespace tail} {
sl@0:     list [namespace tail ""] \
sl@0:          [namespace tail ::] \
sl@0:          [namespace tail x] \
sl@0:          [namespace tail ::x] \
sl@0:          [namespace tail foo::x] \
sl@0:          [namespace tail ::foo::bar::xyz]
sl@0: } {{} {} x x x xyz}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: delete commands and namespaces
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-4.1 {define test namespaces} {
sl@0:     namespace eval test_ns_delete {
sl@0:         namespace eval ns1 {
sl@0:             variable var1 1
sl@0:             proc cmd1 {} {return "cmd1"}
sl@0:         }
sl@0:         namespace eval ns2 {
sl@0:             variable var2 2
sl@0:             proc cmd2 {} {return "cmd2"}
sl@0:         }
sl@0:         namespace eval another {}
sl@0:         lsort [namespace children]
sl@0:     }
sl@0: } {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
sl@0: 
sl@0: test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
sl@0:     list [catch {namespace delete} msg] $msg
sl@0: } {0 {}}
sl@0: 
sl@0: test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
sl@0:     set cmd {
sl@0:         namespace eval test_ns_delete {namespace delete ns*}
sl@0:     }
sl@0:     list [catch $cmd msg] $msg
sl@0: } {1 {unknown namespace "ns*" in namespace delete command}}
sl@0: 
sl@0: test namespace-old-4.4 {command "namespace delete" handles multiple args} {
sl@0:     set cmd {
sl@0:         namespace eval test_ns_delete {
sl@0:             eval namespace delete \
sl@0:                 [namespace children [namespace current] ns?]
sl@0:         }
sl@0:     }
sl@0:     list [catch $cmd msg] $msg [namespace children test_ns_delete]
sl@0: } {0 {} ::test_ns_delete::another}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: namespace hierarchy
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-5.1 {define nested namespaces} {
sl@0:     set test_ns_var_global "var in ::"
sl@0:     proc test_ns_cmd_global {} {return "cmd in ::"}
sl@0: 
sl@0:     namespace eval test_ns_hier1 {
sl@0:         set test_ns_var_hier1 "particular to hier1"
sl@0:         proc test_ns_cmd_hier1 {} {return "particular to hier1"}
sl@0: 
sl@0:         set test_ns_level 1
sl@0:         proc test_ns_show {} {return "[namespace current]: 1"}
sl@0: 
sl@0:         namespace eval test_ns_hier2 {
sl@0:             set test_ns_var_hier2 "particular to hier2"
sl@0:             proc test_ns_cmd_hier2 {} {return "particular to hier2"}
sl@0: 
sl@0:             set test_ns_level 2
sl@0:             proc test_ns_show {} {return "[namespace current]: 2"}
sl@0: 
sl@0:             namespace eval test_ns_hier3a {}
sl@0:             namespace eval test_ns_hier3b {}
sl@0:         }
sl@0: 
sl@0:         namespace eval test_ns_hier2a {}
sl@0:         namespace eval test_ns_hier2b {}
sl@0:     }
sl@0: } {}
sl@0: 
sl@0: test namespace-old-5.2 {namespaces can be nested} {
sl@0:     list [namespace eval test_ns_hier1 {namespace current}] \
sl@0:          [namespace eval test_ns_hier1 {
sl@0:               namespace eval test_ns_hier2 {namespace current}
sl@0:           }]
sl@0: } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
sl@0: 
sl@0: test namespace-old-5.3 {namespace qualifiers work in namespace command} {
sl@0:     list [namespace eval ::test_ns_hier1 {namespace current}] \
sl@0:          [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
sl@0:          [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
sl@0: } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
sl@0: 
sl@0: test namespace-old-5.4 {nested namespaces can access global namespace} {
sl@0:     list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
sl@0:          [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
sl@0:          [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
sl@0:          [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
sl@0: } {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
sl@0: 
sl@0: test namespace-old-5.5 {variables in different namespaces don't conflict} {
sl@0:     list [set test_ns_hier1::test_ns_level] \
sl@0:          [set test_ns_hier1::test_ns_hier2::test_ns_level]
sl@0: } {1 2}
sl@0: 
sl@0: test namespace-old-5.6 {commands in different namespaces don't conflict} {
sl@0:     list [test_ns_hier1::test_ns_show] \
sl@0:          [test_ns_hier1::test_ns_hier2::test_ns_show]
sl@0: } {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
sl@0: 
sl@0: test namespace-old-5.7 {nested namespaces don't see variables in parent} {
sl@0:     set cmd {
sl@0:         namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
sl@0:     }
sl@0:     list [catch $cmd msg] $msg
sl@0: } {1 {can't read "test_ns_var_hier1": no such variable}}
sl@0: 
sl@0: test namespace-old-5.8 {nested namespaces don't see commands in parent} {
sl@0:     set cmd {
sl@0:         namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
sl@0:     }
sl@0:     list [catch $cmd msg] $msg
sl@0: } {1 {invalid command name "test_ns_cmd_hier1"}}
sl@0: 
sl@0: test namespace-old-5.9 {usage for "namespace children"} {
sl@0:     list [catch {namespace children test_ns_hier1 y z} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
sl@0: 
sl@0: test namespace-old-5.10 {command "namespace children" must get valid namespace} {
sl@0:     list [catch {namespace children xyzzy} msg] $msg
sl@0: } {1 {unknown namespace "xyzzy" in namespace children command}}
sl@0: 
sl@0: test namespace-old-5.11 {querying namespace children} {
sl@0:     lsort [namespace children :: test_ns_hier*]
sl@0: } {::test_ns_hier1}
sl@0: 
sl@0: test namespace-old-5.12 {querying namespace children} {
sl@0:     lsort [namespace children test_ns_hier1]
sl@0: } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
sl@0: 
sl@0: test namespace-old-5.13 {querying namespace children} {
sl@0:     lsort [namespace eval test_ns_hier1 {namespace children}]
sl@0: } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
sl@0: 
sl@0: test namespace-old-5.14 {querying namespace children} {
sl@0:     lsort [namespace children test_ns_hier1::test_ns_hier2]
sl@0: } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0: 
sl@0: test namespace-old-5.15 {querying namespace children} {
sl@0:     lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
sl@0: } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0: 
sl@0: test namespace-old-5.16 {querying namespace children with patterns} {
sl@0:     lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
sl@0: } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0: 
sl@0: test namespace-old-5.17 {querying namespace children with patterns} {
sl@0:     lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
sl@0: } {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0: 
sl@0: test namespace-old-5.18 {usage for "namespace parent"} {
sl@0:     list [catch {namespace parent x y} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace parent ?name?"}}
sl@0: 
sl@0: test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
sl@0:     list [catch {namespace parent xyzzy} msg] $msg
sl@0: } {1 {unknown namespace "xyzzy" in namespace parent command}}
sl@0: 
sl@0: test namespace-old-5.20 {querying namespace parent} {
sl@0:     list [namespace eval :: {namespace parent}] \
sl@0:         [namespace eval test_ns_hier1 {namespace parent}] \
sl@0:         [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
sl@0:         [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
sl@0: } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
sl@0: 
sl@0: test namespace-old-5.21 {querying namespace parent for explicit namespace} {
sl@0:     list [namespace parent ::] \
sl@0:          [namespace parent test_ns_hier1] \
sl@0:          [namespace parent test_ns_hier1::test_ns_hier2] \
sl@0:          [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
sl@0: } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: name resolution and caching
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-6.1 {relative ns names only looked up in current ns} {
sl@0:     namespace eval test_ns_cache1 {}
sl@0:     namespace eval test_ns_cache2 {}
sl@0:     namespace eval test_ns_cache2::test_ns_cache3 {}
sl@0:     set trigger {
sl@0:         namespace eval test_ns_cache2 {namespace current}
sl@0:     }
sl@0:     set trigger2 {
sl@0:         namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
sl@0:     }
sl@0:     list [namespace eval test_ns_cache1 $trigger] \
sl@0:          [namespace eval test_ns_cache1 $trigger2]
sl@0: } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0: 
sl@0: test namespace-old-6.2 {relative ns names only looked up in current ns} {
sl@0:     namespace eval test_ns_cache1::test_ns_cache2 {}
sl@0:     list [namespace eval test_ns_cache1 $trigger] \
sl@0:          [namespace eval test_ns_cache1 $trigger2]
sl@0: } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0: 
sl@0: test namespace-old-6.3 {relative ns names only looked up in current ns} {
sl@0:     namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
sl@0:     list [namespace eval test_ns_cache1 $trigger] \
sl@0:          [namespace eval test_ns_cache1 $trigger2]
sl@0: } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0: 
sl@0: test namespace-old-6.4 {relative ns names only looked up in current ns} {
sl@0:     namespace delete test_ns_cache1::test_ns_cache2
sl@0:     list [namespace eval test_ns_cache1 $trigger] \
sl@0:          [namespace eval test_ns_cache1 $trigger2]
sl@0: } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0: 
sl@0: test namespace-old-6.5 {define test commands} {
sl@0:     proc test_ns_cache_cmd {} {
sl@0:         return "global version"
sl@0:     }
sl@0:     namespace eval test_ns_cache1 {
sl@0:         proc trigger {} {
sl@0:             test_ns_cache_cmd
sl@0:         }
sl@0:     }
sl@0:     test_ns_cache1::trigger
sl@0: } {global version}
sl@0: 
sl@0: test namespace-old-6.6 {one-level check for command shadowing} {
sl@0:     proc test_ns_cache1::test_ns_cache_cmd {} {
sl@0:         return "cache1 version"
sl@0:     }
sl@0:     test_ns_cache1::trigger
sl@0: } {cache1 version}
sl@0: 
sl@0: test namespace-old-6.7 {renaming commands changes command epoch} {
sl@0:     namespace eval test_ns_cache1 {
sl@0:         rename test_ns_cache_cmd test_ns_new
sl@0:     }
sl@0:     test_ns_cache1::trigger
sl@0: } {global version}
sl@0: 
sl@0: test namespace-old-6.8 {renaming back handles shadowing} {
sl@0:     namespace eval test_ns_cache1 {
sl@0:         rename test_ns_new test_ns_cache_cmd
sl@0:     }
sl@0:     test_ns_cache1::trigger
sl@0: } {cache1 version}
sl@0: 
sl@0: test namespace-old-6.9 {deleting commands changes command epoch} {
sl@0:     namespace eval test_ns_cache1 {
sl@0:         rename test_ns_cache_cmd ""
sl@0:     }
sl@0:     test_ns_cache1::trigger
sl@0: } {global version}
sl@0: 
sl@0: test namespace-old-6.10 {define test namespaces} {
sl@0:     namespace eval test_ns_cache2 {
sl@0:         proc test_ns_cache_cmd {} {
sl@0:             return "global cache2 version"
sl@0:         }
sl@0:     }
sl@0:     namespace eval test_ns_cache1 {
sl@0:         proc trigger {} {
sl@0:             test_ns_cache2::test_ns_cache_cmd
sl@0:         }
sl@0:     }
sl@0:     namespace eval test_ns_cache1::test_ns_cache2 {
sl@0:         proc trigger {} {
sl@0:             test_ns_cache_cmd
sl@0:         }
sl@0:     }
sl@0:     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
sl@0: } {{global cache2 version} {global version}}
sl@0: 
sl@0: test namespace-old-6.11 {commands affect all parent namespaces} {
sl@0:     proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
sl@0:         return "cache2 version"
sl@0:     }
sl@0:     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
sl@0: } {{cache2 version} {cache2 version}}
sl@0: 
sl@0: test namespace-old-6.12 {define test variables} {
sl@0:     variable test_ns_cache_var "global version"
sl@0:     set trigger {set test_ns_cache_var}
sl@0:     namespace eval test_ns_cache1 $trigger
sl@0: } {global version}
sl@0: 
sl@0: test namespace-old-6.13 {one-level check for variable shadowing} {
sl@0:     namespace eval test_ns_cache1 {
sl@0:         variable test_ns_cache_var "cache1 version"
sl@0:     }
sl@0:     namespace eval test_ns_cache1 $trigger
sl@0: } {cache1 version}
sl@0: 
sl@0: test namespace-old-6.14 {deleting variables changes variable epoch} {
sl@0:     namespace eval test_ns_cache1 {
sl@0:         unset test_ns_cache_var
sl@0:     }
sl@0:     namespace eval test_ns_cache1 $trigger
sl@0: } {global version}
sl@0: 
sl@0: test namespace-old-6.15 {define test namespaces} {
sl@0:     namespace eval test_ns_cache2 {
sl@0:         variable test_ns_cache_var "global cache2 version"
sl@0:     }
sl@0:     set trigger2 {set test_ns_cache2::test_ns_cache_var}
sl@0:     list [namespace eval test_ns_cache1 $trigger2] \
sl@0:          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
sl@0: } {{global cache2 version} {global version}}
sl@0: 
sl@0: test namespace-old-6.16 {public variables affect all parent namespaces} {
sl@0:     variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
sl@0:     list [namespace eval test_ns_cache1 $trigger2] \
sl@0:          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
sl@0: } {{cache2 version} {cache2 version}}
sl@0: 
sl@0: test namespace-old-6.17 {usage for "namespace which"} {
sl@0:     list [catch "namespace which -baz" msg] $msg
sl@0: } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
sl@0: test namespace-old-6.18 {usage for "namespace which"} {
sl@0:     list [catch "namespace which -command" msg] $msg
sl@0: } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
sl@0: 
sl@0: test namespace-old-6.19 {querying:  namespace which -command} {
sl@0:     proc test_ns_cache1::test_ns_cache_cmd {} {
sl@0:         return "cache1 version"
sl@0:     }
sl@0:     list [namespace eval :: {namespace which test_ns_cache_cmd}] \
sl@0:          [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
sl@0:          [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
sl@0:          [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
sl@0: } {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
sl@0: 
sl@0: test namespace-old-6.20 {command "namespace which" may not find commands} {
sl@0:     namespace eval test_ns_cache1 {namespace which -command xyzzy}
sl@0: } {}
sl@0: 
sl@0: test namespace-old-6.21 {querying:  namespace which -variable} {
sl@0:     namespace eval test_ns_cache1::test_ns_cache2 {
sl@0:         namespace which -variable test_ns_cache_var
sl@0:     }
sl@0: } {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
sl@0: 
sl@0: test namespace-old-6.22 {command "namespace which" may not find variables} {
sl@0:     namespace eval test_ns_cache1 {namespace which -variable xyzzy}
sl@0: } {}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: uplevel/upvar across namespace boundaries
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-7.1 {define test namespace} {
sl@0:     namespace eval test_ns_uplevel {
sl@0:         variable x 0
sl@0:         variable y 1
sl@0: 
sl@0:         proc show_vars {num} {
sl@0:             return [uplevel $num {info vars}]
sl@0:         }
sl@0:         proc test_uplevel {num} {
sl@0:             set a 0
sl@0:             set b 1
sl@0:             namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
sl@0:         }
sl@0:     }
sl@0: } {}
sl@0: test namespace-old-7.2 {uplevel can access namespace call frame} {
sl@0:     list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
sl@0:          [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
sl@0: } {1 1}
sl@0: test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
sl@0:     lsort [test_ns_uplevel::test_uplevel 2]
sl@0: } {a b num}
sl@0: test namespace-old-7.4 {uplevel can go up to global context} {
sl@0:     expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
sl@0: } {1}
sl@0: 
sl@0: test namespace-old-7.5 {absolute call frame references work too} {
sl@0:     list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
sl@0:          [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
sl@0: } {1 1}
sl@0: test namespace-old-7.6 {absolute call frame references work too} {
sl@0:     lsort [test_ns_uplevel::test_uplevel #1]
sl@0: } {a b num}
sl@0: test namespace-old-7.7 {absolute call frame references work too} {
sl@0:     expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
sl@0: } {1}
sl@0: 
sl@0: test namespace-old-7.8 {namespaces are included in the call stack} {
sl@0:     namespace eval test_ns_upvar {
sl@0:         variable scope "test_ns_upvar"
sl@0: 
sl@0:         proc show_val {var num} {
sl@0:             upvar $num $var x
sl@0:             return $x
sl@0:         }
sl@0:         proc test_upvar {num} {
sl@0:             set scope "test_ns_upvar::test_upvar"
sl@0:             namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
sl@0:         }
sl@0:     }
sl@0: } {}
sl@0: test namespace-old-7.9 {upvar can access namespace call frame} {
sl@0:     test_ns_upvar::test_upvar 1
sl@0: } {test_ns_upvar}
sl@0: test namespace-old-7.10 {upvar can go beyond namespace call frame} {
sl@0:     test_ns_upvar::test_upvar 2
sl@0: } {test_ns_upvar::test_upvar}
sl@0: test namespace-old-7.11 {absolute call frame references work too} {
sl@0:     test_ns_upvar::test_upvar #2
sl@0: } {test_ns_upvar}
sl@0: test namespace-old-7.12 {absolute call frame references work too} {
sl@0:     test_ns_upvar::test_upvar #1
sl@0: } {test_ns_upvar::test_upvar}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: variable traces across namespace boundaries
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-8.1 {traces work across namespace boundaries} {
sl@0:     namespace eval test_ns_trace {
sl@0:         namespace eval foo {
sl@0:             variable x ""
sl@0:         }
sl@0: 
sl@0:         variable status ""
sl@0:         proc monitor {name1 name2 op} {
sl@0:             variable status
sl@0:             lappend status "$op: $name1"
sl@0:         }
sl@0:         trace variable foo::x rwu [namespace code monitor]
sl@0:     }
sl@0:     set test_ns_trace::foo::x "yes!"
sl@0:     set test_ns_trace::foo::x
sl@0:     unset test_ns_trace::foo::x
sl@0: 
sl@0:     namespace eval test_ns_trace { set status }
sl@0: } {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: imported commands
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-9.1 {empty "namespace export" list} {
sl@0:     list [catch "namespace export" msg] $msg
sl@0: } {0 {}}
sl@0: test namespace-old-9.2 {usage for "namespace export" command} {
sl@0:     list [catch "namespace export test_ns_trace::zzz" msg] $msg
sl@0: } {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
sl@0: 
sl@0: test namespace-old-9.3 {define test namespaces for import} {
sl@0:     namespace eval test_ns_export {
sl@0:         namespace export cmd1 cmd2 cmd3
sl@0:         proc cmd1 {args} {return "cmd1: $args"}
sl@0:         proc cmd2 {args} {return "cmd2: $args"}
sl@0:         proc cmd3 {args} {return "cmd3: $args"}
sl@0:         proc cmd4 {args} {return "cmd4: $args"}
sl@0:         proc cmd5 {args} {return "cmd5: $args"}
sl@0:         proc cmd6 {args} {return "cmd6: $args"}
sl@0:     }
sl@0:     lsort [info commands test_ns_export::*]
sl@0: } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
sl@0: 
sl@0: test namespace-old-9.4 {check export status} {
sl@0:     set x ""
sl@0:     namespace eval test_ns_import {
sl@0:         namespace export cmd1 cmd2
sl@0:         namespace import ::test_ns_export::*
sl@0:     }
sl@0:     foreach cmd [lsort [info commands test_ns_import::*]] {
sl@0:         lappend x $cmd
sl@0:     }
sl@0:     set x
sl@0: } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
sl@0: 
sl@0: test namespace-old-9.5 {empty import list in "namespace import" command} {
sl@0:     namespace import
sl@0: } {}
sl@0: 
sl@0: test namespace-old-9.6 {empty import list for "namespace import" command} {
sl@0:     namespace import
sl@0: } {}
sl@0: 
sl@0: test namespace-old-9.7 {empty forget list for "namespace forget" command} {
sl@0:     namespace forget
sl@0: } {}
sl@0: 
sl@0: catch {rename cmd1 {}}
sl@0: catch {rename cmd2 {}}
sl@0: catch {rename ncmd {}}
sl@0: catch {rename ncmd1 {}}
sl@0: catch {rename ncmd2 {}}
sl@0: test namespace-old-9.8 {only exported commands are imported} {
sl@0:     namespace import test_ns_import::cmd*
sl@0:     set x [lsort [info commands cmd*]]
sl@0: } {cmd1 cmd2}
sl@0: 
sl@0: test namespace-old-9.9 {imported commands work just the same as original} {
sl@0:     list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
sl@0: } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
sl@0: 
sl@0: test namespace-old-9.10 {commands can be imported from many namespaces} {
sl@0:     namespace eval test_ns_import2 {
sl@0:         namespace export ncmd ncmd1 ncmd2
sl@0:         proc ncmd  {args} {return "ncmd: $args"}
sl@0:         proc ncmd1 {args} {return "ncmd1: $args"}
sl@0:         proc ncmd2 {args} {return "ncmd2: $args"}
sl@0:         proc ncmd3 {args} {return "ncmd3: $args"}
sl@0:     }
sl@0:     namespace import test_ns_import2::*
sl@0:     lsort [concat [info commands cmd*] [info commands ncmd*]]
sl@0: } {cmd1 cmd2 ncmd ncmd1 ncmd2}
sl@0: 
sl@0: test namespace-old-9.11 {imported commands can be removed by deleting them} {
sl@0:     rename cmd1 ""
sl@0:     lsort [concat [info commands cmd*] [info commands ncmd*]]
sl@0: } {cmd2 ncmd ncmd1 ncmd2}
sl@0: 
sl@0: test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
sl@0:     list [catch {namespace forget xyzzy::*} msg] $msg
sl@0: } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
sl@0: 
sl@0: test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
sl@0:     list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
sl@0:          [lsort [info commands cmd?]]
sl@0: } {0 {} cmd2}
sl@0: 
sl@0: test namespace-old-9.14 {imported commands can be removed} {
sl@0:     namespace forget test_ns_import::cmd?
sl@0:     list [lsort [info commands cmd?]] \
sl@0:          [catch {cmd1 another test} msg] $msg
sl@0: } {{} 1 {invalid command name "cmd1"}}
sl@0: 
sl@0: test namespace-old-9.15 {existing commands can't be overwritten} {
sl@0:     proc cmd1 {x y} {
sl@0:         return [expr $x+$y]
sl@0:     }
sl@0:     list [catch {namespace import test_ns_import::cmd?} msg] $msg \
sl@0:          [cmd1 3 5]
sl@0: } {1 {can't import command "cmd1": already exists} 8}
sl@0: 
sl@0: test namespace-old-9.16 {use "-force" option to override existing commands} {
sl@0:     list [cmd1 3 5] \
sl@0:          [namespace import -force test_ns_import::cmd?] \
sl@0:          [cmd1 3 5]
sl@0: } {8 {} {cmd1: 3 5}}
sl@0: 
sl@0: test namespace-old-9.17 {commands can be imported into many namespaces} {
sl@0:     namespace eval test_ns_import_use {
sl@0:         namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
sl@0:         lsort [concat [info commands ::test_ns_import_use::cmd*] \
sl@0:                       [info commands ::test_ns_import_use::ncmd*]]
sl@0:     }
sl@0: } {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
sl@0: 
sl@0: test namespace-old-9.18 {when command is deleted, imported commands go away} {
sl@0:     namespace eval test_ns_import { rename cmd1 "" }
sl@0:     list [info commands cmd1] \
sl@0:          [namespace eval test_ns_import_use {info commands cmd1}]
sl@0: } {{} {}}
sl@0: 
sl@0: test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
sl@0:     namespace delete test_ns_import test_ns_import2
sl@0:     list [info commands cmd*] \
sl@0:          [info commands ncmd*] \
sl@0:          [namespace eval test_ns_import_use {info commands cmd*}] \
sl@0:          [namespace eval test_ns_import_use {info commands ncmd*}] \
sl@0: } {{} {} {} {}}
sl@0: 
sl@0: # -----------------------------------------------------------------------
sl@0: # TEST: scoped values
sl@0: # -----------------------------------------------------------------------
sl@0: test namespace-old-10.1 {define namespace for scope test} {
sl@0:     namespace eval test_ns_inscope {
sl@0:         variable x "x-value"
sl@0:         proc show {args} {
sl@0:             return "show: $args"
sl@0:         }
sl@0:         proc do {args} {
sl@0:             return [eval $args]
sl@0:         }
sl@0:         list [set x] [show test]
sl@0:     }
sl@0: } {x-value {show: test}}
sl@0: 
sl@0: test namespace-old-10.2 {command "namespace code" requires one argument} {
sl@0:     list [catch {namespace code} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace code arg"}}
sl@0: 
sl@0: test namespace-old-10.3 {command "namespace code" requires one argument} {
sl@0:     list [catch {namespace code first "second arg" third} msg] $msg
sl@0: } {1 {wrong # args: should be "namespace code arg"}}
sl@0: 
sl@0: test namespace-old-10.4 {command "namespace code" gets current namesp context} {
sl@0:     namespace eval test_ns_inscope {
sl@0:         namespace code {"1 2 3" "4 5" 6}
sl@0:     }
sl@0: } {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
sl@0: 
sl@0: test namespace-old-10.5 {with one arg, first "scope" sticks} {
sl@0:     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
sl@0:     namespace code $sval
sl@0: } {::namespace inscope ::test_ns_inscope {one two}}
sl@0: 
sl@0: test namespace-old-10.6 {with many args, each "scope" adds new args} {
sl@0:     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
sl@0:     namespace code "$sval three"
sl@0: } {::namespace inscope ::test_ns_inscope {one two} three}
sl@0: 
sl@0: test namespace-old-10.7 {scoped commands work with eval} {
sl@0:     set cref [namespace eval test_ns_inscope {namespace code show}]
sl@0:     list [eval $cref "a" "b c" "d e f"]
sl@0: } {{show: a b c d e f}}
sl@0: 
sl@0: test namespace-old-10.8 {scoped commands execute in namespace context} {
sl@0:     set cref [namespace eval test_ns_inscope {
sl@0:         namespace code {set x "some new value"}
sl@0:     }]
sl@0:     list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
sl@0: } {x-value {some new value} {some new value}}
sl@0: 
sl@0: foreach cmd [info commands test_ns_*] {
sl@0:     rename $cmd ""
sl@0: }
sl@0: catch {rename cmd {}}
sl@0: catch {rename cmd1 {}}
sl@0: catch {rename cmd2 {}}
sl@0: catch {rename ncmd {}}
sl@0: catch {rename ncmd1 {}}
sl@0: catch {rename ncmd2 {}}
sl@0: catch {unset cref}
sl@0: catch {unset trigger}
sl@0: catch {unset trigger2}
sl@0: catch {unset sval}
sl@0: catch {unset msg}
sl@0: catch {unset x}
sl@0: catch {unset test_ns_var_global}
sl@0: catch {unset cmd}
sl@0: eval namespace delete [namespace children :: test_ns_*]
sl@0: 
sl@0: # cleanup
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: