os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/namespace-old.test
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
sl@0
     1
# Functionality covered: this file contains slightly modified versions of
sl@0
     2
# the original tests written by Mike McLennan of Lucent Technologies for
sl@0
     3
# the procedures in tclNamesp.c that implement Tcl's basic support for
sl@0
     4
# namespaces. Other namespace-related tests appear in namespace.test
sl@0
     5
# and variable.test.
sl@0
     6
#
sl@0
     7
# Sourcing this file into Tcl runs the tests and generates output for
sl@0
     8
# errors. No output means no errors were found.
sl@0
     9
#
sl@0
    10
# Copyright (c) 1997 Sun Microsystems, Inc.
sl@0
    11
# Copyright (c) 1997 Lucent Technologies
sl@0
    12
# Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0
    13
#
sl@0
    14
# See the file "license.terms" for information on usage and redistribution
sl@0
    15
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    16
#
sl@0
    17
# RCS: @(#) $Id: namespace-old.test,v 1.6 2001/04/07 02:11:19 msofer Exp $
sl@0
    18
sl@0
    19
if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0
    20
    package require tcltest
sl@0
    21
    namespace import -force ::tcltest::*
sl@0
    22
}
sl@0
    23
sl@0
    24
# Clear out any namespaces called test_ns_*
sl@0
    25
catch {eval namespace delete [namespace children :: test_ns_*]}
sl@0
    26
sl@0
    27
