aboutsummaryrefslogtreecommitdiff
path: root/tests/namespace.test
blob: 216d214b760bce460d0c84dd06e4c4b2428d7964 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
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
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
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
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
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
source [file dirname [info script]]/testing.tcl
needs cmd namespace

test namespace-1.1 {usage for "namespace" command} -body {
    namespace
} -returnCodes error -match glob -result {wrong # args: should be *}

test namespace-1.2 {global namespace's name is "::" or {}} {
    list [namespace current] [namespace eval {} {namespace current}] [namespace eval :: {namespace current}]
} {:: :: ::}

test namespace-1.3 {usage for "namespace eval"} -body {
    namespace eval
} -returnCodes error -match glob -result {wrong # args: should be "namespace eval *"}

test namespace-1.5 {access a new namespace} {
    namespace eval ns1 { namespace current }
} {::ns1}

test namespace-1.7 {usage for "namespace eval"} -body {
    namespace eval ns1
} -returnCodes error -match glob -result {wrong # args: should be "namespace eval *"}

test namespace-1.8 {command "namespace eval" concatenates args} {
    namespace eval ns1 namespace current
} {::ns1}

test namespace-1.9 {simple namespace elements} {
    namespace eval ns1 {
        variable v1 1
        proc p1 {a} {variable v1; list $a $v1}
        p1 3
    }
} {3 1}

test namespace-1.10 {commands in a namespace} {
    namespace eval ns1 {
        info commands [namespace current]::*
    }
} {::ns1::p1}

test namespace-1.11 {variables in a namespace} {
    namespace eval ns1 {
        info vars [namespace current]::*
    }
} {::ns1::v1}

test namespace-1.12 {global vars are separate from locals vars} {
    set v1 2
    list [ns1::p1 123] [set ns1::v1] [set ::v1]
} {{123 1} 1 2}

test namespace-1.13 {add to an existing namespace} {
    namespace eval ns1 {
        variable v2 22
        proc p2 {script} {variable v2; eval $script}
        p2 {return $v2}
    }
} 22

test namespace-1.14 {commands in a namespace} {
    lsort [namespace eval ns1 {info commands [namespace current]::*}]
} {::ns1::p1 ::ns1::p2}

test namespace-1.15 {variables in a namespace} {
    lsort [namespace eval ns1 {info vars [namespace current]::*}]
} {::ns1::v1 ::ns1::v2}

# Tcl produces fully scoped names here
test namespace-1.16 {variables in a namespace} jim {
    lsort [info vars ns1::*]
} {ns1::v1 ns1::v2}

test namespace-1.17 {commands in a namespace are hidden} -body {
    v2 {return 3}
} -returnCodes error -result {invalid command name "v2"}

test namespace-1.18 {using namespace qualifiers} {
    ns1::p2 {return 44}
} 44

test namespace-1.19 {using absolute namespace qualifiers} {
    ::ns1::p2 {return 55}
} 55

test namespace-1.20 {variables in a namespace are hidden} -body {
    set v2
}  -returnCodes error -result {can't read "v2": no such variable}

test namespace-1.21 {using namespace qualifiers} {
    list $ns1::v1 $ns1::v2
} {1 22}

test namespace-1.22 {using absolute namespace qualifiers} {
    list $::ns1::v1 $::ns1::v2
} {1 22}

test namespace-1.23 {variables can be accessed within a namespace} {
    ns1::p2 {
        variable v1
        variable v2
        list $v1 $v2
    }
} {1 22}

test namespace-1.24 {setting global variables} {
    ns1::p2 {
		variable v1
        set v1 new
    }
    namespace eval ns1 {
        variable v1
        variable v2
        list $v1 $v2
    }
} {new 22}

test namespace-1.25 {qualified variables don't need a global declaration} {
    namespace eval ns2 { variable x 456 }
    set cmd {set ::ns2::x}
    ns1::p2 "$cmd some-value"
	set ::ns2::x
} {some-value}

test namespace-1.26 {namespace qualifiers are okay after $'s} {
    namespace eval ns1 { variable x; variable y; set x 12; set y 34 }
    set cmd {list $::ns1::x $::ns1::y}
    list [ns1::p2 $cmd] [eval $cmd]
} {{12 34} {12 34}}

test namespace-1.27 {can create commands with null names} {
    proc ns1:: {args} {return $args}
	ns1:: x
} {x}

test namespace-1.28 {namespace variable with array element syntax} -body {
	namespace eval ns1 {
		variable x(3) y
	}
} -returnCodes error -result {can't define "x(3)": name refers to an element in an array}


test namespace-1.29 {namespace variable too many args} -body {
	namespace eval ns1 {
		variable x(3) y a b c
	}
} -returnCodes error -result {wrong # args: should be "variable name ?value?"}

test namespace-1.30 {namespace current too many args} -body {
	namespace current a
} -returnCodes error -result {wrong # args: should be "namespace current"}

# TODO: Add tests for canonical option

test namespace-1.31 {namespace canonical too many args} -body {
	namespace canonical a b c
} -returnCodes error -result {wrong # args: should be "namespace canonical ?current? ?name?"}


unset -nocomplain ns1::x ns1::y

# -----------------------------------------------------------------------
# TEST: using "info" in namespace contexts
# -----------------------------------------------------------------------
test namespace-2.1 {querying:  info commands} {
    lsort [ns1::p2 {info commands [namespace current]::*}]
} {::ns1:: ::ns1::p1 ::ns1::p2}

test namespace-2.2 {querying:  info procs} {
    lsort [ns1::p2 {info procs}]
} {{} p1 p2}

# Tcl produces fully scoped names here
test namespace-2.3 {querying:  info vars} jim {
    lsort [info vars ns1::*]
} {ns1::v1 ns1::v2}

test namespace-2.4 {querying:  info vars} {
    lsort [ns1::p2 {info vars [namespace current]::*}]
} {::ns1::v1 ::ns1::v2}

test namespace-2.5 {querying:  info locals} {
    lsort [ns1::p2 {info locals}]
} {script}

test namespace-2.6 {querying:  info exists} {
    ns1::p2 {info exists v1}
} {0}

test namespace-2.7 {querying:  info exists} {
    ns1::p2 {info exists v2}
} {1}

test namespace-2.8 {querying:  info args} {
    info args ns1::p2
} {script}

test namespace-2.9 {querying:  info body} {
    string trim [info body ns1::p1]
} {variable v1; list $a $v1}

# -----------------------------------------------------------------------
# TEST: namespace qualifiers, namespace tail
# -----------------------------------------------------------------------
test namespace-3.1 {usage for "namespace qualifiers"} {
    list [catch "namespace qualifiers" msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}

test namespace-3.2 {querying:  namespace qualifiers} {
    list [namespace qualifiers ""] \
         [namespace qualifiers ::] \
         [namespace qualifiers x] \
         [namespace qualifiers ::x] \
         [namespace qualifiers foo::x] \
         [namespace qualifiers ::foo::bar::xyz]
} {{} {} {} {} foo ::foo::bar}

test namespace-3.3 {usage for "namespace tail"} {
    list [catch "namespace tail" msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}

test namespace-3.4 {querying:  namespace tail} {
    list [namespace tail ""] \
         [namespace tail ::] \
         [namespace tail x] \
         [namespace tail ::x] \
         [namespace tail foo::x] \
         [namespace tail ::foo::bar::xyz]
} {{} {} x x x xyz}

# -----------------------------------------------------------------------
# TEST: namespace hierarchy
# -----------------------------------------------------------------------
test namespace-5.1 {define nested namespaces} {
    set test_ns_var_global "var in ::"
    proc test_ns_cmd_global {} {return "cmd in ::"}
    namespace eval nsh1 {
        set test_ns_var_hier1 "particular to hier1"
        proc test_ns_cmd_hier1 {} {return "particular to hier1"}
        proc test_ns_show {} {return "[namespace current]: 1"}
        namespace eval nsh2 {
            set test_ns_var_hier2 "particular to hier2"
            proc test_ns_cmd_hier2 {} {return "particular to hier2"}
            proc test_ns_show {} {return "[namespace current]: 2"}
            namespace eval nsh3a {}
            namespace eval nsh3b {}
        }
        namespace eval nsh2a {}
        namespace eval nsh2b {}
    }
} {}

test namespace-5.2 {namespaces can be nested} {
    list [namespace eval nsh1 {namespace current}] \
         [namespace eval nsh1 {
              namespace eval nsh2 {namespace current}
          }]
} {::nsh1 ::nsh1::nsh2}

test namespace-5.3 {namespace qualifiers work in namespace command} {
    list [namespace eval ::nsh1 {namespace current}] \
         [namespace eval nsh1::nsh2 {namespace current}] \
         [namespace eval ::nsh1::nsh2 {namespace current}]
} {::nsh1 ::nsh1::nsh2 ::nsh1::nsh2}

test namespace-5.4 {nested namespaces can access global namespace} {
    list [namespace eval nsh1 {set ::test_ns_var_global}] \
         [namespace eval nsh1 {test_ns_cmd_global}] \
         [namespace eval nsh1::nsh2 {set ::test_ns_var_global}] \
         [namespace eval nsh1::nsh2 {test_ns_cmd_global}]
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}

test namespace-5.6 {commands in different namespaces don't conflict} {
    list [nsh1::test_ns_show] \
         [nsh1::nsh2::test_ns_show]
} {{::nsh1: 1} {::nsh1::nsh2: 2}}
test namespace-5.7 {nested namespaces don't see variables in parent} {
    set cmd {
        namespace eval nsh1::nsh2 {set test_ns_var_hier1}
    }
    list [catch $cmd msg] $msg
} {1 {can't read "test_ns_var_hier1": no such variable}}
test namespace-5.8 {nested namespaces don't see commands in parent} {
    set cmd {
        namespace eval nsh1::nsh2 {test_ns_cmd_hier1}
    }
    list [catch $cmd msg] $msg
} {1 {invalid command name "test_ns_cmd_hier1"}}

test namespace-5.18 {usage for "namespace parent"} {
    list [catch {namespace parent x y} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}

test namespace-5.20 {querying namespace parent} {
    list [namespace eval :: {namespace parent}] \
        [namespace eval nsh1 {namespace parent}] \
        [namespace eval nsh1::nsh2 {namespace parent}] \
        [namespace eval nsh1::nsh2::nsh3a {namespace parent}] \
} {{} :: ::nsh1 ::nsh1::nsh2}

test namespace-5.21 {querying namespace parent for explicit namespace} {
    list [namespace parent ::] \
         [namespace parent nsh1] \
         [namespace parent nsh1::nsh2] \
         [namespace parent nsh1::nsh2::nsh3a]
} {{} :: ::nsh1 ::nsh1::nsh2}

test namespace-5.22 {query namespace parent with fully qualified names} {
    list [namespace eval :: {namespace parent}] \
         [namespace eval ::nsh1 {namespace parent}] \
         [namespace eval ::nsh1::nsh2 {namespace parent}] \
         [namespace eval nsh1::nsh2::nsh3a {namespace parent ::nsh1::nsh2}] \
} {{} :: ::nsh1 ::nsh1}

# -----------------------------------------------------------------------
# TEST: name resolution and caching
# -----------------------------------------------------------------------
test namespace-6.1 {relative ns names only looked up in current ns} {
    namespace eval tns1 {}
    namespace eval tns2 {}
    namespace eval tns2::test_ns_cache3 {}
    set trigger {
        namespace eval tns2 {namespace current}
    }
    set trigger2 {
        namespace eval tns2::test_ns_cache3 {namespace current}
    }
    list [namespace eval tns1 $trigger] \
         [namespace eval tns1 $trigger2]
} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
test namespace-6.2 {relative ns names only looked up in current ns} {
    namespace eval tns1::tns2 {}
    list [namespace eval tns1 $trigger] \
         [namespace eval tns1 $trigger2]
} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
test namespace-6.3 {relative ns names only looked up in current ns} {
    namespace eval tns1::tns2::test_ns_cache3 {}
    list [namespace eval tns1 $trigger] \
         [namespace eval tns1 $trigger2]
} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
test namespace-6.4 {relative ns names only looked up in current ns} {
    namespace delete tns1::tns2
    list [namespace eval tns1 $trigger] \
         [namespace eval tns1 $trigger2]
} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}

test namespace-6.5 {define test commands} {
    proc testcmd {} {
        return "global version"
    }
    namespace eval tns1 {
        proc trigger {} {
            testcmd
        }
    }
    tns1::trigger
} {global version}

test namespace-6.6 {one-level check for command shadowing} {
    proc tns1::testcmd {} {
        return "cache1 version"
    }
    tns1::trigger
} {cache1 version}

test namespace-6.7 {renaming commands changes command epoch} {
    namespace eval tns1 {
        rename testcmd testcmd_new
    }
    tns1::trigger
} {global version}
test namespace-6.8 {renaming back handles shadowing} {
    namespace eval tns1 {
        rename testcmd_new testcmd
    }
    tns1::trigger
} {cache1 version}
test namespace-6.9 {deleting commands changes command epoch} {
    namespace eval tns1 {
        rename testcmd ""
    }
    tns1::trigger
} {global version}
test namespace-6.10 {define test namespaces} {
    namespace eval tns2 {
        proc testcmd {} {
            return "global cache2 version"
        }
    }
    namespace eval tns1 {
        proc trigger {} {
            tns2::testcmd
        }
    }
    namespace eval tns1::tns2 {
        proc trigger {} {
            testcmd
        }
    }
    list [tns1::trigger] [tns1::tns2::trigger]
} {{global cache2 version} {global version}}

test namespace-6.11 {commands affect all parent namespaces} {
    proc tns1::tns2::testcmd {} {
        return "cache2 version"
    }
    list [tns1::trigger] [tns1::tns2::trigger]
} {{cache2 version} {cache2 version}}

# -----------------------------------------------------------------------
# TEST: uplevel/upvar across namespace boundaries
# -----------------------------------------------------------------------
# Note that Tcl behaves a little differently for uplevel and upvar

test namespace-7.1 {uplevel in namespace eval} jim {
	set x 66
    namespace eval uns1 {
		variable y 55
		set x 33
        uplevel 1 set x
    }
} {66}

test namespace-7.2 {upvar in ns proc} jim {
	proc uns1::getvar {v} {
		variable y
		upvar $v var
		list $var $y
	}
	uns1::getvar x
} {66 55}

# -----------------------------------------------------------------------
# TEST: scoped values
# -----------------------------------------------------------------------
test namespace-10.1 {define namespace for scope test} {
    namespace eval ins1 {
        variable x "x-value"
        proc show {args} {
            return "show: $args"
        }
        proc do {args} {
            return [eval $args]
        }
        list [set x] [show test]
    }
} {x-value {show: test}}

test namespace-10.2 {command "namespace code" requires one argument} {
    list [catch {namespace code} msg] $msg
} {1 {wrong # args: should be "namespace code arg"}}

test namespace-10.3 {command "namespace code" requires one argument} {
    list [catch {namespace code first "second arg" third} msg] $msg
} {1 {wrong # args: should be "namespace code arg"}}

test namespace-10.4 {command "namespace code" gets current namesp context} {
    namespace eval ins1 {
        namespace code {"1 2 3" "4 5" 6}
    }
} {::namespace inscope ::ins1 {"1 2 3" "4 5" 6}}

test namespace-10.5 {with one arg, first "scope" sticks} {
    set sval [namespace eval ins1 {namespace code {one two}}]
    namespace code $sval
} {::namespace inscope ::ins1 {one two}}

test namespace-10.6 {with many args, each "scope" adds new args} {
    set sval [namespace eval ins1 {namespace code {one two}}]
    namespace code "$sval three"
} {::namespace inscope ::ins1 {one two} three}

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

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

test namespace-11.1 {command caching} {
	proc cmd1 {} { return global }
	set result {}
	namespace eval ns1 {
		proc cmd1 {} { return ns1 }
		proc cmd2 {} {
			uplevel 1 cmd1
		}
		lappend ::result [cmd2]
	}
	lappend result [ns1::cmd2]
} {ns1 global}

test namespace-12.1 {namespace import} {
	namespace eval test_ns_scope1 {
		proc a {} { return a }
		namespace export a
	}
	namespace eval test_ns_scope2 {
		namespace import ::test_ns_scope1::a
		a
	}
} {a}

test namespace-12.2 {namespace import recursive} -body {
	namespace eval test_ns_scope1 {
            namespace import [namespace current]::*
        }
} -returnCodes error -match glob -result {import pattern "*" tries to import from namespace "*" into itself}

test namespace-12.3 {namespace import loop} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two namespace export cmd
    namespace eval two \
	    [list namespace import [namespace current]::one::cmd]
    namespace eval three namespace export cmd
    namespace eval three \
	    [list namespace import [namespace current]::two::cmd]
} -body {
    namespace eval two [list namespace import -force \
	    [namespace current]::three::cmd]
    namespace origin two::cmd
} -cleanup {
    namespace delete one two three
} -returnCodes error -match glob -result {import pattern * would create a loop*}

test namespace-12.4 {namespace import} {
	namespace eval ::test_ns_one {}
	proc ::test_ns_one::testcmd args { return 2 }
	namespace import ::test_ns_one::*
	testcmd
} 2

foreach cmd [info commands test_ns_*] {
    rename $cmd ""
}

catch {rename cmd {}}
catch {rename cmd1 {}}
catch {rename cmd2 {}}
catch {rename ncmd {}}
catch {rename ncmd1 {}}
catch {rename ncmd2 {}}
catch {unset cref}
catch {unset trigger}
catch {unset trigger2}
catch {unset sval}
catch {unset msg}
catch {unset x}
catch {unset test_ns_var_global}
catch {unset cmd}
catch {eval namespace delete [namespace children :: test_ns_*]}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: