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

     1 # Functionality covered: this file contains slightly modified versions of

     2 # the original tests written by Mike McLennan of Lucent Technologies for

     3 # the procedures in tclNamesp.c that implement Tcl's basic support for

     4 # namespaces. Other namespace-related tests appear in namespace.test

     5 # and variable.test.

6 #

     7 # Sourcing this file into Tcl runs the tests and generates output for

     8 # errors. No output means no errors were found.

9 #

    10 # Copyright (c) 1997 Sun Microsystems, Inc.

    11 # Copyright (c) 1997 Lucent Technologies

    12 # Copyright (c) 1998-1999 by Scriptics Corporation.

    13 #

    14 # See the file "license.terms" for information on usage and redistribution

    15 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    16 #

    17 # RCS: @(#) $Id: namespace-old.test,v 1.6 2001/04/07 02:11:19 msofer Exp $

    19 if {[lsearch [namespace children] ::tcltest] == -1} {

    20     package require tcltest

    21     namespace import -force ::tcltest::*

    22 }

    24 # Clear out any namespaces called test_ns_*

    25 catch {eval namespace delete [namespace children :: test_ns_*]}

    27 test namespace-old-1.1 {usage for "namespace" command} {

    28     list [catch {namespace} msg] $msg

    29 } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}

    31 test namespace-old-1.2 {global namespace's name is "::" or {}} {

    32     list [namespace current] [namespace eval {} {namespace current}]

    33 } {:: ::}

    35 test namespace-old-1.3 {usage for "namespace eval"} {

    36     list [catch {namespace eval} msg] $msg

    37 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

    39 test namespace-old-1.4 {create new namespaces} {

    40     list [lsort [namespace children :: test_ns_simple*]] \

    41 	 [namespace eval test_ns_simple {}] \

    42 	 [namespace eval test_ns_simple2 {}] \

    43          [lsort [namespace children :: test_ns_simple*]]

    44 } {{} {} {} {::test_ns_simple ::test_ns_simple2}}

    46 test namespace-old-1.5 {access a new namespace} {

    47     namespace eval test_ns_simple { namespace current }

    48 } {::test_ns_simple}

    50 test namespace-old-1.6 {usage for "namespace eval"} {

    51     list [catch {namespace eval} msg] $msg

    52 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

    54 test namespace-old-1.7 {usage for "namespace eval"} {

    55     list [catch {namespace eval test_ns_xyzzy} msg] $msg

    56 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

    58 test namespace-old-1.8 {command "namespace eval" concatenates args} {

    59     namespace eval test_ns_simple namespace current

    60 } {::test_ns_simple}

    62 test namespace-old-1.9 {add elements to a namespace} {

    63     namespace eval test_ns_simple {

    64         variable test_ns_x 0

    65         proc test {test_ns_x} {

    66             return "test: $test_ns_x"

    67         }

    68     }

    69 } {}

    71 test namespace-old-1.10 {commands in a namespace} {

    72     namespace eval test_ns_simple { info commands [namespace current]::*}

    73 } {::test_ns_simple::test}

    75 test namespace-old-1.11 {variables in a namespace} {

    76     namespace eval test_ns_simple { info vars [namespace current]::* }

    77 } {::test_ns_simple::test_ns_x}

    79 test namespace-old-1.12 {global vars are separate from locals vars} {

    80     list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]

    81 } {{test: 123} 0}

    83 test namespace-old-1.13 {add to an existing namespace} {

    84     namespace eval test_ns_simple {

    85         variable test_ns_y 123

    86         proc _backdoor {cmd} {

    87             eval $cmd

    88         }

    89     }

    90 } ""

    92 test namespace-old-1.14 {commands in a namespace} {

    93     lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]

    94 } {::test_ns_simple::_backdoor ::test_ns_simple::test}

    96 test namespace-old-1.15 {variables in a namespace} {

    97     lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]

    98 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

    99 test namespace-old-1.16 {variables in a namespace} {

   100     lsort [info vars test_ns_simple::*]

   101 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

   103 test namespace-old-1.17 {commands in a namespace are hidden} {

   104     list [catch "_backdoor {return yes!}" msg] $msg

   105 } {1 {invalid command name "_backdoor"}}

   106 test namespace-old-1.18 {using namespace qualifiers} {

   107     list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg

   108 } {0 yes!}

   109 test namespace-old-1.19 {using absolute namespace qualifiers} {

   110     list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg

   111 } {0 yes!}

   113 test namespace-old-1.20 {variables in a namespace are hidden} {

   114     list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg

   115 } {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}

   116 test namespace-old-1.21 {using namespace qualifiers} {

   117     list [catch "set test_ns_simple::test_ns_x" msg] $msg \

   118          [catch "set test_ns_simple::test_ns_y" msg] $msg

   119 } {0 0 0 123}

   120 test namespace-old-1.22 {using absolute namespace qualifiers} {

   121     list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \

   122          [catch "set ::test_ns_simple::test_ns_y" msg] $msg

   123 } {0 0 0 123}

   124 test namespace-old-1.23 {variables can be accessed within a namespace} {

   125     test_ns_simple::_backdoor {

   126         variable test_ns_x

   127         variable test_ns_y

   128         return "$test_ns_x $test_ns_y"

   129     }

   130 } {0 123}

   132 test namespace-old-1.24 {setting global variables} {

   133     test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}

   134     namespace eval test_ns_simple {set test_ns_x}

   135 } {new val}

   137 test namespace-old-1.25 {qualified variables don't need a global declaration} {

   138     namespace eval test_ns_another { variable test_ns_x 456 }

   139     set cmd {set ::test_ns_another::test_ns_x}

   140     list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \

   141          [eval $cmd]

   142 } {0 some-value some-value}

   144 test namespace-old-1.26 {namespace qualifiers are okay after $'s} {

   145     namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }

   146     set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}

   147     list [test_ns_simple::_backdoor $cmd] [eval $cmd]

   148 } {{12 34} {12 34}}

   150 test namespace-old-1.27 {can create commands with null names} {

   151     proc test_ns_simple:: {args} {return $args}

   152 } {}

   154 # -----------------------------------------------------------------------

   155 # TEST: using "info" in namespace contexts

   156 # -----------------------------------------------------------------------

   157 test namespace-old-2.1 {querying:  info commands} {

   158     lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]

   159 } {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}

   161 test namespace-old-2.2 {querying:  info procs} {

   162     lsort [test_ns_simple::_backdoor {info procs}]

   163 } {{} _backdoor test}

   165 test namespace-old-2.3 {querying:  info vars} {

   166     lsort [info vars test_ns_simple::*]

   167 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

   169 test namespace-old-2.4 {querying:  info vars} {

   170     lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]

   171 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

   173 test namespace-old-2.5 {querying:  info locals} {

   174     lsort [test_ns_simple::_backdoor {info locals}]

   175 } {cmd}

   177 test namespace-old-2.6 {querying:  info exists} {

   178     test_ns_simple::_backdoor {info exists test_ns_x}

   179 } {0}

   181 test namespace-old-2.7 {querying:  info exists} {

   182     test_ns_simple::_backdoor {info exists cmd}

   183 } {1}

   185 test namespace-old-2.8 {querying:  info args} {

   186     info args test_ns_simple::_backdoor

   187 } {cmd}

   189 test namespace-old-2.9 {querying:  info body} {

   190     string trim [info body test_ns_simple::test]

   191 } {return "test: $test_ns_x"}

   193 # -----------------------------------------------------------------------

   194 # TEST: namespace qualifiers, namespace tail

   195 # -----------------------------------------------------------------------

   196 test namespace-old-3.1 {usage for "namespace qualifiers"} {

   197     list [catch "namespace qualifiers" msg] $msg

   198 } {1 {wrong # args: should be "namespace qualifiers string"}}

   200 test namespace-old-3.2 {querying:  namespace qualifiers} {

   201     list [namespace qualifiers ""] \

   202          [namespace qualifiers ::] \

   203          [namespace qualifiers x] \

   204          [namespace qualifiers ::x] \

   205          [namespace qualifiers foo::x] \

   206          [namespace qualifiers ::foo::bar::xyz]

   207 } {{} {} {} {} foo ::foo::bar}

   209 test namespace-old-3.3 {usage for "namespace tail"} {

   210     list [catch "namespace tail" msg] $msg

   211 } {1 {wrong # args: should be "namespace tail string"}}

   213 test namespace-old-3.4 {querying:  namespace tail} {

   214     list [namespace tail ""] \

   215          [namespace tail ::] \

   216          [namespace tail x] \

   217          [namespace tail ::x] \

   218          [namespace tail foo::x] \

   219          [namespace tail ::foo::bar::xyz]

   220 } {{} {} x x x xyz}

   222 # -----------------------------------------------------------------------

   223 # TEST: delete commands and namespaces

   224 # -----------------------------------------------------------------------

   225 test namespace-old-4.1 {define test namespaces} {

   226     namespace eval test_ns_delete {

   227         namespace eval ns1 {

   228             variable var1 1

   229             proc cmd1 {} {return "cmd1"}

   230         }

   231         namespace eval ns2 {

   232             variable var2 2

   233             proc cmd2 {} {return "cmd2"}

   234         }

   235         namespace eval another {}

   236         lsort [namespace children]

   237     }

   238 } {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}

   240 test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {

   241     list [catch {namespace delete} msg] $msg

   242 } {0 {}}

   244 test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {

   245     set cmd {

   246         namespace eval test_ns_delete {namespace delete ns*}

   247     }

   248     list [catch $cmd msg] $msg

   249 } {1 {unknown namespace "ns*" in namespace delete command}}

   251 test namespace-old-4.4 {command "namespace delete" handles multiple args} {

   252     set cmd {

   253         namespace eval test_ns_delete {

   254             eval namespace delete \

   255                 [namespace children [namespace current] ns?]

   256         }

   257     }

   258     list [catch $cmd msg] $msg [namespace children test_ns_delete]

   259 } {0 {} ::test_ns_delete::another}

   261 # -----------------------------------------------------------------------

   262 # TEST: namespace hierarchy

   263 # -----------------------------------------------------------------------

   264 test namespace-old-5.1 {define nested namespaces} {

   265     set test_ns_var_global "var in ::"

   266     proc test_ns_cmd_global {} {return "cmd in ::"}

   268     namespace eval test_ns_hier1 {

   269         set test_ns_var_hier1 "particular to hier1"

   270         proc test_ns_cmd_hier1 {} {return "particular to hier1"}

   272         set test_ns_level 1

   273         proc test_ns_show {} {return "[namespace current]: 1"}

   275         namespace eval test_ns_hier2 {

   276             set test_ns_var_hier2 "particular to hier2"

   277             proc test_ns_cmd_hier2 {} {return "particular to hier2"}

   279             set test_ns_level 2

   280             proc test_ns_show {} {return "[namespace current]: 2"}

   282             namespace eval test_ns_hier3a {}

   283             namespace eval test_ns_hier3b {}

   284         }

   286         namespace eval test_ns_hier2a {}

   287         namespace eval test_ns_hier2b {}

   288     }

   289 } {}

   291 test namespace-old-5.2 {namespaces can be nested} {

   292     list [namespace eval test_ns_hier1 {namespace current}] \

   293          [namespace eval test_ns_hier1 {

   294               namespace eval test_ns_hier2 {namespace current}

   295           }]

   296 } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

   298 test namespace-old-5.3 {namespace qualifiers work in namespace command} {

   299     list [namespace eval ::test_ns_hier1 {namespace current}] \

   300          [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \

   301          [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]

   302 } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}

   304 test namespace-old-5.4 {nested namespaces can access global namespace} {

   305     list [namespace eval test_ns_hier1 {set test_ns_var_global}] \

   306          [namespace eval test_ns_hier1 {test_ns_cmd_global}] \

   307          [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \

   308          [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]

   309 } {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}

   311 test namespace-old-5.5 {variables in different namespaces don't conflict} {

   312     list [set test_ns_hier1::test_ns_level] \

   313          [set test_ns_hier1::test_ns_hier2::test_ns_level]

   314 } {1 2}

   316 test namespace-old-5.6 {commands in different namespaces don't conflict} {

   317     list [test_ns_hier1::test_ns_show] \

   318          [test_ns_hier1::test_ns_hier2::test_ns_show]

   319 } {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}

   321 test namespace-old-5.7 {nested namespaces don't see variables in parent} {

   322     set cmd {

   323         namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}

   324     }

   325     list [catch $cmd msg] $msg

   326 } {1 {can't read "test_ns_var_hier1": no such variable}}

   328 test namespace-old-5.8 {nested namespaces don't see commands in parent} {

   329     set cmd {

   330         namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}

   331     }

   332     list [catch $cmd msg] $msg

   333 } {1 {invalid command name "test_ns_cmd_hier1"}}

   335 test namespace-old-5.9 {usage for "namespace children"} {

   336     list [catch {namespace children test_ns_hier1 y z} msg] $msg

   337 } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}

   339 test namespace-old-5.10 {command "namespace children" must get valid namespace} {

   340     list [catch {namespace children xyzzy} msg] $msg

   341 } {1 {unknown namespace "xyzzy" in namespace children command}}

   343 test namespace-old-5.11 {querying namespace children} {

   344     lsort [namespace children :: test_ns_hier*]

   345 } {::test_ns_hier1}

   347 test namespace-old-5.12 {querying namespace children} {

   348     lsort [namespace children test_ns_hier1]

   349 } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}

   351 test namespace-old-5.13 {querying namespace children} {

   352     lsort [namespace eval test_ns_hier1 {namespace children}]

   353 } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}

   355 test namespace-old-5.14 {querying namespace children} {

   356     lsort [namespace children test_ns_hier1::test_ns_hier2]

   357 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

   359 test namespace-old-5.15 {querying namespace children} {

   360     lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]

   361 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

   363 test namespace-old-5.16 {querying namespace children with patterns} {

   364     lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]

   365 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

   367 test namespace-old-5.17 {querying namespace children with patterns} {

   368     lsort [namespace children test_ns_hier1::test_ns_hier2 *b]

   369 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

   371 test namespace-old-5.18 {usage for "namespace parent"} {

   372     list [catch {namespace parent x y} msg] $msg

   373 } {1 {wrong # args: should be "namespace parent ?name?"}}

   375 test namespace-old-5.19 {command "namespace parent" must get valid namespace} {

   376     list [catch {namespace parent xyzzy} msg] $msg

   377 } {1 {unknown namespace "xyzzy" in namespace parent command}}

   379 test namespace-old-5.20 {querying namespace parent} {

   380     list [namespace eval :: {namespace parent}] \

   381         [namespace eval test_ns_hier1 {namespace parent}] \

   382         [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \

   383         [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \

   384 } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

   386 test namespace-old-5.21 {querying namespace parent for explicit namespace} {

   387     list [namespace parent ::] \

   388          [namespace parent test_ns_hier1] \

   389          [namespace parent test_ns_hier1::test_ns_hier2] \

   390          [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]

   391 } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

   393 # -----------------------------------------------------------------------

   394 # TEST: name resolution and caching

   395 # -----------------------------------------------------------------------

   396 test namespace-old-6.1 {relative ns names only looked up in current ns} {

   397     namespace eval test_ns_cache1 {}

   398     namespace eval test_ns_cache2 {}

   399     namespace eval test_ns_cache2::test_ns_cache3 {}

   400     set trigger {

   401         namespace eval test_ns_cache2 {namespace current}

   402     }

   403     set trigger2 {

   404         namespace eval test_ns_cache2::test_ns_cache3 {namespace current}

   405     }

   406     list [namespace eval test_ns_cache1 $trigger] \

   407          [namespace eval test_ns_cache1 $trigger2]

   408 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

   410 test namespace-old-6.2 {relative ns names only looked up in current ns} {

   411     namespace eval test_ns_cache1::test_ns_cache2 {}

   412     list [namespace eval test_ns_cache1 $trigger] \

   413          [namespace eval test_ns_cache1 $trigger2]

   414 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

   416 test namespace-old-6.3 {relative ns names only looked up in current ns} {

   417     namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}

   418     list [namespace eval test_ns_cache1 $trigger] \

   419          [namespace eval test_ns_cache1 $trigger2]

   420 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

   422 test namespace-old-6.4 {relative ns names only looked up in current ns} {

   423     namespace delete test_ns_cache1::test_ns_cache2

   424     list [namespace eval test_ns_cache1 $trigger] \

   425          [namespace eval test_ns_cache1 $trigger2]

   426 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

   428 test namespace-old-6.5 {define test commands} {

   429     proc test_ns_cache_cmd {} {

   430         return "global version"

   431     }

   432     namespace eval test_ns_cache1 {

   433         proc trigger {} {

   434             test_ns_cache_cmd

   435         }

   436     }

   437     test_ns_cache1::trigger

   438 } {global version}

   440 test namespace-old-6.6 {one-level check for command shadowing} {

   441     proc test_ns_cache1::test_ns_cache_cmd {} {

   442         return "cache1 version"

   443     }

   444     test_ns_cache1::trigger

   445 } {cache1 version}

   447 test namespace-old-6.7 {renaming commands changes command epoch} {

   448     namespace eval test_ns_cache1 {

   449         rename test_ns_cache_cmd test_ns_new

   450     }

   451     test_ns_cache1::trigger

   452 } {global version}

   454 test namespace-old-6.8 {renaming back handles shadowing} {

   455     namespace eval test_ns_cache1 {

   456         rename test_ns_new test_ns_cache_cmd

   457     }

   458     test_ns_cache1::trigger

   459 } {cache1 version}

   461 test namespace-old-6.9 {deleting commands changes command epoch} {

   462     namespace eval test_ns_cache1 {

   463         rename test_ns_cache_cmd ""

   464     }

   465     test_ns_cache1::trigger

   466 } {global version}

   468 test namespace-old-6.10 {define test namespaces} {

   469     namespace eval test_ns_cache2 {

   470         proc test_ns_cache_cmd {} {

   471             return "global cache2 version"

   472         }

   473     }

   474     namespace eval test_ns_cache1 {

   475         proc trigger {} {

   476             test_ns_cache2::test_ns_cache_cmd

   477         }

   478     }

   479     namespace eval test_ns_cache1::test_ns_cache2 {

   480         proc trigger {} {

   481             test_ns_cache_cmd

   482         }

   483     }

   484     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]

   485 } {{global cache2 version} {global version}}

   487 test namespace-old-6.11 {commands affect all parent namespaces} {

   488     proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {

   489         return "cache2 version"

   490     }

   491     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]

   492 } {{cache2 version} {cache2 version}}

   494 test namespace-old-6.12 {define test variables} {

   495     variable test_ns_cache_var "global version"

   496     set trigger {set test_ns_cache_var}

   497     namespace eval test_ns_cache1 $trigger

   498 } {global version}

   500 test namespace-old-6.13 {one-level check for variable shadowing} {

   501     namespace eval test_ns_cache1 {

   502         variable test_ns_cache_var "cache1 version"

   503     }

   504     namespace eval test_ns_cache1 $trigger

   505 } {cache1 version}

   507 test namespace-old-6.14 {deleting variables changes variable epoch} {

   508     namespace eval test_ns_cache1 {

   509         unset test_ns_cache_var

   510     }

   511     namespace eval test_ns_cache1 $trigger

   512 } {global version}

   514 test namespace-old-6.15 {define test namespaces} {

   515     namespace eval test_ns_cache2 {

   516         variable test_ns_cache_var "global cache2 version"

   517     }

   518     set trigger2 {set test_ns_cache2::test_ns_cache_var}

   519     list [namespace eval test_ns_cache1 $trigger2] \

   520          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]

   521 } {{global cache2 version} {global version}}

   523 test namespace-old-6.16 {public variables affect all parent namespaces} {

   524     variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"

   525     list [namespace eval test_ns_cache1 $trigger2] \

   526          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]

   527 } {{cache2 version} {cache2 version}}

   529 test namespace-old-6.17 {usage for "namespace which"} {

   530     list [catch "namespace which -baz" msg] $msg

   531 } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}

   532 test namespace-old-6.18 {usage for "namespace which"} {

   533     list [catch "namespace which -command" msg] $msg

   534 } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}

   536 test namespace-old-6.19 {querying:  namespace which -command} {

   537     proc test_ns_cache1::test_ns_cache_cmd {} {

   538         return "cache1 version"

   539     }

   540     list [namespace eval :: {namespace which test_ns_cache_cmd}] \

   541          [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \

   542          [namespace eval :: {namespace which -command test_ns_cache_cmd}] \

   543          [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]

   544 } {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}

   546 test namespace-old-6.20 {command "namespace which" may not find commands} {

   547     namespace eval test_ns_cache1 {namespace which -command xyzzy}

   548 } {}

   550 test namespace-old-6.21 {querying:  namespace which -variable} {

   551     namespace eval test_ns_cache1::test_ns_cache2 {

   552         namespace which -variable test_ns_cache_var

   553     }

   554 } {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}

   556 test namespace-old-6.22 {command "namespace which" may not find variables} {

   557     namespace eval test_ns_cache1 {namespace which -variable xyzzy}

   558 } {}

   560 # -----------------------------------------------------------------------

   561 # TEST: uplevel/upvar across namespace boundaries

   562 # -----------------------------------------------------------------------

   563 test namespace-old-7.1 {define test namespace} {

   564     namespace eval test_ns_uplevel {

   565         variable x 0

   566         variable y 1

   568         proc show_vars {num} {

   569             return [uplevel $num {info vars}]

   570         }

   571         proc test_uplevel {num} {

   572             set a 0

   573             set b 1

   574             namespace eval ::test_ns_uplevel " return \[show_vars $num\] "

   575         }

   576     }

   577 } {}

   578 test namespace-old-7.2 {uplevel can access namespace call frame} {

   579     list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \

   580          [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]

   581 } {1 1}

   582 test namespace-old-7.3 {uplevel can go beyond namespace call frame} {

   583     lsort [test_ns_uplevel::test_uplevel 2]

   584 } {a b num}

   585 test namespace-old-7.4 {uplevel can go up to global context} {

   586     expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}

   587 } {1}

   589 test namespace-old-7.5 {absolute call frame references work too} {

   590     list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \

   591          [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]

   592 } {1 1}

   593 test namespace-old-7.6 {absolute call frame references work too} {

   594     lsort [test_ns_uplevel::test_uplevel #1]

   595 } {a b num}

   596 test namespace-old-7.7 {absolute call frame references work too} {

   597     expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}

   598 } {1}

   600 test namespace-old-7.8 {namespaces are included in the call stack} {

   601     namespace eval test_ns_upvar {

   602         variable scope "test_ns_upvar"

   604         proc show_val {var num} {

   605             upvar $num $var x

   606             return $x

   607         }

   608         proc test_upvar {num} {

   609             set scope "test_ns_upvar::test_upvar"

   610             namespace eval ::test_ns_upvar " return \[show_val scope $num\] "

   611         }

   612     }

   613 } {}

   614 test namespace-old-7.9 {upvar can access namespace call frame} {

   615     test_ns_upvar::test_upvar 1

   616 } {test_ns_upvar}

   617 test namespace-old-7.10 {upvar can go beyond namespace call frame} {

   618     test_ns_upvar::test_upvar 2

   619 } {test_ns_upvar::test_upvar}

   620 test namespace-old-7.11 {absolute call frame references work too} {

   621     test_ns_upvar::test_upvar #2

   622 } {test_ns_upvar}

   623 test namespace-old-7.12 {absolute call frame references work too} {

   624     test_ns_upvar::test_upvar #1

   625 } {test_ns_upvar::test_upvar}

   627 # -----------------------------------------------------------------------

   628 # TEST: variable traces across namespace boundaries

   629 # -----------------------------------------------------------------------

   630 test namespace-old-8.1 {traces work across namespace boundaries} {

   631     namespace eval test_ns_trace {

   632         namespace eval foo {

   633             variable x ""

   634         }

   636         variable status ""

   637         proc monitor {name1 name2 op} {

   638             variable status

   639             lappend status "$op: $name1"

   640         }

   641         trace variable foo::x rwu [namespace code monitor]

   642     }

   643     set test_ns_trace::foo::x "yes!"

   644     set test_ns_trace::foo::x

   645     unset test_ns_trace::foo::x

   647     namespace eval test_ns_trace { set status }

   648 } {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}

   650 # -----------------------------------------------------------------------

   651 # TEST: imported commands

   652 # -----------------------------------------------------------------------

   653 test namespace-old-9.1 {empty "namespace export" list} {

   654     list [catch "namespace export" msg] $msg

   655 } {0 {}}

   656 test namespace-old-9.2 {usage for "namespace export" command} {

   657     list [catch "namespace export test_ns_trace::zzz" msg] $msg

   658 } {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}

   660 test namespace-old-9.3 {define test namespaces for import} {

   661     namespace eval test_ns_export {

   662         namespace export cmd1 cmd2 cmd3

   663         proc cmd1 {args} {return "cmd1: $args"}

   664         proc cmd2 {args} {return "cmd2: $args"}

   665         proc cmd3 {args} {return "cmd3: $args"}

   666         proc cmd4 {args} {return "cmd4: $args"}

   667         proc cmd5 {args} {return "cmd5: $args"}

   668         proc cmd6 {args} {return "cmd6: $args"}

   669     }

   670     lsort [info commands test_ns_export::*]

   671 } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}

   673 test namespace-old-9.4 {check export status} {

   674     set x ""

   675     namespace eval test_ns_import {

   676         namespace export cmd1 cmd2

   677         namespace import ::test_ns_export::*

   678     }

   679     foreach cmd [lsort [info commands test_ns_import::*]] {

   680         lappend x $cmd

   681     }

   682     set x

   683 } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}

   685 test namespace-old-9.5 {empty import list in "namespace import" command} {

   686     namespace import

   687 } {}

   689 test namespace-old-9.6 {empty import list for "namespace import" command} {

   690     namespace import

   691 } {}

   693 test namespace-old-9.7 {empty forget list for "namespace forget" command} {

   694     namespace forget

   695 } {}

   697 catch {rename cmd1 {}}

   698 catch {rename cmd2 {}}

   699 catch {rename ncmd {}}

   700 catch {rename ncmd1 {}}

   701 catch {rename ncmd2 {}}

   702 test namespace-old-9.8 {only exported commands are imported} {

   703     namespace import test_ns_import::cmd*

   704     set x [lsort [info commands cmd*]]

   705 } {cmd1 cmd2}

   707 test namespace-old-9.9 {imported commands work just the same as original} {

   708     list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]

   709 } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}

   711 test namespace-old-9.10 {commands can be imported from many namespaces} {

   712     namespace eval test_ns_import2 {

   713         namespace export ncmd ncmd1 ncmd2

   714         proc ncmd  {args} {return "ncmd: $args"}

   715         proc ncmd1 {args} {return "ncmd1: $args"}

   716         proc ncmd2 {args} {return "ncmd2: $args"}

   717         proc ncmd3 {args} {return "ncmd3: $args"}

   718     }

   719     namespace import test_ns_import2::*

   720     lsort [concat [info commands cmd*] [info commands ncmd*]]

   721 } {cmd1 cmd2 ncmd ncmd1 ncmd2}

   723 test namespace-old-9.11 {imported commands can be removed by deleting them} {

   724     rename cmd1 ""

   725     lsort [concat [info commands cmd*] [info commands ncmd*]]

   726 } {cmd2 ncmd ncmd1 ncmd2}

   728 test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {

   729     list [catch {namespace forget xyzzy::*} msg] $msg

   730 } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}

   732 test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {

   733     list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \

   734          [lsort [info commands cmd?]]

   735 } {0 {} cmd2}

   737 test namespace-old-9.14 {imported commands can be removed} {

   738     namespace forget test_ns_import::cmd?

   739     list [lsort [info commands cmd?]] \

   740          [catch {cmd1 another test} msg] $msg

   741 } {{} 1 {invalid command name "cmd1"}}

   743 test namespace-old-9.15 {existing commands can't be overwritten} {

   744     proc cmd1 {x y} {

   745         return [expr $x+$y]

   746     }

   747     list [catch {namespace import test_ns_import::cmd?} msg] $msg \

   748          [cmd1 3 5]

   749 } {1 {can't import command "cmd1": already exists} 8}

   751 test namespace-old-9.16 {use "-force" option to override existing commands} {

   752     list [cmd1 3 5] \

   753          [namespace import -force test_ns_import::cmd?] \

   754          [cmd1 3 5]

   755 } {8 {} {cmd1: 3 5}}

   757 test namespace-old-9.17 {commands can be imported into many namespaces} {

   758     namespace eval test_ns_import_use {

   759         namespace import ::test_ns_import::* ::test_ns_import2::ncmd?

   760         lsort [concat [info commands ::test_ns_import_use::cmd*] \

   761                       [info commands ::test_ns_import_use::ncmd*]]

   762     }

   763 } {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}

   765 test namespace-old-9.18 {when command is deleted, imported commands go away} {

   766     namespace eval test_ns_import { rename cmd1 "" }

   767     list [info commands cmd1] \

   768          [namespace eval test_ns_import_use {info commands cmd1}]

   769 } {{} {}}

   771 test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {

   772     namespace delete test_ns_import test_ns_import2

   773     list [info commands cmd*] \

   774          [info commands ncmd*] \

   775          [namespace eval test_ns_import_use {info commands cmd*}] \

   776          [namespace eval test_ns_import_use {info commands ncmd*}] \

   777 } {{} {} {} {}}

   779 # -----------------------------------------------------------------------

   780 # TEST: scoped values

   781 # -----------------------------------------------------------------------

   782 test namespace-old-10.1 {define namespace for scope test} {

   783     namespace eval test_ns_inscope {

   784         variable x "x-value"

   785         proc show {args} {

   786             return "show: $args"

   787         }

   788         proc do {args} {

   789             return [eval $args]

   790         }

   791         list [set x] [show test]

   792     }

   793 } {x-value {show: test}}

   795 test namespace-old-10.2 {command "namespace code" requires one argument} {

   796     list [catch {namespace code} msg] $msg

   797 } {1 {wrong # args: should be "namespace code arg"}}

   799 test namespace-old-10.3 {command "namespace code" requires one argument} {

   800     list [catch {namespace code first "second arg" third} msg] $msg

   801 } {1 {wrong # args: should be "namespace code arg"}}

   803 test namespace-old-10.4 {command "namespace code" gets current namesp context} {

   804     namespace eval test_ns_inscope {

   805         namespace code {"1 2 3" "4 5" 6}

   806     }

   807 } {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}

   809 test namespace-old-10.5 {with one arg, first "scope" sticks} {

   810     set sval [namespace eval test_ns_inscope {namespace code {one two}}]

   811     namespace code $sval

   812 } {::namespace inscope ::test_ns_inscope {one two}}

   814 test namespace-old-10.6 {with many args, each "scope" adds new args} {

   815     set sval [namespace eval test_ns_inscope {namespace code {one two}}]

   816     namespace code "$sval three"

   817 } {::namespace inscope ::test_ns_inscope {one two} three}

   819 test namespace-old-10.7 {scoped commands work with eval} {

   820     set cref [namespace eval test_ns_inscope {namespace code show}]

   821     list [eval $cref "a" "b c" "d e f"]

   822 } {{show: a b c d e f}}

   824 test namespace-old-10.8 {scoped commands execute in namespace context} {

   825     set cref [namespace eval test_ns_inscope {

   826         namespace code {set x "some new value"}

   827     }]

   828     list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]

   829 } {x-value {some new value} {some new value}}

   831 foreach cmd [info commands test_ns_*] {

   832     rename $cmd ""

   833 }

   834 catch {rename cmd {}}

   835 catch {rename cmd1 {}}

   836 catch {rename cmd2 {}}

   837 catch {rename ncmd {}}

   838 catch {rename ncmd1 {}}

   839 catch {rename ncmd2 {}}

   840 catch {unset cref}

   841 catch {unset trigger}

   842 catch {unset trigger2}

   843 catch {unset sval}

   844 catch {unset msg}

   845 catch {unset x}

   846 catch {unset test_ns_var_global}

   847 catch {unset cmd}

   848 eval namespace delete [namespace children :: test_ns_*]

   850 # cleanup

   851 ::tcltest::cleanupTests

   852 return

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