1# Functionality covered: this file contains a collection of tests for the 2# procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic 3# support for namespaces. Other namespace-related tests appear in 4# variable.test. 5# 6# Sourcing this file into Tcl runs the tests and generates output for errors. 7# No output means no errors were found. 8# 9# Copyright © 1997 Sun Microsystems, Inc. 10# Copyright © 1998-2000 Scriptics Corporation. 11# 12# See the file "license.terms" for information on usage and redistribution of 13# this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 15if {"::tcltest" ni [namespace children]} { 16 package require tcltest 2.5 17 namespace import -force ::tcltest::* 18} 19testConstraint memory [llength [info commands memory]] 20 21::tcltest::loadTestedCommands 22catch [list package require -exact tcl::test [info patchlevel]] 23 24# 25# REMARK: the tests for 'namespace upvar' are not done here. They are to be 26# found in the file 'upvar.test'. 27# 28 29# Clear out any namespaces called test_ns_* 30catch {namespace delete {*}[namespace children :: test_ns_*]} 31 32proc fq {ns} { 33 if {[string match ::* $ns]} {return $ns} 34 set current [uplevel 1 {namespace current}] 35 return [string trimright $current :]::[string trimleft $ns :] 36} 37 38test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { 39 namespace children :: test_ns_* 40} {} 41 42catch {unset l} 43test namespace-2.1 {Tcl_GetCurrentNamespace} { 44 list [namespace current] [namespace eval {} {namespace current}] \ 45 [namespace eval {} {namespace current}] 46} {:: :: ::} 47test namespace-2.2 {Tcl_GetCurrentNamespace} { 48 set l {} 49 lappend l [namespace current] 50 namespace eval test_ns_1 { 51 lappend l [namespace current] 52 namespace eval foo { 53 lappend l [namespace current] 54 } 55 } 56 lappend l [namespace current] 57} {:: ::test_ns_1 ::test_ns_1::foo ::} 58 59test namespace-3.1 {Tcl_GetGlobalNamespace} { 60 namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } } 61 # namespace children uses Tcl_GetGlobalNamespace 62 namespace eval test_ns_1 {namespace children foo b*} 63} {::test_ns_1::foo::bar} 64 65test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} { 66 namespace eval test_ns_1 { 67 variable v 123 68 proc p {} { 69 variable v 70 return $v 71 } 72 } 73 test_ns_1::p ;# does Tcl_PushCallFrame to push p's namespace 74} {123} 75test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} { 76 namespace eval test_ns_1::baz {} ;# does Tcl_PushCallFrame to create baz 77 proc test_ns_1::baz::p {} { 78 variable v 79 set v 789 80 set v} 81 test_ns_1::baz::p 82} {789} 83 84test namespace-5.1 {Tcl_PopCallFrame, no vars} { 85 namespace eval test_ns_1::blodge {} ;# pushes then pops frame 86} {} 87test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup { 88 namespace eval test_ns_1 {} 89} -body { 90 proc test_ns_1::r {} { 91 set a 123 92 } 93 test_ns_1::r ;# pushes then pop's r's frame 94} -result {123} 95 96test namespace-6.1 {Tcl_CreateNamespace} { 97 catch {namespace delete {*}[namespace children :: test_ns_*]} 98 list [lsort [namespace children :: test_ns_*]] \ 99 [namespace eval test_ns_1 {namespace current}] \ 100 [namespace eval test_ns_2 {namespace current}] \ 101 [namespace eval ::test_ns_3 {namespace current}] \ 102 [namespace eval ::test_ns_4 \ 103 {namespace eval foo {namespace current}}] \ 104 [namespace eval ::test_ns_5 \ 105 {namespace eval ::test_ns_6 {namespace current}}] \ 106 [lsort [namespace children :: test_ns_*]] 107} {{} ::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}} 108test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} { 109 list [namespace eval :::test_ns_1::::foo {namespace current}] \ 110 [namespace eval test_ns_2:::::foo {namespace current}] 111} {::test_ns_1::foo ::test_ns_2::foo} 112test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { 113 list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 114} {0 ::test_ns_7} 115test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { 116 catch {namespace delete {*}[namespace children :: test_ns_*]} 117 namespace eval test_ns_1:: { 118 namespace eval test_ns_2:: {} 119 namespace eval test_ns_3:: {} 120 } 121 lsort [namespace children ::test_ns_1] 122} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}] 123test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} { 124 set trigger { 125 namespace eval test_ns_2 {namespace current} 126 } 127 set l {} 128 lappend l [namespace eval test_ns_1 $trigger] 129 namespace eval test_ns_1::test_ns_2 {} 130 lappend l [namespace eval test_ns_1 $trigger] 131} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2} 132 133test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} { 134 catch {namespace delete {*}[namespace children :: test_ns_*]} 135 namespace eval test_ns_1 { 136 proc p {} { 137 namespace delete [namespace current] 138 return [namespace current] 139 } 140 } 141 list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg 142} {::test_ns_1 1 {invalid command name "test_ns_1::p"}} 143test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} { 144 namespace eval test_ns_2 { 145 proc p {} { 146 return [namespace current] 147 } 148 } 149 list [test_ns_2::p] [namespace delete test_ns_2] 150} {::test_ns_2 {}} 151test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} { 152 # [Bug 1355942] 153 namespace eval test_ns_2 { 154 set x 1 155 trace add variable x unset "namespace delete [namespace current];#" 156 namespace delete [namespace current] 157 } 158} {} 159test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} { 160 # [Bug 1355942] 161 namespace eval test_ns_2 { 162 proc x {} {} 163 trace add command x delete "namespace delete [namespace current];#" 164 namespace delete [namespace current] 165 } 166} {} 167test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} { 168 # [Bug 1355942] 169 namespace eval test_ns_2 { 170 set x 1 171 trace add variable x unset "namespace delete [namespace current];#" 172 } 173 namespace delete test_ns_2 174} {} 175test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} { 176 # [Bug 1355942] 177 namespace eval test_ns_2 { 178 proc x {} {} 179 trace add command x delete "namespace delete [namespace current];#" 180 } 181 namespace delete test_ns_2 182} {} 183test namespace-7.7 {Bug 1655305} -setup { 184 interp create child 185 # Can't invoke through the ensemble, since deleting ::tcl 186 # (indirectly, via deleting the global namespace) deletes the ensemble. 187 child eval {rename ::tcl::info::commands ::infocommands} 188 child hide infocommands 189 child eval { 190 proc foo {} { 191 namespace delete :: 192 } 193 } 194} -body { 195 child eval foo 196 child invokehidden infocommands 197} -cleanup { 198 interp delete child 199} -result {} 200 201test namespace-7.8 {Bug ba1419303b4c} -setup { 202 namespace eval ns1 { 203 namespace ensemble create 204 } 205 206 trace add command ns1 delete { 207 namespace delete ns1 208 } 209} -body { 210 # No segmentation fault given --enable-symbols. 211 namespace delete ns1 212} -result {} 213 214 215test namespace-7.9 { 216 Bug e39cb3f462631a99 217 218 A namespace being deleted should not be removed from other namespace paths 219 until the contents of the namespace are entirely removed. 220} -setup { 221 222 223 224 225} -body { 226 227 variable res {} 228 229 230 namespace eval ns1 { 231 proc p1 caller { 232 lappend [namespace parent]::res $caller 233 } 234 } 235 236 237 namespace eval ns1a { 238 namespace path [namespace parent]::ns1 239 240 proc t1 {old new op} { 241 $old t1 242 } 243 } 244 245 namespace eval ns2 { 246 proc p1 caller { 247 lappend [namespace parent]::res $caller 248 } 249 } 250 251 namespace eval ns2a { 252 namespace path [namespace parent]::ns2 253 254 proc t1 {old new op} { 255 [namespace tail $old] t2 256 } 257 } 258 259 260 trace add command ns1::p1 delete ns1a::t1 261 namespace delete ns1 262 263 trace add command ns2::p1 delete ns2a::t1 264 namespace delete ns2 265 266 return $res 267 268} -cleanup { 269 namespace delete ns1a 270 namespace delete ns2a 271 unset res 272} -result {t1 t2} 273 274 275 276test namespace-8.1 {TclTeardownNamespace, delete global namespace} { 277 catch {interp delete test_interp} 278 interp create test_interp 279 interp eval test_interp { 280 namespace eval test_ns_1 { 281 namespace export p 282 proc p {} { 283 return [namespace current] 284 } 285 } 286 namespace eval test_ns_2 { 287 namespace import ::test_ns_1::p 288 variable v 27 289 proc q {} { 290 variable v 291 return "[p] $v" 292 } 293 } 294 set x [test_ns_2::q] 295 catch {set xxxx} 296 } 297 list [interp eval test_interp {test_ns_2::q}] \ 298 [interp eval test_interp {namespace delete ::}] \ 299 [catch {interp eval test_interp {set a 123}} msg] $msg \ 300 [interp delete test_interp] 301} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}} 302test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} { 303 catch {namespace delete {*}[namespace children :: test_ns_*]} 304 namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} 305 namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} 306 list [namespace children test_ns_1] \ 307 [namespace delete test_ns_1::test_ns_2] \ 308 [namespace children test_ns_1] 309} {::test_ns_1::test_ns_2 {} {}} 310test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { 311 catch {namespace delete {*}[namespace children :: test_ns_*]} 312 namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} 313 namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} 314 list [namespace children test_ns_1] \ 315 [namespace delete test_ns_1::test_ns_2] \ 316 [namespace children test_ns_1] \ 317 [catch {namespace children test_ns_1::test_ns_2} msg] $msg \ 318 [info commands test_ns_1::test_ns_2::test_ns_3a::*] 319} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}} 320test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} { 321 catch {namespace delete {*}[namespace children :: test_ns_*]} 322 namespace eval test_ns_export { 323 namespace export cmd1 cmd2 324 proc cmd1 {args} {return "cmd1: $args"} 325 proc cmd2 {args} {return "cmd2: $args"} 326 } 327 namespace eval test_ns_import { 328 namespace import ::test_ns_export::* 329 proc p {} {return foo} 330 } 331 list [lsort [info commands test_ns_import::*]] \ 332 [namespace delete test_ns_export] \ 333 [info commands test_ns_import::*] 334} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p] 335test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} { 336 interp create child 337 child eval {trace add execution error leave {namespace delete :: ;#}} 338 catch {child eval error foo bar baz} 339 interp delete child 340 set ::errorInfo 341} {bar 342 invoked from within 343"child eval error foo bar baz"} 344test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} { 345 interp create child 346 child eval {trace add variable errorCode write {namespace delete :: ;#}} 347 catch {child eval error foo bar baz} 348 interp delete child 349 set ::errorInfo 350} {bar 351 invoked from within 352"child eval error foo bar baz"} 353test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} { 354 interp create child 355 child eval {trace add execution error leave {namespace delete :: ;#}} 356 catch {child eval error foo bar baz} 357 interp delete child 358 set ::errorCode 359} baz 360 361test namespace-9.1 {Tcl_Import, empty import pattern} { 362 catch {namespace delete {*}[namespace children :: test_ns_*]} 363 list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg 364} {1 {empty import pattern}} 365test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} { 366 list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg 367} {1 {unknown namespace in import pattern "fred::x"}} 368test namespace-9.3 {Tcl_Import, import ns == export ns} { 369 list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg 370} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}} 371test namespace-9.4 {Tcl_Import, simple import} { 372 catch {namespace delete {*}[namespace children :: test_ns_*]} 373 namespace eval test_ns_export { 374 namespace export cmd1 375 proc cmd1 {args} {return "cmd1: $args"} 376 proc cmd2 {args} {return "cmd2: $args"} 377 } 378 namespace eval test_ns_import { 379 namespace import ::test_ns_export::* 380 proc p {} {return [cmd1 123]} 381 } 382 test_ns_import::p 383} {cmd1: 123} 384test namespace-9.5 {Tcl_Import, RFE 1230597} -setup { 385 namespace eval test_ns_import {} 386 namespace eval test_ns_export {} 387} -body { 388 list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg 389} -result {0 {}} 390test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup { 391 namespace eval test_ns_import {} 392 namespace eval ::test_ns_export { 393 proc cmd1 {args} {return "cmd1: $args"} 394 namespace export cmd1 395 } 396} -body { 397 namespace eval test_ns_import { 398 namespace import -force ::test_ns_export::* 399 cmd1 555 400 } 401} -result {cmd1: 555} 402test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} { 403 catch {namespace delete {*}[namespace children :: test_ns_*]} 404 namespace eval test_ns_export { 405 namespace export cmd1 406 proc cmd1 {args} {return "cmd1: $args"} 407 } 408 namespace eval test_ns_import { 409 namespace import -force ::test_ns_export::* 410 } 411 list [test_ns_import::cmd1 a b c] \ 412 [test_ns_export::cmd1 d e f] \ 413 [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \ 414 [namespace origin test_ns_import::cmd1] \ 415 [namespace origin test_ns_export::cmd1] \ 416 [test_ns_import::cmd1 g h i] \ 417 [test_ns_export::cmd1 j k l] 418} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}} 419test namespace-9.8 {Tcl_Import: Bug 1017299} -setup { 420 namespace eval one { 421 namespace export cmd 422 proc cmd {} {} 423 } 424 namespace eval two { 425 namespace export cmd 426 proc other args {} 427 } 428 namespace eval two \ 429 [list namespace import [namespace current]::one::cmd] 430 namespace eval three \ 431 [list namespace import [namespace current]::two::cmd] 432 namespace eval three { 433 rename cmd other 434 namespace export other 435 } 436} -body { 437 namespace eval two [list namespace import -force \ 438 [namespace current]::three::other] 439 namespace origin two::other 440} -cleanup { 441 namespace delete one two three 442} -match glob -result *::one::cmd 443test namespace-9.9 {Tcl_Import: Bug 1017299} -setup { 444 namespace eval one { 445 namespace export cmd 446 proc cmd {} {} 447 } 448 namespace eval two namespace export cmd 449 namespace eval two \ 450 [list namespace import [namespace current]::one::cmd] 451 namespace eval three namespace export cmd 452 namespace eval three \ 453 [list namespace import [namespace current]::two::cmd] 454} -body { 455 namespace eval two [list namespace import -force \ 456 [namespace current]::three::cmd] 457 namespace origin two::cmd 458} -cleanup { 459 namespace delete one two three 460} -returnCodes error -match glob -result {import pattern * would create a loop*} 461 462test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { 463 catch {namespace delete {*}[namespace children :: test_ns_*]} 464 list [catch {namespace forget xyzzy::*} msg] $msg 465} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} 466test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} { 467 namespace eval test_ns_export { 468 namespace export cmd1 469 proc cmd1 {args} {return "cmd1: $args"} 470 proc cmd2 {args} {return "cmd2: $args"} 471 } 472 namespace eval test_ns_import { 473 namespace forget ::test_ns_export::wombat 474 } 475} {} 476test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup { 477 namespace eval test_ns_export { 478 namespace export cmd1 479 proc cmd1 {args} {return "cmd1: $args"} 480 proc cmd2 {args} {return "cmd2: $args"} 481 } 482} -body { 483 namespace eval test_ns_import { 484 namespace import ::test_ns_export::* 485 proc p {} {return [cmd1 123]} 486 set l {} 487 lappend l [lsort [info commands ::test_ns_import::*]] 488 namespace forget ::test_ns_export::cmd1 489 lappend l [info commands ::test_ns_import::*] 490 lappend l [catch {cmd1 777} msg] $msg 491 } 492} -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}] 493test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup { 494 namespace eval origin { 495 namespace export cmd 496 proc cmd {} {} 497 } 498 namespace eval unrelated { 499 proc cmd {} {} 500 } 501 namespace eval my \ 502 [list namespace import [namespace current]::origin::cmd] 503} -body { 504 namespace eval my \ 505 [list namespace forget [namespace current]::unrelated::cmd] 506 my::cmd 507} -cleanup { 508 namespace delete origin unrelated my 509} 510test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup { 511 namespace eval origin { 512 namespace export cmd 513 proc cmd {} {} 514 } 515 namespace eval my \ 516 [list namespace import [namespace current]::origin::cmd] 517 namespace eval my rename cmd newname 518} -body { 519 namespace eval my \ 520 [list namespace forget [namespace current]::origin::cmd] 521 my::newname 522} -cleanup { 523 namespace delete origin my 524} -returnCodes error -match glob -result * 525test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup { 526 namespace eval origin { 527 namespace export cmd 528 proc cmd {} {} 529 } 530 namespace eval my \ 531 [list namespace import [namespace current]::origin::cmd] 532 namespace eval your {} 533 namespace eval my \ 534 [list rename cmd [namespace current]::your::newname] 535} -body { 536 namespace eval your namespace forget newname 537 your::newname 538} -cleanup { 539 namespace delete origin my your 540} -returnCodes error -match glob -result * 541test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup { 542 namespace eval origin { 543 namespace export cmd 544 proc cmd {} {} 545 } 546 namespace eval link namespace export cmd 547 namespace eval link \ 548 [list namespace import [namespace current]::origin::cmd] 549 namespace eval link2 namespace export cmd 550 namespace eval link2 \ 551 [list namespace import [namespace current]::link::cmd] 552 namespace eval my \ 553 [list namespace import [namespace current]::link2::cmd] 554} -body { 555 namespace eval my \ 556 [list namespace forget [namespace current]::origin::cmd] 557 my::cmd 558} -cleanup { 559 namespace delete origin link link2 my 560} -returnCodes error -match glob -result * 561test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup { 562 namespace eval origin { 563 namespace export cmd 564 proc cmd {} {} 565 } 566 namespace eval link namespace export cmd 567 namespace eval link \ 568 [list namespace import [namespace current]::origin::cmd] 569 namespace eval link2 namespace export cmd 570 namespace eval link2 \ 571 [list namespace import [namespace current]::link::cmd] 572 namespace eval my \ 573 [list namespace import [namespace current]::link2::cmd] 574} -body { 575 namespace eval my \ 576 [list namespace forget [namespace current]::link::cmd] 577 my::cmd 578} -cleanup { 579 namespace delete origin link link2 my 580} 581test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup { 582 namespace eval origin { 583 namespace export cmd 584 proc cmd {} {} 585 } 586 namespace eval link namespace export cmd 587 namespace eval link \ 588 [list namespace import [namespace current]::origin::cmd] 589 namespace eval link2 namespace export cmd 590 namespace eval link2 \ 591 [list namespace import [namespace current]::link::cmd] 592 namespace eval my \ 593 [list namespace import [namespace current]::link2::cmd] 594} -body { 595 namespace eval my \ 596 [list namespace forget [namespace current]::link2::cmd] 597 my::cmd 598} -cleanup { 599 namespace delete origin link link2 my 600} -returnCodes error -match glob -result * 601 602test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup { 603 catch {namespace delete {*}[namespace children :: test_ns_*]} 604} -body { 605 namespace eval test_ns_export { 606 namespace export cmd1 607 proc cmd1 {args} {return "cmd1: $args"} 608 } 609 list [namespace origin set] [namespace origin test_ns_export::cmd1] 610} -result {::set ::test_ns_export::cmd1} 611test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup { 612 catch {namespace delete {*}[namespace children :: test_ns_*]} 613 namespace eval test_ns_export { 614 namespace export cmd1 615 proc cmd1 {args} {return "cmd1: $args"} 616 } 617} -body { 618 namespace eval test_ns_import1 { 619 namespace import ::test_ns_export::* 620 namespace export * 621 proc p {} {namespace origin cmd1} 622 } 623 list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1] 624} -result {::test_ns_export::cmd1 ::test_ns_export::cmd1} 625test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup { 626 catch {namespace delete {*}[namespace children :: test_ns_*]} 627 namespace eval test_ns_export { 628 namespace export cmd1 629 proc cmd1 {args} {return "cmd1: $args"} 630 } 631 namespace eval test_ns_import1 { 632 namespace import ::test_ns_export::* 633 namespace export * 634 proc p {} {namespace origin cmd1} 635 } 636} -body { 637 namespace eval test_ns_import2 { 638 namespace import ::test_ns_import1::* 639 proc q {} {return [cmd1 123]} 640 } 641 list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1] 642} -result {{cmd1: 123} ::test_ns_export::cmd1} 643 644test namespace-12.1 {InvokeImportedCmd} { 645 catch {namespace delete {*}[namespace children :: test_ns_*]} 646 namespace eval test_ns_export { 647 namespace export cmd1 648 proc cmd1 {args} {namespace current} 649 } 650 namespace eval test_ns_import { 651 namespace import ::test_ns_export::* 652 } 653 list [test_ns_import::cmd1] 654} {::test_ns_export} 655 656test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup { 657 catch {namespace delete {*}[namespace children :: test_ns_*]} 658 namespace eval test_ns_export { 659 namespace export cmd1 660 proc cmd1 {args} {namespace current} 661 } 662 namespace eval test_ns_import { 663 namespace import ::test_ns_export::* 664 } 665} -body { 666 namespace eval test_ns_import { 667 set l {} 668 lappend l [info commands ::test_ns_import::*] 669 namespace forget ::test_ns_export::cmd1 670 lappend l [info commands ::test_ns_import::*] 671 } 672} -result {::test_ns_import::cmd1 {}} 673test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} { 674 # Will panic if still buggy 675 namespace eval src {namespace export foo; proc foo {} {}} 676 namespace eval dst {namespace import [namespace parent]::src::foo} 677 trace add command src::foo delete \ 678 "[list namespace delete [namespace current]::dst] ;#" 679 proc src::foo {} {} 680 namespace delete src 681} {} 682 683test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup { 684 catch {namespace delete {*}[namespace children :: test_ns_*]} 685 variable v 10 686 namespace eval test_ns_1::test_ns_2 { 687 variable v 20 688 } 689 namespace eval test_ns_2 { 690 variable v 30 691 } 692} -body { 693 namespace eval test_ns_1 { 694 list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \ 695 [lsort [namespace children :: test_ns_*]] 696 } 697} -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]] 698test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup { 699 catch {namespace delete {*}[namespace children :: test_ns_*]} 700 variable v 10 701 namespace eval test_ns_1::test_ns_2 { 702 variable v 20 703 } 704 namespace eval test_ns_2 { 705 variable v 30 706 } 707} -body { 708 namespace eval test_ns_1 { 709 list [catch {set ::test_ns_777::v} msg] $msg \ 710 [catch {namespace children test_ns_777} msg] $msg 711 } 712} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} 713test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { 714 catch {namespace delete {*}[namespace children :: test_ns_*]} 715 variable v 10 716 namespace eval test_ns_1::test_ns_2 { 717 variable v 20 718 } 719 namespace eval test_ns_2 { 720 variable v 30 721 } 722} -body { 723 namespace eval test_ns_1 { 724 list $v $test_ns_2::v 725 } 726} -result {10 20} 727test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { 728 namespace eval test_ns_1::test_ns_2 { 729 namespace eval foo {} 730 } 731 namespace eval test_ns_1 { 732 list [namespace children test_ns_2] \ 733 [catch {namespace children test_ns_1} msg] $msg 734 } 735} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} 736test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { 737 namespace eval ::test_ns_2 { 738 namespace eval bar {} 739 } 740 namespace eval test_ns_1 { 741 list [catch {namespace delete test_ns_2::bar} msg] $msg 742 } 743} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}} 744test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { 745 namespace eval test_ns_1::test_ns_2 { 746 namespace eval foo {} 747 } 748 namespace eval test_ns_1 { 749 list [namespace children test_ns_2] \ 750 [catch {namespace children test_ns_1} msg] $msg 751 } 752} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}} 753test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup { 754 namespace eval test_ns_1::test_ns_2::foo {} 755} -body { 756 namespace children test_ns_1::: 757} -result {::test_ns_1::test_ns_2} 758test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup { 759 namespace eval test_ns_1::test_ns_2::foo {} 760} -body { 761 namespace children :::test_ns_1:::::test_ns_2::: 762} -result {::test_ns_1::test_ns_2::foo} 763test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} { 764 set l {} 765 lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg 766 namespace eval test_ns_1::test_ns_2 {variable {} 2525} 767 lappend l [set test_ns_1::test_ns_2::] 768} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525} 769test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { 770 namespace eval test_ns_1::test_ns_2::foo {} 771 unset -nocomplain test_ns_1::test_ns_2:: 772 set l {} 773} -body { 774 lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg 775 set test_ns_1::test_ns_2:: 314159 776 lappend l [set test_ns_1::test_ns_2::] 777} -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159} 778test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup { 779 namespace eval test_ns_1::test_ns_2::foo {} 780 catch {rename test_ns_1::test_ns_2:: {}} 781 set l {} 782} -body { 783 lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg 784 proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} 785 lappend l [test_ns_1::test_ns_2:: hello] 786} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} 787test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { 788 catch {namespace delete {*}[namespace children :: test_ns_*]} 789} -body { 790 namespace eval test_ns_1 { 791 variable {} 792 set test_ns_1::(x) y 793 } 794 set test_ns_1::(x) 795} -result y 796test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup { 797 catch {namespace delete {*}[namespace children :: test_ns_*]} 798} -returnCodes error -body { 799 namespace eval test_ns_1 { 800 proc {} {} {} 801 namespace eval {} {} 802 {} 803 } 804} -result {can't create namespace "": only global namespace can have empty name} 805 806test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup { 807 catch {namespace delete {*}[namespace children :: test_ns_*]} 808} -body { 809 namespace eval test_ns_delete { 810 namespace eval test_ns_delete2 {} 811 proc cmd {args} {namespace current} 812 } 813 list [namespace delete ::test_ns_delete::test_ns_delete2] \ 814 [namespace children ::test_ns_delete] 815} -result {{} {}} 816test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body { 817 namespace delete ::test_ns_delete::test_ns_delete2 818} -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command} 819test namespace-15.3 {Tcl_FindNamespace, relative name found} { 820 namespace eval test_ns_delete { 821 namespace eval test_ns_delete2 {} 822 namespace eval test_ns_delete3 {} 823 list [namespace delete test_ns_delete2] \ 824 [namespace children [namespace current]] 825 } 826} {{} ::test_ns_delete::test_ns_delete3} 827test namespace-15.4 {Tcl_FindNamespace, relative name not found} { 828 namespace eval test_ns_delete2 {} 829 namespace eval test_ns_delete { 830 list [catch {namespace delete test_ns_delete2} msg] $msg 831 } 832} {1 {unknown namespace "test_ns_delete2" in namespace delete command}} 833 834test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup { 835 catch {namespace delete {*}[namespace children :: test_ns_*]} 836} -body { 837 namespace eval test_ns_1 { 838 proc cmd {args} {return "[namespace current]::cmd: $args"} 839 variable v "::test_ns_1::cmd" 840 eval $v one 841 } 842} -result {::test_ns_1::cmd: one} 843test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup { 844 catch {namespace delete {*}[namespace children :: test_ns_*]} 845 namespace eval test_ns_1 { 846 proc cmd {args} {return "[namespace current]::cmd: $args"} 847 variable v "::test_ns_1::cmd" 848 } 849} -body { 850 eval $test_ns_1::v two 851} -result {::test_ns_1::cmd: two} 852test namespace-16.3 {Tcl_FindCommand, absolute name not found} { 853 namespace eval test_ns_1 { 854 variable v2 "::test_ns_1::ladidah" 855 list [catch {eval $v2} msg] $msg 856 } 857} {1 {invalid command name "::test_ns_1::ladidah"}} 858 859# save the "unknown" proc, which is redefined by the following two tests 860catch {rename unknown unknown.old} 861proc unknown {args} { 862 return "unknown: $args" 863} 864test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { 865 ::test_ns_1::foobar x y z 866} {unknown: ::test_ns_1::foobar x y z} 867test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { 868 ::foobar 1 2 3 4 5 869} {unknown: ::foobar 1 2 3 4 5} 870test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { 871 test_ns_1::foobar x y z 872} {unknown: test_ns_1::foobar x y z} 873test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { 874 foobar 1 2 3 4 5 875} {unknown: foobar 1 2 3 4 5} 876# restore the "unknown" proc saved previously 877catch {rename unknown {}} 878catch {rename unknown.old unknown} 879 880test namespace-16.8 {Tcl_FindCommand, relative name found} -setup { 881 catch {namespace delete {*}[namespace children :: test_ns_*]} 882 namespace eval test_ns_1 { 883 proc cmd {args} {return "[namespace current]::cmd: $args"} 884 } 885} -body { 886 namespace eval test_ns_1 { 887 cmd a b c 888 } 889} -result {::test_ns_1::cmd: a b c} 890test namespace-16.9 {Tcl_FindCommand, relative name found} -body { 891 proc cmd2 {args} {return "[namespace current]::cmd2: $args"} 892 namespace eval test_ns_1 { 893 cmd2 a b c 894 } 895} -cleanup { 896 catch {rename cmd2 {}} 897} -result {::::cmd2: a b c} 898test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} -body { 899 proc cmd2 {args} {return "[namespace current]::cmd2: $args"} 900 namespace eval test_ns_1 { 901 proc cmd2 {args} { 902 return "[namespace current]::cmd2 in test_ns_1: $args" 903 } 904 namespace eval test_ns_12 { 905 cmd2 a b c 906 } 907 } 908} -cleanup { 909 catch {rename cmd2 {}} 910} -result {::::cmd2: a b c} 911test namespace-16.11 {Tcl_FindCommand, relative name not found} -body { 912 namespace eval test_ns_1 { 913 cmd3 a b c 914 } 915} -returnCodes error -result {invalid command name "cmd3"} 916 917unset -nocomplain x 918test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup { 919 catch {namespace delete {*}[namespace children :: test_ns_*]} 920} -body { 921 set x 314159 922 namespace eval test_ns_1 { 923 set ::x 924 } 925} -result {314159} 926variable ::x 314159 927test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} { 928 namespace eval test_ns_1 { 929 variable x 777 930 set ::test_ns_1::x 931 } 932} {777} 933test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} { 934 namespace eval test_ns_1 { 935 namespace eval test_ns_2 { 936 variable x 1111 937 } 938 set ::test_ns_1::test_ns_2::x 939 } 940} {1111} 941test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body { 942 namespace eval test_ns_1 { 943 namespace eval test_ns_2 { 944 variable x 1111 945 } 946 set ::test_ns_1::test_ns_2::y 947 } 948} -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable} 949test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup { 950 namespace eval ::test_ns_1::test_ns_2 {} 951} -body { 952 namespace eval test_ns_1 { 953 namespace eval test_ns_3 { 954 variable ::test_ns_1::test_ns_2::x 2222 955 } 956 } 957 set ::test_ns_1::test_ns_2::x 958} -result {2222} 959test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup { 960 namespace eval test_ns_1 { 961 variable x 777 962 } 963} -body { 964 namespace eval test_ns_1 { 965 set x 966 } 967} -result {777} 968test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { 969 namespace eval test_ns_1 { 970 variable x 777 971 unset x 972 set x ;# must be global x now 973 } 974} {314159} 975test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body { 976 namespace eval test_ns_1 { 977 set wuzzat 978 } 979} -returnCodes error -result {can't read "wuzzat": no such variable} 980test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { 981 namespace eval test_ns_1 { 982 variable a hello 983 } 984 set test_ns_1::a 985} {hello} 986test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup { 987 namespace eval test_ns_1 {} 988} -body { 989 proc test_ns {} { 990 set ::test_ns_1::a 0 991 } 992 test_ns 993 rename test_ns {} 994 namespace eval test_ns_1 unset a 995 set a 0 996 namespace eval test_ns_1 set a 1 997 namespace delete test_ns_1 998 return $a 999} -result 1 1000catch {unset a} 1001catch {unset x} 1002 1003catch {unset l} 1004catch {rename foo {}} 1005test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup { 1006 catch {namespace delete {*}[namespace children :: test_ns_*]} 1007} -body { 1008 proc foo {} {return "global foo"} 1009 namespace eval test_ns_1 { 1010 proc trigger {} { 1011 return [foo] 1012 } 1013 } 1014 set l "" 1015 lappend l [test_ns_1::trigger] 1016 namespace eval test_ns_1 { 1017 # force invalidation of cached ref to "foo" in proc trigger 1018 proc foo {} {return "foo in test_ns_1"} 1019 } 1020 lappend l [test_ns_1::trigger] 1021} -result {{global foo} {foo in test_ns_1}} 1022test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} { 1023 namespace eval test_ns_2 { 1024 proc foo {} {return "foo in ::test_ns_2"} 1025 } 1026 namespace eval test_ns_1 { 1027 namespace eval test_ns_2 {} 1028 proc trigger {} { 1029 return [test_ns_2::foo] 1030 } 1031 } 1032 set l "" 1033 lappend l [test_ns_1::trigger] 1034 namespace eval test_ns_1 { 1035 namespace eval test_ns_2 { 1036 # force invalidation of cached ref to "foo" in proc trigger 1037 proc foo {} {return "foo in ::test_ns_1::test_ns_2"} 1038 } 1039 } 1040 lappend l [test_ns_1::trigger] 1041} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}} 1042catch {unset l} 1043catch {rename foo {}} 1044 1045test namespace-19.1 {GetNamespaceFromObj, global name found} -setup { 1046 catch {namespace delete {*}[namespace children :: test_ns_*]} 1047} -body { 1048 namespace eval test_ns_1::test_ns_2 {} 1049 namespace children ::test_ns_1 1050} -result {::test_ns_1::test_ns_2} 1051test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup { 1052 catch {namespace delete {*}[namespace children :: test_ns_*]} 1053 namespace eval test_ns_1::test_ns_2 {} 1054} -body { 1055 namespace eval test_ns_1 { 1056 namespace children test_ns_2 1057 } 1058} -result {} 1059test namespace-19.3 {GetNamespaceFromObj, name not found} -setup { 1060 catch {namespace delete {*}[namespace children :: test_ns_*]} 1061} -body { 1062 namespace eval test_ns_1 { 1063 namespace children test_ns_99 1064 } 1065} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"} 1066test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup { 1067 catch {namespace delete {*}[namespace children :: test_ns_*]} 1068 namespace eval test_ns_1::test_ns_2 {} 1069} -body { 1070 namespace eval test_ns_1 { 1071 proc foo {} { 1072 return [namespace children test_ns_2] 1073 } 1074 list [catch {namespace children test_ns_99} msg] $msg 1075 } 1076 set l {} 1077 lappend l [test_ns_1::foo] 1078 namespace delete test_ns_1::test_ns_2 1079 namespace eval test_ns_1::test_ns_2::test_ns_3 {} 1080 lappend l [test_ns_1::foo] 1081} -result {{} ::test_ns_1::test_ns_2::test_ns_3} 1082 1083test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { 1084 catch {namespace delete {*}[namespace children :: test_ns_*]} 1085 list [catch {namespace} msg] $msg 1086} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} 1087test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { 1088 namespace wombat {} 1089} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *} 1090test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { 1091 namespace ch :: test_ns_* 1092} {} 1093 1094test namespace-21.1 {NamespaceChildrenCmd, no args} -setup { 1095 catch {namespace delete {*}[namespace children :: test_ns_*]} 1096} -body { 1097 namespace eval test_ns_1::test_ns_2 {} 1098 expr {"::test_ns_1" in [namespace children]} 1099} -result {1} 1100test namespace-21.2 {NamespaceChildrenCmd, no args} -setup { 1101 catch {namespace delete {*}[namespace children :: test_ns_*]} 1102 namespace eval test_ns_1::test_ns_2 {} 1103} -body { 1104 namespace eval test_ns_1 { 1105 namespace children 1106 } 1107} -result {::test_ns_1::test_ns_2} 1108test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup { 1109 catch {namespace delete {*}[namespace children :: test_ns_*]} 1110 namespace eval test_ns_1::test_ns_2 {} 1111} -body { 1112 namespace children ::test_ns_1 1113} -result {::test_ns_1::test_ns_2} 1114test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup { 1115 catch {namespace delete {*}[namespace children :: test_ns_*]} 1116 namespace eval test_ns_1::test_ns_2 {} 1117} -body { 1118 namespace eval test_ns_1 { 1119 namespace children test_ns_2 1120 } 1121} -result {} 1122test namespace-21.5 {NamespaceChildrenCmd, too many args} { 1123 namespace eval test_ns_1 { 1124 list [catch {namespace children test_ns_2 xxx yyy} msg] $msg 1125 } 1126} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}} 1127test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} { 1128 namespace eval test_ns_1::test_ns_foo {} 1129 namespace children test_ns_1 *f* 1130} {::test_ns_1::test_ns_foo} 1131test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup { 1132 catch {namespace delete {*}[namespace children :: test_ns_*]} 1133 namespace eval test_ns_1::test_ns_2 {} 1134} -body { 1135 namespace eval test_ns_1::test_ns_foo {} 1136 lsort [namespace children test_ns_1 test*] 1137} -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo} 1138test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} { 1139 namespace eval test_ns_1 {} 1140 namespace children [namespace current] [fq test_ns_1] 1141} [fq test_ns_1] 1142 1143test namespace-22.1 {NamespaceCodeCmd, bad args} { 1144 catch {namespace delete {*}[namespace children :: test_ns_*]} 1145 list [catch {namespace code} msg] $msg \ 1146 [catch {namespace code xxx yyy} msg] $msg 1147} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}} 1148test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} { 1149 namespace eval test_ns_1 { 1150 proc cmd {} {return "test_ns_1::cmd"} 1151 } 1152 namespace code {::namespace inscope ::test_ns_1 cmd} 1153} {::namespace inscope ::test_ns_1 cmd} 1154test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} { 1155 namespace code {namespace inscope ::test_ns_1 cmd} 1156} {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}} 1157test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { 1158 namespace code unknown 1159} {::namespace inscope :: unknown} 1160test namespace-22.5 {NamespaceCodeCmd, in other namespace} { 1161 namespace eval test_ns_1 { 1162 namespace code cmd 1163 } 1164} {::namespace inscope ::test_ns_1 cmd} 1165test namespace-22.6 {NamespaceCodeCmd, in other namespace} { 1166 namespace eval test_ns_1 { 1167 variable v 42 1168 } 1169 namespace eval test_ns_2 { 1170 proc namespace args {} 1171 } 1172 namespace eval test_ns_2 [namespace eval test_ns_1 { 1173 namespace code {set v} 1174 }] 1175} {42} 1176test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} { 1177 namespace eval demo { 1178 proc namespace args {puts $args} 1179 ::namespace code {namespace inscope foo} 1180 } 1181} [list ::namespace inscope [fq demo] {namespace inscope foo}] 1182 1183test namespace-23.1 {NamespaceCurrentCmd, bad args} { 1184 catch {namespace delete {*}[namespace children :: test_ns_*]} 1185 list [catch {namespace current xxx} msg] $msg \ 1186 [catch {namespace current xxx yyy} msg] $msg 1187} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}} 1188test namespace-23.2 {NamespaceCurrentCmd, at global level} { 1189 namespace current 1190} {::} 1191test namespace-23.3 {NamespaceCurrentCmd, in nested ns} { 1192 namespace eval test_ns_1::test_ns_2 { 1193 namespace current 1194 } 1195} {::test_ns_1::test_ns_2} 1196 1197test namespace-24.1 {NamespaceDeleteCmd, no args} { 1198 catch {namespace delete {*}[namespace children :: test_ns_*]} 1199 namespace delete 1200} {} 1201test namespace-24.2 {NamespaceDeleteCmd, one arg} { 1202 namespace eval test_ns_1::test_ns_2 {} 1203 namespace delete ::test_ns_1 1204} {} 1205test namespace-24.3 {NamespaceDeleteCmd, two args} { 1206 namespace eval test_ns_1::test_ns_2 {} 1207 list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1] 1208} {{} {}} 1209test namespace-24.4 {NamespaceDeleteCmd, unknown ns} { 1210 list [catch {namespace delete ::test_ns_foo} msg] $msg 1211} {1 {unknown namespace "::test_ns_foo" in namespace delete command}} 1212 1213test namespace-25.1 {NamespaceEvalCmd, bad args} { 1214 catch {namespace delete {*}[namespace children :: test_ns_*]} 1215 list [catch {namespace eval} msg] $msg 1216} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} 1217test namespace-25.2 {NamespaceEvalCmd, bad args} -body { 1218 namespace test_ns_1 1219} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *} 1220catch {unset v} 1221test namespace-25.3 {NamespaceEvalCmd, new namespace} { 1222 set v 123 1223 namespace eval test_ns_1 { 1224 variable v 314159 1225 proc p {} { 1226 variable v 1227 return $v 1228 } 1229 } 1230 test_ns_1::p 1231} {314159} 1232test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup { 1233 namespace eval test_ns_1 { 1234 variable v 314159 1235 proc p {} { 1236 variable v 1237 return $v 1238 } 1239 } 1240} -body { 1241 namespace eval test_ns_1 { 1242 proc q {} {return [expr {[p]+1}]} 1243 } 1244 test_ns_1::q 1245} -result {314160} 1246test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup { 1247 namespace eval test_ns_1 {variable v 314159} 1248} -body { 1249 namespace eval test_ns_1 "set" "v" 1250} -result {314159} 1251test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} { 1252 list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo 1253} {1 {invalid command name "xxxx"} {invalid command name "xxxx" 1254 while executing 1255"xxxx" 1256 (in namespace eval "::test_ns_1" script line 1) 1257 invoked from within 1258"namespace eval test_ns_1 {xxxx}"}} 1259test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} { 1260 list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo 1261} {1 foo {bar 1262 (in namespace eval "::test_ns_1" script line 1) 1263 invoked from within 1264"namespace eval test_ns_1 {error foo bar baz}"}} 1265test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} { 1266 list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo 1267} {1 foo {bar 1268 (in namespace eval "::test_ns_1" script line 1) 1269 invoked from within 1270"namespace eval test_ns_1 error foo bar baz"}} 1271catch {unset v} 1272test namespace-25.9 {NamespaceEvalCmd, 545325} { 1273 namespace eval test_ns_1 info level 0 1274} {namespace eval test_ns_1 info level 0} 1275 1276test namespace-26.1 {NamespaceExportCmd, no args and new ns} { 1277 catch {namespace delete {*}[namespace children :: test_ns_*]} 1278 namespace export 1279} {} 1280test namespace-26.2 {NamespaceExportCmd, just -clear arg} { 1281 namespace export -clear 1282} {} 1283test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} { 1284 namespace eval test_ns_1 { 1285 list [catch {namespace export ::zzz} msg] $msg 1286 } 1287} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}} 1288test namespace-26.4 {NamespaceExportCmd, one pattern} { 1289 namespace eval test_ns_1 { 1290 namespace export cmd1 1291 proc cmd1 {args} {return "cmd1: $args"} 1292 proc cmd2 {args} {return "cmd2: $args"} 1293 proc cmd3 {args} {return "cmd3: $args"} 1294 proc cmd4 {args} {return "cmd4: $args"} 1295 } 1296 namespace eval test_ns_2 { 1297 namespace import ::test_ns_1::* 1298 } 1299 list [info commands test_ns_2::*] [test_ns_2::cmd1 hello] 1300} {::test_ns_2::cmd1 {cmd1: hello}} 1301test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup { 1302 catch {namespace delete {*}[namespace children test_ns_*]} 1303 namespace eval test_ns_1 { 1304 proc cmd1 {args} {return "cmd1: $args"} 1305 proc cmd2 {args} {return "cmd2: $args"} 1306 proc cmd3 {args} {return "cmd3: $args"} 1307 proc cmd4 {args} {return "cmd4: $args"} 1308 namespace export cmd1 cmd3 1309 } 1310} -body { 1311 namespace eval test_ns_2 { 1312 namespace import -force ::test_ns_1::* 1313 } 1314 list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello] 1315} -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}} 1316test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup { 1317 catch {namespace delete {*}[namespace children test_ns_*]} 1318 namespace eval test_ns_1 { 1319 proc cmd1 {args} {return "cmd1: $args"} 1320 proc cmd2 {args} {return "cmd2: $args"} 1321 proc cmd3 {args} {return "cmd3: $args"} 1322 proc cmd4 {args} {return "cmd4: $args"} 1323 namespace export cmd1 cmd3 1324 } 1325} -body { 1326 namespace eval test_ns_1 { 1327 namespace export 1328 } 1329} -result {cmd1 cmd3} 1330test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup { 1331 catch {namespace delete {*}[namespace children test_ns_*]} 1332 namespace eval test_ns_1 { 1333 proc cmd1 {args} {return "cmd1: $args"} 1334 proc cmd2 {args} {return "cmd2: $args"} 1335 proc cmd3 {args} {return "cmd3: $args"} 1336 proc cmd4 {args} {return "cmd4: $args"} 1337 } 1338} -body { 1339 namespace eval test_ns_1 { 1340 namespace export cmd1 cmd3 1341 } 1342 namespace eval test_ns_2 { 1343 namespace import ::test_ns_1::* 1344 } 1345 namespace eval test_ns_1 { 1346 namespace export -clear cmd4 1347 } 1348 namespace eval test_ns_2 { 1349 namespace import ::test_ns_1::* 1350 } 1351 list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello] 1352} -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}] 1353test namespace-26.8 {NamespaceExportCmd, -clear resets export list} { 1354 catch {namespace delete foo} 1355 namespace eval foo { 1356 namespace export x 1357 namespace export -clear 1358 } 1359 list [namespace eval foo namespace export] [namespace delete foo] 1360} {{} {}} 1361 1362test namespace-27.1 {NamespaceForgetCmd, no args} { 1363 catch {namespace delete {*}[namespace children :: test_ns_*]} 1364 namespace forget 1365} {} 1366test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} { 1367 list [catch {namespace forget ::test_ns_1::xxx} msg] $msg 1368} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}} 1369test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} { 1370 namespace eval test_ns_1 { 1371 namespace export cmd* 1372 proc cmd1 {args} {return "cmd1: $args"} 1373 proc cmd2 {args} {return "cmd2: $args"} 1374 } 1375 namespace eval test_ns_2 { 1376 namespace import ::test_ns_1::* 1377 namespace forget ::test_ns_1::cmd1 1378 } 1379 info commands ::test_ns_2::* 1380} {::test_ns_2::cmd2} 1381 1382test namespace-28.1 {NamespaceImportCmd, no args} -setup { 1383 catch {namespace delete {*}[namespace children :: test_ns_*]} 1384} -body { 1385 namespace eval ::test_ns_1 { 1386 proc foo {} {} 1387 proc bar {} {} 1388 proc boo {} {} 1389 proc glorp {} {} 1390 namespace export foo b* 1391 } 1392 namespace eval ::test_ns_2 { 1393 namespace import ::test_ns_1::* 1394 lsort [namespace import] 1395 } 1396} -cleanup { 1397 catch {namespace delete {*}[namespace children :: test_ns_*]} 1398} -result {bar boo foo} 1399test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} { 1400 namespace import -force 1401} {} 1402test namespace-28.3 {NamespaceImportCmd, arg is imported} { 1403 namespace eval test_ns_1 { 1404 namespace export cmd2 1405 proc cmd1 {args} {return "cmd1: $args"} 1406 proc cmd2 {args} {return "cmd2: $args"} 1407 } 1408 namespace eval test_ns_2 { 1409 namespace import ::test_ns_1::* 1410 namespace forget ::test_ns_1::cmd1 1411 } 1412 info commands test_ns_2::* 1413} {::test_ns_2::cmd2} 1414 1415test namespace-29.1 {NamespaceInscopeCmd, bad args} { 1416 catch {namespace delete {*}[namespace children :: test_ns_*]} 1417 list [catch {namespace inscope} msg] $msg 1418} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} 1419test namespace-29.2 {NamespaceInscopeCmd, bad args} { 1420 list [catch {namespace inscope ::} msg] $msg 1421} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} 1422test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body { 1423 namespace inscope test_ns_1 {set v} 1424} -returnCodes error -result {namespace "test_ns_1" not found in "::"} 1425test namespace-29.4 {NamespaceInscopeCmd, simple case} { 1426 namespace eval test_ns_1 { 1427 variable v 747 1428 proc cmd {args} { 1429 variable v 1430 return "[namespace current]::cmd: v=$v, args=$args" 1431 } 1432 } 1433 namespace inscope test_ns_1 cmd 1434} {::test_ns_1::cmd: v=747, args=} 1435test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup { 1436 namespace eval test_ns_1 { 1437 variable v 747 1438 proc cmd {args} { 1439 variable v 1440 return "[namespace current]::cmd: v=$v, args=$args" 1441 } 1442 } 1443} -body { 1444 list [namespace inscope test_ns_1 cmd x y z] \ 1445 [namespace eval test_ns_1 [concat cmd [list x y z]]] 1446} -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}} 1447test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup { 1448 namespace eval test_ns_1 {} 1449} -body { 1450 namespace inscope test_ns_1 {info level 0} 1451} -result {namespace inscope test_ns_1 {info level 0}} 1452 1453test namespace-30.1 {NamespaceOriginCmd, bad args} { 1454 catch {namespace delete {*}[namespace children :: test_ns_*]} 1455 list [catch {namespace origin} msg] $msg 1456} {1 {wrong # args: should be "namespace origin name"}} 1457test namespace-30.2 {NamespaceOriginCmd, bad args} { 1458 list [catch {namespace origin x y} msg] $msg 1459} {1 {wrong # args: should be "namespace origin name"}} 1460test namespace-30.3 {NamespaceOriginCmd, command not found} { 1461 list [catch {namespace origin fred} msg] $msg 1462} {1 {invalid command name "fred"}} 1463test namespace-30.4 {NamespaceOriginCmd, command isn't imported} { 1464 namespace origin set 1465} {::set} 1466test namespace-30.5 {NamespaceOriginCmd, imported command} { 1467 namespace eval test_ns_1 { 1468 namespace export cmd* 1469 proc cmd1 {args} {return "cmd1: $args"} 1470 proc cmd2 {args} {return "cmd2: $args"} 1471 } 1472 namespace eval test_ns_2 { 1473 namespace export * 1474 namespace import ::test_ns_1::* 1475 proc p {} {} 1476 } 1477 namespace eval test_ns_3 { 1478 namespace import ::test_ns_2::* 1479 list [namespace origin foreach] \ 1480 [namespace origin p] \ 1481 [namespace origin cmd1] \ 1482 [namespace origin ::test_ns_2::cmd2] 1483 } 1484} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2} 1485 1486test namespace-31.1 {NamespaceParentCmd, bad args} { 1487 catch {namespace delete {*}[namespace children :: test_ns_*]} 1488 list [catch {namespace parent a b} msg] $msg 1489} {1 {wrong # args: should be "namespace parent ?name?"}} 1490test namespace-31.2 {NamespaceParentCmd, no args} { 1491 namespace parent 1492} {} 1493test namespace-31.3 {NamespaceParentCmd, namespace specified} { 1494 namespace eval test_ns_1 { 1495 namespace eval test_ns_2 { 1496 namespace eval test_ns_3 {} 1497 } 1498 } 1499 list [namespace parent ::] \ 1500 [namespace parent test_ns_1::test_ns_2] \ 1501 [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}] 1502} {{} ::test_ns_1 ::test_ns_1} 1503test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body { 1504 namespace parent test_ns_1::test_ns_foo 1505} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"} 1506 1507test namespace-32.1 {NamespaceQualifiersCmd, bad args} { 1508 catch {namespace delete {*}[namespace children :: test_ns_*]} 1509 list [catch {namespace qualifiers} msg] $msg 1510} {1 {wrong # args: should be "namespace qualifiers string"}} 1511test namespace-32.2 {NamespaceQualifiersCmd, bad args} { 1512 list [catch {namespace qualifiers x y} msg] $msg 1513} {1 {wrong # args: should be "namespace qualifiers string"}} 1514test namespace-32.3 {NamespaceQualifiersCmd, simple name} { 1515 namespace qualifiers foo 1516} {} 1517test namespace-32.4 {NamespaceQualifiersCmd, leading ::} { 1518 namespace qualifiers ::x::y::z 1519} {::x::y} 1520test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} { 1521 namespace qualifiers a::b 1522} {a} 1523test namespace-32.6 {NamespaceQualifiersCmd, :: argument} { 1524 namespace qualifiers :: 1525} {} 1526test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} { 1527 namespace qualifiers ::::: 1528} {} 1529test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} { 1530 namespace qualifiers foo::: 1531} {foo} 1532 1533test namespace-33.1 {NamespaceTailCmd, bad args} { 1534 catch {namespace delete {*}[namespace children :: test_ns_*]} 1535 list [catch {namespace tail} msg] $msg 1536} {1 {wrong # args: should be "namespace tail string"}} 1537test namespace-33.2 {NamespaceTailCmd, bad args} { 1538 list [catch {namespace tail x y} msg] $msg 1539} {1 {wrong # args: should be "namespace tail string"}} 1540test namespace-33.3 {NamespaceTailCmd, simple name} { 1541 namespace tail foo 1542} {foo} 1543test namespace-33.4 {NamespaceTailCmd, leading ::} { 1544 namespace tail ::x::y::z 1545} {z} 1546test namespace-33.5 {NamespaceTailCmd, no leading ::} { 1547 namespace tail a::b 1548} {b} 1549test namespace-33.6 {NamespaceTailCmd, :: argument} { 1550 namespace tail :: 1551} {} 1552test namespace-33.7 {NamespaceTailCmd, odd number of :s} { 1553 namespace tail ::::: 1554} {} 1555test namespace-33.8 {NamespaceTailCmd, odd number of :s} { 1556 namespace tail foo::: 1557} {} 1558 1559test namespace-34.1 {NamespaceWhichCmd, bad args} { 1560 catch {namespace delete {*}[namespace children :: test_ns_*]} 1561 list [catch {namespace which} msg] $msg 1562} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} 1563test namespace-34.2 {NamespaceWhichCmd, bad args} { 1564 list [catch {namespace which -fred x} msg] $msg 1565} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} 1566test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} { 1567 namespace which -command 1568} {} 1569test namespace-34.4 {NamespaceWhichCmd, bad args} { 1570 list [catch {namespace which a b} msg] $msg 1571} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} 1572test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup { 1573 catch {namespace delete {*}[namespace children test_ns_*]} 1574 namespace eval test_ns_1 { 1575 namespace export cmd* 1576 variable v1 111 1577 proc cmd1 {args} {return "cmd1: $args"} 1578 proc cmd2 {args} {return "cmd2: $args"} 1579 } 1580 namespace eval test_ns_2 { 1581 namespace export * 1582 namespace import ::test_ns_1::* 1583 variable v2 222 1584 proc p {} {} 1585 } 1586} -body { 1587 namespace eval test_ns_3 { 1588 namespace import ::test_ns_2::* 1589 variable v3 333 1590 list [namespace which -command foreach] \ 1591 [namespace which -command p] \ 1592 [namespace which -command cmd1] \ 1593 [namespace which -command ::test_ns_2::cmd2] \ 1594 [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg 1595 } 1596} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}} 1597test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup { 1598 catch {namespace delete {*}[namespace children test_ns_*]} 1599 namespace eval test_ns_1 { 1600 namespace export cmd* 1601 proc cmd1 {args} {return "cmd1: $args"} 1602 proc cmd2 {args} {return "cmd2: $args"} 1603 } 1604 namespace eval test_ns_2 { 1605 namespace export * 1606 namespace import ::test_ns_1::* 1607 proc p {} {} 1608 } 1609 namespace eval test_ns_3 { 1610 namespace import ::test_ns_2::* 1611 } 1612} -body { 1613 namespace eval test_ns_3 { 1614 list [namespace which foreach] \ 1615 [namespace which p] \ 1616 [namespace which cmd1] \ 1617 [namespace which ::test_ns_2::cmd2] 1618 } 1619} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} 1620test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { 1621 catch {namespace delete {*}[namespace children test_ns_*]} 1622 namespace eval test_ns_1 { 1623 namespace export cmd* 1624 proc cmd1 {args} {return "cmd1: $args"} 1625 proc cmd2 {args} {return "cmd2: $args"} 1626 } 1627 namespace eval test_ns_2 { 1628 namespace export * 1629 namespace import ::test_ns_1::* 1630 variable v2 222 1631 proc p {} {} 1632 } 1633 namespace eval test_ns_3 { 1634 variable v3 333 1635 namespace import ::test_ns_2::* 1636 } 1637} -body { 1638 namespace eval test_ns_3 { 1639 list [namespace which -variable env] \ 1640 [namespace which -variable v3] \ 1641 [namespace which -variable ::test_ns_2::v2] \ 1642 [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg 1643 } 1644} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} 1645 1646test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup { 1647 catch {namespace delete {*}[namespace children :: test_ns_*]} 1648} -body { 1649 namespace eval test_ns_1 { 1650 proc p {} { 1651 namespace delete [namespace current] 1652 return [namespace current] 1653 } 1654 } 1655 test_ns_1::p 1656} -result {::test_ns_1} 1657test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} { 1658 namespace eval test_ns_1 { 1659 proc q {} { 1660 return [namespace current] 1661 } 1662 } 1663 list [test_ns_1::q] \ 1664 [namespace delete test_ns_1] \ 1665 [catch {test_ns_1::q} msg] $msg 1666} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}} 1667 1668catch {unset x} 1669catch {unset y} 1670test namespace-36.1 {DupNsNameInternalRep} { 1671 catch {namespace delete {*}[namespace children :: test_ns_*]} 1672 namespace eval test_ns_1 {} 1673 set x "::test_ns_1" 1674 list [namespace parent $x] [set y $x] [namespace parent $y] 1675} {:: ::test_ns_1 ::} 1676catch {unset x} 1677catch {unset y} 1678 1679test namespace-37.1 {SetNsNameFromAny, ns name found} { 1680 catch {namespace delete {*}[namespace children :: test_ns_*]} 1681 namespace eval test_ns_1::test_ns_2 {} 1682 namespace eval test_ns_1 { 1683 namespace children ::test_ns_1 1684 } 1685} {::test_ns_1::test_ns_2} 1686test namespace-37.2 {SetNsNameFromAny, ns name not found} -body { 1687 namespace eval test_ns_1 { 1688 namespace children ::test_ns_1::test_ns_foo 1689 } 1690} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found} 1691 1692test namespace-38.1 {UpdateStringOfNsName} { 1693 catch {namespace delete {*}[namespace children :: test_ns_*]} 1694 ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name 1695 list [namespace eval {} {namespace current}] \ 1696 [namespace eval {} {namespace current}] 1697} {:: ::} 1698 1699test namespace-39.1 {NamespaceExistsCmd} { 1700 catch {namespace delete {*}[namespace children :: test_ns_*]} 1701 namespace eval ::test_ns_z::test_me { variable foo } 1702 list [namespace exists ::] \ 1703 [namespace exists ::bogus_namespace] \ 1704 [namespace exists ::test_ns_z] \ 1705 [namespace exists test_ns_z] \ 1706 [namespace exists ::test_ns_z::foo] \ 1707 [namespace exists ::test_ns_z::test_me] \ 1708 [namespace eval ::test_ns_z { namespace exists ::test_me }] \ 1709 [namespace eval ::test_ns_z { namespace exists test_me }] \ 1710 [namespace exists :::::test_ns_z] 1711} {1 0 1 1 0 1 0 1 1} 1712test namespace-39.2 {NamespaceExistsCmd error} { 1713 list [catch {namespace exists} msg] $msg 1714} {1 {wrong # args: should be "namespace exists name"}} 1715test namespace-39.3 {NamespaceExistsCmd error} { 1716 list [catch {namespace exists a b} msg] $msg 1717} {1 {wrong # args: should be "namespace exists name"}} 1718 1719test namespace-40.1 {Ignoring namespace proc "unknown"} -setup { 1720 rename unknown _unknown 1721} -body { 1722 proc unknown args {return global} 1723 namespace eval ns {proc unknown args {return local}} 1724 list [namespace eval ns aaa bbb] [namespace eval ns aaa] 1725} -cleanup { 1726 rename unknown {} 1727 rename _unknown unknown 1728 namespace delete ns 1729} -result {global global} 1730 1731test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { 1732 set res {} 1733 namespace eval ns { 1734 set res {} 1735 proc test {} { 1736 set ::g 0 1737 } 1738 lappend ::res [test] 1739 proc set {a b} { 1740 ::set a [incr b] 1741 } 1742 lappend ::res [test] 1743 } 1744 namespace delete ns 1745 set res 1746} {0 1} 1747test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { 1748 set res {} 1749 namespace eval ns {} 1750 proc ns::a {i} { 1751 variable b 1752 proc set args {return "New proc is called"} 1753 return [set b $i] 1754 } 1755 ns::a 1 1756 set res [ns::a 2] 1757 namespace delete ns 1758 set res 1759} {New proc is called} 1760test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} { 1761 set res {} 1762 namespace eval ns { 1763 variable b 0 1764 } 1765 proc ns::a {i} { 1766 variable b 1767 proc set args {return "New proc is called"} 1768 return [set b $i] 1769 } 1770 set res [list [ns::a 1] $ns::b] 1771 namespace delete ns 1772 set res 1773} {{New proc is called} 0} 1774 1775# Ensembles (TIP#112) 1776 1777test namespace-42.1 {ensembles: basic} { 1778 namespace eval ns { 1779 namespace export x 1780 proc x {} {format 1} 1781 namespace ensemble create 1782 } 1783 list [info command ns] [ns x] [namespace delete ns] [info command ns] 1784} {ns 1 {} {}} 1785test namespace-42.2 {ensembles: basic} { 1786 namespace eval ns { 1787 namespace export x 1788 proc x {} {format 1} 1789 namespace ensemble create 1790 } 1791 rename ns foo 1792 list [info command foo] [foo x] [namespace delete ns] [info command foo] 1793} {foo 1 {} {}} 1794test namespace-42.3 {ensembles: basic} { 1795 namespace eval ns { 1796 namespace export x* 1797 proc x1 {} {format 1} 1798 proc x2 {} {format 2} 1799 namespace ensemble create 1800 } 1801 set result [list [ns x1] [ns x2]] 1802 lappend result [catch {ns x} msg] $msg 1803 rename ns {} 1804 lappend result [info command ns::x1] 1805 namespace delete ns 1806 lappend result [info command ns::x1] 1807} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}} 1808test namespace-42.4 {ensembles: basic} -body { 1809 namespace eval ns { 1810 namespace export y* 1811 proc x1 {} {format 1} 1812 proc x2 {} {format 2} 1813 namespace ensemble create 1814 } 1815 list [catch {ns x} msg] $msg 1816} -cleanup { 1817 namespace delete ns 1818} -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}} 1819test namespace-42.5 {ensembles: basic} -body { 1820 namespace eval ns { 1821 namespace export x* 1822 proc x1 {} {format 1} 1823 proc x2 {} {format 2} 1824 proc x3 {} {format 3} 1825 namespace ensemble create 1826 } 1827 list [catch {ns x} msg] $msg 1828} -cleanup { 1829 namespace delete ns 1830} -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} 1831test namespace-42.6 {ensembles: nested} -body { 1832 namespace eval ns { 1833 namespace export x* 1834 namespace eval x0 { 1835 proc z {} {format 0} 1836 namespace export z 1837 namespace ensemble create 1838 } 1839 proc x1 {} {format 1} 1840 proc x2 {} {format 2} 1841 proc x3 {} {format 3} 1842 namespace ensemble create 1843 } 1844 list [ns x0 z] [ns x1] [ns x2] [ns x3] 1845} -cleanup { 1846 namespace delete ns 1847} -result {0 1 2 3} 1848test namespace-42.7 {ensembles: nested} -body { 1849 namespace eval ns { 1850 namespace export x* 1851 namespace eval x0 { 1852 proc z {} {list [info level] [info level 1]} 1853 namespace export z 1854 namespace ensemble create 1855 } 1856 proc x1 {} {format 1} 1857 proc x2 {} {format 2} 1858 proc x3 {} {format 3} 1859 namespace ensemble create 1860 } 1861 list [ns x0 z] [ns x1] [ns x2] [ns x3] 1862} -cleanup { 1863 namespace delete ns 1864} -result {{1 ::ns::x0::z} 1 2 3} 1865test namespace-42.8 { 1866 ensembles: [Bug 1670091], panic due to pointer to a deallocated List 1867 struct. 1868} -setup { 1869 proc demo args {} 1870 variable target [list [namespace which demo] x] 1871 proc trial args {variable target; string length $target} 1872 trace add execution demo enter [namespace code trial] 1873 namespace ensemble create -command foo -map [list bar $target] 1874} -body { 1875 foo bar 1876} -cleanup { 1877 unset target 1878 rename demo {} 1879 rename trial {} 1880 rename foo {} 1881} -result {} 1882 1883test namespace-42.9 { 1884 ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a 1885 deallocated List struct. 1886} -setup { 1887 namespace eval n {namespace ensemble create} 1888 set lst [dict create one ::two] 1889 namespace ensemble configure n -subcommands $lst -map $lst 1890} -body { 1891 n one 1892} -cleanup { 1893 namespace delete n 1894 unset -nocomplain lst 1895} -returnCodes error -match glob -result {invalid command name*} 1896 1897test namespace-42.10 { 1898 ensembles: [Bug 4f6a1ebd64] segmentation fault due to pointer to a 1899 deallocated List struct (this time with duplicate of one in "dict"). 1900} -setup { 1901 namespace eval n {namespace ensemble create} 1902 set lst [list one ::two one ::three] 1903 namespace ensemble configure n -subcommands $lst -map $lst 1904} -body { 1905 n one 1906} -cleanup { 1907 namespace delete n 1908 unset -nocomplain lst 1909} -returnCodes error -match glob -result {invalid command name *three*} 1910 1911test namespace-43.1 {ensembles: dict-driven} { 1912 namespace eval ns { 1913 namespace export x* 1914 proc x1 {} {format 1} 1915 proc x2 {} {format 2} 1916 namespace ensemble create -map {a x1 b x2} 1917 } 1918 set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]] 1919 rename ns {} 1920 lappend result [namespace ensemble exists ns] 1921} {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0} 1922test namespace-43.2 {ensembles: dict-driven} -body { 1923 namespace eval ns { 1924 namespace export x* 1925 proc x1 {args} {list 1 $args} 1926 proc x2 {args} {list 2 [llength $args]} 1927 namespace ensemble create -map { 1928 a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .} 1929 } 1930 } 1931 list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo] 1932} -cleanup { 1933 namespace delete ns 1934} -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} 1935set SETUP { 1936 namespace eval ns { 1937 namespace export a b 1938 proc a args {format 1,[llength $args]} 1939 proc b args {format 2,[llength $args]} 1940 proc c args {format 3,[llength $args]} 1941 proc d args {format 4,[llength $args]} 1942 namespace ensemble create -subcommands {b c} 1943 } 1944} 1945test namespace-43.3 {ensembles: list-driven} -setup $SETUP -body { 1946 namespace delete ns 1947} -result {} 1948test namespace-43.4 {ensembles: list-driven} -setup $SETUP -body { 1949 ns a foo bar boo spong wibble 1950} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c} 1951test namespace-43.5 {ensembles: list-driven} -setup $SETUP -body { 1952 ns b foo bar boo spong wibble 1953} -cleanup {namespace delete ns} -result 2,5 1954test namespace-43.6 {ensembles: list-driven} -setup $SETUP -body { 1955 ns c foo bar boo spong wibble 1956} -cleanup {namespace delete ns} -result 3,5 1957test namespace-43.7 {ensembles: list-driven} -setup $SETUP -body { 1958 ns d foo bar boo spong wibble 1959} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c} 1960set SETUP { 1961 namespace eval ns { 1962 namespace export a b 1963 proc a args {format 1,[llength $args]} 1964 proc b args {format 2,[llength $args]} 1965 proc c args {format 3,[llength $args]} 1966 proc d args {format 4,[llength $args]} 1967 namespace ensemble create -subcommands {b c} -map {c ::ns::d} 1968 } 1969} 1970test namespace-43.8 {ensembles: list-and-map-driven} -setup $SETUP -body { 1971 namespace delete ns 1972} -result {} 1973test namespace-43.9 {ensembles: list-and-map-driven} -setup $SETUP -body { 1974 ns a foo bar boo spong wibble 1975} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c} 1976test namespace-43.10 {ensembles: list-and-map-driven} -setup $SETUP -body { 1977 ns b foo bar boo spong wibble 1978} -cleanup {namespace delete ns} -result 2,5 1979test namespace-43.11 {ensembles: list-and-map-driven} -setup $SETUP -body { 1980 ns c foo bar boo spong wibble 1981} -cleanup {namespace delete ns} -result 4,5 1982test namespace-43.12 {ensembles: list-and-map-driven} -setup $SETUP -body { 1983 ns d foo bar boo spong wibble 1984} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c} 1985set SETUP { 1986 namespace eval ns { 1987 namespace export * 1988 proc foo args {format bar} 1989 proc spong args {format wibble} 1990 namespace ensemble create -prefixes off 1991 } 1992} 1993test namespace-43.13 {ensembles: turn off prefixes} -setup $SETUP -body { 1994 namespace delete ns 1995} -result {} 1996test namespace-43.14 {ensembles: turn off prefixes} -setup $SETUP -body { 1997 ns fo 1998} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "fo": must be foo, or spong} 1999test namespace-43.15 {ensembles: turn off prefixes} -setup $SETUP -body { 2000 ns foo 2001} -cleanup {namespace delete ns} -result bar 2002test namespace-43.16 {ensembles: turn off prefixes} -setup $SETUP -body { 2003 ns s 2004} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "s": must be foo, or spong} 2005test namespace-43.17 {ensembles: turn off prefixes} -setup $SETUP -body { 2006 ns spong 2007} -cleanup {namespace delete ns} -result wibble 2008 2009test namespace-44.1 {ensemble: errors} { 2010 list [catch {namespace ensemble} msg] $msg 2011} {1 {wrong # args: should be "namespace ensemble subcommand ?arg ...?"}} 2012test namespace-44.2 {ensemble: errors} { 2013 list [catch {namespace ensemble ?} msg] $msg 2014} {1 {bad subcommand "?": must be configure, create, or exists}} 2015test namespace-44.3 {ensemble: errors} { 2016 namespace eval ns { 2017 list [catch {namespace ensemble create -map x} msg] $msg 2018 } 2019} {1 {missing value to go with key}} 2020test namespace-44.4 {ensemble: errors} { 2021 namespace eval ns { 2022 list [catch {namespace ensemble create -map {x {}}} msg] $msg 2023 } 2024} {1 {ensemble subcommand implementations must be non-empty lists}} 2025test namespace-44.5 {ensemble: errors} -setup { 2026 namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure} 2027} -body { 2028 foobar foobarcon 2029} -cleanup { 2030 rename foobar {} 2031} -returnCodes error -result {invalid command name "foobarconfigure"} 2032test namespace-44.6 {ensemble: errors} -returnCodes error -body { 2033 namespace ensemble create gorp 2034} -result {wrong # args: should be "namespace ensemble create ?option value ...?"} 2035 2036test namespace-45.1 {ensemble: introspection} { 2037 namespace eval ns { 2038 namespace export x 2039 proc x {} {} 2040 namespace ensemble create 2041 set ::result [namespace ensemble configure ::ns] 2042 } 2043 namespace delete ns 2044 set result 2045} {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}} 2046test namespace-45.2 {ensemble: introspection} { 2047 namespace eval ns { 2048 namespace export x 2049 proc x {} {} 2050 namespace ensemble create -map {A x} 2051 set ::result [namespace ensemble configure ::ns -map] 2052 } 2053 namespace delete ns 2054 set result 2055} {A ::ns::x} 2056 2057test namespace-46.1 {ensemble: modification} { 2058 namespace eval ns { 2059 namespace export x 2060 proc x {} {format 123} 2061 # Ensemble maps A->x 2062 namespace ensemble create -command ns -map {A ::ns::x} 2063 set ::result [list [namespace ensemble configure ns -map] [ns A]] 2064 # Ensemble maps B->x 2065 namespace ensemble configure ns -map {B ::ns::x} 2066 lappend ::result [namespace ensemble configure ns -map] [ns B] 2067 # Ensemble maps x->x 2068 namespace ensemble configure ns -map {} 2069 lappend ::result [namespace ensemble configure ns -map] [ns x] 2070 } 2071 namespace delete ns 2072 set result 2073} {{A ::ns::x} 123 {B ::ns::x} 123 {} 123} 2074test namespace-46.2 {ensemble: ensembles really use current export list} { 2075 namespace eval ns { 2076 namespace export x1 2077 proc x1 {} {format 1} 2078 proc x2 {} {format 1} 2079 namespace ensemble create 2080 } 2081 catch {ns ?} msg; set result [list $msg] 2082 namespace eval ns {namespace export x*} 2083 catch {ns ?} msg; lappend result $msg 2084 rename ns::x1 {} 2085 catch {ns ?} msg; lappend result $msg 2086 namespace delete ns 2087 set result 2088} {{unknown or ambiguous subcommand "?": must be x1} {unknown or ambiguous subcommand "?": must be x1, or x2} {unknown or ambiguous subcommand "?": must be x2}} 2089test namespace-46.3 {ensemble: implementation errors} { 2090 namespace eval ns { 2091 variable count 0 2092 namespace ensemble create -map { 2093 a {::lappend ::result} 2094 b {::incr ::ns::count} 2095 } 2096 } 2097 set result {} 2098 lappend result [catch { ns } msg] $msg 2099 ns a [ns b 10] 2100 catch {rename p {}} 2101 rename ns p 2102 p a [p b 3000] 2103 lappend result $ns::count 2104 namespace delete ns 2105 lappend result [info command p] 2106} {1 {wrong # args: should be "ns subcommand ?arg ...?"} 10 3010 3010 {}} 2107test namespace-46.4 {ensemble: implementation errors} { 2108 namespace eval ns { 2109 namespace ensemble create 2110 } 2111 set result [info command ns] 2112 lappend result [catch {ns ?} msg] $msg 2113 namespace delete ns 2114 set result 2115} {ns 1 {unknown subcommand "?": namespace ::ns does not export any commands}} 2116test namespace-46.5 {ensemble: implementation errors} { 2117 namespace eval ns { 2118 namespace ensemble create -map {makeError ::error} 2119 } 2120 list [catch {ns makeError "an error happened"} msg] $msg $::errorInfo [namespace delete ns] 2121} {1 {an error happened} {an error happened 2122 while executing 2123"ns makeError "an error happened""} {}} 2124test namespace-46.6 {ensemble: implementation renames/deletes itself} { 2125 namespace eval ns { 2126 namespace ensemble create -map {to ::rename} 2127 } 2128 ns to ns foo 2129 foo to foo bar 2130 bar to bar spong 2131 spong to spong {} 2132 namespace delete ns 2133} {} 2134test namespace-46.7 {ensemble: implementation deletes its namespace} { 2135 namespace eval ns { 2136 namespace ensemble create -map {kill {::namespace delete}} 2137 } 2138 ns kill ns 2139} {} 2140test namespace-46.8 {ensemble: implementation deletes its namespace} { 2141 namespace eval ns { 2142 namespace export * 2143 proc foo {} { 2144 variable x 1 2145 bar 2146 # Tricky; what is the correct return value anyway? 2147 info exist x 2148 } 2149 proc bar {} { 2150 namespace delete [namespace current] 2151 } 2152 namespace ensemble create 2153 } 2154 list [ns foo] [info exist ns::x] 2155} {1 0} 2156test namespace-46.9 {ensemble: configuring really configures things} { 2157 namespace eval ns { 2158 namespace ensemble create -map {a a} -prefixes 0 2159 } 2160 set result [list [catch {ns x} msg] $msg] 2161 namespace ensemble configure ns -map {b b} 2162 lappend result [catch {ns x} msg] $msg 2163 namespace delete ns 2164 set result 2165} {1 {unknown subcommand "x": must be a} 1 {unknown subcommand "x": must be b}} 2166 2167test namespace-47.1 {ensemble: unknown handler} { 2168 set log {} 2169 namespace eval ns { 2170 namespace export {[a-z]*} 2171 proc Magic {ensemble subcmd args} { 2172 global log 2173 if {[string match {[a-z]*} $subcmd]} { 2174 lappend log "making $subcmd" 2175 proc $subcmd args { 2176 global log 2177 lappend log "running [info level 0]" 2178 llength $args 2179 } 2180 } else { 2181 lappend log "unknown $subcmd - args = $args" 2182 return -code error \ 2183 "unknown or protected subcommand \"$subcmd\"" 2184 } 2185 } 2186 namespace ensemble create -unknown ::ns::Magic 2187 } 2188 set result {} 2189 lappend result [catch {ns a b c} msg] $msg 2190 lappend result [catch {ns a b c} msg] $msg 2191 lappend result [catch {ns b c d} msg] $msg 2192 lappend result [catch {ns c d e} msg] $msg 2193 lappend result [catch {ns Magic foo bar spong wibble} msg] $msg 2194 list $result [lsort [info commands ::ns::*]] $log [namespace delete ns] 2195} {{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}} {}} 2196test namespace-47.2 {ensemble: unknown handler} { 2197 namespace eval ns { 2198 namespace export {[a-z]*} 2199 proc Magic {ensemble subcmd args} { 2200 error foobar 2201 } 2202 namespace ensemble create -unknown ::ns::Magic 2203 } 2204 list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns] 2205} {1 foobar {foobar 2206 while executing 2207"error foobar" 2208 (procedure "::ns::Magic" line 2) 2209 invoked from within 2210"::ns::Magic ::ns spong" 2211 (ensemble unknown subcommand handler) 2212 invoked from within 2213"ns spong"} {}} 2214test namespace-47.3 {ensemble: unknown handler} { 2215 namespace eval ns { 2216 variable count 0 2217 namespace export {[a-z]*} 2218 proc a {} {} 2219 proc c {} {} 2220 proc Magic {ensemble subcmd args} { 2221 variable count 2222 incr count 2223 proc b {} {} 2224 } 2225 namespace ensemble create -unknown ::ns::Magic 2226 } 2227 list [catch {ns spong} msg] $msg $ns::count [namespace delete ns] 2228} {1 {unknown or ambiguous subcommand "spong": must be a, b, or c} 1 {}} 2229test namespace-47.4 {ensemble: unknown handler} { 2230 namespace eval ns { 2231 namespace export {[a-z]*} 2232 proc Magic {ensemble subcmd args} { 2233 return -code break 2234 } 2235 namespace ensemble create -unknown ::ns::Magic 2236 } 2237 list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns] 2238} {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break 2239 result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong 2240 invoked from within 2241"ns spong"} {}} 2242test namespace-47.5 {ensemble: unknown handler} { 2243 namespace ensemble create -command foo -unknown bar 2244 proc bar {args} { 2245 global result target 2246 lappend result "LOG $args" 2247 return $target 2248 } 2249 set result {} 2250 set target {} 2251 lappend result [catch {foo bar} msg] $msg 2252 set target {lappend result boo hoo} 2253 lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo] 2254 rename foo {} 2255 set result 2256} {{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 :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}} 2257test namespace-47.6 {ensemble: unknown handler} { 2258 namespace ensemble create -command foo -unknown bar 2259 proc bar {args} { 2260 return "\{" 2261 } 2262 set result [list [catch {foo bar} msg] $msg $::errorInfo] 2263 rename foo {} 2264 set result 2265} {1 {unmatched open brace in list} {unmatched open brace in list 2266 while parsing result of ensemble unknown subcommand handler 2267 invoked from within 2268"foo bar"}} 2269test namespace-47.7 {ensemble: unknown handler, commands with spaces} { 2270 namespace ensemble create -command foo -unknown bar 2271 proc bar {args} { 2272 list ::set ::x [join $args |] 2273 } 2274 set result [foo {one two three}] 2275 rename foo {} 2276 set result 2277} {::foo|one two three} 2278test namespace-47.8 {ensemble: unknown handler, commands with spaces} { 2279 namespace ensemble create -command foo -unknown {bar boo} 2280 proc bar {args} { 2281 list ::set ::x [join $args |] 2282 } 2283 set result [foo {one two three}] 2284 rename foo {} 2285 set result 2286} {boo|::foo|one two three} 2287 2288test namespace-48.1 {ensembles and namespace import: unknown handler} { 2289 namespace eval foo { 2290 namespace export bar 2291 namespace ensemble create -command bar -unknown ::foo::u -subcomm x 2292 proc u {ens args} { 2293 global result 2294 lappend result $ens $args 2295 namespace ensemble config $ens -subcommand {x y} 2296 } 2297 proc u2 {ens args} { 2298 global result 2299 lappend result $ens $args 2300 namespace ensemble config ::bar -subcommand {x y z} 2301 } 2302 proc x args { 2303 global result 2304 lappend result XXX $args 2305 } 2306 proc y args { 2307 global result 2308 lappend result YYY $args 2309 } 2310 proc z args { 2311 global result 2312 lappend result ZZZ $args 2313 } 2314 } 2315 namespace import -force foo::bar 2316 set result [list [namespace ensemble config bar]] 2317 bar x 123 2318 bar y 456 2319 namespace ensemble config bar -unknown ::foo::u2 2320 bar z 789 2321 namespace delete foo 2322 set result 2323} {{-map {} -namespace ::foo -parameters {} -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789} 2324test namespace-48.2 {ensembles and namespace import: exists} { 2325 namespace eval foo { 2326 namespace ensemble create -command ::foo::bar 2327 namespace export bar 2328 } 2329 set result [namespace ensemble exist foo::bar] 2330 lappend result [namespace ensemble exist bar] 2331 namespace import foo::bar 2332 lappend result [namespace ensemble exist bar] 2333 rename foo::bar foo::bar2 2334 lappend result [namespace ensemble exist bar] \ 2335 [namespace ensemble exist spong] 2336 rename bar spong 2337 lappend result [namespace ensemble exist bar] \ 2338 [namespace ensemble exist spong] 2339 rename foo::bar2 {} 2340 lappend result [namespace ensemble exist spong] 2341 namespace delete foo 2342 set result 2343} {1 0 1 1 0 0 1 0} 2344test namespace-48.3 {ensembles and namespace import: config} { 2345 catch {rename spong {}} 2346 namespace eval foo { 2347 namespace ensemble create -command ::foo::bar 2348 namespace export bar boo 2349 proc boo {} {} 2350 } 2351 namespace import foo::bar foo::boo 2352 set result [namespace ensemble config bar -namespace] 2353 lappend result [catch {namespace ensemble config boo} msg] $msg 2354 lappend result [catch {namespace ensemble config spong} msg] $msg 2355 namespace delete foo 2356 set result 2357} {::foo 1 {"boo" is not an ensemble command} 1 {unknown command "spong"}} 2358 2359test namespace-49.1 {ensemble subcommand caching} -body { 2360 namespace ens cre -command a -map {b {lappend result 1}} 2361 namespace ens cre -command c -map {b {lappend result 2}} 2362 proc x {} {a b; c b; a b; c b} 2363 x 2364} -result {1 2 1 2} -cleanup { 2365 rename a {} 2366 rename c {} 2367 rename x {} 2368} 2369test namespace-49.2 {strange delete crash} -body { 2370 namespace eval foo {namespace ensemble create -command ::bar} 2371 trace add command ::bar delete DeleteTrace 2372 proc DeleteTrace {old new op} { 2373 trace remove command ::bar delete DeleteTrace 2374 rename $old "" 2375 # This next line caused a bus error in [Bug 1220058] 2376 namespace delete foo 2377 } 2378 rename ::bar "" 2379} -result "" -cleanup { 2380 rename DeleteTrace "" 2381} 2382 2383test namespace-50.1 {ensembles affect proc arguments error messages} -body { 2384 namespace ens cre -command a -map {b {bb foo}} 2385 proc bb {c d {e f} args} {list $c $args} 2386 a b 2387} -returnCodes error -result "wrong # args: should be \"a b d ?e? ?arg ...?\"" -cleanup { 2388 rename a {} 2389 rename bb {} 2390} 2391test namespace-50.2 {ensembles affect WrongNumArgs error messages} -body { 2392 namespace ens cre -command a -map {b {string is}} 2393 a b boolean 2394} -returnCodes error -result "wrong # args: should be \"a b class ?-strict? ?-failindex var? str\"" -cleanup { 2395 rename a {} 2396} 2397test namespace-50.3 {chained ensembles affect error messages} -body { 2398 namespace ens cre -command a -map {b c} 2399 namespace ens cre -command c -map {d e} 2400 proc e f {} 2401 a b d 2402} -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup { 2403 rename a {} 2404 rename c {} 2405} 2406test namespace-50.4 {chained ensembles affect error messages} -body { 2407 namespace ens cre -command a -map {b {c d}} 2408 namespace ens cre -command c -map {d {e f}} 2409 proc e f {} 2410 a b d 2411} -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup { 2412 rename a {} 2413 rename c {} 2414} 2415test namespace-50.5 {[4402cfa58c]} -setup { 2416 proc bar {ev} {} 2417 proc bingo {xx} {} 2418 namespace ensemble create -command launch -map {foo bar event bingo} 2419 set result {} 2420} -body { 2421 catch {launch foo} m; lappend result $m 2422 catch {launch ev} m; lappend result $m 2423 catch {launch foo} m; lappend result $m 2424} -cleanup { 2425 rename launch {} 2426 rename bingo {} 2427 rename bar {} 2428} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}} 2429test namespace-50.6 {[4402cfa58c]} -setup { 2430 proc target {x y} {} 2431 namespace ensemble create -command e2 -map {s2 target} 2432 namespace ensemble create -command e1 -map {s1 e2} 2433 set result {} 2434} -body { 2435 set s s 2436 catch {e1 s1 s2 a} m; lappend result $m 2437 catch {e1 $s s2 a} m; lappend result $m 2438 catch {e1 s1 $s a} m; lappend result $m 2439 catch {e1 $s $s a} m; lappend result $m 2440} -cleanup { 2441 rename e1 {} 2442 rename e2 {} 2443 rename target {} 2444} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}} 2445test namespace-50.7 {[4402cfa58c]} -setup { 2446 proc target {x y} {} 2447 namespace ensemble create -command e2 -map {s2 target} 2448 namespace ensemble create -command e1 -map {s1 e2} -parameters foo 2449 set result {} 2450} -body { 2451 set s s 2452 catch {e1 s2 s1 a} m; lappend result $m 2453 catch {e1 $s s1 a} m; lappend result $m 2454 catch {e1 s2 $s a} m; lappend result $m 2455 catch {e1 $s $s a} m; lappend result $m 2456} -cleanup { 2457 rename e1 {} 2458 rename e2 {} 2459 rename target {} 2460} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}} 2461test namespace-50.8 {[f961d7d1dd]} -setup { 2462 proc target {} {} 2463 namespace ensemble create -command e -map {s target} -parameters {{a b}} 2464} -body { 2465 e 2466} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup { 2467 rename e {} 2468 rename target {} 2469} 2470test namespace-50.9 {[cea0344a51]} -body { 2471 namespace eval foo { 2472 namespace eval bar { 2473 namespace delete foo 2474 } 2475 } 2476} -returnCodes error -result {unknown namespace "foo" in namespace delete command} 2477 2478test namespace-51.1 {name resolution path control} -body { 2479 namespace eval ::test_ns_1 { 2480 namespace eval test_ns_2 { 2481 proc pathtestA {} { 2482 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2483 } 2484 proc pathtestC {} { 2485 ::return 2 2486 } 2487 } 2488 proc pathtestB {} { 2489 return 1 2490 } 2491 proc pathtestC {} { 2492 return 1 2493 } 2494 namespace path ::test_ns_1 2495 } 2496 proc ::pathtestB {} { 2497 return global 2498 } 2499 proc ::pathtestD {} { 2500 return global 2501 } 2502 test_ns_1::test_ns_2::pathtestA 2503} -result "global,2,global," -cleanup { 2504 namespace delete ::test_ns_1 2505 catch {rename ::pathtestB {}} 2506 catch {rename ::pathtestD {}} 2507} 2508test namespace-51.2 {name resolution path control} -body { 2509 namespace eval ::test_ns_1 { 2510 namespace eval test_ns_2 { 2511 namespace path ::test_ns_1 2512 proc pathtestA {} { 2513 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2514 } 2515 proc pathtestC {} { 2516 ::return 2 2517 } 2518 } 2519 proc pathtestB {} { 2520 return 1 2521 } 2522 proc pathtestC {} { 2523 return 1 2524 } 2525 } 2526 proc ::pathtestB {} { 2527 return global 2528 } 2529 proc ::pathtestD {} { 2530 return global 2531 } 2532 ::test_ns_1::test_ns_2::pathtestA 2533} -result "1,2,global,::test_ns_1" -cleanup { 2534 namespace delete ::test_ns_1 2535 catch {rename ::pathtestB {}} 2536 catch {rename ::pathtestD {}} 2537} 2538test namespace-51.3 {name resolution path control} -body { 2539 namespace eval ::test_ns_1 { 2540 namespace eval test_ns_2 { 2541 proc pathtestA {} { 2542 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2543 } 2544 proc pathtestC {} { 2545 ::return 2 2546 } 2547 } 2548 proc pathtestB {} { 2549 return 1 2550 } 2551 proc pathtestC {} { 2552 return 1 2553 } 2554 } 2555 proc ::pathtestB {} { 2556 return global 2557 } 2558 proc ::pathtestD {} { 2559 return global 2560 } 2561 set result [::test_ns_1::test_ns_2::pathtestA] 2562 namespace eval ::test_ns_1::test_ns_2 { 2563 namespace path ::test_ns_1 2564 } 2565 lappend result [::test_ns_1::test_ns_2::pathtestA] 2566 rename ::test_ns_1::pathtestB {} 2567 lappend result [::test_ns_1::test_ns_2::pathtestA] 2568} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global,::test_ns_1" -cleanup { 2569 namespace delete ::test_ns_1 2570 catch {rename ::pathtestB {}} 2571 catch {rename ::pathtestD {}} 2572} 2573test namespace-51.4 {name resolution path control} -body { 2574 namespace eval ::test_ns_1 { 2575 namespace eval test_ns_2 { 2576 proc pathtestA {} { 2577 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2578 } 2579 proc pathtestC {} { 2580 ::return 2 2581 } 2582 } 2583 proc pathtestB {} { 2584 return 1 2585 } 2586 proc pathtestC {} { 2587 return 1 2588 } 2589 } 2590 proc ::pathtestB {} { 2591 return global 2592 } 2593 proc ::pathtestD {} { 2594 return global 2595 } 2596 set result [::test_ns_1::test_ns_2::pathtestA] 2597 namespace eval ::test_ns_1::test_ns_2 { 2598 namespace path ::test_ns_1 2599 } 2600 lappend result [::test_ns_1::test_ns_2::pathtestA] 2601 namespace eval ::test_ns_1::test_ns_2 { 2602 namespace path {} 2603 } 2604 lappend result [::test_ns_1::test_ns_2::pathtestA] 2605} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global," -cleanup { 2606 namespace delete ::test_ns_1 2607 catch {rename ::pathtestB {}} 2608 catch {rename ::pathtestD {}} 2609} 2610test namespace-51.5 {name resolution path control} -body { 2611 namespace eval ::test_ns_1 { 2612 namespace eval test_ns_2 { 2613 proc pathtestA {} { 2614 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2615 } 2616 proc pathtestC {} { 2617 ::return 2 2618 } 2619 namespace path ::test_ns_1 2620 } 2621 proc pathtestB {} { 2622 return 1 2623 } 2624 proc pathtestC {} { 2625 return 1 2626 } 2627 proc pathtestD {} { 2628 return 1 2629 } 2630 } 2631 proc ::pathtestB {} { 2632 return global 2633 } 2634 proc ::pathtestD {} { 2635 return global 2636 } 2637 set result [::test_ns_1::test_ns_2::pathtestA] 2638 namespace eval ::test_ns_1::test_ns_2 { 2639 namespace path {:: ::test_ns_1} 2640 } 2641 lappend result [::test_ns_1::test_ns_2::pathtestA] 2642 rename ::test_ns_1::test_ns_2::pathtestC {} 2643 lappend result [::test_ns_1::test_ns_2::pathtestA] 2644} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1}" -cleanup { 2645 namespace delete ::test_ns_1 2646 catch {rename ::pathtestB {}} 2647 catch {rename ::pathtestD {}} 2648} 2649test namespace-51.6 {name resolution path control} -body { 2650 namespace eval ::test_ns_1 { 2651 namespace eval test_ns_2 { 2652 proc pathtestA {} { 2653 ::return [pathtestB],[pathtestC],[pathtestD],[namespace path] 2654 } 2655 proc pathtestC {} { 2656 ::return 2 2657 } 2658 namespace path ::test_ns_1 2659 } 2660 proc pathtestB {} { 2661 return 1 2662 } 2663 proc pathtestC {} { 2664 return 1 2665 } 2666 proc pathtestD {} { 2667 return 1 2668 } 2669 } 2670 proc ::pathtestB {} { 2671 return global 2672 } 2673 proc ::pathtestD {} { 2674 return global 2675 } 2676 set result [::test_ns_1::test_ns_2::pathtestA] 2677 namespace eval ::test_ns_1::test_ns_2 { 2678 namespace path {:: ::test_ns_1} 2679 } 2680 lappend result [::test_ns_1::test_ns_2::pathtestA] 2681 rename ::test_ns_1::test_ns_2::pathtestC {} 2682 lappend result [::test_ns_1::test_ns_2::pathtestA] 2683 proc ::pathtestC {} { 2684 return global 2685 } 2686 lappend result [::test_ns_1::test_ns_2::pathtestA] 2687} -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 { 2688 namespace delete ::test_ns_1 2689 catch {rename ::pathtestB {}} 2690 catch {rename ::pathtestD {}} 2691 catch {rename ::pathtestC {}} 2692} 2693test namespace-51.7 {name resolution path control} -body { 2694 namespace eval ::test_ns_1 { 2695 } 2696 namespace eval ::test_ns_2 { 2697 namespace path ::test_ns_1 2698 proc getpath {} {namespace path} 2699 } 2700 list [::test_ns_2::getpath] [namespace delete ::test_ns_1] [::test_ns_2::getpath] 2701} -result {::test_ns_1 {} {}} -cleanup { 2702 catch {namespace delete ::test_ns_1} 2703 namespace delete ::test_ns_2 2704} 2705test namespace-51.8 {name resolution path control} -body { 2706 namespace eval ::test_ns_1 { 2707 } 2708 namespace eval ::test_ns_2 { 2709 } 2710 namespace eval ::test_ns_3 { 2711 } 2712 namespace eval ::test_ns_4 { 2713 namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} 2714 proc getpath {} {namespace path} 2715 } 2716 list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [::test_ns_4::getpath] 2717} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {::test_ns_1 ::test_ns_3}} -cleanup { 2718 catch {namespace delete ::test_ns_1} 2719 catch {namespace delete ::test_ns_2} 2720 catch {namespace delete ::test_ns_3} 2721 catch {namespace delete ::test_ns_4} 2722} 2723test namespace-51.9 {name resolution path control} -body { 2724 namespace eval ::test_ns_1 { 2725 } 2726 namespace eval ::test_ns_2 { 2727 } 2728 namespace eval ::test_ns_3 { 2729 } 2730 namespace eval ::test_ns_4 { 2731 namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3} 2732 proc getpath {} {namespace path} 2733 } 2734 list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [namespace eval ::test_ns_2 {}] [::test_ns_4::getpath] 2735} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {} {::test_ns_1 ::test_ns_3}} -cleanup { 2736 catch {namespace delete ::test_ns_1} 2737 catch {namespace delete ::test_ns_2} 2738 catch {namespace delete ::test_ns_3} 2739 catch {namespace delete ::test_ns_4} 2740} 2741test namespace-51.10 {name resolution path control} -body { 2742 namespace eval ::test_ns_1 { 2743 namespace path does::not::exist 2744 } 2745} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup { 2746 catch {namespace delete ::test_ns_1} 2747} 2748test namespace-51.11 {name resolution path control} -body { 2749 namespace eval ::test_ns_1 { 2750 proc foo {} {return 1} 2751 } 2752 namespace eval ::test_ns_2 { 2753 proc foo {} {return 2} 2754 } 2755 namespace eval ::test_ns_3 { 2756 namespace path ::test_ns_1 2757 } 2758 namespace eval ::test_ns_4 { 2759 namespace path {::test_ns_3 ::test_ns_2} 2760 foo 2761 } 2762} -result 2 -cleanup { 2763 catch {namespace delete ::test_ns_1} 2764 catch {namespace delete ::test_ns_2} 2765 catch {namespace delete ::test_ns_3} 2766 catch {namespace delete ::test_ns_4} 2767} 2768test namespace-51.12 {name resolution path control} -body { 2769 namespace eval ::test_ns_1 { 2770 proc foo {} {return 1} 2771 } 2772 namespace eval ::test_ns_2 { 2773 proc foo {} {return 2} 2774 } 2775 namespace eval ::test_ns_3 { 2776 namespace path ::test_ns_1 2777 } 2778 namespace eval ::test_ns_4 { 2779 namespace path {::test_ns_3 ::test_ns_2} 2780 list [foo] [namespace delete ::test_ns_3] [foo] 2781 } 2782} -result {2 {} 2} -cleanup { 2783 catch {namespace delete ::test_ns_1} 2784 catch {namespace delete ::test_ns_2} 2785 catch {namespace delete ::test_ns_3} 2786 catch {namespace delete ::test_ns_4} 2787} 2788test namespace-51.13 { 2789 name resolution path control 2790 when the trace fires, ns_2 is being deleted but isn't gone yet, and is 2791 still visible for the trace 2792} -body { 2793 set ::result {} 2794 namespace eval ::test_ns_1 { 2795 proc foo {} {lappend ::result 1} 2796 } 2797 namespace eval ::test_ns_2 { 2798 proc foo {} {lappend ::result 2} 2799 trace add command foo delete "namespace eval ::test_ns_3 foo;#" 2800 } 2801 namespace eval ::test_ns_3 { 2802 proc foo {} { 2803 lappend ::result 3 2804 namespace delete [namespace current] 2805 ::test_ns_4::bar 2806 } 2807 } 2808 namespace eval ::test_ns_4 { 2809 namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1} 2810 proc bar {} { 2811 list [foo] [namespace delete ::test_ns_2] [foo] 2812 } 2813 bar 2814 } 2815} -result {2 {} {2 3 2 1}} -cleanup { 2816 catch {namespace delete ::test_ns_1} 2817 catch {namespace delete ::test_ns_2} 2818 catch {namespace delete ::test_ns_3} 2819 catch {namespace delete ::test_ns_4} 2820} 2821test namespace-51.14 {name resolution path control} -setup { 2822 foreach cmd [info commands foo*] { 2823 rename $cmd {} 2824 } 2825 namespace eval ::test_ns_1 {} 2826 namespace eval ::test_ns_2 {} 2827 namespace eval ::test_ns_3 {} 2828} -body { 2829 proc foo0 {} {} 2830 proc ::test_ns_1::foo1 {} {} 2831 proc ::test_ns_2::foo2 {} {} 2832 namespace eval ::test_ns_3 { 2833 variable result {} 2834 lappend result [info commands foo*] 2835 namespace path {::test_ns_1 ::test_ns_2} 2836 lappend result [info commands foo*] 2837 proc foo2 {} {} 2838 lappend result [info commands foo*] 2839 rename foo2 {} 2840 lappend result [info commands foo*] 2841 namespace delete ::test_ns_1 2842 lappend result [info commands foo*] 2843 } 2844} -cleanup { 2845 catch {namespace delete ::test_ns_1} 2846 catch {namespace delete ::test_ns_2} 2847 catch {namespace delete ::test_ns_3} 2848} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} 2849test namespace-51.15 {namespace resolution path control} -body { 2850 namespace eval ::test_ns_2 { 2851 proc foo {} {return 2} 2852 } 2853 namespace eval ::test_ns_1 { 2854 namespace eval test_ns_2 { 2855 proc foo {} {return 1_2} 2856 } 2857 namespace eval test_ns_3 { 2858 namespace path ::test_ns_1 2859 test_ns_2::foo 2860 } 2861 } 2862} -result 1_2 -cleanup { 2863 namespace delete ::test_ns_1 2864 namespace delete ::test_ns_2 2865} 2866test namespace-51.16 {Bug 1566526} { 2867 interp create child 2868 child eval namespace eval demo namespace path :: 2869 interp delete child 2870} {} 2871test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup { 2872 set result {} 2873 catch {namespace delete ::a} 2874} -body { 2875 namespace eval ::a { 2876 proc c {} {lappend ::result A} 2877 c 2878 namespace eval b { 2879 variable d c 2880 lappend ::result [catch { $d }] 2881 } 2882 lappend ::result . 2883 namespace eval b { 2884 namespace path [namespace parent] 2885 $d;[format %c 99] 2886 } 2887 lappend ::result . 2888 namespace eval b { 2889 proc c {} {lappend ::result B} 2890 $d;[format %c 99] 2891 } 2892 lappend ::result . 2893 } 2894 namespace eval ::a::b { 2895 $d;[format %c 99] 2896 lappend ::result . 2897 proc ::c {} {lappend ::result G} 2898 $d;[format %c 99] 2899 lappend ::result . 2900 rename ::a::c {} 2901 $d;[format %c 99] 2902 lappend ::result . 2903 rename ::a::b::c {} 2904 $d;[format %c 99] 2905 } 2906} -cleanup { 2907 namespace delete ::a 2908 catch {rename ::c {}} 2909 unset result 2910} -result {A 1 . A A . B B . B B . B B . B B . G G} 2911test namespace-51.18 {Bug 3185407} -setup { 2912 namespace eval ::test_ns_1 {} 2913} -body { 2914 namespace eval ::test_ns_1 { 2915 variable result {} 2916 namespace eval ns {proc foo {} {}} 2917 namespace eval ns2 {proc foo {} {}} 2918 namespace path {ns ns2} 2919 variable x foo 2920 lappend result [namespace which $x] 2921 proc foo {} {} 2922 lappend result [namespace which $x] 2923 } 2924} -cleanup { 2925 namespace delete ::test_ns_1 2926} -result {::test_ns_1::ns::foo ::test_ns_1::foo} 2927 2928# TIP 181 - namespace unknown tests 2929test namespace-52.1 {unknown: default handler ::unknown} { 2930 set result [list [namespace eval foobar { namespace unknown }]] 2931 lappend result [namespace eval :: { namespace unknown }] 2932 namespace delete foobar 2933 set result 2934} {{} ::unknown} 2935test namespace-52.2 {unknown: default resolution global} { 2936 proc ::foo {} { return "GLOBAL" } 2937 namespace eval ::bar { proc foo {} { return "NAMESPACE" } } 2938 namespace eval ::bar::jim { proc test {} { foo } } 2939 set result [::bar::jim::test] 2940 namespace delete ::bar 2941 rename ::foo {} 2942 set result 2943} {GLOBAL} 2944test namespace-52.3 {unknown: default resolution local} { 2945 proc ::foo {} { return "GLOBAL" } 2946 namespace eval ::bar { 2947 proc foo {} { return "NAMESPACE" } 2948 proc test {} { foo } 2949 } 2950 set result [::bar::test] 2951 namespace delete ::bar 2952 rename ::foo {} 2953 set result 2954} {NAMESPACE} 2955test namespace-52.4 {unknown: set handler} { 2956 namespace eval foo { 2957 namespace unknown [list dispatch] 2958 proc dispatch {args} { return $args } 2959 proc test {} { 2960 UnknownCmd a b c 2961 } 2962 } 2963 set result [foo::test] 2964 namespace delete foo 2965 set result 2966} {UnknownCmd a b c} 2967test namespace-52.5 {unknown: search path before unknown is unaltered} { 2968 proc ::test2 {args} { return "TEST2: $args" } 2969 namespace eval foo { 2970 namespace unknown [list dispatch] 2971 proc dispatch {args} { return "UNKNOWN: $args" } 2972 proc test1 {args} { return "TEST1: $args" } 2973 proc test {} { 2974 set result [list [test1 a b c]] 2975 lappend result [test2 a b c] 2976 lappend result [test3 a b c] 2977 return $result 2978 } 2979 } 2980 set result [foo::test] 2981 namespace delete foo 2982 rename ::test2 {} 2983 set result 2984} {{TEST1: a b c} {TEST2: a b c} {UNKNOWN: test3 a b c}} 2985test namespace-52.6 {unknown: deleting handler restores default} { 2986 rename ::unknown ::_unknown_orig 2987 proc ::unknown {args} { return "DEFAULT: $args" } 2988 namespace eval foo { 2989 namespace unknown dummy 2990 namespace unknown {} 2991 } 2992 set result [namespace eval foo { dummy a b c }] 2993 rename ::unknown {} 2994 rename ::_unknown_orig ::unknown 2995 namespace delete foo 2996 set result 2997} {DEFAULT: dummy a b c} 2998test namespace-52.7 {unknown: setting global unknown handler} { 2999 proc ::myunknown {args} { return "MYUNKNOWN: $args" } 3000 namespace eval :: { namespace unknown ::myunknown } 3001 set result [namespace eval foo { dummy a b c }] 3002 namespace eval :: { namespace unknown {} } 3003 rename ::myunknown {} 3004 namespace delete foo 3005 set result 3006} {MYUNKNOWN: dummy a b c} 3007test namespace-52.8 {unknown: destroying and redefining global namespace} { 3008 set i [interp create] 3009 $i hide proc 3010 $i hide namespace 3011 $i hide return 3012 $i invokehidden namespace delete :: 3013 $i expose return 3014 $i invokehidden proc unknown args { return "FINE" } 3015 $i eval { foo bar bob } 3016} {FINE} 3017test namespace-52.9 {unknown: refcounting} -setup { 3018 proc this args { 3019 unset args ;# stop sharing 3020 set copy [namespace unknown] 3021 string length $copy ;# shimmer away list rep 3022 info level 0 3023 } 3024 set handler [namespace unknown] 3025 namespace unknown {this is a test} 3026 catch {rename noSuchCommand {}} 3027} -body { 3028 noSuchCommand 3029} -cleanup { 3030 namespace unknown $handler 3031 rename this {} 3032} -result {this is a test noSuchCommand} 3033testConstraint testevalobjv [llength [info commands testevalobjv]] 3034test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -constraints { 3035 testevalobjv 3036} -setup { 3037 rename ::unknown unknown.save 3038 proc ::unknown args { 3039 set caller [uplevel 1 {namespace current}] 3040 namespace eval $caller { 3041 variable foo 3042 return $foo 3043 } 3044 } 3045 catch {rename ::noSuchCommand {}} 3046} -body { 3047 namespace eval :: { 3048 variable foo SUCCESS 3049 } 3050 namespace eval test_ns_1 { 3051 variable foo FAIL 3052 testevalobjv 1 noSuchCommand 3053 } 3054} -cleanup { 3055 unset -nocomplain ::foo 3056 namespace delete test_ns_1 3057 rename ::unknown {} 3058 rename unknown.save ::unknown 3059} -result SUCCESS 3060test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup { 3061 set handler [namespace eval :: {namespace unknown}] 3062 namespace eval :: {namespace unknown unknown} 3063 rename ::unknown unknown.save 3064 namespace eval :: { 3065 proc unknown args { 3066 return SUCCESS 3067 } 3068 } 3069 catch {rename ::noSuchCommand {}} 3070 set ::child [interp create] 3071} -body { 3072 $::child alias bar noSuchCommand 3073 namespace eval test_ns_1 { 3074 namespace unknown unknown 3075 proc unknown args { 3076 return FAIL 3077 } 3078 $::child eval bar 3079 } 3080} -cleanup { 3081 interp delete $::child 3082 unset ::child 3083 namespace delete test_ns_1 3084 rename ::unknown {} 3085 rename unknown.save ::unknown 3086 namespace eval :: [list namespace unknown $handler] 3087} -result SUCCESS 3088test namespace-52.12 {unknown: error case must not reset handler} -body { 3089 namespace eval foo { 3090 namespace unknown ok 3091 catch {namespace unknown {{}{}{}}} 3092 namespace unknown 3093 } 3094} -cleanup { 3095 namespace delete foo 3096} -result ok 3097 3098# TIP 314 - ensembles with parameters 3099test namespace-53.1 {ensembles: parameters} { 3100 namespace eval ns { 3101 namespace export x 3102 proc x {para} {list 1 $para} 3103 namespace ensemble create -parameters {para1} 3104 } 3105 list [info command ns] [ns bar x] [namespace delete ns] [info command ns] 3106} {ns {1 bar} {} {}} 3107test namespace-53.2 {ensembles: parameters} -setup { 3108 namespace eval ns { 3109 namespace export x 3110 proc x {para} {list 1 $para} 3111 namespace ensemble create 3112 } 3113} -body { 3114 namespace ensemble configure ns -parameters {para1} 3115 rename ns foo 3116 list [info command foo] [foo bar x] [namespace delete ns] [info command foo] 3117} -result {foo {1 bar} {} {}} 3118test namespace-53.3 {ensembles: parameters} -setup { 3119 namespace eval ns { 3120 namespace export x* 3121 proc x1 {para} {list 1 $para} 3122 proc x2 {para} {list 2 $para} 3123 namespace ensemble create -parameters param1 3124 } 3125} -body { 3126 set result [list [ns x2 x1] [ns x1 x2]] 3127 lappend result [catch {ns x} msg] $msg 3128 lappend result [catch {ns x x} msg] $msg 3129 rename ns {} 3130 lappend result [info command ns::x1] 3131 namespace delete ns 3132 lappend result [info command ns::x1] 3133} -result\ 3134 {{1 x2} {2 x1}\ 3135 1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\ 3136 1 {unknown or ambiguous subcommand "x": must be x1, or x2}\ 3137 ::ns::x1 {}} 3138test namespace-53.4 {ensembles: parameters} -setup { 3139 namespace eval ns { 3140 namespace export x* 3141 proc x1 {a1 a2} {list 1 $a1 $a2} 3142 proc x2 {a1 a2} {list 2 $a1 $a2} 3143 proc x3 {a1 a2} {list 3 $a1 $a2} 3144 namespace ensemble create 3145 } 3146} -body { 3147 set result {} 3148 lappend result [ns x1 x2 x3] 3149 namespace ensemble configure ns -parameters p1 3150 lappend result [ns x1 x2 x3] 3151 namespace ensemble configure ns -parameters {p1 p2} 3152 lappend result [ns x1 x2 x3] 3153} -cleanup { 3154 namespace delete ns 3155} -result {{1 x2 x3} {2 x1 x3} {3 x1 x2}} 3156test namespace-53.5 {ensembles: parameters} -setup { 3157 namespace eval ns { 3158 namespace export x* 3159 proc x1 {para} {list 1 $para} 3160 proc x2 {para} {list 2 $para} 3161 proc x3 {para} {list 3 $para} 3162 namespace ensemble create 3163 } 3164} -body { 3165 set result [list [catch {ns x x1} msg] $msg] 3166 lappend result [catch {ns x1 x} msg] $msg 3167 namespace ensemble configure ns -parameters p1 3168 lappend result [catch {ns x1 x} msg] $msg 3169 lappend result [catch {ns x x1} msg] $msg 3170} -cleanup { 3171 namespace delete ns 3172} -result\ 3173 {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\ 3174 0 {1 x}\ 3175 1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\ 3176 0 {1 x}} 3177test namespace-53.6 {ensembles: nested} -setup { 3178 namespace eval ns { 3179 namespace export x* 3180 namespace eval x0 { 3181 proc z {args} {list 0 $args} 3182 namespace export z 3183 namespace ensemble create 3184 } 3185 proc x1 {args} {list 1 $args} 3186 proc x2 {args} {list 2 $args} 3187 proc x3 {args} {list 3 $args} 3188 namespace ensemble create -parameters p 3189 } 3190} -body { 3191 list [ns z x0] [ns z x1] [ns z x2] [ns z x3] 3192} -cleanup { 3193 namespace delete ns 3194} -result {{0 {}} {1 z} {2 z} {3 z}} 3195test namespace-53.7 {ensembles: parameters & wrong # args} -setup { 3196 namespace eval ns { 3197 namespace export x* 3198 proc x1 {a1 a2 a3 a4} {list x1 $a1 $a2 $a3 $a4} 3199 namespace ensemble create -parameters p1 3200 } 3201} -body { 3202 set result {} 3203 lappend result [catch {ns} msg] $msg 3204 lappend result [catch {ns x1} msg] $msg 3205 lappend result [catch {ns x1 x1} msg] $msg 3206 lappend result [catch {ns x1 x1 x1} msg] $msg 3207 lappend result [catch {ns x1 x1 x1 x1} msg] $msg 3208 lappend result [catch {ns x1 x1 x1 x1 x1} msg] $msg 3209} -cleanup { 3210 namespace delete ns 3211} -result\ 3212 {1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\ 3213 1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\ 3214 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\ 3215 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\ 3216 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\ 3217 0 {x1 x1 x1 x1 x1}} 3218test namespace-53.8 {ensemble: unknown handler changing -parameters} -setup { 3219 namespace eval ns { 3220 namespace export x* 3221 proc x1 {a1} {list 1 $a1} 3222 proc Magic {ensemble subcmd args} { 3223 namespace ensemble configure $ensemble\ 3224 -parameters [lrange p1 [llength [ 3225 namespace ensemble configure $ensemble -parameters 3226 ]] 0] 3227 list 3228 } 3229 namespace ensemble create -unknown ::ns::Magic 3230 } 3231} -body { 3232 set result {} 3233 lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters] 3234 lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters] 3235 lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters] 3236} -cleanup { 3237 namespace delete ns 3238} -result\ 3239 {0 {1 x2} {}\ 3240 0 {1 x2} p1\ 3241 1 {unknown or ambiguous subcommand "x2": must be x1} {}} 3242test namespace-53.9 {ensemble: unknown handler changing -parameters,\ 3243 thereby eating all args} -setup { 3244 namespace eval ns { 3245 namespace export x* 3246 proc x1 {args} {list 1 $args} 3247 proc Magic {ensemble subcmd args} { 3248 namespace ensemble configure $ensemble\ 3249 -parameters {p1 p2 p3 p4 p5} 3250 list 3251 } 3252 namespace ensemble create -unknown ::ns::Magic 3253 } 3254} -body { 3255 set result {} 3256 lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters] 3257 lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters] 3258 lappend result [catch {ns a1 a2 a3 a4 a5 x1} msg] $msg [namespace ensemble configure ns -parameters] 3259} -cleanup { 3260 namespace delete ns 3261} -result\ 3262 {0 {1 x2} {}\ 3263 1 {wrong # args: should be "ns p1 p2 p3 p4 p5 subcommand ?arg ...?"} {p1 p2 p3 p4 p5}\ 3264 0 {1 {a1 a2 a3 a4 a5}} {p1 p2 p3 p4 p5}} 3265test namespace-53.10 {ensembles: nested rewrite} -setup { 3266 namespace eval ns { 3267 namespace export x 3268 namespace eval x { 3269 proc z0 {} {list 0} 3270 proc z1 {a1} {list 1 $a1} 3271 proc z2 {a1 a2} {list 2 $a1 $a2} 3272 proc z3 {a1 a2 a3} {list 3 $a1 $a2 $a3} 3273 namespace export z* 3274 namespace ensemble create 3275 } 3276 namespace ensemble create -parameters p 3277 } 3278} -body { 3279 set result {} 3280 # In these cases, parsing the subensemble does not grab a new word. 3281 lappend result [catch {ns z0 x} msg] $msg 3282 lappend result [catch {ns z1 x} msg] $msg 3283 lappend result [catch {ns z2 x} msg] $msg 3284 lappend result [catch {ns z2 x v} msg] $msg 3285 namespace ensemble configure ns::x -parameters q1 3286 # In these cases, parsing the subensemble grabs a new word. 3287 lappend result [catch {ns v x z0} msg] $msg 3288 lappend result [catch {ns v x z1} msg] $msg 3289 lappend result [catch {ns v x z2} msg] $msg 3290 lappend result [catch {ns v x z2 v2} msg] $msg 3291} -cleanup { 3292 namespace delete ns 3293} -result\ 3294 {0 0\ 3295 1 {wrong # args: should be "ns z1 x a1"}\ 3296 1 {wrong # args: should be "ns z2 x a1 a2"}\ 3297 1 {wrong # args: should be "ns z2 x a1 a2"}\ 3298 1 {wrong # args: should be "::ns::x::z0"}\ 3299 0 {1 v}\ 3300 1 {wrong # args: should be "ns v x z2 a2"}\ 3301 0 {2 v v2}} 3302test namespace-53.11 {ensembles: nested rewrite} -setup { 3303 namespace eval ns { 3304 namespace export x 3305 namespace eval x { 3306 proc z2 {a1 a2} {list 2 $a1 $a2} 3307 namespace export z* 3308 namespace ensemble create -parameter p 3309 } 3310 namespace ensemble create 3311 } 3312} -body { 3313 list [catch {ns x 1 z2} msg] $msg 3314} -cleanup { 3315 namespace delete ns 3316 unset -nocomplain msg 3317} -result {1 {wrong # args: should be "ns x 1 z2 a2"}} 3318 3319test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ 3320-setup { 3321 proc getbytes {} { 3322 set lines [split [memory info] "\n"] 3323 lindex $lines 3 3 3324 } 3325} -body { 3326 set end [getbytes] 3327 for {set i 0} {$i < 5} {incr i} { 3328 set ns ::y$i 3329 namespace eval $ns {} 3330 namespace delete $ns 3331 set start $end 3332 set end [getbytes] 3333 } 3334 set leakedBytes [expr {$end - $start}] 3335} -cleanup { 3336 rename getbytes {} 3337 unset i ns start end 3338} -result 0 3339 3340test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} { 3341 info class [format %s constructor] oo::object 3342} "" 3343 3344test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} { 3345 namespace eval ::testing { 3346 proc abc {} {} 3347 proc def {} {} 3348 trace add command abc delete "rename ::testing::def {}; #" 3349 trace add command def delete "rename ::testing::abc {}; #" 3350 } 3351 namespace delete ::testing 3352} {} 3353test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} { 3354 namespace eval ::testing { 3355 namespace eval abc {proc xyz {} {}} 3356 namespace eval def {proc xyz {} {}} 3357 trace add command abc::xyz delete "namespace delete ::testing::def {}; #" 3358 trace add command def::xyz delete "namespace delete ::testing::abc {}; #" 3359 } 3360 namespace delete ::testing 3361} {} 3362test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} { 3363 namespace eval ::testing { 3364 variable gone {} 3365 oo::class create CB { 3366 variable cmd 3367 constructor other {set cmd $other} 3368 destructor {rename $cmd {}; lappend ::testing::gone $cmd} 3369 } 3370 namespace eval abc { 3371 ::testing::CB create def ::testing::abc::ghi 3372 ::testing::CB create ghi ::testing::abc::def 3373 } 3374 namespace delete abc 3375 try { 3376 return [lsort $gone] 3377 } finally { 3378 namespace delete ::testing 3379 } 3380 } 3381} {::testing::abc::def ::testing::abc::ghi} 3382 3383test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug { 3384namespace eval : { 3385 namespace ensemble create 3386 namespace export * 3387 proc p1 {} { 3388 return 16fe1b5807 3389 } 3390} 3391 3392: p1 3393} 16fe1b5807 3394 3395test namespace-56.5 {Bug 8b9854c3d8} -setup { 3396 namespace eval namespace-56.5 { 3397 proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]} 3398 namespace export * 3399 namespace ensemble create 3400 } 3401} -body { 3402 namespace-56.5 cmd 3403} -cleanup { 3404 namespace delete namespace-56.5 3405} -result 1 3406 3407 3408test namespace-56.6 { 3409 Namespace deletion traces on both the original routine and the imported 3410 routine should run without any memory error under a debug build. 3411} -body { 3412 variable res {} 3413 3414 proc ondelete {old new op} { 3415 variable res 3416 set tail [namespace tail $old] 3417 set up [namespace tail [namespace qualifiers $old]] 3418 lappend res [list $up $tail] 3419 } 3420 3421 3422 namespace eval ns1 {} { 3423 namespace export * 3424 proc p1 {} { 3425 namespace upvar [namespace parent] res res 3426 incr res 3427 } 3428 trace add command p1 delete ondelete 3429 } 3430 3431 namespace eval ns2 {} { 3432 namespace import [namespace parent]::ns1::p1 3433 trace add command p1 delete ondelete 3434 } 3435 3436 namespace delete ns1 3437 namespace delete ns2 3438 after 1 3439 return $res 3440} -cleanup { 3441 unset res 3442 rename ondelete {} 3443} -result {{ns1 p1} {ns2 p1}} 3444 3445 3446test namespace-57.0 { 3447 an imported alias should be usable in the deletion trace for the alias 3448 3449 see 29e8848eb976 3450} -body { 3451 variable res {} 3452 namespace eval ns2 { 3453 namespace export * 3454 proc p1 {oldname newname op} { 3455 return success 3456 } 3457 3458 interp alias {} [namespace current]::p2 {} [namespace which p1] 3459 } 3460 3461 3462 namespace eval ns3 { 3463 namespace import ::ns2::p2 3464 } 3465 3466 3467 set ondelete [list apply [list {oldname newname op} { 3468 variable res 3469 catch { 3470 ns3::p2 $oldname $newname $op 3471 } cres 3472 lappend res $cres 3473 } [namespace current]]] 3474 3475 3476 trace add command ::ns2::p2 delete $ondelete 3477 rename ns2::p2 {} 3478 return $res 3479} -cleanup { 3480 unset res 3481 namespace delete ns2 3482 namespace delete ns3 3483} -result success 3484 3485 3486 3487 3488# cleanup 3489catch {rename cmd1 {}} 3490catch {unset l} 3491catch {unset msg} 3492catch {unset trigger} 3493namespace delete {*}[namespace children :: test_ns_*] 3494::tcltest::cleanupTests 3495return 3496 3497# Local Variables: 3498# mode: tcl 3499# End: 3500