home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / namespace-old.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  32.1 KB  |  845 lines  |  [TEXT/ALFA]
  1. # Functionality covered: this file contains slightly modified versions of
  2. # the original tests written by Mike McLennan of Lucent Technologies for
  3. # the procedures in tclNamesp.c that implement Tcl's basic support for
  4. # namespaces. Other namespace-related tests appear in namespace.test
  5. # and variable.test.
  6. #
  7. # Sourcing this file into Tcl runs the tests and generates output for
  8. # errors. No output means no errors were found.
  9. #
  10. # Copyright (c) 1997 Sun Microsystems, Inc.
  11. # Copyright (c) 1997 Lucent Technologies
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16. # SCCS: @(#) namespace-old.test 1.5 97/06/20 14:51:17
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. # Clear out any namespaces called test_ns_*
  21. catch {eval namespace delete [namespace children :: test_ns_*]}
  22.  
  23. test namespace-old-1.1 {usage for "namespace" command} {
  24.     list [catch {namespace} msg] $msg
  25. } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
  26.  
  27. test namespace-old-1.2 {global namespace's name is "::" or {}} {
  28.     list [namespace current] [namespace eval {} {namespace current}]
  29. } {:: ::}
  30.  
  31. test namespace-old-1.3 {usage for "namespace eval"} {
  32.     list [catch {namespace eval} msg] $msg
  33. } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
  34.  
  35. test namespace-old-1.4 {create new namespaces} {
  36.     list [lsort [namespace children :: test_ns_simple*]] \
  37.      [namespace eval test_ns_simple {}] \
  38.      [namespace eval test_ns_simple2 {}] \
  39.          [lsort [namespace children :: test_ns_simple*]]
  40. } {{} {} {} {::test_ns_simple ::test_ns_simple2}}
  41.  
  42. test namespace-old-1.5 {access a new namespace} {
  43.     namespace eval test_ns_simple { namespace current }
  44. } {::test_ns_simple}
  45.  
  46. test namespace-old-1.6 {usage for "namespace eval"} {
  47.     list [catch {namespace eval} msg] $msg
  48. } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
  49.  
  50. test namespace-old-1.7 {usage for "namespace eval"} {
  51.     list [catch {namespace eval test_ns_xyzzy} msg] $msg
  52. } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
  53.  
  54. test namespace-old-1.8 {command "namespace eval" concatenates args} {
  55.     namespace eval test_ns_simple namespace current
  56. } {::test_ns_simple}
  57.  
  58. test namespace-old-1.9 {add elements to a namespace} {
  59.     namespace eval test_ns_simple {
  60.         variable test_ns_x 0
  61.         proc test {test_ns_x} {
  62.             return "test: $test_ns_x"
  63.         }
  64.     }
  65. } {}
  66.  
  67. test namespace-old-1.10 {commands in a namespace} {
  68.     namespace eval test_ns_simple { info commands [namespace current]::*}
  69. } {::test_ns_simple::test}
  70.  
  71. test namespace-old-1.11 {variables in a namespace} {
  72.     namespace eval test_ns_simple { info vars [namespace current]::* }
  73. } {::test_ns_simple::test_ns_x}
  74.  
  75. test namespace-old-1.12 {global vars are separate from locals vars} {
  76.     list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
  77. } {{test: 123} 0}
  78.  
  79. test namespace-old-1.13 {add to an existing namespace} {
  80.     namespace eval test_ns_simple {
  81.         variable test_ns_y 123
  82.         proc _backdoor {cmd} {
  83.             eval $cmd
  84.         }
  85.     }
  86. } ""
  87.  
  88. test namespace-old-1.14 {commands in a namespace} {
  89.     lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
  90. } {::test_ns_simple::_backdoor ::test_ns_simple::test}
  91.  
  92. test namespace-old-1.15 {variables in a namespace} {
  93.     lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
  94. } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
  95. test namespace-old-1.16 {variables in a namespace} {
  96.     lsort [info vars test_ns_simple::*]
  97. } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
  98.  
  99. test namespace-old-1.17 {commands in a namespace are hidden} {
  100.     list [catch "_backdoor {return yes!}" msg] $msg
  101. } {1 {invalid command name "_backdoor"}}
  102. test namespace-old-1.18 {using namespace qualifiers} {
  103.     list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
  104. } {0 yes!}
  105. test namespace-old-1.19 {using absolute namespace qualifiers} {
  106.     list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
  107. } {0 yes!}
  108.  
  109. test namespace-old-1.20 {variables in a namespace are hidden} {
  110.     list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
  111. } {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
  112. test namespace-old-1.21 {using namespace qualifiers} {
  113.     list [catch "set test_ns_simple::test_ns_x" msg] $msg \
  114.          [catch "set test_ns_simple::test_ns_y" msg] $msg
  115. } {0 0 0 123}
  116. test namespace-old-1.22 {using absolute namespace qualifiers} {
  117.     list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
  118.          [catch "set ::test_ns_simple::test_ns_y" msg] $msg
  119. } {0 0 0 123}
  120. test namespace-old-1.23 {variables can be accessed within a namespace} {
  121.     test_ns_simple::_backdoor {
  122.         variable test_ns_x
  123.         variable test_ns_y
  124.         return "$test_ns_x $test_ns_y"
  125.     }
  126. } {0 123}
  127.  
  128. test namespace-old-1.24 {setting global variables} {
  129.     test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
  130.     namespace eval test_ns_simple {set test_ns_x}
  131. } {new val}
  132.  
  133. test namespace-old-1.25 {qualified variables don't need a global declaration} {
  134.     namespace eval test_ns_another { variable test_ns_x 456 }
  135.     set cmd {set ::test_ns_another::test_ns_x}
  136.     list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
  137.          [eval $cmd]
  138. } {0 some-value some-value}
  139.  
  140. test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
  141.     namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
  142.     set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
  143.     list [test_ns_simple::_backdoor $cmd] [eval $cmd]
  144. } {{12 34} {12 34}}
  145.  
  146. test namespace-old-1.27 {can create commands with null names} {
  147.     proc test_ns_simple:: {args} {return $args}
  148. } {}
  149.  
  150. # -----------------------------------------------------------------------
  151. # TEST: using "info" in namespace contexts
  152. # -----------------------------------------------------------------------
  153. test namespace-old-2.1 {querying:  info commands} {
  154.     lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
  155. } {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
  156.  
  157. test namespace-old-2.2 {querying:  info procs} {
  158.     lsort [test_ns_simple::_backdoor {info procs}]
  159. } {{} _backdoor test}
  160.  
  161. test namespace-old-2.3 {querying:  info vars} {
  162.     lsort [info vars test_ns_simple::*]
  163. } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
  164.  
  165. test namespace-old-2.4 {querying:  info vars} {
  166.     lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
  167. } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
  168.  
  169. test namespace-old-2.5 {querying:  info locals} {
  170.     lsort [test_ns_simple::_backdoor {info locals}]
  171. } {cmd}
  172.  
  173. test namespace-old-2.6 {querying:  info exists} {
  174.     test_ns_simple::_backdoor {info exists test_ns_x}
  175. } {0}
  176.  
  177. test namespace-old-2.7 {querying:  info exists} {
  178.     test_ns_simple::_backdoor {info exists cmd}
  179. } {1}
  180.  
  181. test namespace-old-2.8 {querying:  info args} {
  182.     info args test_ns_simple::_backdoor
  183. } {cmd}
  184.  
  185. test namespace-old-2.9 {querying:  info body} {
  186.     string trim [info body test_ns_simple::test]
  187. } {return "test: $test_ns_x"}
  188.  
  189. # -----------------------------------------------------------------------
  190. # TEST: namespace qualifiers, namespace tail
  191. # -----------------------------------------------------------------------
  192. test namespace-old-3.1 {usage for "namespace qualifiers"} {
  193.     list [catch "namespace qualifiers" msg] $msg
  194. } {1 {wrong # args: should be "namespace qualifiers string"}}
  195.  
  196. test namespace-old-3.2 {querying:  namespace qualifiers} {
  197.     list [namespace qualifiers ""] \
  198.          [namespace qualifiers ::] \
  199.          [namespace qualifiers x] \
  200.          [namespace qualifiers ::x] \
  201.          [namespace qualifiers foo::x] \
  202.          [namespace qualifiers ::foo::bar::xyz]
  203. } {{} {} {} {} foo ::foo::bar}
  204.  
  205. test namespace-old-3.3 {usage for "namespace tail"} {
  206.     list [catch "namespace tail" msg] $msg
  207. } {1 {wrong # args: should be "namespace tail string"}}
  208.  
  209. test namespace-old-3.4 {querying:  namespace tail} {
  210.     list [namespace tail ""] \
  211.          [namespace tail ::] \
  212.          [namespace tail x] \
  213.          [namespace tail ::x] \
  214.          [namespace tail foo::x] \
  215.          [namespace tail ::foo::bar::xyz]
  216. } {{} {} x x x xyz}
  217.  
  218. # -----------------------------------------------------------------------
  219. # TEST: delete commands and namespaces
  220. # -----------------------------------------------------------------------
  221. test namespace-old-4.1 {define test namespaces} {
  222.     namespace eval test_ns_delete {
  223.         namespace eval ns1 {
  224.             variable var1 1
  225.             proc cmd1 {} {return "cmd1"}
  226.         }
  227.         namespace eval ns2 {
  228.             variable var2 2
  229.             proc cmd2 {} {return "cmd2"}
  230.         }
  231.         namespace eval another {}
  232.         lsort [namespace children]
  233.     }
  234. } {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
  235.  
  236. test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
  237.     list [catch {namespace delete} msg] $msg
  238. } {0 {}}
  239.  
  240. test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
  241.     set cmd {
  242.         namespace eval test_ns_delete {namespace delete ns*}
  243.     }
  244.     list [catch $cmd msg] $msg
  245. } {1 {unknown namespace "ns*" in namespace delete command}}
  246.  
  247. test namespace-old-4.4 {command "namespace delete" handles multiple args} {
  248.     set cmd {
  249.         namespace eval test_ns_delete {
  250.             eval namespace delete \
  251.                 [namespace children [namespace current] ns?]
  252.         }
  253.     }
  254.     list [catch $cmd msg] $msg [namespace children test_ns_delete]
  255. } {0 {} ::test_ns_delete::another}
  256.  
  257. # -----------------------------------------------------------------------
  258. # TEST: namespace hierarchy
  259. # -----------------------------------------------------------------------
  260. test namespace-old-5.1 {define nested namespaces} {
  261.     set test_ns_var_global "var in ::"
  262.     proc test_ns_cmd_global {} {return "cmd in ::"}
  263.  
  264.     namespace eval test_ns_hier1 {
  265.         set test_ns_var_hier1 "particular to hier1"
  266.         proc test_ns_cmd_hier1 {} {return "particular to hier1"}
  267.  
  268.         set test_ns_level 1
  269.         proc test_ns_show {} {return "[namespace current]: 1"}
  270.  
  271.         namespace eval test_ns_hier2 {
  272.             set test_ns_var_hier2 "particular to hier2"
  273.             proc test_ns_cmd_hier2 {} {return "particular to hier2"}
  274.  
  275.             set test_ns_level 2
  276.             proc test_ns_show {} {return "[namespace current]: 2"}
  277.  
  278.             namespace eval test_ns_hier3a {}
  279.             namespace eval test_ns_hier3b {}
  280.         }
  281.  
  282.         namespace eval test_ns_hier2a {}
  283.         namespace eval test_ns_hier2b {}
  284.     }
  285. } {}
  286.  
  287. test namespace-old-5.2 {namespaces can be nested} {
  288.     list [namespace eval test_ns_hier1 {namespace current}] \
  289.          [namespace eval test_ns_hier1 {
  290.               namespace eval test_ns_hier2 {namespace current}
  291.           }]
  292. } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
  293.  
  294. test namespace-old-5.3 {namespace qualifiers work in namespace command} {
  295.     list [namespace eval ::test_ns_hier1 {namespace current}] \
  296.          [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
  297.          [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
  298. } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
  299.  
  300. test namespace-old-5.4 {nested namespaces can access global namespace} {
  301.     list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
  302.          [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
  303.          [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
  304.          [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
  305. } {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
  306.  
  307. test namespace-old-5.5 {variables in different namespaces don't conflict} {
  308.     list [set test_ns_hier1::test_ns_level] \
  309.          [set test_ns_hier1::test_ns_hier2::test_ns_level]
  310. } {1 2}
  311.  
  312. test namespace-old-5.6 {commands in different namespaces don't conflict} {
  313.     list [test_ns_hier1::test_ns_show] \
  314.          [test_ns_hier1::test_ns_hier2::test_ns_show]
  315. } {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
  316.  
  317. test namespace-old-5.7 {nested namespaces don't see variables in parent} {
  318.     set cmd {
  319.         namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
  320.     }
  321.     list [catch $cmd msg] $msg
  322. } {1 {can't read "test_ns_var_hier1": no such variable}}
  323.  
  324. test namespace-old-5.8 {nested namespaces don't see commands in parent} {
  325.     set cmd {
  326.         namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
  327.     }
  328.     list [catch $cmd msg] $msg
  329. } {1 {invalid command name "test_ns_cmd_hier1"}}
  330.  
  331. test namespace-old-5.9 {usage for "namespace children"} {
  332.     list [catch {namespace children test_ns_hier1 y z} msg] $msg
  333. } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
  334.  
  335. test namespace-old-5.10 {command "namespace children" must get valid namespace} {
  336.     list [catch {namespace children xyzzy} msg] $msg
  337. } {1 {unknown namespace "xyzzy" in namespace children command}}
  338.  
  339. test namespace-old-5.11 {querying namespace children} {
  340.     lsort [namespace children :: test_ns_hier*]
  341. } {::test_ns_hier1}
  342.  
  343. test namespace-old-5.12 {querying namespace children} {
  344.     lsort [namespace children test_ns_hier1]
  345. } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
  346.  
  347. test namespace-old-5.13 {querying namespace children} {
  348.     lsort [namespace eval test_ns_hier1 {namespace children}]
  349. } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
  350.  
  351. test namespace-old-5.14 {querying namespace children} {
  352.     lsort [namespace children test_ns_hier1::test_ns_hier2]
  353. } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
  354.  
  355. test namespace-old-5.15 {querying namespace children} {
  356.     lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
  357. } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
  358.  
  359. test namespace-old-5.16 {querying namespace children with patterns} {
  360.     lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
  361. } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
  362.  
  363. test namespace-old-5.17 {querying namespace children with patterns} {
  364.     lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
  365. } {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
  366.  
  367. test namespace-old-5.18 {usage for "namespace parent"} {
  368.     list [catch {namespace parent x y} msg] $msg
  369. } {1 {wrong # args: should be "namespace parent ?name?"}}
  370.  
  371. test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
  372.     list [catch {namespace parent xyzzy} msg] $msg
  373. } {1 {unknown namespace "xyzzy" in namespace parent command}}
  374.  
  375. test namespace-old-5.20 {querying namespace parent} {
  376.     list [namespace eval :: {namespace parent}] \
  377.         [namespace eval test_ns_hier1 {namespace parent}] \
  378.         [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
  379.         [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
  380. } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
  381.  
  382. test namespace-old-5.21 {querying namespace parent for explicit namespace} {
  383.     list [namespace parent ::] \
  384.          [namespace parent test_ns_hier1] \
  385.          [namespace parent test_ns_hier1::test_ns_hier2] \
  386.          [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
  387. } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
  388.  
  389. # -----------------------------------------------------------------------
  390. # TEST: name resolution and caching
  391. # -----------------------------------------------------------------------
  392. test namespace-old-6.1 {relative ns names only looked up in current ns} {
  393.     namespace eval test_ns_cache1 {}
  394.     namespace eval test_ns_cache2 {}
  395.     namespace eval test_ns_cache2::test_ns_cache3 {}
  396.     set trigger {
  397.         namespace eval test_ns_cache2 {namespace current}
  398.     }
  399.     set trigger2 {
  400.         namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
  401.     }
  402.     list [namespace eval test_ns_cache1 $trigger] \
  403.          [namespace eval test_ns_cache1 $trigger2]
  404. } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
  405.  
  406. test namespace-old-6.2 {relative ns names only looked up in current ns} {
  407.     namespace eval test_ns_cache1::test_ns_cache2 {}
  408.     list [namespace eval test_ns_cache1 $trigger] \
  409.          [namespace eval test_ns_cache1 $trigger2]
  410. } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
  411.  
  412. test namespace-old-6.3 {relative ns names only looked up in current ns} {
  413.     namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
  414.     list [namespace eval test_ns_cache1 $trigger] \
  415.          [namespace eval test_ns_cache1 $trigger2]
  416. } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
  417.  
  418. test namespace-old-6.4 {relative ns names only looked up in current ns} {
  419.     namespace delete test_ns_cache1::test_ns_cache2
  420.     list [namespace eval test_ns_cache1 $trigger] \
  421.          [namespace eval test_ns_cache1 $trigger2]
  422. } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
  423.  
  424. test namespace-old-6.5 {define test commands} {
  425.     proc test_ns_cache_cmd {} {
  426.         return "global version"
  427.     }
  428.     namespace eval test_ns_cache1 {
  429.         proc trigger {} {
  430.             test_ns_cache_cmd
  431.         }
  432.     }
  433.     test_ns_cache1::trigger
  434. } {global version}
  435.  
  436. test namespace-old-6.6 {one-level check for command shadowing} {
  437.     proc test_ns_cache1::test_ns_cache_cmd {} {
  438.         return "cache1 version"
  439.     }
  440.     test_ns_cache1::trigger
  441. } {cache1 version}
  442.  
  443. test namespace-old-6.7 {renaming commands changes command epoch} {
  444.     namespace eval test_ns_cache1 {
  445.         rename test_ns_cache_cmd test_ns_new
  446.     }
  447.     test_ns_cache1::trigger
  448. } {global version}
  449.  
  450. test namespace-old-6.8 {renaming back handles shadowing} {
  451.     namespace eval test_ns_cache1 {
  452.         rename test_ns_new test_ns_cache_cmd
  453.     }
  454.     test_ns_cache1::trigger
  455. } {cache1 version}
  456.  
  457. test namespace-old-6.9 {deleting commands changes command epoch} {
  458.     namespace eval test_ns_cache1 {
  459.         rename test_ns_cache_cmd ""
  460.     }
  461.     test_ns_cache1::trigger
  462. } {global version}
  463.  
  464. test namespace-old-6.10 {define test namespaces} {
  465.     namespace eval test_ns_cache2 {
  466.         proc test_ns_cache_cmd {} {
  467.             return "global cache2 version"
  468.         }
  469.     }
  470.     namespace eval test_ns_cache1 {
  471.         proc trigger {} {
  472.             test_ns_cache2::test_ns_cache_cmd
  473.         }
  474.     }
  475.     namespace eval test_ns_cache1::test_ns_cache2 {
  476.         proc trigger {} {
  477.             test_ns_cache_cmd
  478.         }
  479.     }
  480.     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
  481. } {{global cache2 version} {global version}}
  482.  
  483. test namespace-old-6.11 {commands affect all parent namespaces} {
  484.     proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
  485.         return "cache2 version"
  486.     }
  487.     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
  488. } {{cache2 version} {cache2 version}}
  489.  
  490. test namespace-old-6.12 {define test variables} {
  491.     variable test_ns_cache_var "global version"
  492.     set trigger {set test_ns_cache_var}
  493.     namespace eval test_ns_cache1 $trigger
  494. } {global version}
  495.  
  496. test namespace-old-6.13 {one-level check for variable shadowing} {
  497.     namespace eval test_ns_cache1 {
  498.         variable test_ns_cache_var "cache1 version"
  499.     }
  500.     namespace eval test_ns_cache1 $trigger
  501. } {cache1 version}
  502.  
  503. test namespace-old-6.14 {deleting variables changes variable epoch} {
  504.     namespace eval test_ns_cache1 {
  505.         unset test_ns_cache_var
  506.     }
  507.     namespace eval test_ns_cache1 $trigger
  508. } {global version}
  509.  
  510. test namespace-old-6.15 {define test namespaces} {
  511.     namespace eval test_ns_cache2 {
  512.         variable test_ns_cache_var "global cache2 version"
  513.     }
  514.     set trigger2 {set test_ns_cache2::test_ns_cache_var}
  515.     list [namespace eval test_ns_cache1 $trigger2] \
  516.          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
  517. } {{global cache2 version} {global version}}
  518.  
  519. test namespace-old-6.16 {public variables affect all parent namespaces} {
  520.     variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
  521.     list [namespace eval test_ns_cache1 $trigger2] \
  522.          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
  523. } {{cache2 version} {cache2 version}}
  524.  
  525. test namespace-old-6.17 {usage for "namespace which"} {
  526.     list [catch "namespace which -baz" msg] $msg
  527. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  528. test namespace-old-6.18 {usage for "namespace which"} {
  529.     list [catch "namespace which -command" msg] $msg
  530. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  531.  
  532. test namespace-old-6.19 {querying:  namespace which -command} {
  533.     proc test_ns_cache1::test_ns_cache_cmd {} {
  534.         return "cache1 version"
  535.     }
  536.     list [namespace eval :: {namespace which test_ns_cache_cmd}] \
  537.          [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
  538.          [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
  539.          [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
  540. } {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
  541.  
  542. test namespace-old-6.20 {command "namespace which" may not find commands} {
  543.     namespace eval test_ns_cache1 {namespace which -command xyzzy}
  544. } {}
  545.  
  546. test namespace-old-6.21 {querying:  namespace which -variable} {
  547.     namespace eval test_ns_cache1::test_ns_cache2 {
  548.         namespace which -variable test_ns_cache_var
  549.     }
  550. } {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
  551.  
  552. test namespace-old-6.22 {command "namespace which" may not find variables} {
  553.     namespace eval test_ns_cache1 {namespace which -variable xyzzy}
  554. } {}
  555.  
  556. # -----------------------------------------------------------------------
  557. # TEST: uplevel/upvar across namespace boundaries
  558. # -----------------------------------------------------------------------
  559. test namespace-old-7.1 {define test namespace} {
  560.     namespace eval test_ns_uplevel {
  561.         variable x 0
  562.         variable y 1
  563.  
  564.         proc show_vars {num} {
  565.             return [uplevel $num {info vars}]
  566.         }
  567.         proc test_uplevel {num} {
  568.             set a 0
  569.             set b 1
  570.             namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
  571.         }
  572.     }
  573. } {}
  574. test namespace-old-7.2 {uplevel can access namespace call frame} {
  575.     list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
  576.          [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
  577. } {1 1}
  578. test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
  579.     lsort [test_ns_uplevel::test_uplevel 2]
  580. } {a b num}
  581. test namespace-old-7.4 {uplevel can go up to global context} {
  582.     expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
  583. } {1}
  584.  
  585. test namespace-old-7.5 {absolute call frame references work too} {
  586.     list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
  587.          [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
  588. } {1 1}
  589. test namespace-old-7.6 {absolute call frame references work too} {
  590.     lsort [test_ns_uplevel::test_uplevel #1]
  591. } {a b num}
  592. test namespace-old-7.7 {absolute call frame references work too} {
  593.     expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
  594. } {1}
  595.  
  596. test namespace-old-7.8 {namespaces are included in the call stack} {
  597.     namespace eval test_ns_upvar {
  598.         variable scope "test_ns_upvar"
  599.  
  600.         proc show_val {var num} {
  601.             upvar $num $var x
  602.             return $x
  603.         }
  604.         proc test_upvar {num} {
  605.             set scope "test_ns_upvar::test_upvar"
  606.             namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
  607.         }
  608.     }
  609. } {}
  610. test namespace-old-7.9 {upvar can access namespace call frame} {
  611.     test_ns_upvar::test_upvar 1
  612. } {test_ns_upvar}
  613. test namespace-old-7.10 {upvar can go beyond namespace call frame} {
  614.     test_ns_upvar::test_upvar 2
  615. } {test_ns_upvar::test_upvar}
  616. test namespace-old-7.11 {absolute call frame references work too} {
  617.     test_ns_upvar::test_upvar #2
  618. } {test_ns_upvar}
  619. test namespace-old-7.12 {absolute call frame references work too} {
  620.     test_ns_upvar::test_upvar #1
  621. } {test_ns_upvar::test_upvar}
  622.  
  623. # -----------------------------------------------------------------------
  624. # TEST: variable traces across namespace boundaries
  625. # -----------------------------------------------------------------------
  626. test namespace-old-8.1 {traces work across namespace boundaries} {
  627.     namespace eval test_ns_trace {
  628.         namespace eval foo {
  629.             variable x ""
  630.         }
  631.  
  632.         variable status ""
  633.         proc monitor {name1 name2 op} {
  634.             variable status
  635.             lappend status "$op: $name1"
  636.         }
  637.         trace variable foo::x rwu [namespace code monitor]
  638.     }
  639.     set test_ns_trace::foo::x "yes!"
  640.     set test_ns_trace::foo::x
  641.     unset test_ns_trace::foo::x
  642.  
  643.     namespace eval test_ns_trace { set status }
  644. } {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
  645.  
  646. # -----------------------------------------------------------------------
  647. # TEST: imported commands
  648. # -----------------------------------------------------------------------
  649. test namespace-old-9.1 {empty "namespace export" list} {
  650.     list [catch "namespace export" msg] $msg
  651. } {0 {}}
  652. test namespace-old-9.2 {usage for "namespace export" command} {
  653.     list [catch "namespace export test_ns_trace::zzz" msg] $msg
  654. } {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
  655.  
  656. test namespace-old-9.3 {define test namespaces for import} {
  657.     namespace eval test_ns_export {
  658.         namespace export cmd1 cmd2 cmd3
  659.         proc cmd1 {args} {return "cmd1: $args"}
  660.         proc cmd2 {args} {return "cmd2: $args"}
  661.         proc cmd3 {args} {return "cmd3: $args"}
  662.         proc cmd4 {args} {return "cmd4: $args"}
  663.         proc cmd5 {args} {return "cmd5: $args"}
  664.         proc cmd6 {args} {return "cmd6: $args"}
  665.     }
  666.     lsort [info commands test_ns_export::*]
  667. } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
  668.  
  669. test namespace-old-9.4 {check export status} {
  670.     set x ""
  671.     namespace eval test_ns_import {
  672.         namespace export cmd1 cmd2
  673.         namespace import ::test_ns_export::*
  674.     }
  675.     foreach cmd [lsort [info commands test_ns_import::*]] {
  676.         lappend x $cmd
  677.     }
  678.     set x
  679. } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
  680.  
  681. test namespace-old-9.5 {empty import list in "namespace import" command} {
  682.     namespace import
  683. } {}
  684.  
  685. test namespace-old-9.6 {empty import list for "namespace import" command} {
  686.     namespace import
  687. } {}
  688.  
  689. test namespace-old-9.7 {empty forget list for "namespace forget" command} {
  690.     namespace forget
  691. } {}
  692.  
  693. catch {rename cmd1 {}}
  694. catch {rename cmd2 {}}
  695. catch {rename ncmd {}}
  696. catch {rename ncmd1 {}}
  697. catch {rename ncmd2 {}}
  698. test namespace-old-9.8 {only exported commands are imported} {
  699.     namespace import test_ns_import::cmd*
  700.     set x [lsort [info commands cmd*]]
  701. } {cmd1 cmd2}
  702.  
  703. test namespace-old-9.9 {imported commands work just the same as original} {
  704.     list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
  705. } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
  706.  
  707. test namespace-old-9.10 {commands can be imported from many namespaces} {
  708.     namespace eval test_ns_import2 {
  709.         namespace export ncmd ncmd1 ncmd2
  710.         proc ncmd  {args} {return "ncmd: $args"}
  711.         proc ncmd1 {args} {return "ncmd1: $args"}
  712.         proc ncmd2 {args} {return "ncmd2: $args"}
  713.         proc ncmd3 {args} {return "ncmd3: $args"}
  714.     }
  715.     namespace import test_ns_import2::*
  716.     lsort [concat [info commands cmd*] [info commands ncmd*]]
  717. } {cmd1 cmd2 ncmd ncmd1 ncmd2}
  718.  
  719. test namespace-old-9.11 {imported commands can be removed by deleting them} {
  720.     rename cmd1 ""
  721.     lsort [concat [info commands cmd*] [info commands ncmd*]]
  722. } {cmd2 ncmd ncmd1 ncmd2}
  723.  
  724. test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
  725.     list [catch {namespace forget xyzzy::*} msg] $msg
  726. } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
  727.  
  728. test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
  729.     list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
  730.          [lsort [info commands cmd?]]
  731. } {0 {} cmd2}
  732.  
  733. test namespace-old-9.14 {imported commands can be removed} {
  734.     namespace forget test_ns_import::cmd?
  735.     list [lsort [info commands cmd?]] \
  736.          [catch {cmd1 another test} msg] $msg
  737. } {{} 1 {invalid command name "cmd1"}}
  738.  
  739. test namespace-old-9.15 {existing commands can't be overwritten} {
  740.     proc cmd1 {x y} {
  741.         return [expr $x+$y]
  742.     }
  743.     list [catch {namespace import test_ns_import::cmd?} msg] $msg \
  744.          [cmd1 3 5]
  745. } {1 {can't import command "cmd1": already exists} 8}
  746.  
  747. test namespace-old-9.16 {use "-force" option to override existing commands} {
  748.     list [cmd1 3 5] \
  749.          [namespace import -force test_ns_import::cmd?] \
  750.          [cmd1 3 5]
  751. } {8 {} {cmd1: 3 5}}
  752.  
  753. test namespace-old-9.17 {commands can be imported into many namespaces} {
  754.     namespace eval test_ns_import_use {
  755.         namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
  756.         lsort [concat [info commands ::test_ns_import_use::cmd*] \
  757.                       [info commands ::test_ns_import_use::ncmd*]]
  758.     }
  759. } {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
  760.  
  761. test namespace-old-9.18 {when command is deleted, imported commands go away} {
  762.     namespace eval test_ns_import { rename cmd1 "" }
  763.     list [info commands cmd1] \
  764.          [namespace eval test_ns_import_use {info commands cmd1}]
  765. } {{} {}}
  766.  
  767. test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
  768.     namespace delete test_ns_import test_ns_import2
  769.     list [info commands cmd*] \
  770.          [info commands ncmd*] \
  771.          [namespace eval test_ns_import_use {info commands cmd*}] \
  772.          [namespace eval test_ns_import_use {info commands ncmd*}] \
  773. } {{} {} {} {}}
  774.  
  775. # -----------------------------------------------------------------------
  776. # TEST: scoped values
  777. # -----------------------------------------------------------------------
  778. test namespace-old-10.1 {define namespace for scope test} {
  779.     namespace eval test_ns_inscope {
  780.         variable x "x-value"
  781.         proc show {args} {
  782.             return "show: $args"
  783.         }
  784.         proc do {args} {
  785.             return [eval $args]
  786.         }
  787.         list [set x] [show test]
  788.     }
  789. } {x-value {show: test}}
  790.  
  791. test namespace-old-10.2 {command "namespace code" requires one argument} {
  792.     list [catch {namespace code} msg] $msg
  793. } {1 {wrong # args: should be "namespace code arg"}}
  794.  
  795. test namespace-old-10.3 {command "namespace code" requires one argument} {
  796.     list [catch {namespace code first "second arg" third} msg] $msg
  797. } {1 {wrong # args: should be "namespace code arg"}}
  798.  
  799. test namespace-old-10.4 {command "namespace code" gets current namesp context} {
  800.     namespace eval test_ns_inscope {
  801.         namespace code {"1 2 3" "4 5" 6}
  802.     }
  803. } {namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
  804.  
  805. test namespace-old-10.5 {with one arg, first "scope" sticks} {
  806.     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
  807.     namespace code $sval
  808. } {namespace inscope ::test_ns_inscope {one two}}
  809.  
  810. test namespace-old-10.6 {with many args, each "scope" adds new args} {
  811.     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
  812.     namespace code "$sval three"
  813. } {namespace inscope ::test_ns_inscope {one two} three}
  814.  
  815. test namespace-old-10.7 {scoped commands work with eval} {
  816.     set cref [namespace eval test_ns_inscope {namespace code show}]
  817.     list [eval $cref "a" "b c" "d e f"]
  818. } {{show: a b c d e f}}
  819.  
  820. test namespace-old-10.8 {scoped commands execute in namespace context} {
  821.     set cref [namespace eval test_ns_inscope {
  822.         namespace code {set x "some new value"}
  823.     }]
  824.     list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
  825. } {x-value {some new value} {some new value}}
  826.  
  827. foreach cmd [info commands test_ns_*] {
  828.     rename $cmd ""
  829. }
  830. catch {rename cmd {}}
  831. catch {rename cmd1 {}}
  832. catch {rename cmd2 {}}
  833. catch {rename ncmd {}}
  834. catch {rename ncmd1 {}}
  835. catch {rename ncmd2 {}}
  836. catch {unset cref}
  837. catch {unset trigger}
  838. catch {unset trigger2}
  839. catch {unset sval}
  840. catch {unset msg}
  841. catch {unset x}
  842. catch {unset test_ns_var_global}
  843. catch {unset cmd}
  844. eval namespace delete [namespace children :: test_ns_*]
  845.