test namespace-old-1.1 {usage for "namespace" command} {
sl@0
    28
    list [catch {namespace} msg] $msg
sl@0
    29
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
sl@0
    30
sl@0
    31
test namespace-old-1.2 {global namespace's name is "::" or {}} {
sl@0
    32
    list [namespace current] [namespace eval {} {namespace current}]
sl@0
    33
} {:: ::}
sl@0
    34
sl@0
    35
test namespace-old-1.3 {usage for "namespace eval"} {
sl@0
    36
    list [catch {namespace eval} msg] $msg
sl@0
    37
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
sl@0
    38
sl@0
    39
test namespace-old-1.4 {create new namespaces} {
sl@0
    40
    list [lsort [namespace children :: test_ns_simple*]] \
sl@0
    41
	 [namespace eval test_ns_simple {}] \
sl@0
    42
	 [namespace eval test_ns_simple2 {}] \
sl@0
    43
         [lsort [namespace children :: test_ns_simple*]]
sl@0
    44
} {{} {} {} {::test_ns_simple ::test_ns_simple2}}
sl@0
    45
sl@0
    46
test namespace-old-1.5 {access a new namespace} {
sl@0
    47
    namespace eval test_ns_simple { namespace current }
sl@0
    48
} {::test_ns_simple}
sl@0
    49
sl@0
    50
test namespace-old-1.6 {usage for "namespace eval"} {
sl@0
    51
    list [catch {namespace eval} msg] $msg
sl@0
    52
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
sl@0
    53
sl@0
    54
test namespace-old-1.7 {usage for "namespace eval"} {
sl@0
    55
    list [catch {namespace eval test_ns_xyzzy} msg] $msg
sl@0
    56
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
sl@0
    57
sl@0
    58
test namespace-old-1.8 {command "namespace eval" concatenates args} {
sl@0
    59
    namespace eval test_ns_simple namespace current
sl@0
    60
} {::test_ns_simple}
sl@0
    61
sl@0
    62
test namespace-old-1.9 {add elements to a namespace} {
sl@0
    63
    namespace eval test_ns_simple {
sl@0
    64
        variable test_ns_x 0
sl@0
    65
        proc test {test_ns_x} {
sl@0
    66
            return "test: $test_ns_x"
sl@0
    67
        }
sl@0
    68
    }
sl@0
    69
} {}
sl@0
    70
sl@0
    71
test namespace-old-1.10 {commands in a namespace} {
sl@0
    72
    namespace eval test_ns_simple { info commands [namespace current]::*}
sl@0
    73
} {::test_ns_simple::test}
sl@0
    74
sl@0
    75
test namespace-old-1.11 {variables in a namespace} {
sl@0
    76
    namespace eval test_ns_simple { info vars [namespace current]::* }
sl@0
    77
} {::test_ns_simple::test_ns_x}
sl@0
    78
sl@0
    79
test namespace-old-1.12 {global vars are separate from locals vars} {
sl@0
    80
    list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
sl@0
    81
} {{test: 123} 0}
sl@0
    82
sl@0
    83
test namespace-old-1.13 {add to an existing namespace} {
sl@0
    84
    namespace eval test_ns_simple {
sl@0
    85
        variable test_ns_y 123
sl@0
    86
        proc _backdoor {cmd} {
sl@0
    87
            eval $cmd
sl@0
    88
        }
sl@0
    89
    }
sl@0
    90
} ""
sl@0
    91
sl@0
    92
test namespace-old-1.14 {commands in a namespace} {
sl@0
    93
    lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
sl@0
    94
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
sl@0
    95
sl@0
    96
test namespace-old-1.15 {variables in a namespace} {
sl@0
    97
    lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
sl@0
    98
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0
    99
test namespace-old-1.16 {variables in a namespace} {
sl@0
   100
    lsort [info vars test_ns_simple::*]
sl@0
   101
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0
   102
sl@0
   103
test namespace-old-1.17 {commands in a namespace are hidden} {
sl@0
   104
    list [catch "_backdoor {return yes!}" msg] $msg
sl@0
   105
} {1 {invalid command name "_backdoor"}}
sl@0
   106
test namespace-old-1.18 {using namespace qualifiers} {
sl@0
   107
    list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
sl@0
   108
} {0 yes!}
sl@0
   109
test namespace-old-1.19 {using absolute namespace qualifiers} {
sl@0
   110
    list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
sl@0
   111
} {0 yes!}
sl@0
   112
sl@0
   113
test namespace-old-1.20 {variables in a namespace are hidden} {
sl@0
   114
    list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
sl@0
   115
} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
sl@0
   116
test namespace-old-1.21 {using namespace qualifiers} {
sl@0
   117
    list [catch "set test_ns_simple::test_ns_x" msg] $msg \
sl@0
   118
         [catch "set test_ns_simple::test_ns_y" msg] $msg
sl@0
   119
} {0 0 0 123}
sl@0
   120
test namespace-old-1.22 {using absolute namespace qualifiers} {
sl@0
   121
    list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
sl@0
   122
         [catch "set ::test_ns_simple::test_ns_y" msg] $msg
sl@0
   123
} {0 0 0 123}
sl@0
   124
test namespace-old-1.23 {variables can be accessed within a namespace} {
sl@0
   125
    test_ns_simple::_backdoor {
sl@0
   126
        variable test_ns_x
sl@0
   127
        variable test_ns_y
sl@0
   128
        return "$test_ns_x $test_ns_y"
sl@0
   129
    }
sl@0
   130
} {0 123}
sl@0
   131
sl@0
   132
test namespace-old-1.24 {setting global variables} {
sl@0
   133
    test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
sl@0
   134
    namespace eval test_ns_simple {set test_ns_x}
sl@0
   135
} {new val}
sl@0
   136
sl@0
   137
test namespace-old-1.25 {qualified variables don't need a global declaration} {
sl@0
   138
    namespace eval test_ns_another { variable test_ns_x 456 }
sl@0
   139
    set cmd {set ::test_ns_another::test_ns_x}
sl@0
   140
    list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
sl@0
   141
         [eval $cmd]
sl@0
   142
} {0 some-value some-value}
sl@0
   143
sl@0
   144
test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
sl@0
   145
    namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
sl@0
   146
    set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
sl@0
   147
    list [test_ns_simple::_backdoor $cmd] [eval $cmd]
sl@0
   148
} {{12 34} {12 34}}
sl@0
   149
sl@0
   150
test namespace-old-1.27 {can create commands with null names} {
sl@0
   151
    proc test_ns_simple:: {args} {return $args}
sl@0
   152
} {}
sl@0
   153
sl@0
   154
# -----------------------------------------------------------------------
sl@0
   155
# TEST: using "info" in namespace contexts
sl@0
   156
# -----------------------------------------------------------------------
sl@0
   157
test namespace-old-2.1 {querying:  info commands} {
sl@0
   158
    lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
sl@0
   159
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
sl@0
   160
sl@0
   161
test namespace-old-2.2 {querying:  info procs} {
sl@0
   162
    lsort [test_ns_simple::_backdoor {info procs}]
sl@0
   163
} {{} _backdoor test}
sl@0
   164
sl@0
   165
test namespace-old-2.3 {querying:  info vars} {
sl@0
   166
    lsort [info vars test_ns_simple::*]
sl@0
   167
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0
   168
sl@0
   169
test namespace-old-2.4 {querying:  info vars} {
sl@0
   170
    lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
sl@0
   171
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
sl@0
   172
sl@0
   173
test namespace-old-2.5 {querying:  info locals} {
sl@0
   174
    lsort [test_ns_simple::_backdoor {info locals}]
sl@0
   175
} {cmd}
sl@0
   176
sl@0
   177
test namespace-old-2.6 {querying:  info exists} {
sl@0
   178
    test_ns_simple::_backdoor {info exists test_ns_x}
sl@0
   179
} {0}
sl@0
   180
sl@0
   181
test namespace-old-2.7 {querying:  info exists} {
sl@0
   182
    test_ns_simple::_backdoor {info exists cmd}
sl@0
   183
} {1}
sl@0
   184
sl@0
   185
test namespace-old-2.8 {querying:  info args} {
sl@0
   186
    info args test_ns_simple::_backdoor
sl@0
   187
} {cmd}
sl@0
   188
sl@0
   189
test namespace-old-2.9 {querying:  info body} {
sl@0
   190
    string trim [info body test_ns_simple::test]
sl@0
   191
} {return "test: $test_ns_x"}
sl@0
   192
sl@0
   193
# -----------------------------------------------------------------------
sl@0
   194
# TEST: namespace qualifiers, namespace tail
sl@0
   195
# -----------------------------------------------------------------------
sl@0
   196
test namespace-old-3.1 {usage for "namespace qualifiers"} {
sl@0
   197
    list [catch "namespace qualifiers" msg] $msg
sl@0
   198
} {1 {wrong # args: should be "namespace qualifiers string"}}
sl@0
   199
sl@0
   200
test namespace-old-3.2 {querying:  namespace qualifiers} {
sl@0
   201
    list [namespace qualifiers ""] \
sl@0
   202
         [namespace qualifiers ::] \
sl@0
   203
         [namespace qualifiers x] \
sl@0
   204
         [namespace qualifiers ::x] \
sl@0
   205
         [namespace qualifiers foo::x] \
sl@0
   206
         [namespace qualifiers ::foo::bar::xyz]
sl@0
   207
} {{} {} {} {} foo ::foo::bar}
sl@0
   208
sl@0
   209
test namespace-old-3.3 {usage for "namespace tail"} {
sl@0
   210
    list [catch "namespace tail" msg] $msg
sl@0
   211
} {1 {wrong # args: should be "namespace tail string"}}
sl@0
   212
sl@0
   213
test namespace-old-3.4 {querying:  namespace tail} {
sl@0
   214
    list [namespace tail ""] \
sl@0
   215
         [namespace tail ::] \
sl@0
   216
         [namespace tail x] \
sl@0
   217
         [namespace tail ::x] \
sl@0
   218
         [namespace tail foo::x] \
sl@0
   219
         [namespace tail ::foo::bar::xyz]
sl@0
   220
} {{} {} x x x xyz}
sl@0
   221
sl@0
   222
# -----------------------------------------------------------------------
sl@0
   223
# TEST: delete commands and namespaces
sl@0
   224
# -----------------------------------------------------------------------
sl@0
   225
test namespace-old-4.1 {define test namespaces} {
sl@0
   226
    namespace eval test_ns_delete {
sl@0
   227
        namespace eval ns1 {
sl@0
   228
            variable var1 1
sl@0
   229
            proc cmd1 {} {return "cmd1"}
sl@0
   230
        }
sl@0
   231
        namespace eval ns2 {
sl@0
   232
            variable var2 2
sl@0
   233
            proc cmd2 {} {return "cmd2"}
sl@0
   234
        }
sl@0
   235
        namespace eval another {}
sl@0
   236
        lsort [namespace children]
sl@0
   237
    }
sl@0
   238
} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
sl@0
   239
sl@0
   240
test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
sl@0
   241
    list [catch {namespace delete} msg] $msg
sl@0
   242
} {0 {}}
sl@0
   243
sl@0
   244
test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
sl@0
   245
    set cmd {
sl@0
   246
        namespace eval test_ns_delete {namespace delete ns*}
sl@0
   247
    }
sl@0
   248
    list [catch $cmd msg] $msg
sl@0
   249
} {1 {unknown namespace "ns*" in namespace delete command}}
sl@0
   250
sl@0
   251
test namespace-old-4.4 {command "namespace delete" handles multiple args} {
sl@0
   252
    set cmd {
sl@0
   253
        namespace eval test_ns_delete {
sl@0
   254
            eval namespace delete \
sl@0
   255
                [namespace children [namespace current] ns?]
sl@0
   256
        }
sl@0
   257
    }
sl@0
   258
    list [catch $cmd msg] $msg [namespace children test_ns_delete]
sl@0
   259
} {0 {} ::test_ns_delete::another}
sl@0
   260
sl@0
   261
# -----------------------------------------------------------------------
sl@0
   262
# TEST: namespace hierarchy
sl@0
   263
# -----------------------------------------------------------------------
sl@0
   264
test namespace-old-5.1 {define nested namespaces} {
sl@0
   265
    set test_ns_var_global "var in ::"
sl@0
   266
    proc test_ns_cmd_global {} {return "cmd in ::"}
sl@0
   267
sl@0
   268
    namespace eval test_ns_hier1 {
sl@0
   269
        set test_ns_var_hier1 "particular to hier1"
sl@0
   270
        proc test_ns_cmd_hier1 {} {return "particular to hier1"}
sl@0
   271
sl@0
   272
        set test_ns_level 1
sl@0
   273
        proc test_ns_show {} {return "[namespace current]: 1"}
sl@0
   274
sl@0
   275
        namespace eval test_ns_hier2 {
sl@0
   276
            set test_ns_var_hier2 "particular to hier2"
sl@0
   277
            proc test_ns_cmd_hier2 {} {return "particular to hier2"}
sl@0
   278
sl@0
   279
            set test_ns_level 2
sl@0
   280
            proc test_ns_show {} {return "[namespace current]: 2"}
sl@0
   281
sl@0
   282
            namespace eval test_ns_hier3a {}
sl@0
   283
            namespace eval test_ns_hier3b {}
sl@0
   284
        }
sl@0
   285
sl@0
   286
        namespace eval test_ns_hier2a {}
sl@0
   287
        namespace eval test_ns_hier2b {}
sl@0
   288
    }
sl@0
   289
} {}
sl@0
   290
sl@0
   291
test namespace-old-5.2 {namespaces can be nested} {
sl@0
   292
    list [namespace eval test_ns_hier1 {namespace current}] \
sl@0
   293
         [namespace eval test_ns_hier1 {
sl@0
   294
              namespace eval test_ns_hier2 {namespace current}
sl@0
   295
          }]
sl@0
   296
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
sl@0
   297
sl@0
   298
test namespace-old-5.3 {namespace qualifiers work in namespace command} {
sl@0
   299
    list [namespace eval ::test_ns_hier1 {namespace current}] \
sl@0
   300
         [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
sl@0
   301
         [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
sl@0
   302
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
sl@0
   303
sl@0
   304
test namespace-old-5.4 {nested namespaces can access global namespace} {
sl@0
   305
    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
sl@0
   306
         [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
sl@0
   307
         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
sl@0
   308
         [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
sl@0
   309
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
sl@0
   310
sl@0
   311
test namespace-old-5.5 {variables in different namespaces don't conflict} {
sl@0
   312
    list [set test_ns_hier1::test_ns_level] \
sl@0
   313
         [set test_ns_hier1::test_ns_hier2::test_ns_level]
sl@0
   314
} {1 2}
sl@0
   315
sl@0
   316
test namespace-old-5.6 {commands in different namespaces don't conflict} {
sl@0
   317
    list [test_ns_hier1::test_ns_show] \
sl@0
   318
         [test_ns_hier1::test_ns_hier2::test_ns_show]
sl@0
   319
} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
sl@0
   320
sl@0
   321
test namespace-old-5.7 {nested namespaces don't see variables in parent} {
sl@0
   322
    set cmd {
sl@0
   323
        namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
sl@0
   324
    }
sl@0
   325
    list [catch $cmd msg] $msg
sl@0
   326
} {1 {can't read "test_ns_var_hier1": no such variable}}
sl@0
   327
sl@0
   328
test namespace-old-5.8 {nested namespaces don't see commands in parent} {
sl@0
   329
    set cmd {
sl@0
   330
        namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
sl@0
   331
    }
sl@0
   332
    list [catch $cmd msg] $msg
sl@0
   333
} {1 {invalid command name "test_ns_cmd_hier1"}}
sl@0
   334
sl@0
   335
test namespace-old-5.9 {usage for "namespace children"} {
sl@0
   336
    list [catch {namespace children test_ns_hier1 y z} msg] $msg
sl@0
   337
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
sl@0
   338
sl@0
   339
test namespace-old-5.10 {command "namespace children" must get valid namespace} {
sl@0
   340
    list [catch {namespace children xyzzy} msg] $msg
sl@0
   341
} {1 {unknown namespace "xyzzy" in namespace children command}}
sl@0
   342
sl@0
   343
test namespace-old-5.11 {querying namespace children} {
sl@0
   344
    lsort [namespace children :: test_ns_hier*]
sl@0
   345
} {::test_ns_hier1}
sl@0
   346
sl@0
   347
test namespace-old-5.12 {querying namespace children} {
sl@0
   348
    lsort [namespace children test_ns_hier1]
sl@0
   349
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
sl@0
   350
sl@0
   351
test namespace-old-5.13 {querying namespace children} {
sl@0
   352
    lsort [namespace eval test_ns_hier1 {namespace children}]
sl@0
   353
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
sl@0
   354
sl@0
   355
test namespace-old-5.14 {querying namespace children} {
sl@0
   356
    lsort [namespace children test_ns_hier1::test_ns_hier2]
sl@0
   357
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0
   358
sl@0
   359
test namespace-old-5.15 {querying namespace children} {
sl@0
   360
    lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
sl@0
   361
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0
   362
sl@0
   363
test namespace-old-5.16 {querying namespace children with patterns} {
sl@0
   364
    lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
sl@0
   365
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0
   366
sl@0
   367
test namespace-old-5.17 {querying namespace children with patterns} {
sl@0
   368
    lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
sl@0
   369
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
sl@0
   370
sl@0
   371
test namespace-old-5.18 {usage for "namespace parent"} {
sl@0
   372
    list [catch {namespace parent x y} msg] $msg
sl@0
   373
} {1 {wrong # args: should be "namespace parent ?name?"}}
sl@0
   374
sl@0
   375
test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
sl@0
   376
    list [catch {namespace parent xyzzy} msg] $msg
sl@0
   377
} {1 {unknown namespace "xyzzy" in namespace parent command}}
sl@0
   378
sl@0
   379
test namespace-old-5.20 {querying namespace parent} {
sl@0
   380
    list [namespace eval :: {namespace parent}] \
sl@0
   381
        [namespace eval test_ns_hier1 {namespace parent}] \
sl@0
   382
        [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
sl@0
   383
        [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
sl@0
   384
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
sl@0
   385
sl@0
   386
test namespace-old-5.21 {querying namespace parent for explicit namespace} {
sl@0
   387
    list [namespace parent ::] \
sl@0
   388
         [namespace parent test_ns_hier1] \
sl@0
   389
         [namespace parent test_ns_hier1::test_ns_hier2] \
sl@0
   390
         [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
sl@0
   391
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
sl@0
   392
sl@0
   393
# -----------------------------------------------------------------------
sl@0
   394
# TEST: name resolution and caching
sl@0
   395
# -----------------------------------------------------------------------
sl@0
   396
test namespace-old-6.1 {relative ns names only looked up in current ns} {
sl@0
   397
    namespace eval test_ns_cache1 {}
sl@0
   398
    namespace eval test_ns_cache2 {}
sl@0
   399
    namespace eval test_ns_cache2::test_ns_cache3 {}
sl@0
   400
    set trigger {
sl@0
   401
        namespace eval test_ns_cache2 {namespace current}
sl@0
   402
    }
sl@0
   403
    set trigger2 {
sl@0
   404
        namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
sl@0
   405
    }
sl@0
   406
    list [namespace eval test_ns_cache1 $trigger] \
sl@0
   407
         [namespace eval test_ns_cache1 $trigger2]
sl@0
   408
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0
   409
sl@0
   410
test namespace-old-6.2 {relative ns names only looked up in current ns} {
sl@0
   411
    namespace eval test_ns_cache1::test_ns_cache2 {}
sl@0
   412
    list [namespace eval test_ns_cache1 $trigger] \
sl@0
   413
         [namespace eval test_ns_cache1 $trigger2]
sl@0
   414
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0
   415
sl@0
   416
test namespace-old-6.3 {relative ns names only looked up in current ns} {
sl@0
   417
    namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
sl@0
   418
    list [namespace eval test_ns_cache1 $trigger] \
sl@0
   419
         [namespace eval test_ns_cache1 $trigger2]
sl@0
   420
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0
   421
sl@0
   422
test namespace-old-6.4 {relative ns names only looked up in current ns} {
sl@0
   423
    namespace delete test_ns_cache1::test_ns_cache2
sl@0
   424
    list [namespace eval test_ns_cache1 $trigger] \
sl@0
   425
         [namespace eval test_ns_cache1 $trigger2]
sl@0
   426
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
sl@0
   427
sl@0
   428
test namespace-old-6.5 {define test commands} {
sl@0
   429
    proc test_ns_cache_cmd {} {
sl@0
   430
        return "global version"
sl@0
   431
    }
sl@0
   432
    namespace eval test_ns_cache1 {
sl@0
   433
        proc trigger {} {
sl@0
   434
            test_ns_cache_cmd
sl@0
   435
        }
sl@0
   436
    }
sl@0
   437
    test_ns_cache1::trigger
sl@0
   438
} {global version}
sl@0
   439
sl@0
   440
test namespace-old-6.6 {one-level check for command shadowing} {
sl@0
   441
    proc test_ns_cache1::test_ns_cache_cmd {} {
sl@0
   442
        return "cache1 version"
sl@0
   443
    }
sl@0
   444
    test_ns_cache1::trigger
sl@0
   445
} {cache1 version}
sl@0
   446
sl@0
   447
test namespace-old-6.7 {renaming commands changes command epoch} {
sl@0
   448
    namespace eval test_ns_cache1 {
sl@0
   449
        rename test_ns_cache_cmd test_ns_new
sl@0
   450
    }
sl@0
   451
    test_ns_cache1::trigger
sl@0
   452
} {global version}
sl@0
   453
sl@0
   454
test namespace-old-6.8 {renaming back handles shadowing} {
sl@0
   455
    namespace eval test_ns_cache1 {
sl@0
   456
        rename test_ns_new test_ns_cache_cmd
sl@0
   457
    }
sl@0
   458
    test_ns_cache1::trigger
sl@0
   459
} {cache1 version}
sl@0
   460
sl@0
   461
test namespace-old-6.9 {deleting commands changes command epoch} {
sl@0
   462
    namespace eval test_ns_cache1 {
sl@0
   463
        rename test_ns_cache_cmd ""
sl@0
   464
    }
sl@0
   465
    test_ns_cache1::trigger
sl@0
   466
} {global version}
sl@0
   467
sl@0
   468
test namespace-old-6.10 {define test namespaces} {
sl@0
   469
    namespace eval test_ns_cache2 {
sl@0
   470
        proc test_ns_cache_cmd {} {
sl@0
   471
            return "global cache2 version"
sl@0
   472
        }
sl@0
   473
    }
sl@0
   474
    namespace eval test_ns_cache1 {
sl@0
   475
        proc trigger {} {
sl@0
   476
            test_ns_cache2::test_ns_cache_cmd
sl@0
   477
        }
sl@0
   478
    }
sl@0
   479
    namespace eval test_ns_cache1::test_ns_cache2 {
sl@0
   480
        proc trigger {} {
sl@0
   481
            test_ns_cache_cmd
sl@0
   482
        }
sl@0
   483
    }
sl@0
   484
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
sl@0
   485
} {{global cache2 version} {global version}}
sl@0
   486
sl@0
   487
test namespace-old-6.11 {commands affect all parent namespaces} {
sl@0
   488
    proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
sl@0
   489
        return "cache2 version"
sl@0
   490
    }
sl@0
   491
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
sl@0
   492
} {{cache2 version} {cache2 version}}
sl@0
   493
sl@0
   494
test namespace-old-6.12 {define test variables} {
sl@0
   495
    variable test_ns_cache_var "global version"
sl@0
   496
    set trigger {set test_ns_cache_var}
sl@0
   497
    namespace eval test_ns_cache1 $trigger
sl@0
   498
} {global version}
sl@0
   499
sl@0
   500
test namespace-old-6.13 {one-level check for variable shadowing} {
sl@0
   501
    namespace eval test_ns_cache1 {
sl@0
   502
        variable test_ns_cache_var "cache1 version"
sl@0
   503
    }
sl@0
   504
    namespace eval test_ns_cache1 $trigger
sl@0
   505
} {cache1 version}
sl@0
   506
sl@0
   507
test namespace-old-6.14 {deleting variables changes variable epoch} {
sl@0
   508
    namespace eval test_ns_cache1 {
sl@0
   509
        unset test_ns_cache_var
sl@0
   510
    }
sl@0
   511
    namespace eval test_ns_cache1 $trigger
sl@0
   512
} {global version}
sl@0
   513
sl@0
   514
test namespace-old-6.15 {define test namespaces} {
sl@0
   515
    namespace eval test_ns_cache2 {
sl@0
   516
        variable test_ns_cache_var "global cache2 version"
sl@0
   517
    }
sl@0
   518
    set trigger2 {set test_ns_cache2::test_ns_cache_var}
sl@0
   519
    list [namespace eval test_ns_cache1 $trigger2] \
sl@0
   520
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
sl@0
   521
} {{global cache2 version} {global version}}
sl@0
   522
sl@0
   523
test namespace-old-6.16 {public variables affect all parent namespaces} {
sl@0
   524
    variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
sl@0
   525
    list [namespace eval test_ns_cache1 $trigger2] \
sl@0
   526
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
sl@0
   527
} {{cache2 version} {cache2 version}}
sl@0
   528
sl@0
   529
test namespace-old-6.17 {usage for "namespace which"} {
sl@0
   530
    list [catch "namespace which -baz" msg] $msg
sl@0
   531
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
sl@0
   532
test namespace-old-6.18 {usage for "namespace which"} {
sl@0
   533
    list [catch "namespace which -command" msg] $msg
sl@0
   534
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
sl@0
   535
sl@0
   536
test namespace-old-6.19 {querying:  namespace which -command} {
sl@0
   537
    proc test_ns_cache1::test_ns_cache_cmd {} {
sl@0
   538
        return "cache1 version"
sl@0
   539
    }
sl@0
   540
    list [namespace eval :: {namespace which test_ns_cache_cmd}] \
sl@0
   541
         [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
sl@0
   542
         [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
sl@0
   543
         [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
sl@0
   544
} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
sl@0
   545
sl@0
   546
test namespace-old-6.20 {command "namespace which" may not find commands} {
sl@0
   547
    namespace eval test_ns_cache1 {namespace which -command xyzzy}
sl@0
   548
} {}
sl@0
   549
sl@0
   550
test namespace-old-6.21 {querying:  namespace which -variable} {
sl@0
   551
    namespace eval test_ns_cache1::test_ns_cache2 {
sl@0
   552
        namespace which -variable test_ns_cache_var
sl@0
   553
    }
sl@0
   554
} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
sl@0
   555
sl@0
   556
test namespace-old-6.22 {command "namespace which" may not find variables} {
sl@0
   557
    namespace eval test_ns_cache1 {namespace which -variable xyzzy}
sl@0
   558
} {}
sl@0
   559
sl@0
   560
# -----------------------------------------------------------------------
sl@0
   561
# TEST: uplevel/upvar across namespace boundaries
sl@0
   562
# -----------------------------------------------------------------------
sl@0
   563
test namespace-old-7.1 {define test namespace} {
sl@0
   564
    namespace eval test_ns_uplevel {
sl@0
   565
        variable x 0
sl@0
   566
        variable y 1
sl@0
   567
sl@0
   568
        proc show_vars {num} {
sl@0
   569
            return [uplevel $num {info vars}]
sl@0
   570
        }
sl@0
   571
        proc test_uplevel {num} {
sl@0
   572
            set a 0
sl@0
   573
            set b 1
sl@0
   574
            namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
sl@0
   575
        }
sl@0
   576
    }
sl@0
   577
} {}
sl@0
   578
test namespace-old-7.2 {uplevel can access namespace call frame} {
sl@0
   579
    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
sl@0
   580
         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
sl@0
   581
} {1 1}
sl@0
   582
test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
sl@0
   583
    lsort [test_ns_uplevel::test_uplevel 2]
sl@0
   584
} {a b num}
sl@0
   585
test namespace-old-7.4 {uplevel can go up to global context} {
sl@0
   586
    expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
sl@0
   587
} {1}
sl@0
   588
sl@0
   589
test namespace-old-7.5 {absolute call frame references work too} {
sl@0
   590
    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
sl@0
   591
         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
sl@0
   592
} {1 1}
sl@0
   593
test namespace-old-7.6 {absolute call frame references work too} {
sl@0
   594
    lsort [test_ns_uplevel::test_uplevel #1]
sl@0
   595
} {a b num}
sl@0
   596
test namespace-old-7.7 {absolute call frame references work too} {
sl@0
   597
    expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
sl@0
   598
} {1}
sl@0
   599
sl@0
   600
test namespace-old-7.8 {namespaces are included in the call stack} {
sl@0
   601
    namespace eval test_ns_upvar {
sl@0
   602
        variable scope "test_ns_upvar"
sl@0
   603
sl@0
   604
        proc show_val {var num} {
sl@0
   605
            upvar $num $var x
sl@0
   606
            return $x
sl@0
   607
        }
sl@0
   608
        proc test_upvar {num} {
sl@0
   609
            set scope "test_ns_upvar::test_upvar"
sl@0
   610
            namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
sl@0
   611
        }
sl@0
   612
    }
sl@0
   613
} {}
sl@0
   614
test namespace-old-7.9 {upvar can access namespace call frame} {
sl@0
   615
    test_ns_upvar::test_upvar 1
sl@0
   616
} {test_ns_upvar}
sl@0
   617
test namespace-old-7.10 {upvar can go beyond namespace call frame} {
sl@0
   618
    test_ns_upvar::test_upvar 2
sl@0
   619
} {test_ns_upvar::test_upvar}
sl@0
   620
test namespace-old-7.11 {absolute call frame references work too} {
sl@0
   621
    test_ns_upvar::test_upvar #2
sl@0
   622
} {test_ns_upvar}
sl@0
   623
test namespace-old-7.12 {absolute call frame references work too} {
sl@0
   624
    test_ns_upvar::test_upvar #1
sl@0
   625
} {test_ns_upvar::test_upvar}
sl@0
   626
sl@0
   627
# -----------------------------------------------------------------------
sl@0
   628
# TEST: variable traces across namespace boundaries
sl@0
   629
# -----------------------------------------------------------------------
sl@0
   630
test namespace-old-8.1 {traces work across namespace boundaries} {
sl@0
   631
    namespace eval test_ns_trace {
sl@0
   632
        namespace eval foo {
sl@0
   633
            variable x ""
sl@0
   634
        }
sl@0
   635
sl@0
   636
        variable status ""
sl@0
   637
        proc monitor {name1 name2 op} {
sl@0
   638
            variable status
sl@0
   639
            lappend status "$op: $name1"
sl@0
   640
        }
sl@0
   641
        trace variable foo::x rwu [namespace code monitor]
sl@0
   642
    }
sl@0
   643
    set test_ns_trace::foo::x "yes!"
sl@0
   644
    set test_ns_trace::foo::x
sl@0
   645
    unset test_ns_trace::foo::x
sl@0
   646
sl@0
   647
    namespace eval test_ns_trace { set status }
sl@0
   648
} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
sl@0
   649
sl@0
   650
# -----------------------------------------------------------------------
sl@0
   651
# TEST: imported commands
sl@0
   652
# -----------------------------------------------------------------------
sl@0
   653
test namespace-old-9.1 {empty "namespace export" list} {
sl@0
   654
    list [catch "namespace export" msg] $msg
sl@0
   655
} {0 {}}
sl@0
   656
test namespace-old-9.2 {usage for "namespace export" command} {
sl@0
   657
    list [catch "namespace export test_ns_trace::zzz" msg] $msg
sl@0
   658
} {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
sl@0
   659
sl@0
   660
test namespace-old-9.3 {define test namespaces for import} {
sl@0
   661
    namespace eval test_ns_export {
sl@0
   662
        namespace export cmd1 cmd2 cmd3
sl@0
   663
        proc cmd1 {args} {return "cmd1: $args"}
sl@0
   664
        proc cmd2 {args} {return "cmd2: $args"}
sl@0
   665
        proc cmd3 {args} {return "cmd3: $args"}
sl@0
   666
        proc cmd4 {args} {return "cmd4: $args"}
sl@0
   667
        proc cmd5 {args} {return "cmd5: $args"}
sl@0
   668
        proc cmd6 {args} {return "cmd6: $args"}
sl@0
   669
    }
sl@0
   670
    lsort [info commands test_ns_export::*]
sl@0
   671
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
sl@0
   672
sl@0
   673
test namespace-old-9.4 {check export status} {
sl@0
   674
    set x ""
sl@0
   675
    namespace eval test_ns_import {
sl@0
   676
        namespace export cmd1 cmd2
sl@0
   677
        namespace import ::test_ns_export::*
sl@0
   678
    }
sl@0
   679
    foreach cmd [lsort [info commands test_ns_import::*]] {
sl@0
   680
        lappend x $cmd
sl@0
   681
    }
sl@0
   682
    set x
sl@0
   683
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
sl@0
   684
sl@0
   685
test namespace-old-9.5 {empty import list in "namespace import" command} {
sl@0
   686
    namespace import
sl@0
   687
} {}
sl@0
   688
sl@0
   689
test namespace-old-9.6 {empty import list for "namespace import" command} {
sl@0
   690
    namespace import
sl@0
   691
} {}
sl@0
   692
sl@0
   693
test namespace-old-9.7 {empty forget list for "namespace forget" command} {
sl@0
   694
    namespace forget
sl@0
   695
} {}
sl@0
   696
sl@0
   697
catch {rename cmd1 {}}
sl@0
   698
catch {rename cmd2 {}}
sl@0
   699
catch {rename ncmd {}}
sl@0
   700
catch {rename ncmd1 {}}
sl@0
   701
catch {rename ncmd2 {}}
sl@0
   702
test namespace-old-9.8 {only exported commands are imported} {
sl@0
   703
    namespace import test_ns_import::cmd*
sl@0
   704
    set x [lsort [info commands cmd*]]
sl@0
   705
} {cmd1 cmd2}
sl@0
   706
sl@0
   707
test namespace-old-9.9 {imported commands work just the same as original} {
sl@0
   708
    list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
sl@0
   709
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
sl@0
   710
sl@0
   711
test namespace-old-9.10 {commands can be imported from many namespaces} {
sl@0
   712
    namespace eval test_ns_import2 {
sl@0
   713
        namespace export ncmd ncmd1 ncmd2
sl@0
   714
        proc ncmd  {args} {return "ncmd: $args"}
sl@0
   715
        proc ncmd1 {args} {return "ncmd1: $args"}
sl@0
   716
        proc ncmd2 {args} {return "ncmd2: $args"}
sl@0
   717
        proc ncmd3 {args} {return "ncmd3: $args"}
sl@0
   718
    }
sl@0
   719
    namespace import test_ns_import2::*
sl@0
   720
    lsort [concat [info commands cmd*] [info commands ncmd*]]
sl@0
   721
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
sl@0
   722
sl@0
   723
test namespace-old-9.11 {imported commands can be removed by deleting them} {
sl@0
   724
    rename cmd1 ""
sl@0
   725
    lsort [concat [info commands cmd*] [info commands ncmd*]]
sl@0
   726
} {cmd2 ncmd ncmd1 ncmd2}
sl@0
   727
sl@0
   728
test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
sl@0
   729
    list [catch {namespace forget xyzzy::*} msg] $msg
sl@0
   730
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
sl@0
   731
sl@0
   732
test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
sl@0
   733
    list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
sl@0
   734
         [lsort [info commands cmd?]]
sl@0
   735
} {0 {} cmd2}
sl@0
   736
sl@0
   737
test namespace-old-9.14 {imported commands can be removed} {
sl@0
   738
    namespace forget test_ns_import::cmd?
sl@0
   739
    list [lsort [info commands cmd?]] \
sl@0
   740
         [catch {cmd1 another test} msg] $msg
sl@0
   741
} {{} 1 {invalid command name "cmd1"}}
sl@0
   742
sl@0
   743
test namespace-old-9.15 {existing commands can't be overwritten} {
sl@0
   744
    proc cmd1 {x y} {
sl@0
   745
        return [expr $x+$y]
sl@0
   746
    }
sl@0
   747
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
sl@0
   748
         [cmd1 3 5]
sl@0
   749
} {1 {can't import command "cmd1": already exists} 8}
sl@0
   750
sl@0
   751
test namespace-old-9.16 {use "-force" option to override existing commands} {
sl@0
   752
    list [cmd1 3 5] \
sl@0
   753
         [namespace import -force test_ns_import::cmd?] \
sl@0
   754
         [cmd1 3 5]
sl@0
   755
} {8 {} {cmd1: 3 5}}
sl@0
   756
sl@0
   757
test namespace-old-9.17 {commands can be imported into many namespaces} {
sl@0
   758
    namespace eval test_ns_import_use {
sl@0
   759
        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
sl@0
   760
        lsort [concat [info commands ::test_ns_import_use::cmd*] \
sl@0
   761
                      [info commands ::test_ns_import_use::ncmd*]]
sl@0
   762
    }
sl@0
   763
} {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
sl@0
   764
sl@0
   765
test namespace-old-9.18 {when command is deleted, imported commands go away} {
sl@0
   766
    namespace eval test_ns_import { rename cmd1 "" }
sl@0
   767
    list [info commands cmd1] \
sl@0
   768
         [namespace eval test_ns_import_use {info commands cmd1}]
sl@0
   769
} {{} {}}
sl@0
   770
sl@0
   771
test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
sl@0
   772
    namespace delete test_ns_import test_ns_import2
sl@0
   773
    list [info commands cmd*] \
sl@0
   774
         [info commands ncmd*] \
sl@0
   775
         [namespace eval test_ns_import_use {info commands cmd*}] \
sl@0
   776
         [namespace eval test_ns_import_use {info commands ncmd*}] \
sl@0
   777
} {{} {} {} {}}
sl@0
   778
sl@0
   779
# -----------------------------------------------------------------------
sl@0
   780
# TEST: scoped values
sl@0
   781
# -----------------------------------------------------------------------
sl@0
   782
test namespace-old-10.1 {define namespace for scope test} {
sl@0
   783
    namespace eval test_ns_inscope {
sl@0
   784
        variable x "x-value"
sl@0
   785
        proc show {args} {
sl@0
   786
            return "show: $args"
sl@0
   787
        }
sl@0
   788
        proc do {args} {
sl@0
   789
            return [eval $args]
sl@0
   790
        }
sl@0
   791
        list [set x] [show test]
sl@0
   792
    }
sl@0
   793
} {x-value {show: test}}
sl@0
   794
sl@0
   795
test namespace-old-10.2 {command "namespace code" requires one argument} {
sl@0
   796
    list [catch {namespace code} msg] $msg
sl@0
   797
} {1 {wrong # args: should be "namespace code arg"}}
sl@0
   798
sl@0
   799
test namespace-old-10.3 {command "namespace code" requires one argument} {
sl@0
   800
    list [catch {namespace code first "second arg" third} msg] $msg
sl@0
   801
} {1 {wrong # args: should be "namespace code arg"}}
sl@0
   802
sl@0
   803
test namespace-old-10.4 {command "namespace code" gets current namesp context} {
sl@0
   804
    namespace eval test_ns_inscope {
sl@0
   805
        namespace code {"1 2 3" "4 5" 6}
sl@0
   806
    }
sl@0
   807
} {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
sl@0
   808
sl@0
   809
test namespace-old-10.5 {with one arg, first "scope" sticks} {
sl@0
   810
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
sl@0
   811
    namespace code $sval
sl@0
   812
} {::namespace inscope ::test_ns_inscope {one two}}
sl@0
   813
sl@0
   814
test namespace-old-10.6 {with many args, each "scope" adds new args} {
sl@0
   815
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
sl@0
   816
    namespace code "$sval three"
sl@0
   817
} {::namespace inscope ::test_ns_inscope {one two} three}
sl@0
   818
sl@0
   819
test namespace-old-10.7 {scoped commands work with eval} {
sl@0
   820
    set cref [namespace eval test_ns_inscope {namespace code show}]
sl@0
   821
    list [eval $cref "a" "b c" "d e f"]
sl@0
   822
} {{show: a b c d e f}}
sl@0
   823
sl@0
   824
test namespace-old-10.8 {scoped commands execute in namespace context} {
sl@0
   825
    set cref [namespace eval test_ns_inscope {
sl@0
   826
        namespace code {set x "some new value"}
sl@0
   827
    }]
sl@0
   828
    list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
sl@0
   829
} {x-value {some new value} {some new value}}
sl@0
   830
sl@0
   831
foreach cmd [info commands test_ns_*] {
sl@0
   832
    rename $cmd ""
sl@0
   833
}
sl@0
   834
catch {rename cmd {}}
sl@0
   835
catch {rename cmd1 {}}
sl@0
   836
catch {rename cmd2 {}}
sl@0
   837
catch {rename ncmd {}}
sl@0
   838
catch {rename ncmd1 {}}
sl@0
   839
catch {rename ncmd2 {}}
sl@0
   840
catch {unset cref}
sl@0
   841
catch {unset trigger}
sl@0
   842
catch {unset trigger2}
sl@0
   843
catch {unset sval}
sl@0
   844
catch {unset msg}
sl@0
   845
catch {unset x}
sl@0
   846
catch {unset test_ns_var_global}
sl@0
   847
catch {unset cmd}
sl@0
   848
eval namespace delete [namespace children :: test_ns_*]
sl@0
   849
sl@0
   850
# cleanup
sl@0
   851
::tcltest::cleanupTests
sl@0
   852
return
sl@0
   853
sl@0
   854
sl@0
   855
sl@0
   856
sl@0
   857
sl@0
   858
sl@0
   859
sl@0
   860
sl@0
   861
sl@0
   862
sl@0
   863
sl@0
   864