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