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

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

通讯编程

开发平台：

Visual C++

namespace.test：源码内容
  1. # Functionality covered: this file contains a collection of tests for the
  2. # procedures in tclNamesp.c that implement Tcl's basic support for
  3. # namespaces. Other namespace-related tests appear in variable.test.
  4. #
  5. # Sourcing this file into Tcl runs the tests and generates output for
  6. # errors. No output means no errors were found.
  7. #
  8. # Copyright (c) 1997 Sun Microsystems, Inc.
  9. # Copyright (c) 1998-2000 by Scriptics Corporation.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14. # RCS: @(#) $Id: namespace.test,v 1.21.2.10 2006/10/04 17:59:06 dgp Exp $
  16. if {[lsearch [namespace children] ::tcltest] == -1} {
  17.     package require tcltest 2
  18.     namespace import -force ::tcltest::*
  19. }
  21. # Clear out any namespaces called test_ns_*
  22. catch {eval namespace delete [namespace children :: test_ns_*]}
  24. test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
  25.     namespace children :: test_ns_*
  26. } {}
  28. catch {unset l}
  29. test namespace-2.1 {Tcl_GetCurrentNamespace} {
  30.     list [namespace current] [namespace eval {} {namespace current}] 
  31.         [namespace eval {} {namespace current}]
  32. } {:: :: ::}
  33. test namespace-2.2 {Tcl_GetCurrentNamespace} {
  34.     set l {}
  35.     lappend l [namespace current]
  36.     namespace eval test_ns_1 {
  37.         lappend l [namespace current]
  38.         namespace eval foo {
  39.             lappend l [namespace current]
  40.         }
  41.     }
  42.     lappend l [namespace current]
  43.     set l
  44. } {:: ::test_ns_1 ::test_ns_1::foo ::}
  46. test namespace-3.1 {Tcl_GetGlobalNamespace} {
  47.     namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
  48.     # namespace children uses Tcl_GetGlobalNamespace 
  49.     namespace eval test_ns_1 {namespace children foo b*}
  50. } {::test_ns_1::foo::bar}
  52. test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
  53.     namespace eval test_ns_1 {
  54.         variable v 123
  55.         proc p {} {
  56.             variable v
  57.             return $v
  58.         }
  59.     }
  60.     test_ns_1::p    ;# does Tcl_PushCallFrame to push p's namespace
  61. } {123}
  62. test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
  63.     namespace eval test_ns_1::baz {}  ;# does Tcl_PushCallFrame to create baz
  64.     proc test_ns_1::baz::p {} {
  65.         variable v
  66.         set v 789
  67.         set v}
  68.     test_ns_1::baz::p
  69. } {789}
  71. test namespace-5.1 {Tcl_PopCallFrame, no vars} {
  72.     namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
  73. } {}
  74. test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
  75.     proc test_ns_1::r {} {
  76.         set a 123
  77.     }
  78.     test_ns_1::r   ;# pushes then pop's r's frame
  79. } {123}
  81. test namespace-6.1 {Tcl_CreateNamespace} {
  82.     catch {eval namespace delete [namespace children :: test_ns_*]}
  83.     list [lsort [namespace children :: test_ns_*]] 
  84.         [namespace eval test_ns_1 {namespace current}] 
  85. [namespace eval test_ns_2 {namespace current}] 
  86. [namespace eval ::test_ns_3 {namespace current}] 
  87. [namespace eval ::test_ns_4 
  88.             {namespace eval foo {namespace current}}] 
  89. [namespace eval ::test_ns_5 
  90.             {namespace eval ::test_ns_6 {namespace current}}] 
  91.         [lsort [namespace children :: test_ns_*]]
  92. } {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
  93. test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
  94.     list [namespace eval :::test_ns_1::::foo {namespace current}] 
  95.          [namespace eval test_ns_2:::::foo {namespace current}]
  96. } {::test_ns_1::foo ::test_ns_2::foo}
  97. test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
  98.     list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
  99. } {0 ::test_ns_7}
  100. test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
  101.     catch {eval namespace delete [namespace children :: test_ns_*]}
  102.     namespace eval test_ns_1:: {
  103.         namespace eval test_ns_2:: {}
  104.         namespace eval test_ns_3:: {}
  105.     }
  106.     lsort [namespace children ::test_ns_1]
  107. } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}]
  108. test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
  109.     set trigger {
  110.         namespace eval test_ns_2 {namespace current}
  111.     }
  112.     set l {}
  113.     lappend l [namespace eval test_ns_1 $trigger]
  114.     namespace eval test_ns_1::test_ns_2 {}
  115.     lappend l [namespace eval test_ns_1 $trigger]
  116. } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
  118. test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
  119.     catch {eval namespace delete [namespace children :: test_ns_*]}
  120.     namespace eval test_ns_1 {
  121.         proc p {} {
  122.             namespace delete [namespace current]
  123.             return [namespace current]
  124.         }
  125.     }
  126.     list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
  127. } {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
  128. test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
  129.     namespace eval test_ns_2 {
  130.         proc p {} {
  131.             return [namespace current]
  132.         }
  133.     }
  134.     list [test_ns_2::p] [namespace delete test_ns_2]
  135. } {::test_ns_2 {}}
  136. test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
  137.     # [Bug 1355942]
  138.     namespace eval test_ns_2 {
  139.         set x 1
  140. trace add variable x unset "namespace delete [namespace current];#"
  141. namespace delete [namespace current]
  142.     }
  143. } {}
  144. test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
  145.     # [Bug 1355942]
  146.     namespace eval test_ns_2 {
  147.         proc x {} {}
  148. trace add command x delete "namespace delete [namespace current];#"
  149. namespace delete [namespace current]
  150.     }
  151. } {}
  152. test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
  153.     # [Bug 1355942]
  154.     namespace eval test_ns_2 {
  155.         set x 1
  156. trace add variable x unset "namespace delete [namespace current];#"
  157.     }
  158.     namespace delete test_ns_2
  159. } {}
  160. test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
  161.     # [Bug 1355942]
  162.     namespace eval test_ns_2 {
  163.         proc x {} {}
  164. trace add command x delete "namespace delete [namespace current];#"
  165.     }
  166.     namespace delete test_ns_2
  167. } {}
  169. test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
  170.     catch {interp delete test_interp}
  171.     interp create test_interp
  172.     interp eval test_interp {
  173.         namespace eval test_ns_1 {
  174.             namespace export p
  175.             proc p {} {
  176.                 return [namespace current]
  177.             }
  178.         }
  179.         namespace eval test_ns_2 {
  180.             namespace import ::test_ns_1::p
  181.             variable v 27
  182.             proc q {} {
  183.                 variable v
  184.                 return "[p] $v"
  185.             }
  186.         }
  187.         set x [test_ns_2::q]
  188.         catch {set xxxx}
  189.     }
  190.     list [interp eval test_interp {test_ns_2::q}] 
  191.          [interp eval test_interp {namespace delete ::}] 
  192.          [catch {interp eval test_interp {set a 123}} msg] $msg 
  193.          [interp delete test_interp]
  194. } {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
  195. test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
  196.     catch {eval namespace delete [namespace children :: test_ns_*]}
  197.     namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
  198.     namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
  199.     list [namespace children test_ns_1] 
  200.          [namespace delete test_ns_1::test_ns_2] 
  201.          [namespace children test_ns_1]
  202. } {::test_ns_1::test_ns_2 {} {}}
  203. test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
  204.     catch {eval namespace delete [namespace children :: test_ns_*]}
  205.     namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
  206.     namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
  207.     list [namespace children test_ns_1] 
  208.          [namespace delete test_ns_1::test_ns_2] 
  209.          [namespace children test_ns_1] 
  210.          [catch {namespace children test_ns_1::test_ns_2} msg] $msg 
  211.          [info commands test_ns_1::test_ns_2::test_ns_3a::*]
  212. } {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
  213. test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
  214.     catch {eval namespace delete [namespace children :: test_ns_*]}
  215.     namespace eval test_ns_export {
  216.         namespace export cmd1 cmd2
  217.         proc cmd1 {args} {return "cmd1: $args"}
  218.         proc cmd2 {args} {return "cmd2: $args"}
  219.     }
  220.     namespace eval test_ns_import {
  221.         namespace import ::test_ns_export::*
  222.         proc p {} {return foo}
  223.     }
  224.     list [lsort [info commands test_ns_import::*]] 
  225.          [namespace delete test_ns_export] 
  226.          [info commands test_ns_import::*]
  227. } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
  228. test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
  229.     interp create slave
  230.     slave eval {trace add execution error leave {namespace delete :: ;#}}
  231.     catch {slave eval error foo bar baz}
  232.     interp delete slave
  233.     set ::errorInfo
  234. } {bar
  235.     invoked from within
  236. "slave eval error foo bar baz"}
  237. test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
  238.     interp create slave
  239.     slave eval {trace add variable errorCode write {namespace delete :: ;#}}
  240.     catch {slave eval error foo bar baz}
  241.     interp delete slave
  242.     set ::errorInfo
  243. } {bar
  244.     invoked from within
  245. "slave eval error foo bar baz"}
  246. test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {   
  247.     interp create slave
  248.     slave eval {trace add execution error leave {namespace delete :: ;#}}
  249.     catch {slave eval error foo bar baz}
  250.     interp delete slave
  251.     set ::errorCode 
  252. } baz
  254. test namespace-9.1 {Tcl_Import, empty import pattern} {
  255.     catch {eval namespace delete [namespace children :: test_ns_*]}
  256.     list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
  257. } {1 {empty import pattern}}
  258. test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
  259.     list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
  260. } {1 {unknown namespace in import pattern "fred::x"}}
  261. test namespace-9.3 {Tcl_Import, import ns == export ns} {
  262.     list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
  263. } {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
  264. test namespace-9.4 {Tcl_Import, simple import} {
  265.     catch {eval namespace delete [namespace children :: test_ns_*]}
  266.     namespace eval test_ns_export {
  267.         namespace export cmd1
  268.         proc cmd1 {args} {return "cmd1: $args"}
  269.         proc cmd2 {args} {return "cmd2: $args"}
  270.     }
  271.     namespace eval test_ns_import {
  272.         namespace import ::test_ns_export::*
  273.         proc p {} {return [cmd1 123]}
  274.     }
  275.     test_ns_import::p
  276. } {cmd1: 123}
  277. test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
  278.     list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
  279. } {0 {}}
  280. test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
  281.     namespace eval test_ns_import {
  282.         namespace import -force ::test_ns_export::*
  283.         cmd1 555
  284.     }
  285. } {cmd1: 555}
  286. test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
  287.     catch {eval namespace delete [namespace children :: test_ns_*]}
  288.     namespace eval test_ns_export {
  289.         namespace export cmd1
  290.         proc cmd1 {args} {return "cmd1: $args"}
  291.     }
  292.     namespace eval test_ns_import {
  293.         namespace import -force ::test_ns_export::*
  294.     }
  295.     list [test_ns_import::cmd1 a b c] 
  296.          [test_ns_export::cmd1 d e f] 
  297.          [proc test_ns_export::cmd1 {args} {return "new1: $args"}] 
  298.          [namespace origin test_ns_import::cmd1] 
  299.          [namespace origin test_ns_export::cmd1] 
  300.          [test_ns_import::cmd1 g h i] 
  301.          [test_ns_export::cmd1 j k l]
  302. } {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
  304. test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
  305.     namespace eval one {
  306. namespace export cmd
  307. proc cmd {} {}
  308.     }
  309.     namespace eval two {
  310. namespace export cmd
  311. proc other args {}
  312.     }
  313.     namespace eval two 
  314.     [list namespace import [namespace current]::one::cmd]
  315.     namespace eval three 
  316.     [list namespace import [namespace current]::two::cmd]
  317.     namespace eval three {
  318. rename cmd other
  319. namespace export other
  320.     }
  321. } -body {
  322.     namespace eval two [list namespace import -force 
  323.     [namespace current]::three::other]
  324.     namespace origin two::other
  325. } -cleanup {
  326.     namespace delete one two three
  327. } -match glob -result *::one::cmd
  329. test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
  330.     namespace eval one {
  331. namespace export cmd
  332. proc cmd {} {}
  333.     }
  334.     namespace eval two namespace export cmd
  335.     namespace eval two 
  336.     [list namespace import [namespace current]::one::cmd]
  337.     namespace eval three namespace export cmd
  338.     namespace eval three 
  339.     [list namespace import [namespace current]::two::cmd]
  340. } -body {
  341.     namespace eval two [list namespace import -force 
  342.     [namespace current]::three::cmd]
  343.     namespace origin two::cmd
  344. } -cleanup {
  345.     namespace delete one two three
  346. } -returnCodes error -match glob -result {import pattern * would create a loop*}
  348. test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
  349.     catch {eval namespace delete [namespace children :: test_ns_*]}
  350.     list [catch {namespace forget xyzzy::*} msg] $msg
  351. } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
  352. test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
  353.     namespace eval test_ns_export {
  354.         namespace export cmd1
  355.         proc cmd1 {args} {return "cmd1: $args"}
  356.         proc cmd2 {args} {return "cmd2: $args"}
  357.     }
  358.     namespace eval test_ns_import {
  359.         namespace forget ::test_ns_export::wombat
  360.     }
  361. } {}
  362. test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
  363.     namespace eval test_ns_import {
  364.         namespace import ::test_ns_export::*
  365.         proc p {} {return [cmd1 123]}
  366.         set l {}
  367.         lappend l [lsort [info commands ::test_ns_import::*]]
  368.         namespace forget ::test_ns_export::cmd1
  369.         lappend l [info commands ::test_ns_import::*]
  370.         lappend l [catch {cmd1 777} msg] $msg
  371.     }
  372. } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
  374. test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
  375.     namespace eval origin {
  376. namespace export cmd
  377. proc cmd {} {}
  378.     }
  379.     namespace eval unrelated {
  380. proc cmd {} {}
  381.     }
  382.     namespace eval my 
  383.     [list namespace import [namespace current]::origin::cmd]
  384. } -body {
  385.     namespace eval my 
  386.     [list namespace forget [namespace current]::unrelated::cmd]
  387.     my::cmd
  388. } -cleanup {
  389.     namespace delete origin unrelated my
  390. }
  392. test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
  393.     namespace eval origin {
  394. namespace export cmd
  395. proc cmd {} {}
  396.     }
  397.     namespace eval my 
  398.     [list namespace import [namespace current]::origin::cmd]
  399.     namespace eval my rename cmd newname
  400. } -body {
  401.     namespace eval my 
  402.     [list namespace forget [namespace current]::origin::cmd]
  403.     my::newname
  404. } -cleanup {
  405.     namespace delete origin my
  406. } -returnCodes error -match glob -result *
  408. test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
  409.     namespace eval origin {
  410. namespace export cmd
  411. proc cmd {} {}
  412.     }
  413.     namespace eval my 
  414.     [list namespace import [namespace current]::origin::cmd]
  415.     namespace eval your {}
  416.     namespace eval my 
  417.     [list rename cmd [namespace current]::your::newname]
  418. } -body {
  419.     namespace eval your namespace forget newname
  420.     your::newname
  421. } -cleanup {
  422.     namespace delete origin my your
  423. } -returnCodes error -match glob -result *
  425. test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
  426.     namespace eval origin {
  427. namespace export cmd
  428. proc cmd {} {}
  429.     }
  430.     namespace eval link namespace export cmd
  431.     namespace eval link 
  432.     [list namespace import [namespace current]::origin::cmd]
  433.     namespace eval link2 namespace export cmd
  434.     namespace eval link2 
  435.     [list namespace import [namespace current]::link::cmd]
  436.     namespace eval my 
  437.     [list namespace import [namespace current]::link2::cmd]
  438. } -body {
  439.     namespace eval my 
  440.     [list namespace forget [namespace current]::origin::cmd]
  441.     my::cmd
  442. } -cleanup {
  443.     namespace delete origin link link2 my
  444. } -returnCodes error -match glob -result *
  446. test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
  447.     namespace eval origin {
  448. namespace export cmd
  449. proc cmd {} {}
  450.     }
  451.     namespace eval link namespace export cmd
  452.     namespace eval link 
  453.     [list namespace import [namespace current]::origin::cmd]
  454.     namespace eval link2 namespace export cmd
  455.     namespace eval link2 
  456.     [list namespace import [namespace current]::link::cmd]
  457.     namespace eval my 
  458.     [list namespace import [namespace current]::link2::cmd]
  459. } -body {
  460.     namespace eval my 
  461.     [list namespace forget [namespace current]::link::cmd]
  462.     my::cmd
  463. } -cleanup {
  464.     namespace delete origin link link2 my
  465. }
  467. test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
  468.     namespace eval origin {
  469. namespace export cmd
  470. proc cmd {} {}
  471.     }
  472.     namespace eval link namespace export cmd
  473.     namespace eval link 
  474.     [list namespace import [namespace current]::origin::cmd]
  475.     namespace eval link2 namespace export cmd
  476.     namespace eval link2 
  477.     [list namespace import [namespace current]::link::cmd]
  478.     namespace eval my 
  479.     [list namespace import [namespace current]::link2::cmd]
  480. } -body {
  481.     namespace eval my 
  482.     [list namespace forget [namespace current]::link2::cmd]
  483.     my::cmd
  484. } -cleanup {
  485.     namespace delete origin link link2 my
  486. } -returnCodes error -match glob -result *
  488. test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
  489.     catch {eval namespace delete [namespace children :: test_ns_*]}
  490.     namespace eval test_ns_export {
  491.         namespace export cmd1
  492.         proc cmd1 {args} {return "cmd1: $args"}
  493.     }
  494.     list [namespace origin set] [namespace origin test_ns_export::cmd1]
  495. } {::set ::test_ns_export::cmd1}
  496. test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
  497.     namespace eval test_ns_import1 {
  498.         namespace import ::test_ns_export::*
  499.         namespace export *
  500.         proc p {} {namespace origin cmd1}
  501.     }
  502.     list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
  503. } {::test_ns_export::cmd1 ::test_ns_export::cmd1}
  504. test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
  505.     namespace eval test_ns_import2 {
  506.         namespace import ::test_ns_import1::*
  507.         proc q {} {return [cmd1 123]}
  508.     }
  509.     list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
  510. } {{cmd1: 123} ::test_ns_export::cmd1}
  512. test namespace-12.1 {InvokeImportedCmd} {
  513.     catch {eval namespace delete [namespace children :: test_ns_*]}
  514.     namespace eval test_ns_export {
  515.         namespace export cmd1
  516.         proc cmd1 {args} {namespace current}
  517.     }
  518.     namespace eval test_ns_import {
  519.         namespace import ::test_ns_export::*
  520.     }
  521.     list [test_ns_import::cmd1]
  522. } {::test_ns_export}
  524. test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
  525.     namespace eval test_ns_import {
  526.         set l {}
  527.         lappend l [info commands ::test_ns_import::*]
  528.         namespace forget ::test_ns_export::cmd1
  529.         lappend l [info commands ::test_ns_import::*]
  530.     }
  531. } {::test_ns_import::cmd1 {}}
  533. test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
  534.     catch {eval namespace delete [namespace children :: test_ns_*]}
  535.     variable v 10
  536.     namespace eval test_ns_1::test_ns_2 {
  537.         variable v 20
  538.     }
  539.     namespace eval test_ns_2 {
  540.         variable v 30
  541.     }
  542.     namespace eval test_ns_1 {
  543.         list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v 
  544. [lsort [namespace children :: test_ns_*]]
  545.     }
  546. } [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
  547. test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
  548.     namespace eval test_ns_1 {
  549.         list [catch {set ::test_ns_777::v} msg] $msg 
  550.              [catch {namespace children test_ns_777} msg] $msg
  551.     }
  552. } {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
  553. test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
  554.     namespace eval test_ns_1 {
  555.         list $v $test_ns_2::v
  556.     }
  557. } {10 20}
  558. test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
  559.     namespace eval test_ns_1::test_ns_2 {
  560.         namespace eval foo {}
  561.     }
  562.     namespace eval test_ns_1 {
  563.         list [namespace children test_ns_2] 
  564.              [catch {namespace children test_ns_1} msg] $msg
  565.     }
  566. } {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
  567. test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
  568.     namespace eval ::test_ns_2 {
  569.         namespace eval bar {}
  570.     }
  571.     namespace eval test_ns_1 {
  572.         set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
  573.     }
  574.     set l
  575. } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
  576. test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
  577.     namespace eval test_ns_1::test_ns_2 {
  578.         namespace eval foo {}
  579.     }
  580.     namespace eval test_ns_1 {
  581.         list [namespace children test_ns_2] 
  582.              [catch {namespace children test_ns_1} msg] $msg
  583.     }
  584. } {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
  585. test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
  586.     namespace children test_ns_1:::
  587. } {::test_ns_1::test_ns_2}
  588. test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
  589.     namespace children :::test_ns_1:::::test_ns_2:::
  590. } {::test_ns_1::test_ns_2::foo}
  591. test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
  592.     set l {}
  593.     lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
  594.     namespace eval test_ns_1::test_ns_2 {variable {} 2525}
  595.     lappend l [set test_ns_1::test_ns_2::]
  596. } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
  597. test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
  598.     catch {unset test_ns_1::test_ns_2::}
  599.     set l {}
  600.     lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
  601.     set test_ns_1::test_ns_2:: 314159
  602.     lappend l [set test_ns_1::test_ns_2::]
  603. } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
  604. test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
  605.     catch {rename test_ns_1::test_ns_2:: {}}
  606.     set l {}
  607.     lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
  608.     proc test_ns_1::test_ns_2:: {args} {return "{}: $args"}
  609.     lappend l [test_ns_1::test_ns_2:: hello]
  610. } {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
  611. test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
  612.     catch {eval namespace delete [namespace children :: test_ns_*]}
  613.     namespace eval test_ns_1 {
  614.         variable {}
  615.         set test_ns_1::(x) y
  616.     }
  617.     set test_ns_1::(x)
  618. } y
  619. test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
  620.     catch {eval namespace delete [namespace children :: test_ns_*]}
  621.     list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
  622. } {1 {can't create namespace "": only global namespace can have empty name}}
  624. test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
  625.     catch {eval namespace delete [namespace children :: test_ns_*]}
  626.     namespace eval test_ns_delete {
  627.         namespace eval test_ns_delete2 {}
  628.         proc cmd {args} {namespace current}
  629.     }
  630.     list [namespace delete ::test_ns_delete::test_ns_delete2] 
  631.          [namespace children ::test_ns_delete]
  632. } {{} {}}
  633. test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
  634.     list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
  635. } {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
  636. test namespace-15.3 {Tcl_FindNamespace, relative name found} {
  637.     namespace eval test_ns_delete {
  638.         namespace eval test_ns_delete2 {}
  639.         namespace eval test_ns_delete3 {}
  640.         list [namespace delete test_ns_delete2] 
  641.              [namespace children [namespace current]]
  642.     }
  643. } {{} ::test_ns_delete::test_ns_delete3}
  644. test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
  645.     namespace eval test_ns_delete2 {}
  646.     namespace eval test_ns_delete {
  647.         list [catch {namespace delete test_ns_delete2} msg] $msg
  648.     }
  649. } {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
  651. test namespace-16.1 {Tcl_FindCommand, absolute name found} {
  652.     catch {eval namespace delete [namespace children :: test_ns_*]}
  653.     namespace eval test_ns_1 {
  654.         proc cmd {args} {return "[namespace current]::cmd: $args"}
  655.         variable v "::test_ns_1::cmd"
  656.         eval $v one
  657.     }
  658. } {::test_ns_1::cmd: one}
  659. test namespace-16.2 {Tcl_FindCommand, absolute name found} {
  660.     eval $test_ns_1::v two
  661. } {::test_ns_1::cmd: two}
  662. test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
  663.     namespace eval test_ns_1 {
  664.         variable v2 "::test_ns_1::ladidah"
  665.         list [catch {eval $v2} msg] $msg
  666.     }
  667. } {1 {invalid command name "::test_ns_1::ladidah"}}
  669. # save the "unknown" proc, which is redefined by the following two tests
  670. catch {rename unknown unknown.old}
  671. proc unknown {args} {
  672.     return "unknown: $args"
  673. }
  674. test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
  675.     ::test_ns_1::foobar x y z
  676. } {unknown: ::test_ns_1::foobar x y z}
  677. test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
  678.     ::foobar 1 2 3 4 5
  679. } {unknown: ::foobar 1 2 3 4 5}
  680. test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
  681.     test_ns_1::foobar x y z
  682. } {unknown: test_ns_1::foobar x y z}
  683. test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
  684.     foobar 1 2 3 4 5
  685. } {unknown: foobar 1 2 3 4 5}
  686. # restore the "unknown" proc saved previously
  687. catch {rename unknown {}}
  688. catch {rename unknown.old unknown}
  690. test namespace-16.8 {Tcl_FindCommand, relative name found} {
  691.     namespace eval test_ns_1 {
  692.         cmd a b c
  693.     }
  694. } {::test_ns_1::cmd: a b c}
  695. test namespace-16.9 {Tcl_FindCommand, relative name found} {
  696.     catch {rename cmd2 {}}
  697.     proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
  698.     namespace eval test_ns_1 {
  699.        cmd2 a b c
  700.     }
  701. } {::::cmd2: a b c}
  702. test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
  703.     namespace eval test_ns_1 {
  704.         proc cmd2 {args} {
  705.             return "[namespace current]::cmd2 in test_ns_1: $args"
  706.         }
  707.         namespace eval test_ns_12 {
  708.             cmd2 a b c
  709.         }
  710.     }
  711. } {::::cmd2: a b c}
  712. test namespace-16.11 {Tcl_FindCommand, relative name not found} {
  713.     namespace eval test_ns_1 {
  714.        list [catch {cmd3 a b c} msg] $msg
  715.     }
  716. } {1 {invalid command name "cmd3"}}
  718. catch {unset x}
  719. test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
  720.     catch {eval namespace delete [namespace children :: test_ns_*]}
  721.     set x 314159
  722.     namespace eval test_ns_1 {
  723.         set ::x
  724.     }
  725. } {314159}
  726. test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
  727.     namespace eval test_ns_1 {
  728.         variable x 777
  729.         set ::test_ns_1::x
  730.     }
  731. } {777}
  732. test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
  733.     namespace eval test_ns_1 {
  734.         namespace eval test_ns_2 {
  735.             variable x 1111
  736.         }
  737.         set ::test_ns_1::test_ns_2::x
  738.     }
  739. } {1111}
  740. test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
  741.     namespace eval test_ns_1 {
  742.         namespace eval test_ns_2 {
  743.             variable x 1111
  744.         }
  745.         list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
  746.     }
  747. } {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
  748. test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
  749.     namespace eval test_ns_1 {
  750.         namespace eval test_ns_3 {
  751.             variable ::test_ns_1::test_ns_2::x 2222
  752.         }
  753.     }
  754.     set ::test_ns_1::test_ns_2::x
  755. } {2222}
  756. test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
  757.     namespace eval test_ns_1 {
  758.         set x
  759.     }
  760. } {777}
  761. test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
  762.     namespace eval test_ns_1 {
  763.         unset x
  764.         set x  ;# must be global x now
  765.     }
  766. } {314159}
  767. test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
  768.     namespace eval test_ns_1 {
  769.         list [catch {set wuzzat} msg] $msg
  770.     }
  771. } {1 {can't read "wuzzat": no such variable}}
  772. test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
  773.     namespace eval test_ns_1 {
  774.         variable a hello
  775.     }
  776.     set test_ns_1::a
  777. } {hello}
  778. catch {unset x}
  780. catch {unset l}
  781. catch {rename foo {}}
  782. test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
  783.     catch {eval namespace delete [namespace children :: test_ns_*]}
  784.     proc foo {} {return "global foo"}
  785.     namespace eval test_ns_1 {
  786.         proc trigger {} {
  787.             return [foo]
  788.         }
  789.     }
  790.     set l ""
  791.     lappend l [test_ns_1::trigger]
  792.     namespace eval test_ns_1 {
  793.         # force invalidation of cached ref to "foo" in proc trigger
  794.         proc foo {} {return "foo in test_ns_1"}
  795.     }
  796.     lappend l [test_ns_1::trigger]
  797.     set l
  798. } {{global foo} {foo in test_ns_1}}
  799. test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
  800.     namespace eval test_ns_2 {
  801.         proc foo {} {return "foo in ::test_ns_2"}
  802.     }
  803.     namespace eval test_ns_1 {
  804.         namespace eval test_ns_2 {}
  805.         proc trigger {} {
  806.             return [test_ns_2::foo]
  807.         }
  808.     }
  809.     set l ""
  810.     lappend l [test_ns_1::trigger]
  811.     namespace eval test_ns_1 {
  812.         namespace eval test_ns_2 {
  813.             # force invalidation of cached ref to "foo" in proc trigger
  814.             proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
  815.         }
  816.     }
  817.     lappend l [test_ns_1::trigger]
  818.     set l
  819. } {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
  820. catch {unset l}
  821. catch {rename foo {}}
  823. test namespace-19.1 {GetNamespaceFromObj, global name found} {
  824.     catch {eval namespace delete [namespace children :: test_ns_*]}
  825.     namespace eval test_ns_1::test_ns_2 {}
  826.     namespace children ::test_ns_1
  827. } {::test_ns_1::test_ns_2}
  828. test namespace-19.2 {GetNamespaceFromObj, relative name found} {
  829.     namespace eval test_ns_1 {
  830.         namespace children test_ns_2
  831.     }
  832. } {}
  833. test namespace-19.3 {GetNamespaceFromObj, name not found} {
  834.     namespace eval test_ns_1 {
  835.         list [catch {namespace children test_ns_99} msg] $msg
  836.     }
  837. } {1 {unknown namespace "test_ns_99" in namespace children command}}
  838. test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
  839.     namespace eval test_ns_1 {
  840.         proc foo {} {
  841.             return [namespace children test_ns_2]
  842.         }
  843.         list [catch {namespace children test_ns_99} msg] $msg
  844.     }
  845.     set l {}
  846.     lappend l [test_ns_1::foo]
  847.     namespace delete test_ns_1::test_ns_2
  848.     namespace eval test_ns_1::test_ns_2::test_ns_3 {}
  849.     lappend l [test_ns_1::foo]
  850.     set l
  851. } {{} ::test_ns_1::test_ns_2::test_ns_3}
  853. test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
  854.     catch {eval namespace delete [namespace children :: test_ns_*]}
  855.     list [catch {namespace} msg] $msg
  856. } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
  857. test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
  858.     list [catch {namespace wombat {}} msg] $msg
  859. } {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
  860. test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
  861.     namespace ch :: test_ns_*
  862. } {}
  864. test namespace-21.1 {NamespaceChildrenCmd, no args} {
  865.     catch {eval namespace delete [namespace children :: test_ns_*]}
  866.     namespace eval test_ns_1::test_ns_2 {}
  867.     expr {[string first ::test_ns_1 [namespace children]] != -1}
  868. } {1}
  869. test namespace-21.2 {NamespaceChildrenCmd, no args} {
  870.     namespace eval test_ns_1 {
  871.         namespace children
  872.     }
  873. } {::test_ns_1::test_ns_2}
  874. test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
  875.     namespace children ::test_ns_1
  876. } {::test_ns_1::test_ns_2}
  877. test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
  878.     namespace eval test_ns_1 {
  879.         namespace children test_ns_2
  880.     }
  881. } {}
  882. test namespace-21.5 {NamespaceChildrenCmd, too many args} {
  883.     namespace eval test_ns_1 {
  884.         list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
  885.     }
  886. } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
  887. test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
  888.     namespace eval test_ns_1::test_ns_foo {}
  889.     namespace children test_ns_1 *f*
  890. } {::test_ns_1::test_ns_foo}
  891. test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
  892.     namespace eval test_ns_1::test_ns_foo {}
  893.     lsort [namespace children test_ns_1 test*]
  894. } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
  896. test namespace-22.1 {NamespaceCodeCmd, bad args} {
  897.     catch {eval namespace delete [namespace children :: test_ns_*]}
  898.     list [catch {namespace code} msg] $msg 
  899.          [catch {namespace code xxx yyy} msg] $msg
  900. } {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
  901. test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
  902.     namespace eval test_ns_1 {
  903.         proc cmd {} {return "test_ns_1::cmd"}
  904.     }
  905.     namespace code {namespace inscope ::test_ns_1 cmd}
  906. } {namespace inscope ::test_ns_1 cmd}
  907. test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
  908.     namespace code {namespace     inscope     ::test_ns_1 cmd}
  909. } {namespace     inscope     ::test_ns_1 cmd}
  910. test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
  911.     namespace code unknown
  912. } {::namespace inscope :: unknown}
  913. test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
  914.     namespace eval test_ns_1 {
  915.         namespace code cmd
  916.     }
  917. } {::namespace inscope ::test_ns_1 cmd}
  918. test namespace-22.6 {NamespaceCodeCmd, in other namespace} { 
  919.     namespace eval test_ns_1 { 
  920. variable v 42 
  921.     } 
  922.     namespace eval test_ns_2 { 
  923. proc namespace args {} 
  924.     } 
  925.     namespace eval test_ns_2 [namespace eval test_ns_1 { 
  926. namespace code {set v} 
  927.     }] 
  928. } {42} 
  930. test namespace-23.1 {NamespaceCurrentCmd, bad args} {
  931.     catch {eval namespace delete [namespace children :: test_ns_*]}
  932.     list [catch {namespace current xxx} msg] $msg 
  933.          [catch {namespace current xxx yyy} msg] $msg
  934. } {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
  935. test namespace-23.2 {NamespaceCurrentCmd, at global level} {
  936.     namespace current
  937. } {::}
  938. test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
  939.     namespace eval test_ns_1::test_ns_2 {
  940.         namespace current
  941.     }
  942. } {::test_ns_1::test_ns_2}
  944. test namespace-24.1 {NamespaceDeleteCmd, no args} {
  945.     catch {eval namespace delete [namespace children :: test_ns_*]}
  946.     namespace delete
  947. } {}
  948. test namespace-24.2 {NamespaceDeleteCmd, one arg} {
  949.     namespace eval test_ns_1::test_ns_2 {}
  950.     namespace delete ::test_ns_1
  951. } {}
  952. test namespace-24.3 {NamespaceDeleteCmd, two args} {
  953.     namespace eval test_ns_1::test_ns_2 {}
  954.     list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
  955. } {{} {}}
  956. test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
  957.     list [catch {namespace delete ::test_ns_foo} msg] $msg
  958. } {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
  960. test namespace-25.1 {NamespaceEvalCmd, bad args} {
  961.     catch {eval namespace delete [namespace children :: test_ns_*]}
  962.     list [catch {namespace eval} msg] $msg
  963. } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
  964. test namespace-25.2 {NamespaceEvalCmd, bad args} {
  965.     list [catch {namespace test_ns_1} msg] $msg
  966. } {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
  967. catch {unset v}
  968. test namespace-25.3 {NamespaceEvalCmd, new namespace} {
  969.     set v 123
  970.     namespace eval test_ns_1 {
  971.         variable v 314159
  972.         proc p {} {
  973.             variable v
  974.             return $v
  975.         }
  976.     }
  977.     test_ns_1::p
  978. } {314159}
  979. test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
  980.     namespace eval test_ns_1 {
  981.         proc q {} {return [expr {[p]+1}]}
  982.     }
  983.     test_ns_1::q
  984. } {314160}
  985. test namespace-25.5 {NamespaceEvalCmd, multiple args} {
  986.     namespace eval test_ns_1 "set" "v"
  987. } {314159}
  988. test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
  989.     list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
  990. } {1 {invalid command name "xxxx"} {invalid command name "xxxx"
  991.     while executing
  992. "xxxx"
  993.     (in namespace eval "::test_ns_1" script line 1)
  994.     invoked from within
  995. "namespace eval test_ns_1 {xxxx}"}}
  996. test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
  997.     list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
  998. } {1 foo {bar
  999.     (in namespace eval "::test_ns_1" script line 1)
  1000.     invoked from within
  1001. "namespace eval test_ns_1 {error foo bar baz}"}}
  1002. test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} knownBug {
  1003.     list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
  1004. } {1 foo {bar
  1005.     (in namespace eval "::test_ns_1" script line 1)
  1006.     invoked from within
  1007. "namespace eval test_ns_1 error foo bar baz"}}
  1008. catch {unset v}
  1009. test namespace-25.9 {NamespaceEvalCmd, 545325} {
  1010.     namespace eval test_ns_1 info level 0
  1011. } {namespace eval test_ns_1 info level 0}
  1013. test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
  1014.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1015.     namespace export
  1016. } {}
  1017. test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
  1018.     namespace export -clear
  1019. } {}
  1020. test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
  1021.     namespace eval test_ns_1 {
  1022.         list [catch {namespace export ::zzz} msg] $msg
  1023.     }
  1024. } {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
  1025. test namespace-26.4 {NamespaceExportCmd, one pattern} {
  1026.     namespace eval test_ns_1 {
  1027.         namespace export cmd1
  1028.         proc cmd1 {args} {return "cmd1: $args"}
  1029.         proc cmd2 {args} {return "cmd2: $args"}
  1030.         proc cmd3 {args} {return "cmd3: $args"}
  1031.         proc cmd4 {args} {return "cmd4: $args"}
  1032.     }
  1033.     namespace eval test_ns_2 {
  1034.         namespace import ::test_ns_1::*
  1035.     }
  1036.     list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
  1037. } {::test_ns_2::cmd1 {cmd1: hello}}
  1038. test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
  1039.     namespace eval test_ns_1 {
  1040.         namespace export cmd1 cmd3
  1041.     }
  1042.     namespace eval test_ns_2 {
  1043.         namespace import -force ::test_ns_1::*
  1044.     }
  1045.     list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
  1046. } [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
  1047. test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
  1048.     namespace eval test_ns_1 {
  1049.         namespace export
  1050.     }
  1051. } {cmd1 cmd3}
  1052. test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
  1053.     namespace eval test_ns_1 {
  1054.         namespace export -clear cmd4
  1055.     }
  1056.     namespace eval test_ns_2 {
  1057.         namespace import ::test_ns_1::*
  1058.     }
  1059.     list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
  1060. } [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
  1062. test namespace-27.1 {NamespaceForgetCmd, no args} {
  1063.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1064.     namespace forget
  1065. } {}
  1066. test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
  1067.     list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
  1068. } {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
  1069. test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
  1070.     namespace eval test_ns_1 {
  1071.         namespace export cmd*
  1072.         proc cmd1 {args} {return "cmd1: $args"}
  1073.         proc cmd2 {args} {return "cmd2: $args"}
  1074.     }
  1075.     namespace eval test_ns_2 {
  1076.         namespace import ::test_ns_1::*
  1077.         namespace forget ::test_ns_1::cmd1
  1078.     }
  1079.     info commands ::test_ns_2::*
  1080. } {::test_ns_2::cmd2}
  1082. test namespace-28.1 {NamespaceImportCmd, no args} {
  1083.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1084.     namespace import
  1085. } {}
  1086. test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
  1087.     namespace import -force
  1088. } {}
  1089. test namespace-28.3 {NamespaceImportCmd, arg is imported} {
  1090.     namespace eval test_ns_1 {
  1091.         namespace export cmd2
  1092.         proc cmd1 {args} {return "cmd1: $args"}
  1093.         proc cmd2 {args} {return "cmd2: $args"}
  1094.     }
  1095.     namespace eval test_ns_2 {
  1096.         namespace import ::test_ns_1::*
  1097.         namespace forget ::test_ns_1::cmd1
  1098.     }
  1099.     info commands test_ns_2::*
  1100. } {::test_ns_2::cmd2}
  1102. test namespace-29.1 {NamespaceInscopeCmd, bad args} {
  1103.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1104.     list [catch {namespace inscope} msg] $msg
  1105. } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
  1106. test namespace-29.2 {NamespaceInscopeCmd, bad args} {
  1107.     list [catch {namespace inscope ::} msg] $msg
  1108. } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
  1109. test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
  1110.     list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
  1111. } {1 {unknown namespace "test_ns_1" in inscope namespace command}}
  1112. test namespace-29.4 {NamespaceInscopeCmd, simple case} {
  1113.     namespace eval test_ns_1 {
  1114.         variable v 747
  1115.         proc cmd {args} {
  1116.             variable v
  1117.             return "[namespace current]::cmd: v=$v, args=$args"
  1118.         }
  1119.     }
  1120.     namespace inscope test_ns_1 cmd
  1121. } {::test_ns_1::cmd: v=747, args=}
  1122. test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
  1123.     list [namespace inscope test_ns_1 cmd x y z] 
  1124.          [namespace eval test_ns_1 [concat cmd [list x y z]]]
  1125. } {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
  1126. test namespace-29.6 {NamespaceInscopeCmd, 1400572} knownBug {
  1127.     namespace inscope test_ns_1 {info level 0}
  1128. } {namespace inscope test_ns_1 {info level 0}}
  1131. test namespace-30.1 {NamespaceOriginCmd, bad args} {
  1132.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1133.     list [catch {namespace origin} msg] $msg
  1134. } {1 {wrong # args: should be "namespace origin name"}}
  1135. test namespace-30.2 {NamespaceOriginCmd, bad args} {
  1136.     list [catch {namespace origin x y} msg] $msg
  1137. } {1 {wrong # args: should be "namespace origin name"}}
  1138. test namespace-30.3 {NamespaceOriginCmd, command not found} {
  1139.     list [catch {namespace origin fred} msg] $msg
  1140. } {1 {invalid command name "fred"}}
  1141. test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
  1142.     namespace origin set
  1143. } {::set}
  1144. test namespace-30.5 {NamespaceOriginCmd, imported command} {
  1145.     namespace eval test_ns_1 {
  1146.         namespace export cmd*
  1147.         proc cmd1 {args} {return "cmd1: $args"}
  1148.         proc cmd2 {args} {return "cmd2: $args"}
  1149.     }
  1150.     namespace eval test_ns_2 {
  1151.         namespace export *
  1152.         namespace import ::test_ns_1::*
  1153.         proc p {} {}
  1154.     }
  1155.     namespace eval test_ns_3 {
  1156.         namespace import ::test_ns_2::*
  1157.         list [namespace origin foreach] 
  1158.              [namespace origin p] 
  1159.              [namespace origin cmd1] 
  1160.              [namespace origin ::test_ns_2::cmd2]
  1161.     }
  1162. } {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
  1164. test namespace-31.1 {NamespaceParentCmd, bad args} {
  1165.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1166.     list [catch {namespace parent a b} msg] $msg
  1167. } {1 {wrong # args: should be "namespace parent ?name?"}}
  1168. test namespace-31.2 {NamespaceParentCmd, no args} {
  1169.     namespace parent
  1170. } {}
  1171. test namespace-31.3 {NamespaceParentCmd, namespace specified} {
  1172.     namespace eval test_ns_1 {
  1173.         namespace eval test_ns_2 {
  1174.             namespace eval test_ns_3 {}
  1175.         }
  1176.     }
  1177.     list [namespace parent ::] 
  1178.          [namespace parent test_ns_1::test_ns_2] 
  1179.          [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
  1180. } {{} ::test_ns_1 ::test_ns_1}
  1181. test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
  1182.     list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
  1183. } {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
  1185. test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
  1186.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1187.     list [catch {namespace qualifiers} msg] $msg
  1188. } {1 {wrong # args: should be "namespace qualifiers string"}}
  1189. test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
  1190.     list [catch {namespace qualifiers x y} msg] $msg
  1191. } {1 {wrong # args: should be "namespace qualifiers string"}}
  1192. test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
  1193.     namespace qualifiers foo
  1194. } {}
  1195. test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
  1196.     namespace qualifiers ::x::y::z
  1197. } {::x::y}
  1198. test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
  1199.     namespace qualifiers a::b
  1200. } {a}
  1201. test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
  1202.     namespace qualifiers ::
  1203. } {}
  1204. test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
  1205.     namespace qualifiers :::::
  1206. } {}
  1207. test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
  1208.     namespace qualifiers foo:::
  1209. } {foo}
  1211. test namespace-33.1 {NamespaceTailCmd, bad args} {
  1212.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1213.     list [catch {namespace tail} msg] $msg
  1214. } {1 {wrong # args: should be "namespace tail string"}}
  1215. test namespace-33.2 {NamespaceTailCmd, bad args} {
  1216.     list [catch {namespace tail x y} msg] $msg
  1217. } {1 {wrong # args: should be "namespace tail string"}}
  1218. test namespace-33.3 {NamespaceTailCmd, simple name} {
  1219.     namespace tail foo
  1220. } {foo}
  1221. test namespace-33.4 {NamespaceTailCmd, leading ::} {
  1222.     namespace tail ::x::y::z
  1223. } {z}
  1224. test namespace-33.5 {NamespaceTailCmd, no leading ::} {
  1225.     namespace tail a::b
  1226. } {b}
  1227. test namespace-33.6 {NamespaceTailCmd, :: argument} {
  1228.     namespace tail ::
  1229. } {}
  1230. test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
  1231.     namespace tail :::::
  1232. } {}
  1233. test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
  1234.     namespace tail foo:::
  1235. } {}
  1237. test namespace-34.1 {NamespaceWhichCmd, bad args} {
  1238.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1239.     list [catch {namespace which} msg] $msg
  1240. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  1241. test namespace-34.2 {NamespaceWhichCmd, bad args} {
  1242.     list [catch {namespace which -fred} msg] $msg
  1243. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  1244. test namespace-34.3 {NamespaceWhichCmd, bad args} {
  1245.     list [catch {namespace which -command} msg] $msg
  1246. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  1247. test namespace-34.4 {NamespaceWhichCmd, bad args} {
  1248.     list [catch {namespace which a b} msg] $msg
  1249. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  1250. test namespace-34.5 {NamespaceWhichCmd, command lookup} {
  1251.     namespace eval test_ns_1 {
  1252.         namespace export cmd*
  1253.         variable v1 111
  1254.         proc cmd1 {args} {return "cmd1: $args"}
  1255.         proc cmd2 {args} {return "cmd2: $args"}
  1256.     }
  1257.     namespace eval test_ns_2 {
  1258.         namespace export *
  1259.         namespace import ::test_ns_1::*
  1260.         variable v2 222
  1261.         proc p {} {}
  1262.     }
  1263.     namespace eval test_ns_3 {
  1264.         namespace import ::test_ns_2::*
  1265.         variable v3 333
  1266.         list [namespace which -command foreach] 
  1267.              [namespace which -command p] 
  1268.              [namespace which -command cmd1] 
  1269.              [namespace which -command ::test_ns_2::cmd2] 
  1270.              [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
  1271.     }
  1272. } {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
  1273. test namespace-34.6 {NamespaceWhichCmd, -command is default} {
  1274.     namespace eval test_ns_3 {
  1275.         list [namespace which foreach] 
  1276.              [namespace which p] 
  1277.              [namespace which cmd1] 
  1278.              [namespace which ::test_ns_2::cmd2]
  1279.     }
  1280. } {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
  1281. test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
  1282.     namespace eval test_ns_3 {
  1283.         list [namespace which -variable env] 
  1284.              [namespace which -variable v3] 
  1285.              [namespace which -variable ::test_ns_2::v2] 
  1286.              [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
  1287.     }
  1288. } {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
  1290. test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
  1291.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1292.     namespace eval test_ns_1 {
  1293.         proc p {} {
  1294.             namespace delete [namespace current]
  1295.             return [namespace current]
  1296.         }
  1297.     }
  1298.     test_ns_1::p
  1299. } {::test_ns_1}
  1300. test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
  1301.     namespace eval test_ns_1 {
  1302.         proc q {} {
  1303.             return [namespace current]
  1304.         }
  1305.     }
  1306.     list [test_ns_1::q] 
  1307.          [namespace delete test_ns_1] 
  1308.          [catch {test_ns_1::q} msg] $msg
  1309. } {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
  1311. catch {unset x}
  1312. catch {unset y}
  1313. test namespace-36.1 {DupNsNameInternalRep} {
  1314.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1315.     namespace eval test_ns_1 {}
  1316.     set x "::test_ns_1"
  1317.     list [namespace parent $x] [set y $x] [namespace parent $y]
  1318. } {:: ::test_ns_1 ::}
  1319. catch {unset x}
  1320. catch {unset y}
  1322. test namespace-37.1 {SetNsNameFromAny, ns name found} {
  1323.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1324.     namespace eval test_ns_1::test_ns_2 {}
  1325.     namespace eval test_ns_1 {
  1326.         namespace children ::test_ns_1
  1327.     }
  1328. } {::test_ns_1::test_ns_2}
  1329. test namespace-37.2 {SetNsNameFromAny, ns name not found} {
  1330.     namespace eval test_ns_1 {
  1331.         list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
  1332.     }
  1333. } {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
  1335. test namespace-38.1 {UpdateStringOfNsName} {
  1336.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1337.     ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
  1338.     list [namespace eval {} {namespace current}] 
  1339.          [namespace eval {} {namespace current}]
  1340. } {:: ::}
  1342. test namespace-39.1 {NamespaceExistsCmd} {
  1343.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1344.     namespace eval ::test_ns_z::test_me { variable foo }
  1345.     list [namespace exists ::] 
  1346.     [namespace exists ::bogus_namespace] 
  1347.     [namespace exists ::test_ns_z] 
  1348.     [namespace exists test_ns_z] 
  1349.     [namespace exists ::test_ns_z::foo] 
  1350.     [namespace exists ::test_ns_z::test_me] 
  1351.     [namespace eval ::test_ns_z { namespace exists ::test_me }] 
  1352.     [namespace eval ::test_ns_z { namespace exists test_me }] 
  1353.     [namespace exists :::::test_ns_z]
  1354. } {1 0 1 1 0 1 0 1 1}
  1355. test namespace-39.2 {NamespaceExistsCmd error} {
  1356.     list [catch {namespace exists} msg] $msg
  1357. } {1 {wrong # args: should be "namespace exists name"}}
  1358. test namespace-39.3 {NamespaceExistsCmd error} {
  1359.     list [catch {namespace exists a b} msg] $msg
  1360. } {1 {wrong # args: should be "namespace exists name"}}
  1362. test namespace-40.1 {Ignoring namespace proc "unknown"} {
  1363.     rename unknown _unknown
  1364.     proc unknown args {return global}
  1365.     namespace eval ns {proc unknown args {return local}}
  1366.     set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
  1367.     rename unknown {}   
  1368.     rename _unknown unknown
  1369.     namespace delete ns
  1370.     set l
  1371. } {global global}
  1373. test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
  1374.     set res {}
  1375.     namespace eval ns {
  1376. set res {}
  1377. proc test {} {
  1378.     set ::g 0
  1379. }  
  1380. lappend ::res [test]
  1381. proc set {a b} {
  1382.     ::set a [incr b]
  1383. }
  1384. lappend ::res [test]
  1385.     }
  1386.     namespace delete ns
  1387.     set res
  1388. } {0 1}
  1390. test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
  1391.     set res {}
  1392.     namespace eval ns {}
  1393.     proc ns::a {i} {
  1394. variable b
  1395. proc set args {return "New proc is called"}
  1396. return [set b $i]
  1397.     }
  1398.     ns::a 1
  1399.     set res [ns::a 2]
  1400.     namespace delete ns
  1401.     set res
  1402. } {New proc is called}
  1404. test namespace-41.3 {Shadowing byte-compiled commands, Bug: 231259} {knownBug} {
  1405.     set res {}
  1406.     namespace eval ns {
  1407. variable b 0
  1408.     }
  1410.     proc ns::a {i} {
  1411. variable b
  1412. proc set args {return "New proc is called"}
  1413. return [set b $i]
  1414.     }
  1415.     
  1416.     set res [list [ns::a 1] $ns::b]
  1417.     namespace delete ns
  1418.     set res
  1419. } {{New proc is called} 0}
  1421. # cleanup
  1422. catch {rename cmd1 {}}
  1423. catch {unset l}
  1424. catch {unset msg}
  1425. catch {unset trigger}
  1426. eval namespace delete [namespace children :: test_ns_*]
  1427. ::tcltest::cleanupTests
  1428. return