1# Functionality covered: this file contains a collection of tests for the 2# procedures in tclNamesp.c that implement Tcl's basic support for 3# namespaces. Other namespace-related tests appear in variable.test. 4# 5# Sourcing this file into Tcl runs the tests and generates output for 6# errors. No output means no errors were found. 7# 8# Copyright (c) 1997 Sun Microsystems, Inc. 9# Copyright (c) 1998-2000 by Scriptics Corporation. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 14if {[lsearch [namespace children] ::tcltest] == -1} { 15 package require tcltest 2 16 namespace import -force ::tcltest::* 17} 18 19# 20# REMARK: the tests for 'namespace upvar' are not done here. They are to be 21# found in the file 'upvar.test'. 22# 23 24# Clear out any namespaces called test_ns_* 25catch {namespace delete {*}[namespace children :: test_ns_*]} 26 27proc fq {ns} { 28 if {[string match ::* $ns]} {return $ns} 29 set current [uplevel 1 {namespace current}] 30 return [string trimright $current :]::[string trimleft $ns :] 31} 32 33test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { 34 namespace children :: test_ns_* 35} {} 36 37catch {unset l} 38test namespace-2.1 {Tcl_GetCurrentNamespace} { 39 list [namespace current] [namespace eval {} {namespace current}] \ 40 [namespace eval {} {namespace current}] 41} {:: :: ::} 42test namespace-2.2 {Tcl_GetCurrentNamespace} { 43 set l {} 44 lappend l [namespace current] 45 namespace eval test_ns_1 { 46 lappend l [namespace current] 47 namespace eval foo { 48 lappend l [namespace current] 49 } 50 } 51 lappend l [namespace current] 52 set l 53} {:: ::test_ns_1 ::test_ns_1::foo ::} 54 55test namespace-3.1 {Tcl_GetGlobalNamespace} { 56 namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } } 57 # namespace children uses Tcl_GetGlobalNamespace 58 namespace eval test_ns_1 {namespace children foo b*} 59} {::test_ns_1::foo::bar} 60 61test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} { 62 namespace eval test_ns_1 { 63 variable v 123 64 proc p {} { 65 variable v 66 return $v 67 } 68 } 69 test_ns_1::p ;# does Tcl_PushCallFrame to push p's namespace 70} {123} 71test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} { 72 namespace eval test_ns_1::baz {} ;# does Tcl_PushCallFrame to create baz 73 proc test_ns_1::baz::p {} { 74 variable v 75 set v 789 76 set v} 77 test_ns_1::baz::p 78} {789} 79 80test namespace-5.1 {Tcl_PopCallFrame, no vars} { 81 namespace eval test_ns_1::blodge {} ;# pushes then pops frame 82} {} 83test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} { 84 proc test_ns_1::r {} { 85 set a 123 86 } 87 test_ns_1::r ;# pushes then pop's r's frame 88} {123} 89 90test namespace-6.1 {Tcl_CreateNamespace} { 91 catch {namespace delete {*}[namespace children :: test_ns_*]} 92 list [lsort [namespace children :: test_ns_*]] \ 93 [namespace eval test_ns_1 {namespace current}] \ 94 [namespace eval test_ns_2 {namespace current}] \ 95 [namespace eval ::test_ns_3 {namespace current}] \ 96 [namespace eval ::test_ns_4 \ 97 {namespace eval foo {namespace current}}] \ 98 [namespace eval ::test_ns_5 \ 99 {namespace eval ::test_ns_6 {namespace current}}] \ 100 [lsort [namespace children :: test_ns_*]] 101} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}} 102test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} { 103 list [namespace eval :::test_ns_1::::foo {namespace current}] \ 104 [namespace eval test_ns_2:::::foo {namespace current}] 105} {::test_ns_1::foo ::test_ns_2::foo} 106test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { 107 list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 108} {0 ::test_ns_7} 109test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { 110 catch {namespace delete {*}[namespace children :: test_ns_*]} 111 namespace eval test_ns_1:: { 112 namespace eval test_ns_2:: {} 113 namespace eval test_ns_3:: {} 114 } 115 lsort [namespace children ::test_ns_1] 116} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}] 117test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} { 118 set trigger { 119 namespace eval test_ns_2 {namespace current} 120 } 121 set l {} 122 lappend l [namespace eval test_ns_1 $trigger] 123 namespace eval test_ns_1::test_ns_2 {} 124 lappend l [namespace eval test_ns_1 $trigger] 125} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2} 126 127test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} { 128 catch {namespace delete {*}[namespace children :: test_ns_*]} 129 namespace eval test_ns_1 { 130 proc p {} { 131 namespace delete [namespace current] 132 return [namespace current] 133 } 134 } 135 list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg 136} {::test_ns_1 1 {invalid command name "test_ns_1::p"}} 137test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} { 138 namespace eval test_ns_2 { 139 proc p {} { 140 return [namespace current] 141 } 142 } 143 list [test_ns_2::p] [namespace delete test_ns_2] 144} {::test_ns_2 {}} 145test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} { 146 # [Bug 1355942] 147 namespace eval test_ns_2 { 148 set x 1 149 trace add variable x unset "namespace delete [namespace current];#" 150 namespace delete [namespace current] 151 } 152} {} 153test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} { 154 # [Bug 1355942] 155 namespace eval test_ns_2 { 156 proc x {} {} 157 trace add command x delete "namespace delete [namespace current];#" 158 namespace delete [namespace current] 159 } 160} {} 161test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} { 162 # [Bug 1355942] 163 namespace eval test_ns_2 { 164 set x 1 165 trace add variable x unset "namespace delete [namespace current];#" 166 } 167 namespace delete test_ns_2 168} {} 169test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} { 170 # [Bug 1355942] 171 namespace eval test_ns_2 { 172 proc x {} {} 173 trace add command x delete "namespace delete [namespace current];#" 174 } 175 namespace delete test_ns_2 176} {} 177test namespace-7.7 {Bug 1655305} -setup { 178 interp create slave 179 # Can't invoke through the ensemble, since deleting the global namespace 180 # (indirectly, via deleting ::tcl) deletes the ensemble. 181 slave eval {rename ::tcl::info::commands ::infocommands} 182 slave hide infocommands 183 slave eval { 184 proc foo {} { 185 namespace delete :: 186 } 187 } 188} -body { 189 slave eval foo 190 slave invokehidden infocommands 191} -cleanup { 192 interp delete slave 193} -result {} 194 195 196test namespace-8.1 {TclTeardownNamespace, delete global namespace} { 197 catch {interp delete test_interp} 198 interp create test_interp 199 interp eval test_interp { 200 namespace eval test_ns_1 { 201 namespace export p 202 proc p {} { 203 return [namespace current] 204 } 205 } 206 namespace eval test_ns_2 { 207 namespace import ::test_ns_1::p 208 variable v 27 209 proc q {} { 210 variable v 211 return "[p] $v" 212 } 213 } 214 set x [test_ns_2::q] 215 catch {set xxxx} 216 } 217 list [interp eval test_interp {test_ns_2::q}] \ 218 [interp eval test_interp {namespace delete ::}] \ 219 [catch {interp eval test_interp {set a 123}} msg] $msg \ 220 [interp delete test_interp] 221} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}} 222test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} { 223 catch {namespace delete {*}[namespace children :: test_ns_*]} 224 namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} 225 namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} 226 list [namespace children test_ns_1] \ 227 [namespace delete test_ns_1::test_ns_2] \ 228 [namespace children test_ns_1] 229} {::test_ns_1::test_ns_2 {} {}} 230test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { 231 catch {namespace delete {*}[namespace children :: test_ns_*]} 232 namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} 233 namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} 234 list [namespace children test_ns_1] \ 235 [namespace delete test_ns_1::test_ns_2] \ 236 [namespace children test_ns_1] \ 237 [catch {namespace children test_ns_1::test_ns_2} msg] $msg \ 238 [info commands test_ns_1::test_ns_2::test_ns_3a::*] 239} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}} 240test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} { 241 catch {namespace delete {*}[namespace children :: test_ns_*]} 242 namespace eval test_ns_export { 243 namespace export cmd1 cmd2 244 proc cmd1 {args} {return "cmd1: $args"} 245 proc cmd2 {args} {return "cmd2: $args"} 246 } 247 namespace eval test_ns_import { 248 namespace import ::test_ns_export::* 249 proc p {} {return foo} 250 } 251 list [lsort [info commands test_ns_import::*]] \ 252 [namespace delete test_ns_export] \ 253 [info commands test_ns_import::*] 254} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p] 255test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} { 256 interp create slave 257 slave eval {trace add execution error leave {namespace delete :: ;#}} 258 catch {slave eval error foo bar baz} 259 interp delete slave 260 set ::errorInfo 261} {bar 262 invoked from within 263"slave eval error foo bar baz"} 264test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} { 265 interp create slave 266 slave eval {trace add variable errorCode write {namespace delete :: ;#}} 267 catch {slave eval error foo bar baz} 268 interp delete slave 269 set ::errorInfo 270} {bar 271 invoked from within 272"slave eval error foo bar baz"} 273test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} { 274 interp create slave 275 slave eval {trace add execution error leave {namespace delete :: ;#}} 276 catch {slave eval error foo bar baz} 277 interp delete slave 278 set ::errorCode 279} baz 280 281test namespace-9.1 {Tcl_Import, empty import pattern} { 282 catch {namespace delete {*}[namespace children :: test_ns_*]} 283 list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg 284} {1 {empty import pattern}} 285test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} { 286 list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg 287} {1 {unknown namespace in import pattern "fred::x"}} 288test namespace-9.3 {Tcl_Import, import ns == export ns} { 289 list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg 290} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}} 291test namespace-9.4 {Tcl_Import, simple import} { 292 catch {namespace delete {*}[namespace children :: test_ns_*]} 293 namespace eval test_ns_export { 294 namespace export cmd1 295 proc cmd1 {args} {return "cmd1: $args"} 296 proc cmd2 {args} {return "cmd2: $args"} 297 } 298 namespace eval test_ns_import { 299 namespace import ::test_ns_export::* 300 proc p {} {return [cmd1 123]} 301 } 302 test_ns_import::p 303} {cmd1: 123} 304test namespace-9.5 {Tcl_Import, RFE 1230597} { 305 list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg 306} {0 {}} 307test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} { 308 namespace eval test_ns_import { 309 namespace import -force ::test_ns_export::* 310 cmd1 555 311 } 312} {cmd1: 555} 313test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} { 314 catch {namespace delete {*}[namespace children :: test_ns_*]} 315 namespace eval test_ns_export { 316 namespace export cmd1 317 proc cmd1 {args} {return "cmd1: $args"} 318 } 319 namespace eval test_ns_import { 320 namespace import -force ::test_ns_export::* 321 } 322 list [test_ns_import::cmd1 a b c] \ 323 [test_ns_export::cmd1 d e f] \ 324 [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \ 325 [namespace origin test_ns_import::cmd1] \ 326 [namespace origin test_ns_export::cmd1] \ 327 [test_ns_import::cmd1 g h i] \ 328 [test_ns_export::cmd1 j k l] 329} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}} 330 331test namespace-9.8 {Tcl_Import: Bug 1017299} -setup { 332 namespace eval one { 333 namespace export cmd 334 proc cmd {} {} 335 } 336 namespace eval two { 337 namespace export cmd 338 proc other args {} 339 } 340 namespace eval two \ 341 [list namespace import [namespace current]::one::cmd] 342 namespace eval three \ 343 [list namespace import [namespace current]::two::cmd] 344 namespace eval three { 345 rename cmd other 346 namespace export other 347 } 348} -body { 349 namespace eval two [list namespace import -force \ 350 [namespace current]::three::other] 351 namespace origin two::other 352} -cleanup { 353 namespace delete one two three 354} -match glob -result *::one::cmd 355 356test namespace-9.9 {Tcl_Import: Bug 1017299} -setup { 357 namespace eval one { 358 namespace export cmd 359 proc cmd {} {} 360 } 361 namespace eval two namespace export cmd 362 namespace eval two \ 363 [list namespace import [namespace current]::one::cmd] 364 namespace eval three namespace export cmd 365 namespace eval three \ 366 [list namespace import [namespace current]::two::cmd] 367} -body { 368 namespace eval two [list namespace import -force \ 369 [namespace current]::three::cmd] 370 namespace origin two::cmd 371} -cleanup { 372 namespace delete one two three 373} -returnCodes error -match glob -result {import pattern * would create a loop*} 374 375test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { 376 catch {namespace delete {*}[namespace children :: test_ns_*]} 377 list [catch {namespace forget xyzzy::*} msg] $msg 378} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} 379test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} { 380 namespace eval test_ns_export { 381 namespace export cmd1 382 proc cmd1 {args} {return "cmd1: $args"} 383 proc cmd2 {args} {return "cmd2: $args"} 384 } 385 namespace eval test_ns_import { 386 namespace forget ::test_ns_export::wombat 387 } 388} {} 389test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} { 390 namespace eval test_ns_import { 391 namespace import ::test_ns_export::* 392 proc p {} {return [cmd1 123]} 393 set l {} 394 lappend l [lsort [info commands ::test_ns_import::*]] 395 namespace forget ::test_ns_export::cmd1 396 lappend l [info commands ::test_ns_import::*] 397 lappend l [catch {cmd1 777} msg] $msg 398 } 399} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}] 400 401test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup { 402 namespace eval origin { 403 namespace export cmd 404 proc cmd {} {} 405 } 406 namespace eval unrelated { 407 proc cmd {} {} 408 } 409 namespace eval my \ 410 [list namespace import [namespace current]::origin::cmd] 411} -body { 412 namespace eval my \ 413 [list namespace forget [namespace current]::unrelated::cmd] 414 my::cmd 415} -cleanup { 416 namespace delete origin unrelated my 417} 418 419test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup { 420 namespace eval origin { 421 namespace export cmd 422 proc cmd {} {} 423 } 424 namespace eval my \ 425 [list namespace import [namespace current]::origin::cmd] 426 namespace eval my rename cmd newname 427} -body { 428 namespace eval my \ 429 [list namespace forget [namespace current]::origin::cmd] 430 my::newname 431} -cleanup { 432 namespace delete origin my 433} -returnCodes error -match glob -result * 434 435test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup { 436 namespace eval origin { 437 namespace export cmd 438 proc cmd {} {} 439 } 440 namespace eval my \ 441 [list namespace import [namespace current]::origin::cmd] 442 namespace eval your {} 443 namespace eval my \ 444 [list rename cmd [namespace current]::your::newname] 445} -body { 446 namespace eval your namespace forget newname 447 your::newname 448} -cleanup { 449 namespace delete origin my your 450} -returnCodes error -match glob -result * 451 452test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup { 453 namespace eval origin { 454 namespace export cmd 455 proc cmd {} {} 456 } 457 namespace eval link namespace export cmd 458 namespace eval link \ 459 [list namespace import [namespace current]::origin::cmd] 460 namespace eval link2 namespace export cmd 461 namespace eval link2 \ 462 [list namespace import [namespace current]::link::cmd] 463 namespace eval my \ 464 [list namespace import [namespace current]::link2::cmd] 465} -body { 466 namespace eval my \ 467 [list namespace forget [namespace current]::origin::cmd] 468 my::cmd 469} -cleanup { 470 namespace delete origin link link2 my 471} -returnCodes error -match glob -result * 472 473test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup { 474 namespace eval origin { 475 namespace export cmd 476 proc cmd {} {} 477 } 478 namespace eval link namespace export cmd 479 namespace eval link \ 480 [list namespace import [namespace current]::origin::cmd] 481 namespace eval link2 namespace export cmd 482 namespace eval link2 \ 483 [list namespace import [namespace current]::link::cmd] 484 namespace eval my \ 485 [list namespace import [namespace current]::link2::cmd] 486} -body { 487 namespace eval my \ 488 [list namespace forget [namespace current]::link::cmd] 489 my::cmd 490} -cleanup { 491 namespace delete origin link link2 my 492} 493 494test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup { 495 namespace eval origin { 496 namespace export cmd 497 proc cmd {} {} 498 } 499 namespace eval link namespace export cmd 500 namespace eval link \ 501 [list namespace import [namespace current]::origin::cmd] 502 namespace eval link2 namespace export cmd 503 namespace eval link2 \ 504 [list namespace import [namespace current]::link::cmd] 505 namespace eval my \ 506 [list namespace import [namespace current]::link2::cmd] 507} -body { 508 namespace eval my \ 509 [list namespace forget [namespace current]::link2::cmd] 510 my::cmd 511} -cleanup { 512 namespace delete origin link link2 my 513} -returnCodes error -match glob -result * 514 515test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} { 516 catch {namespace delete {*}[namespace children :: test_ns_*]} 517 namespace eval test_ns_export { 518 namespace export cmd1 519 proc cmd1 {args} {return "cmd1: $args"} 520 } 521 list [namespace origin set] [namespace origin test_ns_export::cmd1] 522} {::set ::test_ns_export::cmd1} 523test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} { 524 namespace eval test_ns_import1 { 525 namespace import ::test_ns_export::* 526 namespace export * 527 proc p {} {namespace origin cmd1} 528 } 529 list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1] 530} {::test_ns_export::cmd1 ::test_ns_export::cmd1} 531test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} { 532 namespace eval test_ns_import2 { 533 namespace import ::test_ns_import1::* 534 proc q {} {return [cmd1 123]} 535 } 536 list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1] 537} {{cmd1: 123} ::test_ns_export::cmd1} 538 539test namespace-12.1 {InvokeImportedCmd} { 540 catch {namespace delete {*}[namespace children :: test_ns_*]} 541 namespace eval test_ns_export { 542 namespace export cmd1 543 proc cmd1 {args} {namespace current} 544 } 545 namespace eval test_ns_import { 546 namespace import ::test_ns_export::* 547 } 548 list [test_ns_import::cmd1] 549} {::test_ns_export} 550 551test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} { 552 namespace eval test_ns_import { 553 set l {} 554 lappend l [info commands ::test_ns_import::*] 555 namespace forget ::test_ns_export::cmd1 556 lappend l [info commands ::test_ns_import::*] 557 } 558} {::test_ns_import::cmd1 {}} 559test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} { 560 # Will panic if still buggy 561 namespace eval src {namespace export foo; proc foo {} {}} 562 namespace eval dst {namespace import [namespace parent]::src::foo} 563 trace add command src::foo delete \ 564 "[list namespace delete [namespace current]::dst] ;#" 565 proc src::foo {} {} 566 namespace delete src 567} {} 568 569test namespace-14.1 {TclGetNamespaceForQualName, absolute names} { 570 catch {namespace delete {*}[namespace children :: test_ns_*]} 571 variable v 10 572 namespace eval test_ns_1::test_ns_2 { 573 variable v 20 574 } 575 namespace eval test_ns_2 { 576 variable v 30 577 } 578 namespace eval test_ns_1 { 579 list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \ 580 [lsort [namespace children :: test_ns_*]] 581 } 582} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]] 583test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} { 584 namespace eval test_ns_1 { 585 list [catch {set ::test_ns_777::v} msg] $msg \ 586 [catch {namespace children test_ns_777} msg] $msg 587 } 588} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} 589test namespace-14.3 {TclGetNamespaceForQualName, relative names} { 590 namespace eval test_ns_1 { 591 list $v $test_ns_2::v 592 } 593} {10 20} 594test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { 595 namespace eval test_ns_1::test_ns_2 { 596 namespace eval foo {} 597 } 598 namespace eval test_ns_1 { 599 list [namespace children test_ns_2] \ 600 [catch {namespace children test_ns_1} msg] $msg 601 } 602} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} 603test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { 604 namespace eval ::test_ns_2 { 605 namespace eval bar {} 606 } 607 namespace eval test_ns_1 { 608 set l [list [catch {namespace delete test_ns_2::bar} msg] $msg] 609 } 610 set l 611} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}} 612test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { 613 namespace eval test_ns_1::test_ns_2 { 614 namespace eval foo {} 615 } 616 namespace eval test_ns_1 { 617 list [namespace children test_ns_2] \ 618 [catch {namespace children test_ns_1} msg] $msg 619 } 620} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} 621test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} { 622 namespace children test_ns_1::: 623} {::test_ns_1::test_ns_2} 624test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} { 625 namespace children :::test_ns_1:::::test_ns_2::: 626} {::test_ns_1::test_ns_2::foo} 627test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} { 628 set l {} 629 lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg 630 namespace eval test_ns_1::test_ns_2 {variable {} 2525} 631 lappend l [set test_ns_1::test_ns_2::] 632} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525} 633test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} { 634 catch {unset test_ns_1::test_ns_2::} 635 set l {} 636 lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg 637 set test_ns_1::test_ns_2:: 314159 638 lappend l [set test_ns_1::test_ns_2::] 639} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159} 640test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} { 641 catch {rename test_ns_1::test_ns_2:: {}} 642 set l {} 643 lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg 644 proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} 645 lappend l [test_ns_1::test_ns_2:: hello] 646} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} 647test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} { 648 catch {namespace delete {*}[namespace children :: test_ns_*]} 649 namespace eval test_ns_1 { 650 variable {} 651 set test_ns_1::(x) y 652 } 653 set test_ns_1::(x) 654} y 655test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} { 656 catch {namespace delete {*}[namespace children :: test_ns_*]} 657 list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg 658} {1 {can't create namespace "": only global namespace can have empty name}} 659 660test namespace-15.1 {Tcl_FindNamespace, absolute name found} { 661 catch {namespace delete {*}[namespace children :: test_ns_*]} 662 namespace eval test_ns_delete { 663 namespace eval test_ns_delete2 {} 664 proc cmd {args} {namespace current} 665 } 666 list [namespace delete ::test_ns_delete::test_ns_delete2] \ 667 [namespace children ::test_ns_delete] 668} {{} {}} 669test namespace-15.2 {Tcl_FindNamespace, absolute name not found} { 670 list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg 671} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}} 672test namespace-15.3 {Tcl_FindNamespace, relative name found} { 673 namespace eval test_ns_delete { 674 namespace eval test_ns_delete2 {} 675 namespace eval test_ns_delete3 {} 676 list [namespace delete test_ns_delete2] \ 677 [namespace children [namespace current]] 678 } 679} {{} ::test_ns_delete::test_ns_delete3} 680test namespace-15.4 {Tcl_FindNamespace, relative name not found} { 681 namespace eval test_ns_delete2 {} 682 namespace eval test_ns_delete { 683 list [catch {namespace delete test_ns_delete2} msg] $msg 684 } 685} {1 {unknown namespace "test_ns_delete2" in namespace delete command}} 686 687test namespace-16.1 {Tcl_FindCommand, absolute name found} { 688 catch {namespace delete {*}[namespace children :: test_ns_*]} 689 namespace eval test_ns_1 { 690 proc cmd {args} {return "[namespace current]::cmd: $args"} 691 variable v "::test_ns_1::cmd" 692 eval $v one 693 } 694} {::test_ns_1::cmd: one} 695test namespace-16.2 {Tcl_FindCommand, absolute name found} { 696 eval $test_ns_1::v two 697} {::test_ns_1::cmd: two} 698test namespace-16.3 {Tcl_FindCommand, absolute name not found} { 699 namespace eval test_ns_1 { 700 variable v2 "::test_ns_1::ladidah" 701 list [catch {eval $v2} msg] $msg 702 } 703} {1 {invalid command name "::test_ns_1::ladidah"}} 704 705# save the "unknown" proc, which is redefined by the following two tests 706catch {rename unknown unknown.old} 707proc unknown {args} { 708 return "unknown: $args" 709} 710test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { 711 ::test_ns_1::foobar x y z 712} {unknown: ::test_ns_1::foobar x y z} 713test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { 714 ::foobar 1 2 3 4 5 715} {unknown: ::foobar 1 2 3 4 5} 716test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { 717 test_ns_1::foobar x y z 718} {unknown: test_ns_1::foobar x y z} 719test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { 720 foobar 1 2 3 4 5 721} {unknown: foobar 1 2 3 4 5} 722# restore the "unknown" proc saved previously 723catch {rename unknown {}} 724catch {rename unknown.old unknown} 725 726test namespace-16.8 {Tcl_FindCommand, relative name found} { 727 namespace eval test_ns_1 { 728 cmd a b c 729 } 730} {::test_ns_1::cmd: a b c} 731test namespace-16.9 {Tcl_FindCommand, relative name found} { 732 catch {rename cmd2 {}} 733 proc cmd2 {args} {return "[namespace current]::cmd2: $args"} 734 namespace eval test_ns_1 { 735 cmd2 a b c 736 } 737} {::::cmd2: a b c} 738test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} { 739 namespace eval test_ns_1 { 740 proc cmd2 {args} { 741 return "[namespace current]::cmd2 in test_ns_1: $args" 742 } 743 namespace eval test_ns_12 { 744 cmd2 a b c 745 } 746 } 747} {::::cmd2: a b c} 748test namespace-16.11 {Tcl_FindCommand, relative name not found} { 749 namespace eval test_ns_1 { 750 list [catch {cmd3 a b c} msg] $msg 751 } 752} {1 {invalid command name "cmd3"}} 753 754catch {unset x} 755test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} { 756 catch {namespace delete {*}[namespace children :: test_ns_*]} 757 set x 314159 758 namespace eval test_ns_1 { 759 set ::x 760 } 761} {314159} 762test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} { 763 namespace eval test_ns_1 { 764 variable x 777 765 set ::test_ns_1::x 766 } 767} {777} 768test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} { 769 namespace eval test_ns_1 { 770 namespace eval test_ns_2 { 771 variable x 1111 772 } 773 set ::test_ns_1::test_ns_2::x 774 } 775} {1111} 776test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} { 777 namespace eval test_ns_1 { 778 namespace eval test_ns_2 { 779 variable x 1111 780 } 781 list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg 782 } 783} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}} 784test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} { 785 namespace eval test_ns_1 { 786 namespace eval test_ns_3 { 787 variable ::test_ns_1::test_ns_2::x 2222 788 } 789 } 790 set ::test_ns_1::test_ns_2::x 791} {2222} 792test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} { 793 namespace eval test_ns_1 { 794 set x 795 } 796} {777} 797test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { 798 namespace eval test_ns_1 { 799 unset x 800 set x ;# must be global x now 801 } 802} {314159} 803test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} { 804 namespace eval test_ns_1 { 805 list [catch {set wuzzat} msg] $msg 806 } 807} {1 {can't read "wuzzat": no such variable}} 808test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { 809 namespace eval test_ns_1 { 810 variable a hello 811 } 812 set test_ns_1::a 813} {hello} 814test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} { 815 namespace eval test_ns_1 {} 816 proc test_ns {} { 817 set ::test_ns_1::a 0 818 } 819 test_ns 820 rename test_ns {} 821 namespace eval test_ns_1 unset a 822 set a 0 823 namespace eval test_ns_1 set a 1 824 namespace delete test_ns_1 825 set a 826} 1 827catch {unset a} 828catch {unset x} 829 830catch {unset l} 831catch {rename foo {}} 832test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} { 833 catch {namespace delete {*}[namespace children :: test_ns_*]} 834 proc foo {} {return "global foo"} 835 namespace eval test_ns_1 { 836 proc trigger {} { 837 return [foo] 838 } 839 } 840 set l "" 841 lappend l [test_ns_1::trigger] 842 namespace eval test_ns_1 { 843 # force invalidation of cached ref to "foo" in proc trigger 844 proc foo {} {return "foo in test_ns_1"} 845 } 846 lappend l [test_ns_1::trigger] 847 set l 848} {{global foo} {foo in test_ns_1}} 849test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} { 850 namespace eval test_ns_2 { 851 proc foo {} {return "foo in ::test_ns_2"} 852 } 853 namespace eval test_ns_1 { 854 namespace eval test_ns_2 {} 855 proc trigger {} { 856 return [test_ns_2::foo] 857 } 858 } 859 set l "" 860 lappend l [test_ns_1::trigger] 861 namespace eval test_ns_1 { 862 namespace eval test_ns_2 { 863 # force invalidation of cached ref to "foo" in proc trigger 864 proc foo {} {return "foo in ::test_ns_1::test_ns_2"} 865 } 866 } 867 lappend l [test_ns_1::trigger] 868 set l 869} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}} 870catch {unset l} 871catch {rename foo {}} 872 873test namespace-19.1 {GetNamespaceFromObj, global name found} { 874 catch {namespace delete {*}[namespace children :: test_ns_*]} 875 namespace eval test_ns_1::test_ns_2 {} 876 namespace children ::test_ns_1 877} {::test_ns_1::test_ns_2} 878test namespace-19.2 {GetNamespaceFromObj, relative name found} { 879 namespace eval test_ns_1 { 880 namespace children test_ns_2 881 } 882} {} 883test namespace-19.3 {GetNamespaceFromObj, name not found} -body { 884 namespace eval test_ns_1 { 885 namespace children test_ns_99 886 } 887} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"} 888test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} { 889 namespace eval test_ns_1 { 890 proc foo {} { 891 return [namespace children test_ns_2] 892 } 893 list [catch {namespace children test_ns_99} msg] $msg 894 } 895 set l {} 896 lappend l [test_ns_1::foo] 897 namespace delete test_ns_1::test_ns_2 898 namespace eval test_ns_1::test_ns_2::test_ns_3 {} 899 lappend l [test_ns_1::foo] 900 set l 901} {{} ::test_ns_1::test_ns_2::test_ns_3} 902 903test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { 904 catch {namespace delete {*}[namespace children :: test_ns_*]} 905 list [catch {namespace} msg] $msg 906} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} 907test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { 908 namespace wombat {} 909} -returnCodes error -match glob -result {bad option "wombat": must be *} 910test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { 911 namespace ch :: test_ns_* 912} {} 913 914test namespace-21.1 {NamespaceChildrenCmd, no args} { 915 catch {namespace delete {*}[namespace children :: test_ns_*]} 916 namespace eval test_ns_1::test_ns_2 {} 917 expr {[string first ::test_ns_1 [namespace children]] != -1} 918} {1} 919test namespace-21.2 {NamespaceChildrenCmd, no args} { 920 namespace eval test_ns_1 { 921 namespace children 922 } 923} {::test_ns_1::test_ns_2} 924test namespace-21.3 {NamespaceChildrenCmd, ns name given} { 925 namespace children ::test_ns_1 926} {::test_ns_1::test_ns_2} 927test namespace-21.4 {NamespaceChildrenCmd, ns name given} { 928 namespace eval test_ns_1 { 929 namespace children test_ns_2 930 } 931} {} 932test namespace-21.5 {NamespaceChildrenCmd, too many args} { 933 namespace eval test_ns_1 { 934 list [catch {namespace children test_ns_2 xxx yyy} msg] $msg 935 } 936} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}} 937test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} { 938 namespace eval test_ns_1::test_ns_foo {} 939 namespace children test_ns_1 *f* 940} {::test_ns_1::test_ns_foo} 941test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { 942 namespace eval test_ns_1::test_ns_foo {} 943 lsort [namespace children test_ns_1 test*] 944} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] 945test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} { 946 namespace eval test_ns_1 {} 947 namespace children [namespace current] [fq test_ns_1] 948} [fq test_ns_1] 949 950test namespace-22.1 {NamespaceCodeCmd, bad args} { 951 catch {namespace delete {*}[namespace children :: test_ns_*]} 952 list [catch {namespace code} msg] $msg \ 953 [catch {namespace code xxx yyy} msg] $msg 954} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}} 955test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} { 956 namespace eval test_ns_1 { 957 proc cmd {} {return "test_ns_1::cmd"} 958 } 959 namespace code {::namespace inscope ::test_ns_1 cmd} 960} {::namespace inscope ::test_ns_1 cmd} 961test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} { 962 namespace code {namespace inscope ::test_ns_1 cmd} 963} {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}} 964test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { 965 namespace code unknown 966} {::namespace inscope :: unknown} 967test namespace-22.5 {NamespaceCodeCmd, in other namespace} { 968 namespace eval test_ns_1 { 969 namespace code cmd 970 } 971} {::namespace inscope ::test_ns_1 cmd} 972test namespace-22.6 {NamespaceCodeCmd, in other namespace} { 973 namespace eval test_ns_1 { 974 variable v 42 975 } 976 namespace eval test_ns_2 { 977 proc namespace args {} 978 } 979 namespace eval test_ns_2 [namespace eval test_ns_1 { 980 namespace code {set v} 981 }] 982} {42} 983test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} { 984 namespace eval demo { 985 proc namespace args {puts $args} 986 ::namespace code {namespace inscope foo} 987 } 988} [list ::namespace inscope [fq demo] {namespace inscope foo}] 989 990test namespace-23.1 {NamespaceCurrentCmd, bad args} { 991 catch {namespace delete {*}[namespace children :: test_ns_*]} 992 list [catch {namespace current xxx} msg] $msg \ 993 [catch {namespace current xxx yyy} msg] $msg 994} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}} 995test namespace-23.2 {NamespaceCurrentCmd, at global level} { 996 namespace current 997} {::} 998test namespace-23.3 {NamespaceCurrentCmd, in nested ns} { 999 namespace eval test_ns_1::test_ns_2 { 1000 namespace current 1001 } 1002} {::test_ns_1::test_ns_2} 1003 1004test namespace-24.1 {NamespaceDeleteCmd, no args} { 1005 catch {namespace delete {*}[namespace children :: test_ns_*]} 1006 namespace delete 1007} {} 1008test namespace-24.2 {NamespaceDeleteCmd, one arg} { 1009 namespace eval test_ns_1::test_ns_2 {} 1010 namespace delete ::test_ns_1 1011} {} 1012test namespace-24.3 {NamespaceDeleteCmd, two args} { 1013 namespace eval test_ns_1::test_ns_2 {} 1014 list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1] 1015} {{} {}} 1016test namespace-24.4 {NamespaceDeleteCmd, unknown ns} { 1017 list [catch {namespace delete ::test_ns_foo} msg] $msg 1018} {1 {unknown namespace "::test_ns_foo" in namespace delete command}} 1019 1020test namespace-25.1 {NamespaceEvalCmd, bad args} { 1021 catch {namespace delete {*}[namespace children :: test_ns_*]} 1022 list [catch {namespace eval} msg] $msg 1023} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} 1024test namespace-25.2 {NamespaceEvalCmd, bad args} -body { 1025 namespace test_ns_1 1026} -returnCodes error -match glob -result {bad option "test_ns_1": must be *} 1027catch {unset v} 1028test namespace-25.3 {NamespaceEvalCmd, new namespace} { 1029 set v 123 1030 namespace eval test_ns_1 { 1031 variable v 314159 1032 proc p {} { 1033 variable v 1034 return $v 1035 } 1036 } 1037 test_ns_1::p 1038} {314159} 1039test namespace-25.4 {NamespaceEvalCmd, existing namespace} { 1040 namespace eval test_ns_1 { 1041 proc q {} {return [expr {[p]+1}]} 1042 } 1043 test_ns_1::q 1044} {314160} 1045test namespace-25.5 {NamespaceEvalCmd, multiple args} { 1046 namespace eval test_ns_1 "set" "v" 1047} {314159} 1048test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} { 1049 list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo 1050} {1 {invalid command name "xxxx"} {invalid command name "xxxx" 1051 while executing 1052"xxxx" 1053 (in namespace eval "::test_ns_1" script line 1) 1054 invoked from within 1055"namespace eval test_ns_1 {xxxx}"}} 1056test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} { 1057 list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo 1058} {1 foo {bar 1059 (in namespace eval "::test_ns_1" script line 1) 1060 invoked from within 1061"namespace eval test_ns_1 {error foo bar baz}"}} 1062test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} { 1063 list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo 1064} {1 foo {bar 1065 (in namespace eval "::test_ns_1" script line 1) 1066 invoked from within 1067"namespace eval test_ns_1 error foo bar baz"}} 1068catch {unset v} 1069test namespace-25.9 {NamespaceEvalCmd, 545325} { 1070 namespace eval test_ns_1 info level 0 1071} {namespace eval test_ns_1 info level 0} 1072 1073test namespace-26.1 {NamespaceExportCmd, no args and new ns} { 1074 catch {namespace delete {*}[namespace children :: test_ns_*]} 1075 namespace export 1076} {} 1077test namespace-26.2 {NamespaceExportCmd, just -clear arg} { 1078 namespace export -clear 1079} {} 1080test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} { 1081 namespace eval test_ns_1 { 1082 list [catch {namespace export ::zzz} msg] $msg 1083 } 1084} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}} 1085test namespace-26.4 {NamespaceExportCmd, one pattern} { 1086 namespace eval test_ns_1 { 1087 namespace export cmd1 1088 proc cmd1 {args} {return "cmd1: $args"} 1089 proc cmd2 {args} {return "cmd2: $args"} 1090 proc cmd3 {args} {return "cmd3: $args"} 1091 proc cmd4 {args} {return "cmd4: $args"} 1092 } 1093 namespace eval test_ns_2 { 1094 namespace import ::test_ns_1::* 1095 } 1096 list [info commands test_ns_2::*] [test_ns_2::cmd1 hello] 1097} {::test_ns_2::cmd1 {cmd1: hello}} 1098test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} { 1099 namespace eval test_ns_1 { 1100 namespace export cmd1 cmd3 1101 } 1102 namespace eval test_ns_2 { 1103 namespace import -force ::test_ns_1::* 1104 } 1105 list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello] 1106} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}] 1107test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} { 1108 namespace eval test_ns_1 { 1109 namespace export 1110 } 1111} {cmd1 cmd3} 1112test namespace-26.7 {NamespaceExportCmd, -clear resets export list} { 1113 namespace eval test_ns_1 { 1114 namespace export -clear cmd4 1115 } 1116 namespace eval test_ns_2 { 1117 namespace import ::test_ns_1::* 1118 } 1119 list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello] 1120} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}] 1121test namespace-26.8 {NamespaceExportCmd, -clear resets export list} { 1122 catch {namespace delete foo} 1123 namespace eval foo { 1124 namespace export x 1125 namespace export -clear 1126 } 1127 list [namespace eval foo namespace export] [namespace delete foo] 1128} {{} {}} 1129 1130test namespace-27.1 {NamespaceForgetCmd, no args} { 1131 catch {namespace delete {*}[namespace children :: test_ns_*]} 1132 namespace forget 1133} {} 1134test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} { 1135 list [catch {namespace forget ::test_ns_1::xxx} msg] $msg 1136} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}} 1137test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} { 1138 namespace eval test_ns_1 { 1139 namespace export cmd* 1140 proc cmd1 {args} {return "cmd1: $args"} 1141 proc cmd2 {args} {return "cmd2: $args"} 1142 } 1143 namespace eval test_ns_2 { 1144 namespace import ::test_ns_1::* 1145 namespace forget ::test_ns_1::cmd1 1146 } 1147 info commands ::test_ns_2::* 1148} {::test_ns_2::cmd2} 1149 1150test namespace-28.1 {NamespaceImportCmd, no args} { 1151 catch {namespace delete {*}[namespace children :: test_ns_*]} 1152 lsort [namespace import] 1153} {bytestring cleanupTests configure customMatch debug errorChannel errorFile getMatchingFiles interpreter limitConstraints loadFile loadScript loadTestedCommands mainThread makeDirectory makeFile match matchDirectories matchFiles normalizeMsg normalizePath outputChannel outputFile preserveCore removeDirectory removeFile restoreState runAllTests saveState singleProcess skip skipDirectories skipFiles temporaryDirectory test testConstraint testsDirectory threadReap verbose viewFile workingDirectory} 1154test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} { 1155 namespace import -force 1156} {} 1157test namespace-28.3 {NamespaceImportCmd, arg is imported} { 1158 namespace eval test_ns_1 { 1159 namespace export cmd2 1160 proc cmd1 {args} {return "cmd1: $args"} 1161 proc cmd2 {args} {return "cmd2: $args"} 1162 } 1163 namespace eval test_ns_2 { 1164 namespace import ::test_ns_1::* 1165 namespace forget ::test_ns_1::cmd1 1166 } 1167 info commands test_ns_2::* 1168} {::test_ns_2::cmd2} 1169 1170test namespace-29.1 {NamespaceInscopeCmd, bad args} { 1171 catch {namespace delete {*}[namespace children :: test_ns_*]} 1172 list [catch {namespace inscope} msg] $msg 1173} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} 1174test namespace-29.2 {NamespaceInscopeCmd, bad args} { 1175 list [catch {namespace inscope ::} msg] $msg 1176} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} 1177test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body { 1178 namespace inscope test_ns_1 {set v} 1179} -returnCodes error -result {namespace "test_ns_1" not found in "::"} 1180test namespace-29.4 {NamespaceInscopeCmd, simple case} { 1181 namespace eval test_ns_1 { 1182 variable v 747 1183 proc cmd {args} { 1184 variable v 1185 return "[namespace current]::cmd: v=$v, args=$args" 1186 } 1187 } 1188 namespace inscope test_ns_1 cmd 1189} {::test_ns_1::cmd: v=747, args=} 1190test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} { 1191 list [namespace inscope test_ns_1 cmd x y z] \ 1192 [namespace eval test_ns_1 [concat cmd [list x y z]]] 1193} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}} 1194test namespace-29.6 {NamespaceInscopeCmd, 1400572} { 1195 namespace inscope test_ns_1 {info level 0} 1196} {namespace inscope test_ns_1 {info level 0}} 1197 1198 1199test namespace-30.1 {NamespaceOriginCmd, bad args} { 1200 catch {namespace delete {*}[namespace children :: test_ns_*]} 1201 list [catch {namespace origin} msg] $msg 1202} {1 {wrong # args: should be "namespace origin name"}} 1203test namespace-30.2 {NamespaceOriginCmd, bad args} { 1204 list [catch {namespace origin x y} msg] $msg 1205} {1 {wrong # args: should be "namespace origin name"}} 1206test namespace-30.3 {NamespaceOriginCmd, command not found} { 1207 list [catch {namespace origin fred} msg] $msg 1208} {1 {invalid command name "fred"}} 1209test namespace-30.4 {NamespaceOriginCmd, command isn't imported} { 1210 namespace origin set 1211} {::set} 1212test namespace-30.5 {NamespaceOriginCmd, imported command} { 1213 namespace eval test_ns_1 { 1214 namespace export cmd* 1215 proc cmd1 {args} {return "cmd1: $args"} 1216 proc cmd2 {args} {return "cmd2: $args"} 1217 } 1218 namespace eval test_ns_2 { 1219 namespace export * 1220 namespace import ::test_ns_1::* 1221 proc p {} {} 1222 } 1223 namespace eval test_ns_3 { 1224 namespace import ::test_ns_2::* 1225 list [namespace origin foreach] \ 1226 [namespace origin p] \ 1227 [namespace origin cmd1] \ 1228 [namespace origin ::test_ns_2::cmd2] 1229 } 1230} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2} 1231 1232test namespace-31.1 {NamespaceParentCmd, bad args} { 1233 catch {namespace delete {*}[namespace children :: test_ns_*]} 1234 list [catch {namespace parent a b} msg] $msg 1235} {1 {wrong # args: should be "namespace parent ?name?"}} 1236test namespace-31.2 {NamespaceParentCmd, no args} { 1237 namespace parent 1238} {} 1239test namespace-31.3 {NamespaceParentCmd, namespace specified} { 1240 namespace eval test_ns_1 { 1241 namespace eval test_ns_2 { 1242 namespace eval test_ns_3 {} 1243 } 1244 } 1245 list [namespace parent ::] \ 1246 [namespace parent test_ns_1::test_ns_2] \ 1247 [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}] 1248} {{} ::test_ns_1 ::test_ns_1} 1249test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body { 1250 namespace parent test_ns_1::test_ns_foo 1251} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"} 1252 1253test namespace-32.1 {NamespaceQualifiersCmd, bad args} { 1254 catch {namespace delete {*}[namespace children :: test_ns_*]} 1255 list [catch {namespace qualifiers} msg] $msg 1256} {1 {wrong # args: should be "namespace qualifiers string"}} 1257test namespace-32.2 {NamespaceQualifiersCmd, bad args} { 1258 list [catch {namespace qualifiers x y} msg] $msg 1259} {1 {wrong # args: should be "namespace qualifiers string"}} 1260test namespace-32.3 {NamespaceQualifiersCmd, simple name} { 1261 namespace qualifiers foo 1262} {} 1263test namespace-32.4 {NamespaceQualifiersCmd, leading ::} { 1264 namespace qualifiers ::x::y::z 1265} {::x::y} 1266test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} { 1267 namespace qualifiers a::b 1268} {a} 1269test namespace-32.6 {NamespaceQualifiersCmd, :: argument} { 1270 namespace qualifiers :: 1271} {} 1272test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} { 1273 namespace qualifiers ::::: 1274} {} 1275test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} { 1276 namespace qualifiers foo::: 1277} {foo} 1278 1279test namespace-33.1 {NamespaceTailCmd, bad args} { 1280 catch {namespace delete {*}[namespace children :: test_ns_*]} 1281 list [catch {namespace tail} msg] $msg 1282} {1 {wrong # args: should be "namespace tail string"}} 1283test namespace-33.2 {NamespaceTailCmd, bad args} { 1284 list [catch {namespace tail x y} msg] $msg 1285} {1 {wrong # args: should be "namespace tail string"}} 1286test namespace-33.3 {NamespaceTailCmd, simple name} { 1287 namespace tail foo 1288} {foo} 1289test namespace-33.4 {NamespaceTailCmd, leading ::} { 1290 namespace tail ::x::y::z 1291} {z} 1292test namespace-33.5 {NamespaceTailCmd, no leading ::} { 1293 namespace tail a::b 1294} {b} 1295test namespace-33.6 {NamespaceTailCmd, :: argument} { 1296 namespace tail :: 1297} {} 1298test namespace-33.7 {NamespaceTailCmd, odd number of :s} { 1299 namespace tail ::::: 1300} {} 1301test namespace-33.8 {NamespaceTailCmd, odd number of :s} { 1302 namespace tail foo::: 1303} {} 1304 1305test namespace-34.1 {NamespaceWhichCmd, bad args} { 1306 catch {namespace delete {*}[namespace children :: test_ns_*]} 1307 list [catch {namespace which} msg] $msg 1308} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} 1309test namespace-34.2 {NamespaceWhichCmd, bad args} { 1310 list [catch {namespace which -fred x} msg] $msg 1311} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} 1312test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} { 1313 namespace which -command 1314} {} 1315test namespace-34.4 {NamespaceWhichCmd, bad args} { 1316 list [catch {namespace which a b} msg] $msg 1317} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} 1318test namespace-34.5 {NamespaceWhichCmd, command lookup} { 1319 namespace eval test_ns_1 { 1320 namespace export cmd* 1321 variable v1 111 1322 proc cmd1 {args} {return "cmd1: $args"} 1323 proc cmd2 {args} {return "cmd2: $args"} 1324 } 1325 namespace eval test_ns_2 { 1326 namespace export * 1327 namespace import ::test_ns_1::* 1328 variable v2 222 1329 proc p {} {} 1330 } 1331 namespace eval test_ns_3 { 1332 namespace import ::test_ns_2::* 1333 variable v3 333 1334 list [namespace which -command foreach] \ 1335 [namespace which -command p] \ 1336 [namespace which -command cmd1] \ 1337 [namespace which -command ::test_ns_2::cmd2] \ 1338 [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg 1339 } 1340} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}} 1341test namespace-34.6 {NamespaceWhichCmd, -command is default} { 1342 namespace eval test_ns_3 { 1343 list [namespace which foreach] \ 1344 [namespace which p] \ 1345 [namespace which cmd1] \ 1346 [namespace which ::test_ns_2::cmd2] 1347 } 1348} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} 1349test namespace-34.7 {NamespaceWhichCmd, variable lookup} { 1350 namespace eval test_ns_3 { 1351 list [namespace which -variable env] \ 1352 [namespace which -variable v3] \ 1353 [namespace which -variable ::test_ns_2::v2] \ 1354 [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg 1355 } 1356} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} 1357 1358test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} { 1359 catch {namespace delete {*}[namespace children :: test_ns_*]} 1360 namespace eval test_ns_1 { 1361 proc p {} { 1362 namespace delete [namespace current] 1363 return [namespace current] 1364 } 1365 } 1366 test_ns_1::p 1367} {::test_ns_1} 1368test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} { 1369 namespace eval test_ns_1 { 1370 proc q {} { 1371 return [namespace current] 1372 } 1373 } 1374 list [test_ns_1::q] \ 1375 [namespace delete test_ns_1] \ 1376 [catch {test_ns_1::q} msg] $msg 1377} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}} 1378 1379catch {unset x} 1380catch {unset y} 1381test namespace-36.1 {DupNsNameInternalRep} { 1382 catch {namespace delete {*}[namespace children :: test_ns_*]} 1383 namespace eval test_ns_1 {} 1384 set x "::test_ns_1" 1385 list [namespace parent $x] [set y $x] [namespace parent $y] 1386} {:: ::test_ns_1 ::} 1387catch {unset x} 1388catch {unset y} 1389 1390test namespace-37.1 {SetNsNameFromAny, ns name found} { 1391 catch {namespace delete {*}[namespace children :: test_ns_*]} 1392 namespace eval test_ns_1::test_ns_2 {} 1393 namespace eval test_ns_1 { 1394 namespace children ::test_ns_1 1395 } 1396} {::test_ns_1::test_ns_2} 1397test namespace-37.2 {SetNsNameFromAny, ns name not found} -body { 1398 namespace eval test_ns_1 { 1399 namespace children ::test_ns_1::test_ns_foo 1400 } 1401} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found} 1402 1403test namespace-38.1 {UpdateStringOfNsName} { 1404 catch {namespace delete {*}[namespace children :: test_ns_*]} 1405 ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name 1406 list [namespace eval {} {namespace current}] \ 1407 [namespace eval {} {namespace current}] 1408} {:: ::} 1409 1410test namespace-39.1 {NamespaceExistsCmd} { 1411 catch {namespace delete {*}[namespace children :: test_ns_*]} 1412 namespace eval ::test_ns_z::test_me { variable foo } 1413 list [namespace exists ::] \ 1414 [namespace exists ::bogus_namespace] \ 1415 [namespace exists ::test_ns_z] \ 1416 [namespace exists test_ns_z] \ 1417 [namespace exists ::test_ns_z::foo] \ 1418 [namespace exists ::test_ns_z::test_me] \ 1419 [namespace eval ::test_ns_z { namespace exists ::test_me }] \ 1420 [namespace eval ::test_ns_z { namespace exists test_me }] \ 1421 [namespace exists :::::test_ns_z] 1422} {1 0 1 1 0 1 0 1 1} 1423test namespace-39.2 {NamespaceExistsCmd error} { 1424 list [catch {namespace exists} msg] $msg 1425} {1 {wrong # args: should be "namespace exists name"}} 1426test namespace-39.3 {NamespaceExistsCmd error} { 1427 list [catch {namespace exists a b} msg] $msg 1428} {1 {wrong # args: should be "namespace exists name"}} 1429 1430test namespace-40.1 {Ignoring namespace proc "unknown"} { 1431 rename unknown _unknown 1432 proc unknown args {return global} 1433 namespace eval ns {proc unknown args {return local}} 1434 set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]] 1435 rename unknown {} 1436 rename _unknown unknown 1437 namespace delete ns 1438 set l 1439} {global global} 1440 1441test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { 1442 set res {} 1443 namespace eval ns { 1444 set res {} 1445 proc test {} { 1446 set ::g 0 1447 } 1448 lappend ::res [test] 1449 proc set {a b} { 1450 ::set a [incr b] 1451 } 1452 lappend ::res [test] 1453 } 1454 namespace delete ns 1455 set res 1456} {0 1} 1457 1458test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { 1459 set res {} 1460 namespace eval ns {} 1461 proc ns::a {i} { 1462 variable b 1463 proc set args {return "New proc is called"} 1464 return [set b $i] 1465 } 1466 ns::a 1 1467 set res [ns::a 2] 1468 namespace delete ns 1469 set res 1470} {New proc is called} 1471 1472test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} { 1473 set res {} 1474 namespace eval ns { 1475 variable b 0 1476 } 1477 1478 proc ns::a {i} { 1479 variable b 1480 proc set args {return "New proc is called"} 1481 return [set b $i] 1482 } 1483 1484 set res [list [ns::a 1] $ns::b] 1485 namespace delete ns 1486 set res 1487} {{New proc is called} 0} 1488 1489# Ensembles (TIP#112) 1490 1491test namespace-42.1 {ensembles: basic} { 1492 namespace eval ns { 1493 namespace export x 1494 proc x {} {format 1} 1495 namespace ensemble create 1496 } 1497 list [info command ns] [ns x] [namespace delete ns] [info command ns] 1498} {ns 1 {} {}} 1499test namespace-42.2 {ensembles: basic} { 1500 namespace eval ns { 1501 namespace export x 1502 proc x {} {format 1} 1503 namespace ensemble create 1504 } 1505 rename ns foo 1506 list [info command foo] [foo x] [namespace delete ns] [info command foo] 1507} {foo 1 {} {}} 1508test namespace-42.3 {ensembles: basic} { 1509 namespace eval ns { 1510 namespace export x* 1511 proc x1 {} {format 1} 1512 proc x2 {} {format 2} 1513 namespace ensemble create 1514 } 1515 set result [list [ns x1] [ns x2]] 1516 lappend result [catch {ns x} msg] $msg 1517 rename ns {} 1518 lappend result [info command ns::x1] 1519 namespace delete ns 1520 lappend result [info command ns::x1] 1521} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}} 1522test namespace-42.4 {ensembles: basic} { 1523 namespace eval ns { 1524 namespace export y* 1525 proc x1 {} {format 1} 1526 proc x2 {} {format 2} 1527 namespace ensemble create 1528 } 1529 set result [list [catch {ns x} msg] $msg] 1530 namespace delete ns 1531 set result 1532} {1 {unknown subcommand "x": namespace ::ns does not export any commands}} 1533test namespace-42.5 {ensembles: basic} { 1534 namespace eval ns { 1535 namespace export x* 1536 proc x1 {} {format 1} 1537 proc x2 {} {format 2} 1538 proc x3 {} {format 3} 1539 namespace ensemble create 1540 } 1541 set result [list [catch {ns x} msg] $msg] 1542 namespace delete ns 1543 set result 1544} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} 1545test namespace-42.6 {ensembles: nested} { 1546 namespace eval ns { 1547 namespace export x* 1548 namespace eval x0 { 1549 proc z {} {format 0} 1550 namespace export z 1551 namespace ensemble create 1552 } 1553 proc x1 {} {format 1} 1554 proc x2 {} {format 2} 1555 proc x3 {} {format 3} 1556 namespace ensemble create 1557 } 1558 set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] 1559 namespace delete ns 1560 set result 1561} {0 1 2 3} 1562test namespace-42.7 {ensembles: nested} { 1563 namespace eval ns { 1564 namespace export x* 1565 namespace eval x0 { 1566 proc z {} {list [info level] [info level 1]} 1567 namespace export z 1568 namespace ensemble create 1569 } 1570 proc x1 {} {format 1} 1571 proc x2 {} {format 2} 1572 proc x3 {} {format 3} 1573 namespace ensemble create 1574 } 1575 set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] 1576 namespace delete ns 1577 set result 1578} {{1 ::ns::x0::z} 1 2 3} 1579test namespace-42.8 {ensembles: [Bug 1670091]} -setup { 1580 proc demo args {} 1581 variable target [list [namespace which demo] x] 1582 proc trial args {variable target; string length $target} 1583 trace add execution demo enter [namespace code trial] 1584 namespace ensemble create -command foo -map [list bar $target] 1585} -body { 1586 foo bar 1587} -cleanup { 1588 unset target 1589 rename demo {} 1590 rename trial {} 1591 rename foo {} 1592} -result {} 1593 1594test namespace-43.1 {ensembles: dict-driven} { 1595 namespace eval ns { 1596 namespace export x* 1597 proc x1 {} {format 1} 1598 proc x2 {} {format 2} 1599 namespace ensemble create -map {a x1 b x2} 1600 } 1601 set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]] 1602 rename ns {} 1603 lappend result [namespace ensemble exists ns] 1604} {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0} 1605test namespace-43.2 {ensembles: dict-driven} { 1606 namespace eval ns { 1607 namespace export x* 1608 proc x1 {args} {list 1 $args} 1609 proc x2 {args} {list 2 [llength $args]} 1610 namespace ensemble create -map { 1611 a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .} 1612 } 1613 } 1614 set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]] 1615 namespace delete ns 1616 set result 1617} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} 1618set SETUP { 1619 namespace eval ns { 1620 namespace export a b 1621 proc a args {format 1,[llength $args]} 1622 proc b args {format 2,[llength $args]} 1623 proc c args {format 3,[llength $args]} 1624 proc d args {format 4,[llength $args]} 1625 namespace ensemble create -subcommands {b c} 1626 } 1627} 1628test namespace-43.3 {ensembles: list-driven} -setup $SETUP -body { 1629 namespace delete ns 1630} -result {} 1631test namespace-43.4 {ensembles: list-driven} -setup $SETUP -body { 1632 ns a foo bar boo spong wibble 1633} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c} 1634test namespace-43.5 {ensembles: list-driven} -setup $SETUP -body { 1635 ns b foo bar boo spong wibble 1636} -cleanup {namespace delete ns} -result 2,5 1637test namespace-43.6 {ensembles: list-driven} -setup $SETUP -body { 1638 ns c foo bar boo spong wibble 1639} -cleanup {namespace delete ns} -result 3,5 1640test namespace-43.7 {ensembles: list-driven} -setup $SETUP -body { 1641 ns d foo bar boo spong wibble 1642} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c} 1643set SETUP { 1644 namespace eval ns { 1645 namespace export a b 1646 proc a args {format 1,[llength $args]} 1647 proc b args {format 2,[llength $args]} 1648 proc c args {format 3,[llength $args]} 1649 proc d args {format 4,[llength $args]} 1650 namespace ensemble create -subcommands {b c} -map {c ::ns::d} 1651 } 1652} 1653test namespace-43.8 {ensembles: list-and-map-driven} -setup $SETUP -body { 1654 namespace delete ns 1655} -result {} 1656test namespace-43.9 {ensembles: list-and-map-driven} -setup $SETUP -body { 1657 ns a foo bar boo spong wibble 1658} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c} 1659test namespace-43.10 {ensembles: list-and-map-driven} -setup $SETUP -body { 1660 ns b foo bar boo spong wibble 1661} -cleanup {namespace delete ns} -result 2,5 1662test namespace-43.11 {ensembles: list-and-map-driven} -setup $SETUP -body { 1663 ns c foo bar boo spong wibble 1664} -cleanup {namespace delete ns} -result 4,5 1665test namespace-43.12 {ensembles: list-and-map-driven} -setup $SETUP -body { 1666 ns d foo bar boo spong wibble 1667} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c} 1668set SETUP { 1669 namespace eval ns { 1670 namespace export * 1671 proc foo args {format bar} 1672 proc spong args {format wibble} 1673 namespace ensemble create -prefixes off 1674 } 1675} 1676test namespace-43.13 {ensembles: turn off prefixes} -setup $SETUP -body { 1677 namespace delete ns 1678} -result {} 1679test namespace-43.14 {ensembles: turn off prefixes} -setup $SETUP -body { 1680 ns fo 1681} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "fo": must be foo, or spong} 1682test namespace-43.15 {ensembles: turn off prefixes} -setup $SETUP -body { 1683 ns foo 1684} -cleanup {namespace delete ns} -result bar 1685test namespace-43.16 {ensembles: turn off prefixes} -setup $SETUP -body { 1686 ns s 1687} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "s": must be foo, or spong} 1688test namespace-43.17 {ensembles: turn off prefixes} -setup $SETUP -body { 1689 ns spong 1690} -cleanup {namespace delete ns} -result wibble 1691 1692test namespace-44.1 {ensemble: errors} { 1693 list [catch {namespace ensemble} msg] $msg 1694} {1 {wrong # args: should be "namespace ensemble subcommand ?arg ...?"}} 1695test namespace-44.2 {ensemble: errors} { 1696 list [catch {namespace ensemble ?} msg] $msg 1697} {1 {bad subcommand "?": must be configure, create, or exists}} 1698test namespace-44.3 {ensemble: errors} { 1699 namespace eval ns { 1700 list [catch {namespace ensemble create -map x} msg] $msg 1701 } 1702} {1 {missing value to go with key}} 1703test namespace-44.4 {ensemble: errors} { 1704 namespace eval ns { 1705 list [catch {namespace ensemble create -map {x {}}} msg] $msg 1706 } 1707} {1 {ensemble subcommand implementations must be non-empty lists}} 1708test namespace-44.5 {ensemble: errors} -setup { 1709 namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure} 1710} -body { 1711 foobar foobarcon 1712} -cleanup { 1713 rename foobar {} 1714} -returnCodes error -result {invalid command name "::foobarconfigure"} 1715 1716test namespace-45.1 {ensemble: introspection} { 1717 namespace eval ns { 1718 namespace export x 1719 proc x {} {} 1720 namespace ensemble create 1721 set ::result [namespace ensemble configure ::ns] 1722 } 1723 namespace delete ns 1724 set result 1725} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}} 1726test namespace-45.2 {ensemble: introspection} { 1727 namespace eval ns { 1728 namespace export x 1729 proc x {} {} 1730 namespace ensemble create -map {A x} 1731 set ::result [namespace ensemble configure ::ns -map] 1732 } 1733 namespace delete ns 1734 set result 1735} {A ::ns::x} 1736 1737test namespace-46.1 {ensemble: modification} { 1738 namespace eval ns { 1739 namespace export x 1740 proc x {} {format 123} 1741 1742 # Ensemble maps A->x 1743 namespace ensemble create -command ns -map {A ::ns::x} 1744 set ::result [list [namespace ensemble configure ns -map] [ns A]] 1745 1746 # Ensemble maps B->x 1747 namespace ensemble configure ns -map {B ::ns::x} 1748 lappend ::result [namespace ensemble configure ns -map] [ns B] 1749 1750 # Ensemble maps x->x 1751 namespace ensemble configure ns -map {} 1752 lappend ::result [namespace ensemble configure ns -map] [ns x] 1753 } 1754 namespace delete ns 1755 set result 1756} {{A ::ns::x} 123 {B ::ns::x} 123 {} 123} 1757test namespace-46.2 {ensemble: ensembles really use current export list} { 1758 namespace eval ns { 1759 namespace export x1 1760 proc x1 {} {format 1} 1761 proc x2 {} {format 1} 1762 namespace ensemble create 1763 } 1764 catch {ns ?} msg; set result [list $msg] 1765 namespace eval ns {namespace export x*} 1766 catch {ns ?} msg; lappend result $msg 1767 rename ns::x1 {} 1768 catch {ns ?} msg; lappend result $msg 1769 namespace delete ns 1770 set result 1771} {{unknown or ambiguous subcommand "?": must be x1} {unknown or ambiguous subcommand "?": must be x1, or x2} {unknown or ambiguous subcommand "?": must be x2}} 1772test namespace-46.3 {ensemble: implementation errors} { 1773 namespace eval ns { 1774 variable count 0 1775 namespace ensemble create -map { 1776 a {::lappend ::result} 1777 b {::incr ::ns::count} 1778 } 1779 } 1780 set result {} 1781 lappend result [catch { ns } msg] $msg 1782 ns a [ns b 10] 1783 catch {rename p {}} 1784 rename ns p 1785 p a [p b 3000] 1786 lappend result $ns::count 1787 namespace delete ns 1788 lappend result [info command p] 1789} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}} 1790test namespace-46.4 {ensemble: implementation errors} { 1791 namespace eval ns { 1792 namespace ensemble create 1793 } 1794 set result [info command ns] 1795 lappend result [catch {ns ?} msg] $msg 1796 namespace delete ns 1797 set result 1798} {ns 1 {unknown subcommand "?": namespace ::ns does not export any commands}} 1799test namespace-46.5 {ensemble: implementation errors} { 1800 namespace eval ns { 1801 namespace ensemble create -map {makeError ::error} 1802 } 1803 list [catch {ns makeError "an error happened"} msg] $msg $::errorInfo [namespace delete ns] 1804} {1 {an error happened} {an error happened 1805 while executing 1806"ns makeError "an error happened""} {}} 1807test namespace-46.6 {ensemble: implementation renames/deletes itself} { 1808 namespace eval ns { 1809 namespace ensemble create -map {to ::rename} 1810 } 1811 ns to ns foo 1812 foo to foo bar 1813 bar to bar spong 1814 spong to spong {} 1815 namespace delete ns 1816} {} 1817test namespace-46.7 {ensemble: implementation deletes its namespace} { 1818 namespace eval ns { 1819 namespace ensemble create -map {kill {::namespace delete}} 1820 } 1821 ns kill ns 1822} {} 1823test namespace-46.8 {ensemble: implementation deletes its namespace} { 1824 namespace eval ns { 1825 namespace export * 1826 proc foo {} { 1827 variable x 1 1828 bar 1829 # Tricky; what is the correct return value anyway? 1830 info exist x 1831 } 1832 proc bar {} { 1833 namespace delete [namespace current] 1834 } 1835 namespace ensemble create 1836 } 1837 list [ns foo] [info exist ns::x] 1838} {1 0} 1839test namespace-46.9 {ensemble: configuring really configures things} { 1840 namespace eval ns { 1841 namespace ensemble create -map {a a} -prefixes 0 1842 } 1843 set result [list [catch {ns x} msg] $msg] 1844 namespace ensemble configure ns -map {b b} 1845 lappend result [catch {ns x} msg] $msg 1846 namespace delete ns 1847 set result 1848} {1 {unknown subcommand "x": must be a} 1 {unknown subcommand "x": must be b}} 1849 1850test namespace-47.1 {ensemble: unknown handler} { 1851 set log {} 1852 namespace eval ns { 1853 namespace export {[a-z]*} 1854 proc Magic {ensemble subcmd args} { 1855 global log 1856 if {[string match {[a-z]*} $subcmd]} { 1857 lappend log "making $subcmd" 1858 proc $subcmd args { 1859 global log 1860 lappend log "running [info level 0]" 1861 llength $args 1862 } 1863 } else { 1864 lappend log "unknown $subcmd - args = $args" 1865 return -code error \ 1866 "unknown or protected subcommand \"$subcmd\"" 1867 } 1868 } 1869 namespace ensemble create -unknown ::ns::Magic 1870 } 1871 set result {} 1872 lappend result [catch {ns a b c} msg] $msg 1873 lappend result [catch {ns a b c} msg] $msg 1874 lappend result [catch {ns b c d} msg] $msg 1875 lappend result [catch {ns c d e} msg] $msg 1876 lappend result [catch {ns Magic foo bar spong wibble} msg] $msg 1877 list $result [lsort [info commands ::ns::*]] $log [namespace delete ns] 1878} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}} 1879test namespace-47.2 {ensemble: unknown handler} { 1880 namespace eval ns { 1881 namespace export {[a-z]*} 1882 proc Magic {ensemble subcmd args} { 1883 error foobar 1884 } 1885 namespace ensemble create -unknown ::ns::Magic 1886 } 1887 list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns] 1888} {1 foobar {foobar 1889 while executing 1890"error foobar" 1891 (procedure "::ns::Magic" line 2) 1892 invoked from within 1893"::ns::Magic ::ns spong" 1894 (ensemble unknown subcommand handler) 1895 invoked from within 1896"ns spong"} {}} 1897test namespace-47.3 {ensemble: unknown handler} { 1898 namespace eval ns { 1899 variable count 0 1900 namespace export {[a-z]*} 1901 proc a {} {} 1902 proc c {} {} 1903 proc Magic {ensemble subcmd args} { 1904 variable count 1905 incr count 1906 proc b {} {} 1907 } 1908 namespace ensemble create -unknown ::ns::Magic 1909 } 1910 list [catch {ns spong} msg] $msg $ns::count [namespace delete ns] 1911} {1 {unknown or ambiguous subcommand "spong": must be a, b, or c} 1 {}} 1912test namespace-47.4 {ensemble: unknown handler} { 1913 namespace eval ns { 1914 namespace export {[a-z]*} 1915 proc Magic {ensemble subcmd args} { 1916 return -code break 1917 } 1918 namespace ensemble create -unknown ::ns::Magic 1919 } 1920 list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns] 1921} {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break 1922 result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong 1923 invoked from within 1924"ns spong"} {}} 1925test namespace-47.5 {ensemble: unknown handler} { 1926 namespace ensemble create -command foo -unknown bar 1927 proc bar {args} { 1928 global result target 1929 lappend result "LOG $args" 1930 return $target 1931 } 1932 set result {} 1933 set target {} 1934 lappend result [catch {foo bar} msg] $msg 1935 set target {lappend result boo hoo} 1936 lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo] 1937 rename foo {} 1938 set result 1939} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -prefixes 1 -subcommands {} -unknown bar}} 1940test namespace-47.6 {ensemble: unknown handler} { 1941 namespace ensemble create -command foo -unknown bar 1942 proc bar {args} { 1943 return "\{" 1944 } 1945 set result [list [catch {foo bar} msg] $msg $::errorInfo] 1946 rename foo {} 1947 set result 1948} {1 {unmatched open brace in list} {unmatched open brace in list 1949 while parsing result of ensemble unknown subcommand handler 1950 invoked from within 1951"foo bar"}} 1952test namespace-47.7 {ensemble: unknown handler, commands with spaces} { 1953 namespace ensemble create -command foo -unknown bar 1954 proc bar {args} { 1955 list ::set ::x [join $args |] 1956 } 1957 set result [foo {one two three}] 1958 rename foo {} 1959 set result 1960} {::foo|one two three} 1961test namespace-47.8 {ensemble: unknown handler, commands with spaces} { 1962 namespace ensemble create -command foo -unknown {bar boo} 1963 proc bar {args} { 1964 list ::set ::x [join $args |] 1965 } 1966 set result [foo {one two three}] 1967 rename foo {} 1968 set result 1969} {boo|::foo|one two three} 1970 1971test namespace-48.1 {ensembles and namespace import: unknown handler} { 1972 namespace eval foo { 1973 namespace export bar 1974 namespace ensemble create -command bar -unknown ::foo::u -subcomm x 1975 proc u {ens args} { 1976 global result 1977 lappend result $ens $args 1978 namespace ensemble config $ens -subcommand {x y} 1979 } 1980 proc u2 {ens args} { 1981 global result 1982 lappend result $ens $args 1983 namespace ensemble config ::bar -subcommand {x y z} 1984 } 1985 proc x args { 1986 global result 1987 lappend result XXX $args 1988 } 1989 proc y args { 1990 global result 1991 lappend result YYY $args 1992 } 1993 proc z args { 1994 global result 1995 lappend result ZZZ $args 1996 } 1997 } 1998 namespace import -force foo::bar 1999 set result [list [namespace ensemble config bar]] 2000 bar x 123 2001 bar y 456 2002 namespace ensemble config bar -unknown ::foo::u2 2003 bar z 789 2004 namespace delete foo 2005 set result 2006} {{-map {} -namespace ::foo -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789} 2007test namespace-48.2 {ensembles and namespace import: exists} { 2008 namespace eval foo { 2009 namespace ensemble create -command ::foo::bar 2010 namespace export bar 2011 } 2012 set result [namespace ensemble exist foo::bar] 2013 lappend result [namespace ensemble exist bar] 2014 namespace import foo::bar 2015 lappend result [namespace ensemble exist bar] 2016 rename foo::bar foo::bar2 2017 lappend result [namespace ensemble exist bar] \ 2018 [namespace ensemble exist spong] 2019 rename bar spong 2020 lappend result [namespace ensemble exist bar] \ 2021 [namespace ensemble exist spong] 2022 rename foo::bar2 {} 2023 lappend result [namespace ensemble exist spong] 2024 namespace delete foo 2025 set result 2026} {1 0 1 1 0 0 1 0} 2027test namespace-48.3 {ensembles and namespace import: config} { 2028 catch {rename spong {}} 2029 namespace eval foo { 2030 namespace ensemble create -command ::foo::bar 2031 namespace export bar boo 2032 proc boo {} {} 2033 } 2034 namespace import foo::bar foo::boo 2035 set result [namespace ensemble config bar -namespace] 2036 lappend result [catch {namespace ensemble config boo} msg] $msg 2037 lappend result [catch {namespace ensemble config spong} msg] $msg 2038 namespace delete foo 2039 set result 2040} {::foo 1 {"boo" is not an ensemble command} 1 {unknown command "spong"}} 2041 2042test namespace-49.1 {ensemble subcommand caching} -body { 2043 namespace ens cre -command a -map {b {lappend result 1}} 2044 namespace ens cre -command c -map {b {lappend result 2}} 2045 proc x {} {a b; c b; a b; c b} 2046 x 2047} -result {1 2 1 2} -cleanup { 2048 rename a {} 2049 rename c {} 2050 rename x {} 2051} 2052test namespace-49.2 {strange delete crash} -body { 2053 namespace eval foo {namespace ensemble create -command ::bar} 2054 trace add command ::bar delete DeleteTrace 2055 proc DeleteTrace {old new op} { 2056 trace remove command ::bar delete DeleteTrace 2057 rename $old "" 2058 # This next line caused a bus error in [Bug 1220058] 2059 namespace delete foo 2060 } 2061 rename ::bar "" 2062} -result "" -cleanup { 2063 rename DeleteTrace "" 2064} 2065 2066test namespace-50.1 {ensembles affect proc arguments error messages} -body { 2067 namespace ens cre -command a -map {b {bb foo}} 2068 proc bb {c d {e f} args} {list $c $args} 2069 a b 2070} -returnCodes error -result "wrong # args: should be \"a b d ?e? ...\"" -cleanup { 2071 rename a {} 2072 rename bb {} 2073} 2074test namespace-50.2 {ensembles affect WrongNumArgs error messages} -body { 2075 namespace ens cre -command a -map {b {string is}} 2076 a b boolean 2077} -returnCodes error -result "wrong # args: should be \"a b class ?-strict? ?-failindex var? str\"" -cleanup { 2078 rename a {} 2079} 2080test namespace-50.3 {chained ensembles affect error messages} -body { 2081 namespace ens cre -command a -map {b c} 2082 namespace ens cre -command c -map {d e} 2083 proc e f {} 2084 a b d 2085} -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup { 2086 rename a {} 2087} 2088test namespace-50.4 {chained ensembles affect error messages} -body { 2089 namespace ens cre -command a -map {b {c d}} 2090 namespace ens cre -command c -map {d {e f}} 2091 proc e f {} 2092 a b d 2093} -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup { 2094 rename a {} 2095} 2096 2097test namespace-51.1 {name resolution path control} -body { 2098 namespace eval ::test_ns_1 { 2099 namespace eval test_ns_2 { 2100 proc pathtestA {} { 2101 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2102 } 2103 proc pathtestC {} { 2104 ::return 2 2105 } 2106 } 2107 proc pathtestB {} { 2108 return 1 2109 } 2110 proc pathtestC {} { 2111 return 1 2112 } 2113 namespace path ::test_ns_1 2114 } 2115 proc ::pathtestB {} { 2116 return global 2117 } 2118 proc ::pathtestD {} { 2119 return global 2120 } 2121 test_ns_1::test_ns_2::pathtestA 2122} -result "global,2,global," -cleanup { 2123 namespace delete ::test_ns_1 2124 catch {rename ::pathtestB {}} 2125 catch {rename ::pathtestD {}} 2126} 2127test namespace-51.2 {name resolution path control} -body { 2128 namespace eval ::test_ns_1 { 2129 namespace eval test_ns_2 { 2130 namespace path ::test_ns_1 2131 proc pathtestA {} { 2132 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2133 } 2134 proc pathtestC {} { 2135 ::return 2 2136 } 2137 } 2138 proc pathtestB {} { 2139 return 1 2140 } 2141 proc pathtestC {} { 2142 return 1 2143 } 2144 } 2145 proc ::pathtestB {} { 2146 return global 2147 } 2148 proc ::pathtestD {} { 2149 return global 2150 } 2151 ::test_ns_1::test_ns_2::pathtestA 2152} -result "1,2,global,::test_ns_1" -cleanup { 2153 namespace delete ::test_ns_1 2154 catch {rename ::pathtestB {}} 2155 catch {rename ::pathtestD {}} 2156} 2157test namespace-51.3 {name resolution path control} -body { 2158 namespace eval ::test_ns_1 { 2159 namespace eval test_ns_2 { 2160 proc pathtestA {} { 2161 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2162 } 2163 proc pathtestC {} { 2164 ::return 2 2165 } 2166 } 2167 proc pathtestB {} { 2168 return 1 2169 } 2170 proc pathtestC {} { 2171 return 1 2172 } 2173 } 2174 proc ::pathtestB {} { 2175 return global 2176 } 2177 proc ::pathtestD {} { 2178 return global 2179 } 2180 set result [::test_ns_1::test_ns_2::pathtestA] 2181 namespace eval ::test_ns_1::test_ns_2 { 2182 namespace path ::test_ns_1 2183 } 2184 lappend result [::test_ns_1::test_ns_2::pathtestA] 2185 rename ::test_ns_1::pathtestB {} 2186 lappend result [::test_ns_1::test_ns_2::pathtestA] 2187} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global,::test_ns_1" -cleanup { 2188 namespace delete ::test_ns_1 2189 catch {rename ::pathtestB {}} 2190 catch {rename ::pathtestD {}} 2191} 2192test namespace-51.4 {name resolution path control} -body { 2193 namespace eval ::test_ns_1 { 2194 namespace eval test_ns_2 { 2195 proc pathtestA {} { 2196 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2197 } 2198 proc pathtestC {} { 2199 ::return 2 2200 } 2201 } 2202 proc pathtestB {} { 2203 return 1 2204 } 2205 proc pathtestC {} { 2206 return 1 2207 } 2208 } 2209 proc ::pathtestB {} { 2210 return global 2211 } 2212 proc ::pathtestD {} { 2213 return global 2214 } 2215 set result [::test_ns_1::test_ns_2::pathtestA] 2216 namespace eval ::test_ns_1::test_ns_2 { 2217 namespace path ::test_ns_1 2218 } 2219 lappend result [::test_ns_1::test_ns_2::pathtestA] 2220 namespace eval ::test_ns_1::test_ns_2 { 2221 namespace path {} 2222 } 2223 lappend result [::test_ns_1::test_ns_2::pathtestA] 2224} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global," -cleanup { 2225 namespace delete ::test_ns_1 2226 catch {rename ::pathtestB {}} 2227 catch {rename ::pathtestD {}} 2228} 2229test namespace-51.5 {name resolution path control} -body { 2230 namespace eval ::test_ns_1 { 2231 namespace eval test_ns_2 { 2232 proc pathtestA {} { 2233 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2234 } 2235 proc pathtestC {} { 2236 ::return 2 2237 } 2238 namespace path ::test_ns_1 2239 } 2240 proc pathtestB {} { 2241 return 1 2242 } 2243 proc pathtestC {} { 2244 return 1 2245 } 2246 proc pathtestD {} { 2247 return 1 2248 } 2249 } 2250 proc ::pathtestB {} { 2251 return global 2252 } 2253 proc ::pathtestD {} { 2254 return global 2255 } 2256 set result [::test_ns_1::test_ns_2::pathtestA] 2257 namespace eval ::test_ns_1::test_ns_2 { 2258 namespace path {:: ::test_ns_1} 2259 } 2260 lappend result [::test_ns_1::test_ns_2::pathtestA] 2261 rename ::test_ns_1::test_ns_2::pathtestC {} 2262 lappend result [::test_ns_1::test_ns_2::pathtestA] 2263} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1}" -cleanup { 2264 namespace delete ::test_ns_1 2265 catch {rename ::pathtestB {}} 2266 catch {rename ::pathtestD {}} 2267} 2268test namespace-51.6 {name resolution path control} -body { 2269 namespace eval ::test_ns_1 { 2270 namespace eval test_ns_2 { 2271 proc pathtestA {} { 2272 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2273 } 2274 proc pathtestC {} { 2275 ::return 2 2276 } 2277 namespace path ::test_ns_1 2278 } 2279 proc pathtestB {} { 2280 return 1 2281 } 2282 proc pathtestC {} { 2283 return 1 2284 } 2285 proc pathtestD {} { 2286 return 1 2287 } 2288 } 2289 proc ::pathtestB {} { 2290 return global 2291 } 2292 proc ::pathtestD {} { 2293 return global 2294 } 2295 set result [::test_ns_1::test_ns_2::pathtestA] 2296 namespace eval ::test_ns_1::test_ns_2 { 2297 namespace path {:: ::test_ns_1} 2298 } 2299 lappend result [::test_ns_1::test_ns_2::pathtestA] 2300 rename ::test_ns_1::test_ns_2::pathtestC {} 2301 lappend result [::test_ns_1::test_ns_2::pathtestA] 2302 proc ::pathtestC {} { 2303 return global 2304 } 2305 lappend result [::test_ns_1::test_ns_2::pathtestA] 2306} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1} {global,global,global,:: ::test_ns_1}" -cleanup { 2307 namespace delete ::test_ns_1 2308 catch {rename ::pathtestB {}} 2309 catch {rename ::pathtestD {}} 2310} 2311test namespace-51.7 {name resolution path control} -body { 2312 namespace eval ::test_ns_1 { 2313 } 2314 namespace eval ::test_ns_2 { 2315 namespace path ::test_ns_1 2316 proc getpath {} {namespace path} 2317 } 2318 list [::test_ns_2::getpath] [namespace delete ::test_ns_1] [::test_ns_2::getpath] 2319} -result {::test_ns_1 {} {}} -cleanup { 2320 catch {namespace delete ::test_ns_1} 2321 namespace delete ::test_ns_2 2322} 2323test namespace-51.8 {name resolution path control} -body { 2324 namespace eval ::test_ns_1 { 2325 } 2326 namespace eval ::test_ns_2 { 2327 } 2328 namespace eval ::test_ns_3 { 2329 } 2330 namespace eval ::test_ns_4 { 2331 namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} 2332 proc getpath {} {namespace path} 2333 } 2334 list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [::test_ns_4::getpath] 2335} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {::test_ns_1 ::test_ns_3}} -cleanup { 2336 catch {namespace delete ::test_ns_1} 2337 catch {namespace delete ::test_ns_2} 2338 catch {namespace delete ::test_ns_3} 2339 catch {namespace delete ::test_ns_4} 2340} 2341test namespace-51.9 {name resolution path control} -body { 2342 namespace eval ::test_ns_1 { 2343 } 2344 namespace eval ::test_ns_2 { 2345 } 2346 namespace eval ::test_ns_3 { 2347 } 2348 namespace eval ::test_ns_4 { 2349 namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} 2350 proc getpath {} {namespace path} 2351 } 2352 list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [namespace eval ::test_ns_2 {}] [::test_ns_4::getpath] 2353} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {} {::test_ns_1 ::test_ns_3}} -cleanup { 2354 catch {namespace delete ::test_ns_1} 2355 catch {namespace delete ::test_ns_2} 2356 catch {namespace delete ::test_ns_3} 2357 catch {namespace delete ::test_ns_4} 2358} 2359test namespace-51.10 {name resolution path control} -body { 2360 namespace eval ::test_ns_1 { 2361 namespace path does::not::exist 2362 } 2363} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup { 2364 catch {namespace delete ::test_ns_1} 2365} 2366test namespace-51.11 {name resolution path control} -body { 2367 namespace eval ::test_ns_1 { 2368 proc foo {} {return 1} 2369 } 2370 namespace eval ::test_ns_2 { 2371 proc foo {} {return 2} 2372 } 2373 namespace eval ::test_ns_3 { 2374 namespace path ::test_ns_1 2375 } 2376 namespace eval ::test_ns_4 { 2377 namespace path {::test_ns_3 ::test_ns_2} 2378 foo 2379 } 2380} -result 2 -cleanup { 2381 catch {namespace delete ::test_ns_1} 2382 catch {namespace delete ::test_ns_2} 2383 catch {namespace delete ::test_ns_3} 2384 catch {namespace delete ::test_ns_4} 2385} 2386test namespace-51.12 {name resolution path control} -body { 2387 namespace eval ::test_ns_1 { 2388 proc foo {} {return 1} 2389 } 2390 namespace eval ::test_ns_2 { 2391 proc foo {} {return 2} 2392 } 2393 namespace eval ::test_ns_3 { 2394 namespace path ::test_ns_1 2395 } 2396 namespace eval ::test_ns_4 { 2397 namespace path {::test_ns_3 ::test_ns_2} 2398 list [foo] [namespace delete ::test_ns_3] [foo] 2399 } 2400} -result {2 {} 2} -cleanup { 2401 catch {namespace delete ::test_ns_1} 2402 catch {namespace delete ::test_ns_2} 2403 catch {namespace delete ::test_ns_3} 2404 catch {namespace delete ::test_ns_4} 2405} 2406 2407test namespace-51.13 {name resolution path control} -body { 2408 set ::result {} 2409 namespace eval ::test_ns_1 { 2410 proc foo {} {lappend ::result 1} 2411 } 2412 namespace eval ::test_ns_2 { 2413 proc foo {} {lappend ::result 2} 2414 trace add command foo delete {namespace eval ::test_ns_3 foo;#} 2415 } 2416 namespace eval ::test_ns_3 { 2417 proc foo {} { 2418 lappend ::result 3 2419 namespace delete [namespace current] 2420 ::test_ns_4::bar 2421 } 2422 } 2423 namespace eval ::test_ns_4 { 2424 namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1} 2425 proc bar {} { 2426 list [foo] [namespace delete ::test_ns_2] [foo] 2427 } 2428 bar 2429 } 2430 # Should the result be "2 {} {2 3 2 1}" instead? 2431} -result {2 {} {2 3 1 1}} -cleanup { 2432 catch {namespace delete ::test_ns_1} 2433 catch {namespace delete ::test_ns_2} 2434 catch {namespace delete ::test_ns_3} 2435 catch {namespace delete ::test_ns_4} 2436} 2437test namespace-51.14 {name resolution path control} -body { 2438 foreach cmd [info commands foo*] { 2439 rename $cmd {} 2440 } 2441 proc foo0 {} {} 2442 namespace eval ::test_ns_1 { 2443 proc foo1 {} {} 2444 } 2445 namespace eval ::test_ns_2 { 2446 proc foo2 {} {} 2447 } 2448 namespace eval ::test_ns_3 { 2449 variable result {} 2450 lappend result [info commands foo*] 2451 namespace path {::test_ns_1 ::test_ns_2} 2452 lappend result [info commands foo*] 2453 proc foo2 {} {} 2454 lappend result [info commands foo*] 2455 rename foo2 {} 2456 lappend result [info commands foo*] 2457 namespace delete ::test_ns_1 2458 lappend result [info commands foo*] 2459 } 2460} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup { 2461 catch {namespace delete ::test_ns_1} 2462 catch {namespace delete ::test_ns_2} 2463 catch {namespace delete ::test_ns_3} 2464} 2465test namespace-51.15 {namespace resolution path control} -body { 2466 namespace eval ::test_ns_2 { 2467 proc foo {} {return 2} 2468 } 2469 namespace eval ::test_ns_1 { 2470 namespace eval test_ns_2 { 2471 proc foo {} {return 1_2} 2472 } 2473 namespace eval test_ns_3 { 2474 namespace path ::test_ns_1 2475 test_ns_2::foo 2476 } 2477 } 2478} -result 1_2 -cleanup { 2479 namespace delete ::test_ns_1 2480 namespace delete ::test_ns_2 2481} 2482test namespace-51.16 {Bug 1566526} { 2483 interp create slave 2484 slave eval namespace eval demo namespace path :: 2485 interp delete slave 2486} {} 2487test namespace-51.17 {Bug 3185407} -setup { 2488 namespace eval ::test_ns_1 {} 2489} -body { 2490 namespace eval ::test_ns_1 { 2491 variable result {} 2492 namespace eval ns {proc foo {} {}} 2493 namespace eval ns2 {proc foo {} {}} 2494 namespace path {ns ns2} 2495 variable x foo 2496 lappend result [namespace which $x] 2497 proc foo {} {} 2498 lappend result [namespace which $x] 2499 } 2500} -cleanup { 2501 namespace delete ::test_ns_1 2502} -result {::test_ns_1::ns::foo ::test_ns_1::foo} 2503 2504# TIP 181 - namespace unknown tests 2505test namespace-52.1 {unknown: default handler ::unknown} { 2506 set result [list [namespace eval foobar { namespace unknown }]] 2507 lappend result [namespace eval :: { namespace unknown }] 2508 namespace delete foobar 2509 set result 2510} {{} ::unknown} 2511test namespace-52.2 {unknown: default resolution global} { 2512 proc ::foo {} { return "GLOBAL" } 2513 namespace eval ::bar { proc foo {} { return "NAMESPACE" } } 2514 namespace eval ::bar::jim { proc test {} { foo } } 2515 set result [::bar::jim::test] 2516 namespace delete ::bar 2517 rename ::foo {} 2518 set result 2519} {GLOBAL} 2520test namespace-52.3 {unknown: default resolution local} { 2521 proc ::foo {} { return "GLOBAL" } 2522 namespace eval ::bar { 2523 proc foo {} { return "NAMESPACE" } 2524 proc test {} { foo } 2525 } 2526 set result [::bar::test] 2527 namespace delete ::bar 2528 rename ::foo {} 2529 set result 2530} {NAMESPACE} 2531test namespace-52.4 {unknown: set handler} { 2532 namespace eval foo { 2533 namespace unknown [list dispatch] 2534 proc dispatch {args} { return $args } 2535 proc test {} { 2536 UnknownCmd a b c 2537 } 2538 } 2539 set result [foo::test] 2540 namespace delete foo 2541 set result 2542} {UnknownCmd a b c} 2543test namespace-52.5 {unknown: search path before unknown is unaltered} { 2544 proc ::test2 {args} { return "TEST2: $args" } 2545 namespace eval foo { 2546 namespace unknown [list dispatch] 2547 proc dispatch {args} { return "UNKNOWN: $args" } 2548 proc test1 {args} { return "TEST1: $args" } 2549 proc test {} { 2550 set result [list [test1 a b c]] 2551 lappend result [test2 a b c] 2552 lappend result [test3 a b c] 2553 return $result 2554 } 2555 } 2556 set result [foo::test] 2557 namespace delete foo 2558 rename ::test2 {} 2559 set result 2560} {{TEST1: a b c} {TEST2: a b c} {UNKNOWN: test3 a b c}} 2561test namespace-52.6 {unknown: deleting handler restores default} { 2562 rename ::unknown ::_unknown_orig 2563 proc ::unknown {args} { return "DEFAULT: $args" } 2564 namespace eval foo { 2565 namespace unknown dummy 2566 namespace unknown {} 2567 } 2568 set result [namespace eval foo { dummy a b c }] 2569 rename ::unknown {} 2570 rename ::_unknown_orig ::unknown 2571 namespace delete foo 2572 set result 2573} {DEFAULT: dummy a b c} 2574test namespace-52.7 {unknown: setting global unknown handler} { 2575 proc ::myunknown {args} { return "MYUNKNOWN: $args" } 2576 namespace eval :: { namespace unknown ::myunknown } 2577 set result [namespace eval foo { dummy a b c }] 2578 namespace eval :: { namespace unknown {} } 2579 rename ::myunknown {} 2580 namespace delete foo 2581 set result 2582} {MYUNKNOWN: dummy a b c} 2583test namespace-52.8 {unknown: destroying and redefining global namespace} { 2584 set i [interp create] 2585 $i hide proc 2586 $i hide namespace 2587 $i hide return 2588 $i invokehidden namespace delete :: 2589 $i expose return 2590 $i invokehidden proc unknown args { return "FINE" } 2591 $i eval { foo bar bob } 2592} {FINE} 2593test namespace-52.9 {unknown: refcounting} -setup { 2594 proc this args { 2595 unset args ;# stop sharing 2596 set copy [namespace unknown] 2597 string length $copy ;# shimmer away list rep 2598 info level 0 2599 } 2600 set handler [namespace unknown] 2601 namespace unknown {this is a test} 2602 catch {rename noSuchCommand {}} 2603} -body { 2604 noSuchCommand 2605} -cleanup { 2606 namespace unknown $handler 2607 rename this {} 2608} -result {this is a test noSuchCommand} 2609testConstraint testevalobjv [llength [info commands testevalobjv]] 2610test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -constraints { 2611 testevalobjv 2612} -setup { 2613 rename ::unknown unknown.save 2614 proc ::unknown args { 2615 set caller [uplevel 1 {namespace current}] 2616 namespace eval $caller { 2617 variable foo 2618 return $foo 2619 } 2620 } 2621 catch {rename ::noSuchCommand {}} 2622} -body { 2623 namespace eval :: { 2624 variable foo SUCCESS 2625 } 2626 namespace eval test_ns_1 { 2627 variable foo FAIL 2628 testevalobjv 1 noSuchCommand 2629 } 2630} -cleanup { 2631 unset -nocomplain ::foo 2632 namespace delete test_ns_1 2633 rename ::unknown {} 2634 rename unknown.save ::unknown 2635} -result SUCCESS 2636test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup { 2637 set handler [namespace eval :: {namespace unknown}] 2638 namespace eval :: {namespace unknown unknown} 2639 rename ::unknown unknown.save 2640 namespace eval :: { 2641 proc unknown args { 2642 return SUCCESS 2643 } 2644 } 2645 catch {rename ::noSuchCommand {}} 2646 set ::slave [interp create] 2647} -body { 2648 $::slave alias bar noSuchCommand 2649 namespace eval test_ns_1 { 2650 namespace unknown unknown 2651 proc unknown args { 2652 return FAIL 2653 } 2654 $::slave eval bar 2655 } 2656} -cleanup { 2657 interp delete $::slave 2658 unset ::slave 2659 namespace delete test_ns_1 2660 rename ::unknown {} 2661 rename unknown.save ::unknown 2662 namespace eval :: [list namespace unknown $handler] 2663} -result SUCCESS 2664test namespace-52.12 {unknown: error case must not reset handler} -body { 2665 namespace eval foo { 2666 namespace unknown ok 2667 catch {namespace unknown {{}{}{}}} 2668 namespace unknown 2669 } 2670} -cleanup { 2671 namespace delete foo 2672} -result ok 2673 2674# cleanup 2675catch {rename cmd1 {}} 2676catch {unset l} 2677catch {unset msg} 2678catch {unset trigger} 2679namespace delete {*}[namespace children :: test_ns_*] 2680::tcltest::cleanupTests 2681return 2682 2683# Local Variables: 2684# mode: tcl 2685# End: 2686