Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/namespace.test@bde4ae8d615e

     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     }

  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

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--