开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
namespace-old.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：32k
源码类别：

通讯编程

开发平台：

Visual C++

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