tests/namespace.test

   1 source [file dirname [info script]]/testing.tcl
   2 needs cmd namespace
   3
   4 test namespace-1.1 {usage for "namespace" command} -body {
   5     namespace
   6 } -returnCodes error -match glob -result {wrong # args: should be *}
   7
   8 test namespace-1.2 {global namespace's name is "::" or {}} {
   9     list [namespace current] [namespace eval {} {namespace current}] [namespace eval :: {namespace current}]
  10 } {:: :: ::}
  11
  12 test namespace-1.3 {usage for "namespace eval"} -body {
  13     namespace eval
  14 } -returnCodes error -match glob -result {wrong # args: should be "namespace eval *"}
  15
  16 test namespace-1.5 {access a new namespace} {
  17     namespace eval ns1 { namespace current }
  18 } {::ns1}
  19
  20 test namespace-1.7 {usage for "namespace eval"} -body {
  21     namespace eval ns1
  22 } -returnCodes error -match glob -result {wrong # args: should be "namespace eval *"}
  23
  24 test namespace-1.8 {command "namespace eval" concatenates args} {
  25     namespace eval ns1 namespace current
  26 } {::ns1}
  27
  28 test namespace-1.9 {simple namespace elements} {
  29     namespace eval ns1 {
  30         variable v1 1
  31         proc p1 {a} {variable v1; list $a $v1}
  32         p1 3
  33     }
  34 } {3 1}
  35
  36 test namespace-1.10 {commands in a namespace} {
  37     namespace eval ns1 {
  38         info commands [namespace current]::*
  39     }
  40 } {::ns1::p1}
  41
  42 test namespace-1.11 {variables in a namespace} {
  43     namespace eval ns1 {
  44         info vars [namespace current]::*
  45     }
  46 } {::ns1::v1}
  47
  48 test namespace-1.12 {global vars are separate from locals vars} {
  49     set v1 2
  50     list [ns1::p1 123] [set ns1::v1] [set ::v1]
  51 } {{123 1} 1 2}
  52
  53 test namespace-1.13 {add to an existing namespace} {
  54     namespace eval ns1 {
  55         variable v2 22
  56         proc p2 {script} {variable v2; eval $script}
  57         p2 {return $v2}
  58     }
  59 } 22
  60
  61 test namespace-1.14 {commands in a namespace} {
  62     lsort [namespace eval ns1 {info commands [namespace current]::*}]
  63 } {::ns1::p1 ::ns1::p2}
  64
  65 test namespace-1.15 {variables in a namespace} {
  66     lsort [namespace eval ns1 {info vars [namespace current]::*}]
  67 } {::ns1::v1 ::ns1::v2}
  68
  69 # Tcl produces fully scoped names here
  70 test namespace-1.16 {variables in a namespace} jim {
  71     lsort [info vars ns1::*]
  72 } {ns1::v1 ns1::v2}
  73
  74 test namespace-1.17 {commands in a namespace are hidden} -body {
  75     v2 {return 3}
  76 } -returnCodes error -result {invalid command name "v2"}
  77
  78 test namespace-1.18 {using namespace qualifiers} {
  79     ns1::p2 {return 44}
  80 } 44
  81
  82 test namespace-1.19 {using absolute namespace qualifiers} {
  83     ::ns1::p2 {return 55}
  84 } 55
  85
  86 test namespace-1.20 {variables in a namespace are hidden} -body {
  87     set v2
  88 }  -returnCodes error -result {can't read "v2": no such variable}
  89
  90 test namespace-1.21 {using namespace qualifiers} {
  91     list $ns1::v1 $ns1::v2
  92 } {1 22}
  93
  94 test namespace-1.22 {using absolute namespace qualifiers} {
  95     list $::ns1::v1 $::ns1::v2
  96 } {1 22}
  97
  98 test namespace-1.23 {variables can be accessed within a namespace} {
  99     ns1::p2 {
 100         variable v1
 101         variable v2
 102         list $v1 $v2
 103     }
 104 } {1 22}
 105
 106 test namespace-1.24 {setting global variables} {
 107     ns1::p2 {
 108                 variable v1
 109         set v1 new
 110     }
 111     namespace eval ns1 {
 112         variable v1
 113         variable v2
 114         list $v1 $v2
 115     }
 116 } {new 22}
 117
 118 test namespace-1.25 {qualified variables don't need a global declaration} {
 119     namespace eval ns2 { variable x 456 }
 120     set cmd {set ::ns2::x}
 121     ns1::p2 "$cmd some-value"
 122         set ::ns2::x
 123 } {some-value}
 124
 125 test namespace-1.26 {namespace qualifiers are okay after $'s} {
 126     namespace eval ns1 { variable x; variable y; set x 12; set y 34 }
 127     set cmd {list $::ns1::x $::ns1::y}
 128     list [ns1::p2 $cmd] [eval $cmd]
 129 } {{12 34} {12 34}}
 130
 131 test namespace-1.27 {can create commands with null names} {
 132     proc ns1:: {args} {return $args}
 133         ns1:: x
 134 } {x}
 135
 136 test namespace-1.28 {namespace variable with array element syntax} -body {
 137         namespace eval ns1 {
 138                 variable x(3) y
 139         }
 140 } -returnCodes error -result {can't define "x(3)": name refers to an element in an array}
 141
 142 unset -nocomplain ns1::x ns1::y
 143
 144 # -----------------------------------------------------------------------
 145 # TEST: using "info" in namespace contexts
 146 # -----------------------------------------------------------------------
 147 test namespace-2.1 {querying:  info commands} {
 148     lsort [ns1::p2 {info commands [namespace current]::*}]
 149 } {::ns1:: ::ns1::p1 ::ns1::p2}
 150
 151 test namespace-2.2 {querying:  info procs} {
 152     lsort [ns1::p2 {info procs}]
 153 } {{} p1 p2}
 154
 155 # Tcl produces fully scoped names here
 156 test namespace-2.3 {querying:  info vars} jim {
 157     lsort [info vars ns1::*]
 158 } {ns1::v1 ns1::v2}
 159
 160 test namespace-2.4 {querying:  info vars} {
 161     lsort [ns1::p2 {info vars [namespace current]::*}]
 162 } {::ns1::v1 ::ns1::v2}
 163
 164 test namespace-2.5 {querying:  info locals} {
 165     lsort [ns1::p2 {info locals}]
 166 } {script}
 167
 168 test namespace-2.6 {querying:  info exists} {
 169     ns1::p2 {info exists v1}
 170 } {0}
 171
 172 test namespace-2.7 {querying:  info exists} {
 173     ns1::p2 {info exists v2}
 174 } {1}
 175
 176 test namespace-2.8 {querying:  info args} {
 177     info args ns1::p2
 178 } {script}
 179
 180 test namespace-2.9 {querying:  info body} {
 181     string trim [info body ns1::p1]
 182 } {variable v1; list $a $v1}
 183
 184 # -----------------------------------------------------------------------
 185 # TEST: namespace qualifiers, namespace tail
 186 # -----------------------------------------------------------------------
 187 test namespace-3.1 {usage for "namespace qualifiers"} {
 188     list [catch "namespace qualifiers" msg] $msg
 189 } {1 {wrong # args: should be "namespace qualifiers string"}}
 190
 191 test namespace-3.2 {querying:  namespace qualifiers} {
 192     list [namespace qualifiers ""] \
 193          [namespace qualifiers ::] \
 194          [namespace qualifiers x] \
 195          [namespace qualifiers ::x] \
 196          [namespace qualifiers foo::x] \
 197          [namespace qualifiers ::foo::bar::xyz]
 198 } {{} {} {} {} foo ::foo::bar}
 199
 200 test namespace-3.3 {usage for "namespace tail"} {
 201     list [catch "namespace tail" msg] $msg
 202 } {1 {wrong # args: should be "namespace tail string"}}
 203
 204 test namespace-3.4 {querying:  namespace tail} {
 205     list [namespace tail ""] \
 206          [namespace tail ::] \
 207          [namespace tail x] \
 208          [namespace tail ::x] \
 209          [namespace tail foo::x] \
 210          [namespace tail ::foo::bar::xyz]
 211 } {{} {} x x x xyz}
 212
 213 # -----------------------------------------------------------------------
 214 # TEST: namespace hierarchy
 215 # -----------------------------------------------------------------------
 216 test namespace-5.1 {define nested namespaces} {
 217     set test_ns_var_global "var in ::"
 218     proc test_ns_cmd_global {} {return "cmd in ::"}
 219     namespace eval nsh1 {
 220         set test_ns_var_hier1 "particular to hier1"
 221         proc test_ns_cmd_hier1 {} {return "particular to hier1"}
 222         proc test_ns_show {} {return "[namespace current]: 1"}
 223         namespace eval nsh2 {
 224             set test_ns_var_hier2 "particular to hier2"
 225             proc test_ns_cmd_hier2 {} {return "particular to hier2"}
 226             proc test_ns_show {} {return "[namespace current]: 2"}
 227             namespace eval nsh3a {}
 228             namespace eval nsh3b {}
 229         }
 230         namespace eval nsh2a {}
 231         namespace eval nsh2b {}
 232     }
 233 } {}
 234
 235 test namespace-5.2 {namespaces can be nested} {
 236     list [namespace eval nsh1 {namespace current}] \
 237          [namespace eval nsh1 {
 238               namespace eval nsh2 {namespace current}
 239           }]
 240 } {::nsh1 ::nsh1::nsh2}
 241
 242 test namespace-5.3 {namespace qualifiers work in namespace command} {
 243     list [namespace eval ::nsh1 {namespace current}] \
 244          [namespace eval nsh1::nsh2 {namespace current}] \
 245          [namespace eval ::nsh1::nsh2 {namespace current}]
 246 } {::nsh1 ::nsh1::nsh2 ::nsh1::nsh2}
 247
 248 test namespace-5.4 {nested namespaces can access global namespace} {
 249     list [namespace eval nsh1 {set ::test_ns_var_global}] \
 250          [namespace eval nsh1 {test_ns_cmd_global}] \
 251          [namespace eval nsh1::nsh2 {set ::test_ns_var_global}] \
 252          [namespace eval nsh1::nsh2 {test_ns_cmd_global}]
 253 } {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
 254
 255 test namespace-5.6 {commands in different namespaces don't conflict} {
 256     list [nsh1::test_ns_show] \
 257          [nsh1::nsh2::test_ns_show]
 258 } {{::nsh1: 1} {::nsh1::nsh2: 2}}
 259 test namespace-5.7 {nested namespaces don't see variables in parent} {
 260     set cmd {
 261         namespace eval nsh1::nsh2 {set test_ns_var_hier1}
 262     }
 263     list [catch $cmd msg] $msg
 264 } {1 {can't read "test_ns_var_hier1": no such variable}}
 265 test namespace-5.8 {nested namespaces don't see commands in parent} {
 266     set cmd {
 267         namespace eval nsh1::nsh2 {test_ns_cmd_hier1}
 268     }
 269     list [catch $cmd msg] $msg
 270 } {1 {invalid command name "test_ns_cmd_hier1"}}
 271
 272 test namespace-5.18 {usage for "namespace parent"} {
 273     list [catch {namespace parent x y} msg] $msg
 274 } {1 {wrong # args: should be "namespace parent ?name?"}}
 275
 276 test namespace-5.20 {querying namespace parent} {
 277     list [namespace eval :: {namespace parent}] \
 278         [namespace eval nsh1 {namespace parent}] \
 279         [namespace eval nsh1::nsh2 {namespace parent}] \
 280         [namespace eval nsh1::nsh2::nsh3a {namespace parent}] \
 281 } {{} :: ::nsh1 ::nsh1::nsh2}
 282
 283 test namespace-5.21 {querying namespace parent for explicit namespace} {
 284     list [namespace parent ::] \
 285          [namespace parent nsh1] \
 286          [namespace parent nsh1::nsh2] \
 287          [namespace parent nsh1::nsh2::nsh3a]
 288 } {{} :: ::nsh1 ::nsh1::nsh2}
 289
 290 # -----------------------------------------------------------------------
 291 # TEST: name resolution and caching
 292 # -----------------------------------------------------------------------
 293 test namespace-6.1 {relative ns names only looked up in current ns} {
 294     namespace eval tns1 {}
 295     namespace eval tns2 {}
 296     namespace eval tns2::test_ns_cache3 {}
 297     set trigger {
 298         namespace eval tns2 {namespace current}
 299     }
 300     set trigger2 {
 301         namespace eval tns2::test_ns_cache3 {namespace current}
 302     }
 303     list [namespace eval tns1 $trigger] \
 304          [namespace eval tns1 $trigger2]
 305 } {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
 306 test namespace-6.2 {relative ns names only looked up in current ns} {
 307     namespace eval tns1::tns2 {}
 308     list [namespace eval tns1 $trigger] \
 309          [namespace eval tns1 $trigger2]
 310 } {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
 311 test namespace-6.3 {relative ns names only looked up in current ns} {
 312     namespace eval tns1::tns2::test_ns_cache3 {}
 313     list [namespace eval tns1 $trigger] \
 314          [namespace eval tns1 $trigger2]
 315 } {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
 316 test namespace-6.4 {relative ns names only looked up in current ns} {
 317     namespace delete tns1::tns2
 318     list [namespace eval tns1 $trigger] \
 319          [namespace eval tns1 $trigger2]
 320 } {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
 321
 322 test namespace-6.5 {define test commands} {
 323     proc testcmd {} {
 324         return "global version"
 325     }
 326     namespace eval tns1 {
 327         proc trigger {} {
 328             testcmd
 329         }
 330     }
 331     tns1::trigger
 332 } {global version}
 333
 334 test namespace-6.6 {one-level check for command shadowing} {
 335     proc tns1::testcmd {} {
 336         return "cache1 version"
 337     }
 338     tns1::trigger
 339 } {cache1 version}
 340
 341 test namespace-6.7 {renaming commands changes command epoch} {
 342     namespace eval tns1 {
 343         rename testcmd testcmd_new
 344     }
 345     tns1::trigger
 346 } {global version}
 347 test namespace-6.8 {renaming back handles shadowing} {
 348     namespace eval tns1 {
 349         rename testcmd_new testcmd
 350     }
 351     tns1::trigger
 352 } {cache1 version}
 353 test namespace-6.9 {deleting commands changes command epoch} {
 354     namespace eval tns1 {
 355         rename testcmd ""
 356     }
 357     tns1::trigger
 358 } {global version}
 359 test namespace-6.10 {define test namespaces} {
 360     namespace eval tns2 {
 361         proc testcmd {} {
 362             return "global cache2 version"
 363         }
 364     }
 365     namespace eval tns1 {
 366         proc trigger {} {
 367             tns2::testcmd
 368         }
 369     }
 370     namespace eval tns1::tns2 {
 371         proc trigger {} {
 372             testcmd
 373         }
 374     }
 375     list [tns1::trigger] [tns1::tns2::trigger]
 376 } {{global cache2 version} {global version}}
 377
 378 test namespace-6.11 {commands affect all parent namespaces} {
 379     proc tns1::tns2::testcmd {} {
 380         return "cache2 version"
 381     }
 382     list [tns1::trigger] [tns1::tns2::trigger]
 383 } {{cache2 version} {cache2 version}}
 384
 385 # -----------------------------------------------------------------------
 386 # TEST: uplevel/upvar across namespace boundaries
 387 # -----------------------------------------------------------------------
 388 # Note that Tcl behaves a little differently for uplevel and upvar
 389
 390 test namespace-7.1 {uplevel in namespace eval} jim {
 391         set x 66
 392     namespace eval uns1 {
 393                 variable y 55
 394                 set x 33
 395         uplevel 1 set x
 396     }
 397 } {66}
 398
 399 test namespace-7.2 {upvar in ns proc} jim {
 400         proc uns1::getvar {v} {
 401                 variable y
 402                 upvar $v var
 403                 list $var $y
 404         }
 405         uns1::getvar x
 406 } {66 55}
 407
 408 # -----------------------------------------------------------------------
 409 # TEST: scoped values
 410 # -----------------------------------------------------------------------
 411 test namespace-10.1 {define namespace for scope test} {
 412     namespace eval ins1 {
 413         variable x "x-value"
 414         proc show {args} {
 415             return "show: $args"
 416         }
 417         proc do {args} {
 418             return [eval $args]
 419         }
 420         list [set x] [show test]
 421     }
 422 } {x-value {show: test}}
 423
 424 test namespace-10.2 {command "namespace code" requires one argument} {
 425     list [catch {namespace code} msg] $msg
 426 } {1 {wrong # args: should be "namespace code arg"}}
 427
 428 test namespace-10.3 {command "namespace code" requires one argument} {
 429     list [catch {namespace code first "second arg" third} msg] $msg
 430 } {1 {wrong # args: should be "namespace code arg"}}
 431
 432 test namespace-10.4 {command "namespace code" gets current namesp context} {
 433     namespace eval ins1 {
 434         namespace code {"1 2 3" "4 5" 6}
 435     }
 436 } {::namespace inscope ::ins1 {"1 2 3" "4 5" 6}}
 437
 438 test namespace-10.5 {with one arg, first "scope" sticks} {
 439     set sval [namespace eval ins1 {namespace code {one two}}]
 440     namespace code $sval
 441 } {::namespace inscope ::ins1 {one two}}
 442
 443 test namespace-10.6 {with many args, each "scope" adds new args} {
 444     set sval [namespace eval ins1 {namespace code {one two}}]
 445     namespace code "$sval three"
 446 } {::namespace inscope ::ins1 {one two} three}
 447
 448 test namespace-10.7 {scoped commands work with eval} {
 449     set cref [namespace eval ins1 {namespace code show}]
 450     list [eval $cref "a" "b c" "d e f"]
 451 } {{show: a b c d e f}}
 452
 453 test namespace-10.8 {scoped commands execute in namespace context} {
 454     set cref [namespace eval ins1 {
 455         namespace code {variable x; set x "some new value"}
 456     }]
 457     list [set ins1::x] [eval $cref] [set ins1::x]
 458 } {x-value {some new value} {some new value}}
 459
 460 test namespace-11.1 {command caching} {
 461         proc cmd1 {} { return global }
 462         set result {}
 463         namespace eval ns1 {
 464                 proc cmd1 {} { return ns1 }
 465                 proc cmd2 {} {
 466                         uplevel 1 cmd1
 467                 }
 468                 lappend ::result [cmd2]
 469         }
 470         lappend result [ns1::cmd2]
 471 } {ns1 global}
 472
 473 test namespace-12.1 {namespace import} {
 474         namespace eval test_ns_scope1 {
 475                 proc a {} { return a }
 476                 namespace export a
 477         }
 478         namespace eval test_ns_scope2 {
 479                 namespace import ::test_ns_scope1::a
 480                 a
 481         }
 482 } {a}
 483
 484 test namespace-12.2 {namespace import recursive} -body {
 485         namespace eval test_ns_scope1 {
 486             namespace import [namespace current]::*
 487         }
 488 } -returnCodes error -match glob -result {import pattern "*" tries to import from namespace "*" into itself}
 489
 490 test namespace-12.3 {namespace import loop} -setup {
 491     namespace eval one {
 492         namespace export cmd
 493         proc cmd {} {}
 494     }
 495     namespace eval two namespace export cmd
 496     namespace eval two \
 497             [list namespace import [namespace current]::one::cmd]
 498     namespace eval three namespace export cmd
 499     namespace eval three \
 500             [list namespace import [namespace current]::two::cmd]
 501 } -body {
 502     namespace eval two [list namespace import -force \
 503             [namespace current]::three::cmd]
 504     namespace origin two::cmd
 505 } -cleanup {
 506     namespace delete one two three
 507 } -returnCodes error -match glob -result {import pattern * would create a loop*}
 508
 509 foreach cmd [info commands test_ns_*] {
 510     rename $cmd ""
 511 }
 512
 513 catch {rename cmd {}}
 514 catch {rename cmd1 {}}
 515 catch {rename cmd2 {}}
 516 catch {rename ncmd {}}
 517 catch {rename ncmd1 {}}
 518 catch {rename ncmd2 {}}
 519 catch {unset cref}
 520 catch {unset trigger}
 521 catch {unset trigger2}
 522 catch {unset sval}
 523 catch {unset msg}
 524 catch {unset x}
 525 catch {unset test_ns_var_global}
 526 catch {unset cmd}
 527 catch {eval namespace delete [namespace children :: test_ns_*]}
 528
 529 # cleanup
 530 ::tcltest::cleanupTests
 531 return
 532
 533 # Local Variables:
 534 # mode: tcl
 535 # End: