Changes On Branch bug-3606121
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch bug-3606121 Excluding Merge-Ins

This is equivalent to a diff from b6a05c2ceb to c5ddb319aa

2016-07-10
14:15
[3606121] Making tests less cross-dependent. check-in: e2bacdca41 user: dkf tags: core-8-6-branch
14:14
Fixes to namespace-old.test Closed-Leaf check-in: c5ddb319aa user: dkf tags: bug-3606121
12:45
Fix to resolver.test check-in: 6045212d73 user: dkf tags: bug-3606121
07:59
Fixes to namespace.test check-in: 68b9457756 user: dkf tags: bug-3606121
06:41
Bugfix [da340d4f32]. clock-55.9 and clock-55.10 test failures. check-in: b6a05c2ceb user: ashok tags: core-8-6-branch
06:33
Fix compiler warnings (const-ness and unused label) that did not show up in the non-optimized build... check-in: d8603114aa user: ashok tags: core-8-6-branch

Changes to tests/namespace-old.test.
53
54
55
56
57
58
59






60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76






77
78
79
80
81
82
83
    namespace eval test_ns_simple {
        variable test_ns_x 0
        proc test {test_ns_x} {
            return "test: $test_ns_x"
        }
    }
} {}






test namespace-old-1.10 {commands in a namespace} {
    namespace eval test_ns_simple { info commands [namespace current]::*}
} {::test_ns_simple::test}
test namespace-old-1.11 {variables in a namespace} {
    namespace eval test_ns_simple { info vars [namespace current]::* }
} {::test_ns_simple::test_ns_x}
test namespace-old-1.12 {global vars are separate from locals vars} {
    list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
} {{test: 123} 0}
test namespace-old-1.13 {add to an existing namespace} {
    namespace eval test_ns_simple {
        variable test_ns_y 123
        proc _backdoor {cmd} {
            eval $cmd
        }
    }
} ""






test namespace-old-1.14 {commands in a namespace} {
    lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
test namespace-old-1.15 {variables in a namespace} {
    lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
test namespace-old-1.16 {variables in a namespace} {







>
>
>
>
>
>

















>
>
>
>
>
>







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
    namespace eval test_ns_simple {
        variable test_ns_x 0
        proc test {test_ns_x} {
            return "test: $test_ns_x"
        }
    }
} {}
namespace eval test_ns_simple {
    variable test_ns_x 0
    proc test {test_ns_x} {
	return "test: $test_ns_x"
    }
}
test namespace-old-1.10 {commands in a namespace} {
    namespace eval test_ns_simple { info commands [namespace current]::*}
} {::test_ns_simple::test}
test namespace-old-1.11 {variables in a namespace} {
    namespace eval test_ns_simple { info vars [namespace current]::* }
} {::test_ns_simple::test_ns_x}
test namespace-old-1.12 {global vars are separate from locals vars} {
    list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
} {{test: 123} 0}
test namespace-old-1.13 {add to an existing namespace} {
    namespace eval test_ns_simple {
        variable test_ns_y 123
        proc _backdoor {cmd} {
            eval $cmd
        }
    }
} ""
namespace eval test_ns_simple {
    variable test_ns_y 123
    proc _backdoor {cmd} {
	eval $cmd
    }
}
test namespace-old-1.14 {commands in a namespace} {
    lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
test namespace-old-1.15 {variables in a namespace} {
    lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
test namespace-old-1.16 {variables in a namespace} {
124
125
126
127
128
129
130


131
132
133
134
135
136
137
    namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
    set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
    list [test_ns_simple::_backdoor $cmd] [eval $cmd]
} {{12 34} {12 34}}
test namespace-old-1.27 {can create commands with null names} {
    proc test_ns_simple:: {args} {return $args}
} {}



# -----------------------------------------------------------------------
# TEST: using "info" in namespace contexts
# -----------------------------------------------------------------------
test namespace-old-2.1 {querying:  info commands} {
    lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}







>
>







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
    namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
    set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
    list [test_ns_simple::_backdoor $cmd] [eval $cmd]
} {{12 34} {12 34}}
test namespace-old-1.27 {can create commands with null names} {
    proc test_ns_simple:: {args} {return $args}
} {}
# Redeclare; later tests depend on it
proc test_ns_simple:: {args} {return $args}

# -----------------------------------------------------------------------
# TEST: using "info" in namespace contexts
# -----------------------------------------------------------------------
test namespace-old-2.1 {querying:  info commands} {
    lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
208
209
210
211
212
213
214





215
216
217
218
219
220
221
} {0 {}}
test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
    set cmd {
        namespace eval test_ns_delete {namespace delete ns*}
    }
    list [catch $cmd msg] $msg
} {1 {unknown namespace "ns*" in namespace delete command}}





test namespace-old-4.4 {command "namespace delete" handles multiple args} {
    set cmd {
        namespace eval test_ns_delete {
            namespace delete \
                {*}[namespace children [namespace current] ns?]
        }
    }







>
>
>
>
>







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
} {0 {}}
test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
    set cmd {
        namespace eval test_ns_delete {namespace delete ns*}
    }
    list [catch $cmd msg] $msg
} {1 {unknown namespace "ns*" in namespace delete command}}
namespace eval test_ns_delete {
    namespace eval ns1 {}
    namespace eval ns2 {}
    namespace eval another {}
}
test namespace-old-4.4 {command "namespace delete" handles multiple args} {
    set cmd {
        namespace eval test_ns_delete {
            namespace delete \
                {*}[namespace children [namespace current] ns?]
        }
    }
252
253
254
255
256
257
258


















259
260
261
262
263
264
265
          }]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
test namespace-old-5.3 {namespace qualifiers work in namespace command} {
    list [namespace eval ::test_ns_hier1 {namespace current}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
         [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}


















test namespace-old-5.4 {nested namespaces can access global namespace} {
    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
test namespace-old-5.5 {variables in different namespaces don't conflict} {







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
          }]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
test namespace-old-5.3 {namespace qualifiers work in namespace command} {
    list [namespace eval ::test_ns_hier1 {namespace current}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
         [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
set ::test_ns_var_global "var in ::"
proc test_ns_cmd_global {} {return "cmd in ::"}
namespace eval test_ns_hier1 {
    variable test_ns_var_hier1 "particular to hier1"
    proc test_ns_cmd_hier1 {} {return "particular to hier1"}
    variable test_ns_level 1
    proc test_ns_show {} {return "[namespace current]: 1"}
    namespace eval test_ns_hier2 {
	variable test_ns_var_hier2 "particular to hier2"
	proc test_ns_cmd_hier2 {} {return "particular to hier2"}
	variable test_ns_level 2
        proc test_ns_show {} {return "[namespace current]: 2"}
	namespace eval test_ns_hier3a {}
	namespace eval test_ns_hier3b {}
    }
    namespace eval test_ns_hier2a {}
    namespace eval test_ns_hier2b {}
}
test namespace-old-5.4 {nested namespaces can access global namespace} {
    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
test namespace-old-5.5 {variables in different namespaces don't conflict} {
327
328
329
330
331
332
333


334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356

357
358
359
360
361



362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378



379
380
381
382



383
384
385
386
387
388



389
390
391
392
393
394



395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414






415
416
417
418
419
420
421
422
423
424
425

426
427
428
429
430
431

432
433
434
435


436
437
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
         [namespace parent test_ns_hier1::test_ns_hier2] \
         [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

# -----------------------------------------------------------------------
# TEST: name resolution and caching
# -----------------------------------------------------------------------


test namespace-old-6.1 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1 {}
    namespace eval test_ns_cache2 {}
    namespace eval test_ns_cache2::test_ns_cache3 {}
    set trigger {
        namespace eval test_ns_cache2 {namespace current}
    }
    set trigger2 {
        namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
    }
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
test namespace-old-6.2 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1::test_ns_cache2 {}
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
test namespace-old-6.3 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

test namespace-old-6.4 {relative ns names only looked up in current ns} {
    namespace delete test_ns_cache1::test_ns_cache2
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}



test namespace-old-6.5 {define test commands} {
    proc test_ns_cache_cmd {} {
        return "global version"
    }
    namespace eval test_ns_cache1 {
        proc trigger {} {
            test_ns_cache_cmd
        }
    }
    test_ns_cache1::trigger
} {global version}
test namespace-old-6.6 {one-level check for command shadowing} {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    }
    test_ns_cache1::trigger
} {cache1 version}



test namespace-old-6.7 {renaming commands changes command epoch} {
    namespace eval test_ns_cache1 {
        rename test_ns_cache_cmd test_ns_new
    }



    test_ns_cache1::trigger
} {global version}
test namespace-old-6.8 {renaming back handles shadowing} {
    namespace eval test_ns_cache1 {
        rename test_ns_new test_ns_cache_cmd
    }



    test_ns_cache1::trigger
} {cache1 version}
test namespace-old-6.9 {deleting commands changes command epoch} {
    namespace eval test_ns_cache1 {
        rename test_ns_cache_cmd ""
    }



    test_ns_cache1::trigger
} {global version}
test namespace-old-6.10 {define test namespaces} {
    namespace eval test_ns_cache2 {
        proc test_ns_cache_cmd {} {
            return "global cache2 version"
        }
    }
    namespace eval test_ns_cache1 {
        proc trigger {} {
            test_ns_cache2::test_ns_cache_cmd
        }
    }
    namespace eval test_ns_cache1::test_ns_cache2 {
        proc trigger {} {
            test_ns_cache_cmd
        }
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{global cache2 version} {global version}}






test namespace-old-6.11 {commands affect all parent namespaces} {
    proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
        return "cache2 version"
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
test namespace-old-6.12 {define test variables} {
    variable test_ns_cache_var "global version"
    set trigger {set test_ns_cache_var}
    namespace eval test_ns_cache1 $trigger
} {global version}

test namespace-old-6.13 {one-level check for variable shadowing} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    namespace eval test_ns_cache1 $trigger
} {cache1 version}

test namespace-old-6.14 {deleting variables changes variable epoch} {
    namespace eval test_ns_cache1 {
        unset test_ns_cache_var
    }


    namespace eval test_ns_cache1 $trigger
} {global version}
test namespace-old-6.15 {define test namespaces} {
    namespace eval test_ns_cache2 {
        variable test_ns_cache_var "global cache2 version"
    }
    set trigger2 {set test_ns_cache2::test_ns_cache_var}
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}

test namespace-old-6.16 {public variables affect all parent namespaces} {
    variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{cache2 version} {cache2 version}}
test namespace-old-6.17 {usage for "namespace which"} {
    list [catch "namespace which -baz x" msg] $msg







>
>




<
<
<
<
<
<













>





>
>
>




<
<
<
<
<








>
>
>
|
|
|

>
>
>
|
|
|
|
|

>
>
>
|
|
|
|
|

>
>
>
|
|


















>
>
>
>
>
>











>






>


|

>
>
|
|








>







364
365
366
367
368
369
370
371
372
373
374
375
376






377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402





403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
         [namespace parent test_ns_hier1::test_ns_hier2] \
         [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

# -----------------------------------------------------------------------
# TEST: name resolution and caching
# -----------------------------------------------------------------------
set trigger {namespace eval test_ns_cache2 {namespace current}}
set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}}
test namespace-old-6.1 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1 {}
    namespace eval test_ns_cache2 {}
    namespace eval test_ns_cache2::test_ns_cache3 {}






    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
test namespace-old-6.2 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1::test_ns_cache2 {}
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
test namespace-old-6.3 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
namespace eval test_ns_cache1::test_ns_cache2 {}
test namespace-old-6.4 {relative ns names only looked up in current ns} {
    namespace delete test_ns_cache1::test_ns_cache2
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
namespace eval test_ns_cache1 {
    proc trigger {} {test_ns_cache_cmd}
}
test namespace-old-6.5 {define test commands} {
    proc test_ns_cache_cmd {} {
        return "global version"
    }





    test_ns_cache1::trigger
} {global version}
test namespace-old-6.6 {one-level check for command shadowing} {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    }
    test_ns_cache1::trigger
} {cache1 version}
proc test_ns_cache_cmd {} {
    return "global version"
}
test namespace-old-6.7 {renaming commands changes command epoch} -setup {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    }
} -body {
    list [test_ns_cache1::trigger] \
	[namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\
	[test_ns_cache1::trigger]
} -result {{cache1 version} {} {global version}}
test namespace-old-6.8 {renaming back handles shadowing} -setup {
    proc test_ns_cache1::test_ns_new {} {
        return "cache1 version"
    }
} -body {
    list [test_ns_cache1::trigger] \
	[namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\
	[test_ns_cache1::trigger]
} -result {{global version} {} {cache1 version}}
test namespace-old-6.9 {deleting commands changes command epoch} -setup {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    }
} -body {
    list [test_ns_cache1::trigger] \
	[namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \
	[test_ns_cache1::trigger]
} -result {{cache1 version} {} {global version}}
test namespace-old-6.10 {define test namespaces} {
    namespace eval test_ns_cache2 {
        proc test_ns_cache_cmd {} {
            return "global cache2 version"
        }
    }
    namespace eval test_ns_cache1 {
        proc trigger {} {
            test_ns_cache2::test_ns_cache_cmd
        }
    }
    namespace eval test_ns_cache1::test_ns_cache2 {
        proc trigger {} {
            test_ns_cache_cmd
        }
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{global cache2 version} {global version}}
namespace eval test_ns_cache1 {
    proc trigger {} { test_ns_cache2::test_ns_cache_cmd }
    namespace eval test_ns_cache2 {
	proc trigger {} { test_ns_cache_cmd }
    }
}
test namespace-old-6.11 {commands affect all parent namespaces} {
    proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
        return "cache2 version"
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
test namespace-old-6.12 {define test variables} {
    variable test_ns_cache_var "global version"
    set trigger {set test_ns_cache_var}
    namespace eval test_ns_cache1 $trigger
} {global version}
    set trigger {set test_ns_cache_var}
test namespace-old-6.13 {one-level check for variable shadowing} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    namespace eval test_ns_cache1 $trigger
} {cache1 version}
variable ::test_ns_cache_var "global version"
test namespace-old-6.14 {deleting variables changes variable epoch} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    list [namespace eval test_ns_cache1 $trigger] \
	[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
	[namespace eval test_ns_cache1 $trigger]
} {{cache1 version} {} {global version}}
test namespace-old-6.15 {define test namespaces} {
    namespace eval test_ns_cache2 {
        variable test_ns_cache_var "global cache2 version"
    }
    set trigger2 {set test_ns_cache2::test_ns_cache_var}
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}
set trigger2 {set test_ns_cache2::test_ns_cache_var}
test namespace-old-6.16 {public variables affect all parent namespaces} {
    variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{cache2 version} {cache2 version}}
test namespace-old-6.17 {usage for "namespace which"} {
    list [catch "namespace which -baz x" msg] $msg
463
464
465
466
467
468
469

470
471
472
473
474
475
476
         [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
         [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
         [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
test namespace-old-6.20 {command "namespace which" may not find commands} {
    namespace eval test_ns_cache1 {namespace which -command xyzzy}
} {}

test namespace-old-6.21 {querying:  namespace which -variable} {
    namespace eval test_ns_cache1::test_ns_cache2 {
        namespace which -variable test_ns_cache_var
    }
} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
test namespace-old-6.22 {command "namespace which" may not find variables} {
    namespace eval test_ns_cache1 {namespace which -variable xyzzy}







>







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
         [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
         [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
         [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
test namespace-old-6.20 {command "namespace which" may not find commands} {
    namespace eval test_ns_cache1 {namespace which -command xyzzy}
} {}
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
test namespace-old-6.21 {querying:  namespace which -variable} {
    namespace eval test_ns_cache1::test_ns_cache2 {
        namespace which -variable test_ns_cache_var
    }
} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
test namespace-old-6.22 {command "namespace which" may not find variables} {
    namespace eval test_ns_cache1 {namespace which -variable xyzzy}
489
490
491
492
493
494
495












496
497
498
499
500
501
502
        proc test_uplevel {num} {
            set a 0
            set b 1
            namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
        }
    }
} {}












test namespace-old-7.2 {uplevel can access namespace call frame} {
    list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
         [expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
} {1 1}
test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
    lsort [test_ns_uplevel::test_uplevel 2]
} {a b num}







>
>
>
>
>
>
>
>
>
>
>
>







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
        proc test_uplevel {num} {
            set a 0
            set b 1
            namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
        }
    }
} {}
namespace eval test_ns_uplevel {
    variable x 0
    variable y 1
    proc show_vars {num} {
	return [uplevel $num {info vars}]
    }
    proc test_uplevel {num} {
	set a 0
	set b 1
	namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
    }
}
test namespace-old-7.2 {uplevel can access namespace call frame} {
    list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
         [expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
} {1 1}
test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
    lsort [test_ns_uplevel::test_uplevel 2]
} {a b num}
522
523
524
525
526
527
528











529
530
531
532
533
534
535
        }
        proc test_upvar {num} {
            set scope "test_ns_upvar::test_upvar"
            namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
        }
    }
} {}











test namespace-old-7.9 {upvar can access namespace call frame} {
    test_ns_upvar::test_upvar 1
} {test_ns_upvar}
test namespace-old-7.10 {upvar can go beyond namespace call frame} {
    test_ns_upvar::test_upvar 2
} {test_ns_upvar::test_upvar}
test namespace-old-7.11 {absolute call frame references work too} {







>
>
>
>
>
>
>
>
>
>
>







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
        }
        proc test_upvar {num} {
            set scope "test_ns_upvar::test_upvar"
            namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
        }
    }
} {}
namespace eval test_ns_upvar {
    variable scope "test_ns_upvar"
    proc show_val {var num} {
	upvar $num $var x
	return $x
    }
    proc test_upvar {num} {
	set scope "test_ns_upvar::test_upvar"
	namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
    }
}
test namespace-old-7.9 {upvar can access namespace call frame} {
    test_ns_upvar::test_upvar 1
} {test_ns_upvar}
test namespace-old-7.10 {upvar can go beyond namespace call frame} {
    test_ns_upvar::test_upvar 2
} {test_ns_upvar::test_upvar}
test namespace-old-7.11 {absolute call frame references work too} {
577
578
579
580
581
582
583









584
585
586
587
588
589
590
591
592
593
594




595
596
597
598
599
600
601
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        proc cmd5 {args} {return "cmd5: $args"}
        proc cmd6 {args} {return "cmd6: $args"}
    }
    lsort [info commands test_ns_export::*]
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}









test namespace-old-9.4 {check export status} {
    set x ""
    namespace eval test_ns_import {
        namespace export cmd1 cmd2
        namespace import ::test_ns_export::*
    }
    foreach cmd [lsort [info commands test_ns_import::*]] {
        lappend x $cmd
    }
    set x
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}




test namespace-old-9.5 {empty import list in "namespace import" command} {
    namespace eval test_ns_import_empty {
	namespace import ::test_ns_export::*
	try {
	    lsort [namespace import]
	} finally {
	    namespace delete [namespace current]







>
>
>
>
>
>
>
>
>











>
>
>
>







656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        proc cmd5 {args} {return "cmd5: $args"}
        proc cmd6 {args} {return "cmd6: $args"}
    }
    lsort [info commands test_ns_export::*]
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
namespace eval test_ns_export {
    namespace export cmd1 cmd2 cmd3
    proc cmd1 {args} {return "cmd1: $args"}
    proc cmd2 {args} {return "cmd2: $args"}
    proc cmd3 {args} {return "cmd3: $args"}
    proc cmd4 {args} {return "cmd4: $args"}
    proc cmd5 {args} {return "cmd5: $args"}
    proc cmd6 {args} {return "cmd6: $args"}
}
test namespace-old-9.4 {check export status} {
    set x ""
    namespace eval test_ns_import {
        namespace export cmd1 cmd2
        namespace import ::test_ns_export::*
    }
    foreach cmd [lsort [info commands test_ns_import::*]] {
        lappend x $cmd
    }
    set x
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
namespace eval test_ns_import {
    namespace export cmd1 cmd2
    namespace import ::test_ns_export::*
}
test namespace-old-9.5 {empty import list in "namespace import" command} {
    namespace eval test_ns_import_empty {
	namespace import ::test_ns_export::*
	try {
	    lsort [namespace import]
	} finally {
	    namespace delete [namespace current]
611
612
613
614
615
616
617

618
619
620
621
622
623
624
625
626
627
628
629
630
631








632
633
634
635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655

656
657
658
659
660
661
662
catch {rename ncmd {}}
catch {rename ncmd1 {}}
catch {rename ncmd2 {}}
test namespace-old-9.8 {only exported commands are imported} {
    namespace import test_ns_import::cmd*
    set x [lsort [info commands cmd*]]
} {cmd1 cmd2}

test namespace-old-9.9 {imported commands work just the same as original} {
    list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
test namespace-old-9.10 {commands can be imported from many namespaces} {
    namespace eval test_ns_import2 {
        namespace export ncmd ncmd1 ncmd2
        proc ncmd  {args} {return "ncmd: $args"}
        proc ncmd1 {args} {return "ncmd1: $args"}
        proc ncmd2 {args} {return "ncmd2: $args"}
        proc ncmd3 {args} {return "ncmd3: $args"}
    }
    namespace import test_ns_import2::*
    lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd1 cmd2 ncmd ncmd1 ncmd2}








test namespace-old-9.11 {imported commands can be removed by deleting them} {
    rename cmd1 ""
    lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd2 ncmd ncmd1 ncmd2}

test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
    list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
    list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
         [lsort [info commands cmd?]]
} {0 {} cmd2}
test namespace-old-9.14 {imported commands can be removed} {
    namespace forget test_ns_import::cmd?
    list [lsort [info commands cmd?]] \
         [catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}
test namespace-old-9.15 {existing commands can't be overwritten} {
    proc cmd1 {x y} {
        return [expr $x+$y]
    }
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
         [cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}
test namespace-old-9.16 {use "-force" option to override existing commands} {

    list [cmd1 3 5] \
         [namespace import -force test_ns_import::cmd?] \
         [cmd1 3 5]
} {8 {} {cmd1: 3 5}}
test namespace-old-9.17 {commands can be imported into many namespaces} {
    namespace eval test_ns_import_use {
        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?







>














>
>
>
>
>
>
>
>




>




















>







703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
catch {rename ncmd {}}
catch {rename ncmd1 {}}
catch {rename ncmd2 {}}
test namespace-old-9.8 {only exported commands are imported} {
    namespace import test_ns_import::cmd*
    set x [lsort [info commands cmd*]]
} {cmd1 cmd2}
namespace import test_ns_import::cmd*
test namespace-old-9.9 {imported commands work just the same as original} {
    list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
test namespace-old-9.10 {commands can be imported from many namespaces} {
    namespace eval test_ns_import2 {
        namespace export ncmd ncmd1 ncmd2
        proc ncmd  {args} {return "ncmd: $args"}
        proc ncmd1 {args} {return "ncmd1: $args"}
        proc ncmd2 {args} {return "ncmd2: $args"}
        proc ncmd3 {args} {return "ncmd3: $args"}
    }
    namespace import test_ns_import2::*
    lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
namespace eval test_ns_import2 {
    namespace export ncmd ncmd1 ncmd2
    proc ncmd  {args} {return "ncmd: $args"}
    proc ncmd1 {args} {return "ncmd1: $args"}
    proc ncmd2 {args} {return "ncmd2: $args"}
    proc ncmd3 {args} {return "ncmd3: $args"}
}
namespace import test_ns_import2::*
test namespace-old-9.11 {imported commands can be removed by deleting them} {
    rename cmd1 ""
    lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd2 ncmd ncmd1 ncmd2}
catch { rename cmd1 "" }
test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
    list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
    list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
         [lsort [info commands cmd?]]
} {0 {} cmd2}
test namespace-old-9.14 {imported commands can be removed} {
    namespace forget test_ns_import::cmd?
    list [lsort [info commands cmd?]] \
         [catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}
test namespace-old-9.15 {existing commands can't be overwritten} {
    proc cmd1 {x y} {
        return [expr $x+$y]
    }
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
         [cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}
test namespace-old-9.16 {use "-force" option to override existing commands} {
    proc cmd1 {x y} { return [expr $x+$y] }
    list [cmd1 3 5] \
         [namespace import -force test_ns_import::cmd?] \
         [cmd1 3 5]
} {8 {} {cmd1: 3 5}}
test namespace-old-9.17 {commands can be imported into many namespaces} {
    namespace eval test_ns_import_use {
        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
707
708
709
710
711
712
713





714
715
716
717



718
719
720
721
722
723
724
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
    namespace code $sval
} {::namespace inscope ::test_ns_inscope {one two}}
test namespace-old-10.6 {with many args, each "scope" adds new args} {
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
    namespace code "$sval three"
} {::namespace inscope ::test_ns_inscope {one two} three}





test namespace-old-10.7 {scoped commands work with eval} {
    set cref [namespace eval test_ns_inscope {namespace code show}]
    list [eval $cref "a" "b c" "d e f"]
} {{show: a b c d e f}}



test namespace-old-10.8 {scoped commands execute in namespace context} {
    set cref [namespace eval test_ns_inscope {
        namespace code {set x "some new value"}
    }]
    list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
} {x-value {some new value} {some new value}}








>
>
>
>
>




>
>
>







810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
    namespace code $sval
} {::namespace inscope ::test_ns_inscope {one two}}
test namespace-old-10.6 {with many args, each "scope" adds new args} {
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
    namespace code "$sval three"
} {::namespace inscope ::test_ns_inscope {one two} three}
namespace eval test_ns_inscope {
    proc show {args} {
	return "show: $args"
    }
}
test namespace-old-10.7 {scoped commands work with eval} {
    set cref [namespace eval test_ns_inscope {namespace code show}]
    list [eval $cref "a" "b c" "d e f"]
} {{show: a b c d e f}}
namespace eval test_ns_inscope {
    variable x "x-value"
}
test namespace-old-10.8 {scoped commands execute in namespace context} {
    set cref [namespace eval test_ns_inscope {
        namespace code {set x "some new value"}
    }]
    list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
} {x-value {some new value} {some new value}}

Changes to tests/namespace.test.
78
79
80
81
82
83
84
85


86
87
88
89
90
91
92
93
94
95
96
97
        set v}
    test_ns_1::baz::p
} {789}

test namespace-5.1 {Tcl_PopCallFrame, no vars} {
    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
} {}
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {


    proc test_ns_1::r {} {
        set a 123
    }
    test_ns_1::r   ;# pushes then pop's r's frame
} {123}

test namespace-6.1 {Tcl_CreateNamespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [lsort [namespace children :: test_ns_*]] \
        [namespace eval test_ns_1 {namespace current}] \
	[namespace eval test_ns_2 {namespace current}] \
	[namespace eval ::test_ns_3 {namespace current}] \







|
>
>




|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
        set v}
    test_ns_1::baz::p
} {789}

test namespace-5.1 {Tcl_PopCallFrame, no vars} {
    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
} {}
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup {
    namespace eval test_ns_1 {}
} -body {
    proc test_ns_1::r {} {
        set a 123
    }
    test_ns_1::r   ;# pushes then pop's r's frame
} -result {123}

test namespace-6.1 {Tcl_CreateNamespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [lsort [namespace children :: test_ns_*]] \
        [namespace eval test_ns_1 {namespace current}] \
	[namespace eval test_ns_2 {namespace current}] \
	[namespace eval ::test_ns_3 {namespace current}] \
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
    }
} -body {
    slave eval foo
    slave invokehidden infocommands
} -cleanup {
    interp delete slave
} -result {}


test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p







<







191
192
193
194
195
196
197

198
199
200
201
202
203
204
    }
} -body {
    slave eval foo
    slave invokehidden infocommands
} -cleanup {
    interp delete slave
} -result {}


test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p
299
300
301
302
303
304
305
306



307
308
309






310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
    }
    test_ns_import::p
} {cmd1: 123}
test namespace-9.5 {Tcl_Import, RFE 1230597} {



    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
} {0 {}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {






    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
        cmd1 555
    }
} {cmd1: 555}
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
    }
    list [test_ns_import::cmd1 a b c] \
         [test_ns_export::cmd1 d e f] \
         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
         [namespace origin test_ns_import::cmd1] \
         [namespace origin test_ns_export::cmd1] \
         [test_ns_import::cmd1 g h i] \
         [test_ns_export::cmd1 j k l]
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}

test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two {
	namespace export cmd







|
>
>
>

|
|
>
>
>
>
>
>




|

















<







300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

342
343
344
345
346
347
348
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
    }
    test_ns_import::p
} {cmd1: 123}
test namespace-9.5 {Tcl_Import, RFE 1230597} -setup {
    namespace eval test_ns_import {}
    namespace eval test_ns_export {}
} -body {
    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
} -result {0 {}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup {
    namespace eval test_ns_import {}
    namespace eval ::test_ns_export {
        proc cmd1 {args} {return "cmd1: $args"}
	namespace export cmd1
    }
} -body {
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
        cmd1 555
    }
} -result {cmd1: 555}
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
    }
    list [test_ns_import::cmd1 a b c] \
         [test_ns_export::cmd1 d e f] \
         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
         [namespace origin test_ns_import::cmd1] \
         [namespace origin test_ns_export::cmd1] \
         [test_ns_import::cmd1 g h i] \
         [test_ns_export::cmd1 j k l]
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}

test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two {
	namespace export cmd
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
} -body {
    namespace eval two [list namespace import -force \
	    [namespace current]::three::other]
    namespace origin two::other
} -cleanup {
    namespace delete one two three
} -match glob -result *::one::cmd

test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two namespace export cmd
    namespace eval two \







<







359
360
361
362
363
364
365

366
367
368
369
370
371
372
} -body {
    namespace eval two [list namespace import -force \
	    [namespace current]::three::other]
    namespace origin two::other
} -cleanup {
    namespace delete one two three
} -match glob -result *::one::cmd

test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two namespace export cmd
    namespace eval two \
384
385
386
387
388
389
390
391






392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_import {
        namespace forget ::test_ns_export::wombat
    }
} {}
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {






    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
        set l {}
        lappend l [lsort [info commands ::test_ns_import::*]]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
        lappend l [catch {cmd1 777} msg] $msg
    }
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]

test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval unrelated {
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::unrelated::cmd]
    my::cmd
} -cleanup {
    namespace delete origin unrelated my
}

test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval my rename cmd newname
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::origin::cmd]
    my::newname
} -cleanup {
    namespace delete origin my
} -returnCodes error -match glob -result *

test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval your {}
    namespace eval my \
	    [list rename cmd [namespace current]::your::newname]
} -body {
    namespace eval your namespace forget newname
    your::newname
} -cleanup {
    namespace delete origin my your
} -returnCodes error -match glob -result *

test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval link2 namespace export cmd
    namespace eval link2 \
	    [list namespace import [namespace current]::link::cmd]
    namespace eval my \
	    [list namespace import [namespace current]::link2::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::origin::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *

test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval link2 namespace export cmd
    namespace eval link2 \
	    [list namespace import [namespace current]::link::cmd]
    namespace eval my \
	    [list namespace import [namespace current]::link2::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::link::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
}

test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \







|
>
>
>
>
>
>









|
<

















<















<
















<




















<




















<







392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463

464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503

504
505
506
507
508
509
510
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_import {
        namespace forget ::test_ns_export::wombat
    }
} {}
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
} -body {
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
        set l {}
        lappend l [lsort [info commands ::test_ns_import::*]]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
        lappend l [catch {cmd1 777} msg] $msg
    }
} -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]

test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval unrelated {
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::unrelated::cmd]
    my::cmd
} -cleanup {
    namespace delete origin unrelated my
}

test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval my rename cmd newname
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::origin::cmd]
    my::newname
} -cleanup {
    namespace delete origin my
} -returnCodes error -match glob -result *

test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval your {}
    namespace eval my \
	    [list rename cmd [namespace current]::your::newname]
} -body {
    namespace eval your namespace forget newname
    your::newname
} -cleanup {
    namespace delete origin my your
} -returnCodes error -match glob -result *

test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval link2 namespace export cmd
    namespace eval link2 \
	    [list namespace import [namespace current]::link::cmd]
    namespace eval my \
	    [list namespace import [namespace current]::link2::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::origin::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *

test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval link2 namespace export cmd
    namespace eval link2 \
	    [list namespace import [namespace current]::link::cmd]
    namespace eval my \
	    [list namespace import [namespace current]::link2::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::link::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
}

test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
510
511
512
513
514
515
516
517
518

519
520
521
522
523
524
525






526
527
528
529
530
531
532
533











534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553









554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571






























572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
    namespace eval my \
	    [list namespace forget [namespace current]::link2::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *

test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    list [namespace origin set] [namespace origin test_ns_export::cmd1]
} {::set ::test_ns_export::cmd1}
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {






    namespace eval test_ns_import1 {
        namespace import ::test_ns_export::*
        namespace export *
        proc p {} {namespace origin cmd1}
    }
    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {











    namespace eval test_ns_import2 {
        namespace import ::test_ns_import1::*
        proc q {} {return [cmd1 123]}
    }
    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
} {{cmd1: 123} ::test_ns_export::cmd1}

test namespace-12.1 {InvokeImportedCmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {namespace current}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
    }
    list [test_ns_import::cmd1]
} {::test_ns_export}

test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {









    namespace eval test_ns_import {
        set l {}
        lappend l [info commands ::test_ns_import::*]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
    }
} {::test_ns_import::cmd1 {}}
test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
    # Will panic if still buggy
    namespace eval src {namespace export foo; proc foo {} {}}
    namespace eval dst {namespace import [namespace parent]::src::foo}
    trace add command src::foo delete \
        "[list namespace delete [namespace current]::dst] ;#"
    proc src::foo {} {}
    namespace delete src
} {}

test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {






























    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
    namespace eval test_ns_1 {
        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
		[lsort [namespace children :: test_ns_*]]
    }
} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
    namespace eval test_ns_1 {
        list $v $test_ns_2::v
    }
} {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg







|

>





|
|
>
>
>
>
>
>






|
|
>
>
>
>
>
>
>
>
>
>
>





|













|
>
>
>
>
>
>
>
>
>






|










|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








<
<
<
|
<
<
<
<
<
<
<
<



|







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644



645








646
647
648
649
650
651
652
653
654
655
656
    namespace eval my \
	    [list namespace forget [namespace current]::link2::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *

test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    list [namespace origin set] [namespace origin test_ns_export::cmd1]
} -result {::set ::test_ns_export::cmd1}
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
} -body {
    namespace eval test_ns_import1 {
        namespace import ::test_ns_export::*
        namespace export *
        proc p {} {namespace origin cmd1}
    }
    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
} -result {::test_ns_export::cmd1 ::test_ns_export::cmd1}
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    namespace eval test_ns_import1 {
        namespace import ::test_ns_export::*
        namespace export *
        proc p {} {namespace origin cmd1}
    }
} -body {
    namespace eval test_ns_import2 {
        namespace import ::test_ns_import1::*
        proc q {} {return [cmd1 123]}
    }
    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
} -result {{cmd1: 123} ::test_ns_export::cmd1}

test namespace-12.1 {InvokeImportedCmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {namespace current}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
    }
    list [test_ns_import::cmd1]
} {::test_ns_export}

test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {namespace current}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
    }
} -body {
    namespace eval test_ns_import {
        set l {}
        lappend l [info commands ::test_ns_import::*]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
    }
} -result {::test_ns_import::cmd1 {}}
test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
    # Will panic if still buggy
    namespace eval src {namespace export foo; proc foo {} {}}
    namespace eval dst {namespace import [namespace parent]::src::foo}
    trace add command src::foo delete \
        "[list namespace delete [namespace current]::dst] ;#"
    proc src::foo {} {}
    namespace delete src
} {}

test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
		[lsort [namespace children :: test_ns_*]]
    }
} -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }



} -body {








    namespace eval test_ns_1 {
        list $v $test_ns_2::v
    }
} -result {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
615
616
617
618
619
620
621
622


623
624
625


626
627
628
629
630
631
632
633
634
635

636

637
638
639
640
641

642
643

644
645
646
647
648
649

650
651
652
653
654
655
656
657

658




659
660
661
662

663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689

690
691
692
693
694
695
696






697
698
699
700
701
702
703
704
705
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {


    namespace children test_ns_1:::
} {::test_ns_1::test_ns_2}
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {


    namespace children :::test_ns_1:::::test_ns_2:::
} {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    set l {}
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
    lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    catch {unset test_ns_1::test_ns_2::}

    set l {}

    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    set test_ns_1::test_ns_2:: 314159
    lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {

    catch {rename test_ns_1::test_ns_2:: {}}
    set l {}

    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
    lappend l [test_ns_1::test_ns_2:: hello]
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_1 {
        variable {}
        set test_ns_1::(x) y
    }
    set test_ns_1::(x)
} y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg




} {1 {can't create namespace "": only global namespace can have empty name}}

test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        proc cmd {args} {namespace current}
    }
    list [namespace delete ::test_ns_delete::test_ns_delete2] \
         [namespace children ::test_ns_delete]
} {{} {}}
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        namespace eval test_ns_delete3 {}
        list [namespace delete test_ns_delete2] \
             [namespace children [namespace current]]
    }
} {{} ::test_ns_delete::test_ns_delete3}
test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
    namespace eval test_ns_delete2 {}
    namespace eval test_ns_delete {
        list [catch {namespace delete test_ns_delete2} msg] $msg
    }
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}

test namespace-16.1 {Tcl_FindCommand, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
        variable v "::test_ns_1::cmd"
        eval $v one
    }
} {::test_ns_1::cmd: one}
test namespace-16.2 {Tcl_FindCommand, absolute name found} {






    eval $test_ns_1::v two
} {::test_ns_1::cmd: two}
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
    namespace eval test_ns_1 {
        variable v2 "::test_ns_1::ladidah"
        list [catch {eval $v2} msg] $msg
    }
} {1 {invalid command name "::test_ns_1::ladidah"}}








|
>
>

|
|
>
>

|






|
|
>

>



|
|
>


>



|
|

>





|
|

>
|
>
>
>
>
|

|

>






|
|
|
|















|

>





|
|
>
>
>
>
>
>

|







669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
    namespace eval test_ns_1::test_ns_2::foo {}
} -body {
    namespace children test_ns_1:::
} -result {::test_ns_1::test_ns_2}
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
    namespace eval test_ns_1::test_ns_2::foo {}
} -body {
    namespace children :::test_ns_1:::::test_ns_2:::
} -result {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    set l {}
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
    lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    namespace eval test_ns_1::test_ns_2::foo {}
    unset -nocomplain test_ns_1::test_ns_2::
    set l {}
} -body {
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    set test_ns_1::test_ns_2:: 314159
    lappend l [set test_ns_1::test_ns_2::]
} -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup {
    namespace eval test_ns_1::test_ns_2::foo {}
    catch {rename test_ns_1::test_ns_2:: {}}
    set l {}
} -body {
    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
    lappend l [test_ns_1::test_ns_2:: hello]
} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        variable {}
        set test_ns_1::(x) y
    }
    set test_ns_1::(x)
} -result y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    namespace eval test_ns_1 {
	proc {} {} {}
	namespace eval {} {}
	{}
    }
} -result {can't create namespace "": only global namespace can have empty name}

test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        proc cmd {args} {namespace current}
    }
    list [namespace delete ::test_ns_delete::test_ns_delete2] \
         [namespace children ::test_ns_delete]
} -result {{} {}}
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body {
    namespace delete ::test_ns_delete::test_ns_delete2
} -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        namespace eval test_ns_delete3 {}
        list [namespace delete test_ns_delete2] \
             [namespace children [namespace current]]
    }
} {{} ::test_ns_delete::test_ns_delete3}
test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
    namespace eval test_ns_delete2 {}
    namespace eval test_ns_delete {
        list [catch {namespace delete test_ns_delete2} msg] $msg
    }
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}

test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
        variable v "::test_ns_1::cmd"
        eval $v one
    }
} -result {::test_ns_1::cmd: one}
test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
        variable v "::test_ns_1::cmd"
    }
} -body {
    eval $test_ns_1::v two
} -result {::test_ns_1::cmd: two}
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
    namespace eval test_ns_1 {
        variable v2 "::test_ns_1::ladidah"
        list [catch {eval $v2} msg] $msg
    }
} {1 {invalid command name "::test_ns_1::ladidah"}}

720
721
722
723
724
725
726
727





728
729
730
731
732
733
734
735
736
737
738
test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
    foobar 1 2 3 4 5
} {unknown: foobar 1 2 3 4 5}
# restore the "unknown" proc saved previously
catch {rename unknown {}}
catch {rename unknown.old unknown}

test namespace-16.8 {Tcl_FindCommand, relative name found} {





    namespace eval test_ns_1 {
        cmd a b c
    }
} {::test_ns_1::cmd: a b c}
test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
    namespace eval test_ns_1 {
       cmd2 a b c
    }
} -cleanup {
    catch {rename cmd2 {}}







|
>
>
>
>
>



|







796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
    foobar 1 2 3 4 5
} {unknown: foobar 1 2 3 4 5}
# restore the "unknown" proc saved previously
catch {rename unknown {}}
catch {rename unknown.old unknown}

test namespace-16.8 {Tcl_FindCommand, relative name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
    }
} -body {
    namespace eval test_ns_1 {
        cmd a b c
    }
} -result {::test_ns_1::cmd: a b c}
test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
    namespace eval test_ns_1 {
       cmd2 a b c
    }
} -cleanup {
    catch {rename cmd2 {}}
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761

762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789


790
791
792
793
794
795
796
797




798
799
800
801
802
803
804
805
806
807
808
        namespace eval test_ns_12 {
            cmd2 a b c
        }
    }
} -cleanup {
    catch {rename cmd2 {}}
} -result {::::cmd2: a b c}
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
    namespace eval test_ns_1 {
       list [catch {cmd3 a b c} msg] $msg
    }
} {1 {invalid command name "cmd3"}}

catch {unset x}
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    set x 314159
    namespace eval test_ns_1 {
        set ::x
    }
} {314159}
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        variable x 777
        set ::test_ns_1::x
    }
} {777}
test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::x
    }
} {1111}
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
    }
} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {


    namespace eval test_ns_1 {
        namespace eval test_ns_3 {
            variable ::test_ns_1::test_ns_2::x 2222
        }
    }
    set ::test_ns_1::test_ns_2::x
} {2222}
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {




    namespace eval test_ns_1 {
        set x
    }
} {777}
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
        unset x
        set x  ;# must be global x now
    }
} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {







|

|

|

|
|

>




|














|




|

|
|
>
>






|
|
>
>
>
>



|







827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
        namespace eval test_ns_12 {
            cmd2 a b c
        }
    }
} -cleanup {
    catch {rename cmd2 {}}
} -result {::::cmd2: a b c}
test namespace-16.11 {Tcl_FindCommand, relative name not found} -body {
    namespace eval test_ns_1 {
       cmd3 a b c
    }
} -returnCodes error -result {invalid command name "cmd3"}

unset -nocomplain x
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    set x 314159
    namespace eval test_ns_1 {
        set ::x
    }
} -result {314159}
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        variable x 777
        set ::test_ns_1::x
    }
} {777}
test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::x
    }
} {1111}
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::y
    }
} -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable}
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup {
    namespace eval ::test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace eval test_ns_3 {
            variable ::test_ns_1::test_ns_2::x 2222
        }
    }
    set ::test_ns_1::test_ns_2::x
} -result {2222}
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
    namespace eval test_ns_1 {
        variable x 777
    }
} -body {
    namespace eval test_ns_1 {
        set x
    }
} -result {777}
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
        unset x
        set x  ;# must be global x now
    }
} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
830
831
832
833
834
835
836
837
838

839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
    return $a
} 1
catch {unset a}
catch {unset x}

catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    proc foo {} {return "global foo"}
    namespace eval test_ns_1 {
        proc trigger {} {
            return [foo]
        }
    }
    set l ""
    lappend l [test_ns_1::trigger]
    namespace eval test_ns_1 {
        # force invalidation of cached ref to "foo" in proc trigger
        proc foo {} {return "foo in test_ns_1"}
    }
    lappend l [test_ns_1::trigger]
} {{global foo} {foo in test_ns_1}}
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
    namespace eval test_ns_2 {
        proc foo {} {return "foo in ::test_ns_2"}
    }
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {}
        proc trigger {} {







|

>













|







918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
    return $a
} 1
catch {unset a}
catch {unset x}

catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    proc foo {} {return "global foo"}
    namespace eval test_ns_1 {
        proc trigger {} {
            return [foo]
        }
    }
    set l ""
    lappend l [test_ns_1::trigger]
    namespace eval test_ns_1 {
        # force invalidation of cached ref to "foo" in proc trigger
        proc foo {} {return "foo in test_ns_1"}
    }
    lappend l [test_ns_1::trigger]
} -result {{global foo} {foo in test_ns_1}}
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
    namespace eval test_ns_2 {
        proc foo {} {return "foo in ::test_ns_2"}
    }
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {}
        proc trigger {} {
869
870
871
872
873
874
875
876
877

878
879
880
881



882
883
884
885
886


887
888
889
890
891



892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917

918
919
920
921



922
923
924
925
926



927
928
929



930
931
932
933
934
935
936
937
938
939
940
941
942
943



944
945
946
947
948
949
950
951
952
953
        }
    }
    lappend l [test_ns_1::trigger]
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
catch {unset l}
catch {rename foo {}}

test namespace-19.1 {GetNamespaceFromObj, global name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_1::test_ns_2 {}
    namespace children ::test_ns_1
} {::test_ns_1::test_ns_2}
test namespace-19.2 {GetNamespaceFromObj, relative name found} {



    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} {}
test namespace-19.3 {GetNamespaceFromObj, name not found} -body {


    namespace eval test_ns_1 {
        namespace children test_ns_99
    }
} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {



    namespace eval test_ns_1 {
        proc foo {} {
            return [namespace children test_ns_2]
        }
        list [catch {namespace children test_ns_99} msg] $msg
    }
    set l {}
    lappend l [test_ns_1::foo]
    namespace delete test_ns_1::test_ns_2
    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
    lappend l [test_ns_1::foo]
} {{} ::test_ns_1::test_ns_2::test_ns_3}

test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
    namespace wombat {}
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
    namespace ch :: test_ns_*
} {}

test namespace-21.1 {NamespaceChildrenCmd, no args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_1::test_ns_2 {}
    expr {[string first ::test_ns_1 [namespace children]] != -1}
} {1}
test namespace-21.2 {NamespaceChildrenCmd, no args} {



    namespace eval test_ns_1 {
        namespace children
    }
} {::test_ns_1::test_ns_2}
test namespace-21.3 {NamespaceChildrenCmd, ns name given} {



    namespace children ::test_ns_1
} {::test_ns_1::test_ns_2}
test namespace-21.4 {NamespaceChildrenCmd, ns name given} {



    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} {}
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
    namespace eval test_ns_1 {
        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
    }
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
    namespace eval test_ns_1::test_ns_foo {}
    namespace children test_ns_1 *f*
} {::test_ns_1::test_ns_foo}
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {



    namespace eval test_ns_1::test_ns_foo {}
    lsort [namespace children test_ns_1 test*]
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
    namespace eval test_ns_1 {}
    namespace children [namespace current] [fq test_ns_1]
} [fq test_ns_1]

test namespace-22.1 {NamespaceCodeCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}







|

>


|
|
>
>
>



|
|
>
>




|
>
>
>











|












|

>

|
|
|
>
>
>



|
|
>
>
>

|
|
>
>
>



|









|
>
>
>


|







958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
        }
    }
    lappend l [test_ns_1::trigger]
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
catch {unset l}
catch {rename foo {}}

test namespace-19.1 {GetNamespaceFromObj, global name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::test_ns_2 {}
    namespace children ::test_ns_1
} -result {::test_ns_1::test_ns_2}
test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} -result {}
test namespace-19.3 {GetNamespaceFromObj, name not found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        namespace children test_ns_99
    }
} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        proc foo {} {
            return [namespace children test_ns_2]
        }
        list [catch {namespace children test_ns_99} msg] $msg
    }
    set l {}
    lappend l [test_ns_1::foo]
    namespace delete test_ns_1::test_ns_2
    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
    lappend l [test_ns_1::foo]
} -result {{} ::test_ns_1::test_ns_2::test_ns_3}

test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
    namespace wombat {}
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
    namespace ch :: test_ns_*
} {}

test namespace-21.1 {NamespaceChildrenCmd, no args} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::test_ns_2 {}
    expr {"::test_ns_1" in [namespace children]}
} -result {1}
test namespace-21.2 {NamespaceChildrenCmd, no args} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace children
    }
} -result {::test_ns_1::test_ns_2}
test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace children ::test_ns_1
} -result {::test_ns_1::test_ns_2}
test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} -result {}
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
    namespace eval test_ns_1 {
        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
    }
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
    namespace eval test_ns_1::test_ns_foo {}
    namespace children test_ns_1 *f*
} {::test_ns_1::test_ns_foo}
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1::test_ns_foo {}
    lsort [namespace children test_ns_1 test*]
} -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
    namespace eval test_ns_1 {}
    namespace children [namespace current] [fq test_ns_1]
} [fq test_ns_1]

test namespace-22.1 {NamespaceCodeCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
1034
1035
1036
1037
1038
1039
1040
1041








1042
1043
1044
1045
1046
1047


1048
1049
1050
1051
1052
1053
1054
1055
1056
        proc p {} {
            variable v
            return $v
        }
    }
    test_ns_1::p
} {314159}
test namespace-25.4 {NamespaceEvalCmd, existing namespace} {








    namespace eval test_ns_1 {
        proc q {} {return [expr {[p]+1}]}
    }
    test_ns_1::q
} {314160}
test namespace-25.5 {NamespaceEvalCmd, multiple args} {


    namespace eval test_ns_1 "set" "v"
} {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
    while executing
"xxxx"
    (in namespace eval "::test_ns_1" script line 1)
    invoked from within







|
>
>
>
>
>
>
>
>




|
|
>
>

|







1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
        proc p {} {
            variable v
            return $v
        }
    }
    test_ns_1::p
} {314159}
test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup {
    namespace eval test_ns_1 {
        variable v 314159
        proc p {} {
            variable v
            return $v
        }
    }
} -body {
    namespace eval test_ns_1 {
        proc q {} {return [expr {[p]+1}]}
    }
    test_ns_1::q
} -result {314160}
test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup {
    namespace eval test_ns_1 {variable v 314159}
} -body {
    namespace eval test_ns_1 "set" "v"
} -result {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
    while executing
"xxxx"
    (in namespace eval "::test_ns_1" script line 1)
    invoked from within
1093
1094
1095
1096
1097
1098
1099
1100

1101




1102
1103

1104
1105
1106
1107
1108
1109

1110








1111
1112
1113
1114














1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
        proc cmd4 {args} {return "cmd4: $args"}
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
} {::test_ns_2::cmd1 {cmd1: hello}}
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {

    namespace eval test_ns_1 {




        namespace export cmd1 cmd3
    }

    namespace eval test_ns_2 {
        namespace import -force ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {

    namespace eval test_ns_1 {








        namespace export
    }
} {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {














    namespace eval test_ns_1 {
        namespace export -clear cmd4
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
    catch {namespace delete foo}
    namespace eval foo {
	namespace export x
	namespace export -clear
    }
    list [namespace eval foo namespace export] [namespace delete foo]







|
>

>
>
>
>


>




|
|
>

>
>
>
>
>
>
>
>


|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|







1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
        proc cmd4 {args} {return "cmd4: $args"}
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
} {::test_ns_2::cmd1 {cmd1: hello}}
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        namespace export cmd1 cmd3
    }
} -body {
    namespace eval test_ns_2 {
        namespace import -force ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
} -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        namespace export cmd1 cmd3
    }
} -body {
    namespace eval test_ns_1 {
        namespace export
    }
} -result {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
    }
} -body {
    namespace eval test_ns_1 {
        namespace export cmd1 cmd3
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    namespace eval test_ns_1 {
        namespace export -clear cmd4
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
} -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
    catch {namespace delete foo}
    namespace eval foo {
	namespace export x
	namespace export -clear
    }
    list [namespace eval foo namespace export] [namespace delete foo]
1198
1199
1200
1201
1202
1203
1204
1205








1206
1207
1208
1209


1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }
    }
    namespace inscope test_ns_1 cmd
} {::test_ns_1::cmd: v=747, args=}
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {








    list [namespace inscope test_ns_1 cmd x y z] \
         [namespace eval test_ns_1 [concat cmd [list x y z]]]
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
test namespace-29.6 {NamespaceInscopeCmd, 1400572} {


    namespace inscope test_ns_1 {info level 0}
} {namespace inscope test_ns_1 {info level 0}}


test namespace-30.1 {NamespaceOriginCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace origin} msg] $msg
} {1 {wrong # args: should be "namespace origin name"}}
test namespace-30.2 {NamespaceOriginCmd, bad args} {
    list [catch {namespace origin x y} msg] $msg







|
>
>
>
>
>
>
>
>


|
|
>
>

|
<







1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371

1372
1373
1374
1375
1376
1377
1378
        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }
    }
    namespace inscope test_ns_1 cmd
} {::test_ns_1::cmd: v=747, args=}
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup {
    namespace eval test_ns_1 {
        variable v 747
        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }
    }
} -body {
    list [namespace inscope test_ns_1 cmd x y z] \
         [namespace eval test_ns_1 [concat cmd [list x y z]]]
} -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup {
    namespace eval test_ns_1 {}
} -body {
    namespace inscope test_ns_1 {info level 0}
} -result {namespace inscope test_ns_1 {info level 0}}


test namespace-30.1 {NamespaceOriginCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace origin} msg] $msg
} {1 {wrong # args: should be "namespace origin name"}}
test namespace-30.2 {NamespaceOriginCmd, bad args} {
    list [catch {namespace origin x y} msg] $msg
1326
1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345

1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356















1357
1358
1359
1360
1361
1362
1363
1364

















1365
1366
1367
1368
1369
1370
1371
1372
1373
1374

1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
    namespace which -command
} {}
test namespace-34.4 {NamespaceWhichCmd, bad args} {
    list [catch {namespace which a b} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.5 {NamespaceWhichCmd, command lookup} {

    namespace eval test_ns_1 {
        namespace export cmd*
        variable v1 111
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }

    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
        variable v3 333
        list [namespace which -command foreach] \
             [namespace which -command p] \
             [namespace which -command cmd1] \
             [namespace which -command ::test_ns_2::cmd2] \
             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
    }
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
test namespace-34.6 {NamespaceWhichCmd, -command is default} {















    namespace eval test_ns_3 {
        list [namespace which foreach] \
             [namespace which p] \
             [namespace which cmd1] \
             [namespace which ::test_ns_2::cmd2]
    }
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
test namespace-34.7 {NamespaceWhichCmd, variable lookup} {

















    namespace eval test_ns_3 {
        list [namespace which -variable env] \
             [namespace which -variable v3] \
             [namespace which -variable ::test_ns_2::v2] \
             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
    }
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} {::test_ns_1}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
    namespace eval test_ns_1 {
        proc q {} {
            return [namespace current]
        }
    }
    list [test_ns_1::q] \







|
>












>









|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






|

|

>







|







1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
    namespace which -command
} {}
test namespace-34.4 {NamespaceWhichCmd, bad args} {
    list [catch {namespace which a b} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        variable v1 111
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }
} -body {
    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
        variable v3 333
        list [namespace which -command foreach] \
             [namespace which -command p] \
             [namespace which -command cmd1] \
             [namespace which -command ::test_ns_2::cmd2] \
             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
    }
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        proc p {} {}
    }
    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
    }
} -body {
    namespace eval test_ns_3 {
        list [namespace which foreach] \
             [namespace which p] \
             [namespace which cmd1] \
             [namespace which ::test_ns_2::cmd2]
    }
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }
    namespace eval test_ns_3 {
        variable v3 333
        namespace import ::test_ns_2::*
    }
} -body {
    namespace eval test_ns_3 {
        list [namespace which -variable env] \
             [namespace which -variable v3] \
             [namespace which -variable ::test_ns_2::v2] \
             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
    }
} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} -result {::test_ns_1}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
    namespace eval test_ns_1 {
        proc q {} {
            return [namespace current]
        }
    }
    list [test_ns_1::q] \
Changes to tests/resolver.test.
130
131
132
133
134
135
136



137
138
139
140
141
142
143
	namespace export z
    }
    proc ::y {} { return Y }
    namespace eval ::ns2 {
	proc x {} {
	    z
	}



    }
} -constraints testinterpresolver -body {
    set r0 [namespace eval ::ns2 {x}]
    set r1 [namespace eval ::ns2 {z}]
    namespace eval ::ns2 {
	namespace import ::ns1::z
	set r2 [z]







>
>
>







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
	namespace export z
    }
    proc ::y {} { return Y }
    namespace eval ::ns2 {
	proc x {} {
	    z
	}
    }
    namespace eval :: {
	variable r2 ""
    }
} -constraints testinterpresolver -body {
    set r0 [namespace eval ::ns2 {x}]
    set r1 [namespace eval ::ns2 {z}]
    namespace eval ::ns2 {
	namespace import ::ns1::z
	set r2 [z]