tcl/tests/execute.test

   1 # This file contains tests for the tclExecute.c source file. Tests appear
   2 # in the same order as the C code that they test. The set of tests is
   3 # currently incomplete since it currently includes only new tests for
   4 # code changed for the addition of Tcl namespaces. Other execution-
   5 # related tests appear in several other test files including
   6 # namespace.test, basic.test, eval.test, for.test, etc.
   7 #
   8 # Sourcing this file into Tcl runs the tests and generates output for
   9 # errors. No output means no errors were found.
  10 #
  11 # Copyright (c) 1997 Sun Microsystems, Inc.
  12 # Copyright (c) 1998-1999 by Scriptics Corporation.
  13 #
  14 # See the file "license.terms" for information on usage and redistribution
  15 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16 #
  17 # RCS: @(#) $Id$
  18
  19 if {[lsearch [namespace children] ::tcltest] == -1} {
  20     package require tcltest
  21     namespace import -force ::tcltest::*
  22 }
  23
  24 catch {eval namespace delete [namespace children :: test_ns_*]}
  25 catch {rename foo ""}
  26 catch {unset x}
  27 catch {unset y}
  28 catch {unset msg}
  29
  30 set ::tcltest::testConstraints(testobj) \
  31         [expr {[info commands testobj] != {} \
  32         && [info commands testdoubleobj] != {} \
  33         && [info commands teststringobj] != {} \
  34         && [info commands testobj] != {}}]
  35
  36 # Tests for the omnibus TclExecuteByteCode function:
  37
  38 # INST_DONE not tested
  39 # INST_PUSH1 not tested
  40 # INST_PUSH4 not tested
  41 # INST_POP not tested
  42 # INST_DUP not tested
  43 # INST_CONCAT1 not tested
  44 # INST_INVOKE_STK4 not tested
  45 # INST_INVOKE_STK1 not tested
  46 # INST_EVAL_STK not tested
  47 # INST_EXPR_STK not tested
  48
  49 # INST_LOAD_SCALAR1
  50
  51 test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
  52     proc foo {} {
  53         set x 1
  54         return $x
  55     }
  56     foo
  57 } 1
  58 test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {
  59     # Bug: 2243
  60     set body {}
  61     for {set i 0} {$i < 129} {incr i} {
  62         append body "set x$i x\n"
  63     }
  64     append body {
  65         set y 1
  66         return $y
  67     }
  68
  69     proc foo {} $body
  70     foo
  71 } 1
  72 test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
  73     proc foo {} {
  74         set x 1
  75         unset x
  76         return $x
  77     }
  78     list [catch {foo} msg] $msg
  79 } {1 {can't read "x": no such variable}}
  80
  81
  82 # INST_LOAD_SCALAR4
  83
  84 test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
  85     set body {}
  86     for {set i 0} {$i < 256} {incr i} {
  87         append body "set x$i x\n"
  88     }
  89     append body {
  90         set y 1
  91         return $y
  92     }
  93
  94     proc foo {} $body
  95     foo
  96 } 1
  97 test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {
  98     set body {}
  99     for {set i 0} {$i < 256} {incr i} {
 100         append body "set x$i x\n"
 101     }
 102     append body {
 103         set y 1
 104         unset y
 105         return $y
 106     }
 107
 108     proc foo {} $body
 109     list [catch {foo} msg] $msg
 110 } {1 {can't read "y": no such variable}}
 111
 112
 113 # INST_LOAD_SCALAR_STK not tested
 114 # INST_LOAD_ARRAY4 not tested
 115 # INST_LOAD_ARRAY1 not tested
 116 # INST_LOAD_ARRAY_STK not tested
 117 # INST_LOAD_STK not tested
 118 # INST_STORE_SCALAR4 not tested
 119 # INST_STORE_SCALAR1 not tested
 120 # INST_STORE_SCALAR_STK not tested
 121 # INST_STORE_ARRAY4 not tested
 122 # INST_STORE_ARRAY1 not tested
 123 # INST_STORE_ARRAY_STK not tested
 124 # INST_STORE_STK not tested
 125 # INST_INCR_SCALAR1 not tested
 126 # INST_INCR_SCALAR_STK not tested
 127 # INST_INCR_STK not tested
 128 # INST_INCR_ARRAY1 not tested
 129 # INST_INCR_ARRAY_STK not tested
 130 # INST_INCR_SCALAR1_IMM not tested
 131 # INST_INCR_SCALAR_STK_IMM not tested
 132 # INST_INCR_STK_IMM not tested
 133 # INST_INCR_ARRAY1_IMM not tested
 134 # INST_INCR_ARRAY_STK_IMM not tested
 135 # INST_JUMP1 not tested
 136 # INST_JUMP4 not tested
 137 # INST_JUMP_TRUE4 not tested
 138 # INST_JUMP_TRUE1 not tested
 139 # INST_JUMP_FALSE4 not tested
 140 # INST_JUMP_FALSE1 not tested
 141 # INST_LOR not tested
 142 # INST_LAND not tested
 143 # INST_EQ not tested
 144 # INST_NEQ not tested
 145 # INST_LT not tested
 146 # INST_GT not tested
 147 # INST_LE not tested
 148 # INST_GE not tested
 149 # INST_MOD not tested
 150 # INST_LSHIFT not tested
 151 # INST_RSHIFT not tested
 152 # INST_BITOR not tested
 153 # INST_BITXOR not tested
 154 # INST_BITAND not tested
 155
 156 # INST_ADD is partially tested:
 157 test execute-3.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {
 158     set x [testintobj set 0 1]
 159     expr {$x + 1}
 160 } 2
 161 test execute-3.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {
 162     set x [testdoubleobj set 0 1]
 163     expr {$x + 1}
 164 } 2.0
 165 test execute-3.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} {
 166     set x [testintobj set 0 1]
 167     testobj convert 0 double
 168     expr {$x + 1}
 169 } 2
 170 test execute-3.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {
 171     set x [teststringobj set 0 1]
 172     expr {$x + 1}
 173 } 2
 174 test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
 175     set x [teststringobj set 0 1.0]
 176     expr {$x + 1}
 177 } 2.0
 178 test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
 179     set x [teststringobj set 0 foo]
 180     list [catch {expr {$x + 1}} msg] $msg
 181 } {1 {can't use non-numeric string as operand of "+"}}
 182 test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
 183     set x [testintobj set 0 1]
 184     expr {1 + $x}
 185 } 2
 186 test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
 187     set x [testdoubleobj set 0 1]
 188     expr {1 + $x}
 189 } 2.0
 190 test execute-3.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} {
 191     set x [testintobj set 0 1]
 192     testobj convert 0 double
 193     expr {1 + $x}
 194 } 2
 195 test execute-3.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {
 196     set x [teststringobj set 0 1]
 197     expr {1 + $x}
 198 } 2
 199 test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
 200     set x [teststringobj set 0 1.0]
 201     expr {1 + $x}
 202 } 2.0
 203 test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
 204     set x [teststringobj set 0 foo]
 205     list [catch {expr {1 + $x}} msg] $msg
 206 } {1 {can't use non-numeric string as operand of "+"}}
 207
 208 # INST_SUB is partially tested:
 209 test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
 210     set x [testintobj set 0 1]
 211     expr {$x - 1}
 212 } 0
 213 test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
 214     set x [testdoubleobj set 0 1]
 215     expr {$x - 1}
 216 } 0.0
 217 test execute-3.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} {
 218     set x [testintobj set 0 1]
 219     testobj convert 0 double
 220     expr {$x - 1}
 221 } 0
 222 test execute-3.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {
 223     set x [teststringobj set 0 1]
 224     expr {$x - 1}
 225 } 0
 226 test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
 227     set x [teststringobj set 0 1.0]
 228     expr {$x - 1}
 229 } 0.0
 230 test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
 231     set x [teststringobj set 0 foo]
 232     list [catch {expr {$x - 1}} msg] $msg
 233 } {1 {can't use non-numeric string as operand of "-"}}
 234 test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
 235     set x [testintobj set 0 1]
 236     expr {1 - $x}
 237 } 0
 238 test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
 239     set x [testdoubleobj set 0 1]
 240     expr {1 - $x}
 241 } 0.0
 242 test execute-3.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} {
 243     set x [testintobj set 0 1]
 244     testobj convert 0 double
 245     expr {1 - $x}
 246 } 0
 247 test execute-3.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {
 248     set x [teststringobj set 0 1]
 249     expr {1 - $x}
 250 } 0
 251 test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
 252     set x [teststringobj set 0 1.0]
 253     expr {1 - $x}
 254 } 0.0
 255 test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
 256     set x [teststringobj set 0 foo]
 257     list [catch {expr {1 - $x}} msg] $msg
 258 } {1 {can't use non-numeric string as operand of "-"}}
 259
 260 # INST_MULT is partially tested:
 261 test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
 262     set x [testintobj set 1 1]
 263     expr {$x * 1}
 264 } 1
 265 test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
 266     set x [testdoubleobj set 1 2.0]
 267     expr {$x * 1}
 268 } 2.0
 269 test execute-3.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} {
 270     set x [testintobj set 1 2]
 271     testobj convert 1 double
 272     expr {$x * 1}
 273 } 2
 274 test execute-3.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {
 275     set x [teststringobj set 1 1]
 276     expr {$x * 1}
 277 } 1
 278 test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
 279     set x [teststringobj set 1 1.0]
 280     expr {$x * 1}
 281 } 1.0
 282 test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
 283     set x [teststringobj set 1 foo]
 284     list [catch {expr {$x * 1}} msg] $msg
 285 } {1 {can't use non-numeric string as operand of "*"}}
 286 test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
 287     set x [testintobj set 1 1]
 288     expr {1 * $x}
 289 } 1
 290 test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
 291     set x [testdoubleobj set 1 2.0]
 292     expr {1 * $x}
 293 } 2.0
 294 test execute-3.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} {
 295     set x [testintobj set 1 2]
 296     testobj convert 1 double
 297     expr {1 * $x}
 298 } 2
 299 test execute-3.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {
 300     set x [teststringobj set 1 1]
 301     expr {1 * $x}
 302 } 1
 303 test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
 304     set x [teststringobj set 1 1.0]
 305     expr {1 * $x}
 306 } 1.0
 307 test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
 308     set x [teststringobj set 1 foo]
 309     list [catch {expr {1 * $x}} msg] $msg
 310 } {1 {can't use non-numeric string as operand of "*"}}
 311
 312 # INST_DIV is partially tested:
 313 test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
 314     set x [testintobj set 1 1]
 315     expr {$x / 1}
 316 } 1
 317 test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
 318     set x [testdoubleobj set 1 2.0]
 319     expr {$x / 1}
 320 } 2.0
 321 test execute-3.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} {
 322     set x [testintobj set 1 2]
 323     testobj convert 1 double
 324     expr {$x / 1}
 325 } 2
 326 test execute-3.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {
 327     set x [teststringobj set 1 1]
 328     expr {$x / 1}
 329 } 1
 330 test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
 331     set x [teststringobj set 1 1.0]
 332     expr {$x / 1}
 333 } 1.0
 334 test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
 335     set x [teststringobj set 1 foo]
 336     list [catch {expr {$x / 1}} msg] $msg
 337 } {1 {can't use non-numeric string as operand of "/"}}
 338 test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
 339     set x [testintobj set 1 1]
 340     expr {2 / $x}
 341 } 2
 342 test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
 343     set x [testdoubleobj set 1 1.0]
 344     expr {2 / $x}
 345 } 2.0
 346 test execute-3.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} {
 347     set x [testintobj set 1 1]
 348     testobj convert 1 double
 349     expr {2 / $x}
 350 } 2
 351 test execute-3.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {
 352     set x [teststringobj set 1 1]
 353     expr {2 / $x}
 354 } 2
 355 test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
 356     set x [teststringobj set 1 1.0]
 357     expr {2 / $x}
 358 } 2.0
 359 test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
 360     set x [teststringobj set 1 foo]
 361     list [catch {expr {1 / $x}} msg] $msg
 362 } {1 {can't use non-numeric string as operand of "/"}}
 363
 364 # INST_UPLUS is partially tested:
 365 test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
 366     set x [testintobj set 1 1]
 367     expr {+ $x}
 368 } 1
 369 test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
 370     set x [testdoubleobj set 1 1.0]
 371     expr {+ $x}
 372 } 1.0
 373 test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} {
 374     set x [testintobj set 1 1]
 375     testobj convert 1 double
 376     expr {+ $x}
 377 } 1
 378 test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
 379     set x [teststringobj set 1 1]
 380     expr {+ $x}
 381 } 1
 382 test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
 383     set x [teststringobj set 1 1.0]
 384     expr {+ $x}
 385 } 1.0
 386 test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
 387     set x [teststringobj set 1 foo]
 388     list [catch {expr {+ $x}} msg] $msg
 389 } {1 {can't use non-numeric string as operand of "+"}}
 390
 391 # INST_UMINUS is partially tested:
 392 test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
 393     set x [testintobj set 1 1]
 394     expr {- $x}
 395 } -1
 396 test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
 397     set x [testdoubleobj set 1 1.0]
 398     expr {- $x}
 399 } -1.0
 400 test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} {
 401     set x [testintobj set 1 1]
 402     testobj convert 1 double
 403     expr {- $x}
 404 } -1
 405 test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
 406     set x [teststringobj set 1 1]
 407     expr {- $x}
 408 } -1
 409 test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
 410     set x [teststringobj set 1 1.0]
 411     expr {- $x}
 412 } -1.0
 413 test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
 414     set x [teststringobj set 1 foo]
 415     list [catch {expr {- $x}} msg] $msg
 416 } {1 {can't use non-numeric string as operand of "-"}}
 417
 418 # INST_LNOT is partially tested:
 419 test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
 420     set x [testintobj set 1 2]
 421     expr {! $x}
 422 } 0
 423 test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
 424     set x [testintobj set 1 0]
 425     expr {! $x}
 426 } 1
 427 test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
 428     set x [testdoubleobj set 1 1.0]
 429     expr {! $x}
 430 } 0
 431 test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
 432     set x [testdoubleobj set 1 0.0]
 433     expr {! $x}
 434 } 1
 435 test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
 436     set x [testintobj set 1 1]
 437     testobj convert 1 double
 438     expr {! $x}
 439 } 0
 440 test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
 441     set x [testintobj set 1 0]
 442     testobj convert 1 double
 443     expr {! $x}
 444 } 1
 445 test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
 446     set x [teststringobj set 1 1]
 447     expr {! $x}
 448 } 0
 449 test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
 450     set x [teststringobj set 1 0]
 451     expr {! $x}
 452 } 1
 453 test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
 454     set x [teststringobj set 1 1.0]
 455     expr {! $x}
 456 } 0
 457 test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
 458     set x [teststringobj set 1 0.0]
 459     expr {! $x}
 460 } 1
 461 test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
 462     set x [teststringobj set 1 foo]
 463     list [catch {expr {! $x}} msg] $msg
 464 } {1 {can't use non-numeric string as operand of "!"}}
 465
 466 # INST_BITNOT not tested
 467 # INST_CALL_BUILTIN_FUNC1 not tested
 468 # INST_CALL_FUNC1 not tested
 469
 470 # INST_TRY_CVT_TO_NUMERIC is partially tested:
 471 test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
 472     set x [testintobj set 1 1]
 473     expr {$x}
 474 } 1
 475 test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
 476     set x [testdoubleobj set 1 1.0]
 477     expr {$x}
 478 } 1.0
 479 test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} {
 480     set x [testintobj set 1 1]
 481     testobj convert 1 double
 482     expr {$x}
 483 } 1
 484 test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
 485     set x [teststringobj set 1 1]
 486     expr {$x}
 487 } 1
 488 test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} {
 489     set x [teststringobj set 1 1.0]
 490     expr {$x}
 491 } 1.0
 492 test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} {
 493     set x [teststringobj set 1 foo]
 494     expr {$x}
 495 } foo
 496
 497 # INST_BREAK not tested
 498 # INST_CONTINUE not tested
 499 # INST_FOREACH_START4 not tested
 500 # INST_FOREACH_STEP4 not tested
 501 # INST_BEGIN_CATCH4 not tested
 502 # INST_END_CATCH not tested
 503 # INST_PUSH_RESULT not tested
 504 # INST_PUSH_RETURN_CODE not tested
 505
 506 test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
 507     catch {eval namespace delete [namespace children :: test_ns_*]}
 508     catch {unset x}
 509     catch {unset y}
 510     namespace eval test_ns_1 {
 511         namespace export cmd1
 512         proc cmd1 {args} {return "cmd1: $args"}
 513         proc cmd2 {args} {return "cmd2: $args"}
 514     }
 515     namespace eval test_ns_1::test_ns_2 {
 516         namespace import ::test_ns_1::*
 517     }
 518     set x "test_ns_1::"
 519     set y "test_ns_2::"
 520     list [namespace which -command ${x}${y}cmd1] \
 521          [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
 522          [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
 523 } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
 524 test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
 525     catch {eval namespace delete [namespace children :: test_ns_*]}
 526     catch {rename foo ""}
 527     catch {unset l}
 528     proc foo {} {
 529         return "global foo"
 530     }
 531     namespace eval test_ns_1 {
 532         proc whichFoo {} {
 533             return [namespace which -command foo]
 534         }
 535     }
 536     set l ""
 537     lappend l [test_ns_1::whichFoo]
 538     namespace eval test_ns_1 {
 539         proc foo {} {
 540             return "namespace foo"
 541         }
 542     }
 543     lappend l [test_ns_1::whichFoo]
 544     set l
 545 } {::foo ::test_ns_1::foo}
 546 test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
 547     catch {eval namespace delete [namespace children :: test_ns_*]}
 548     catch {rename foo ""}
 549     namespace eval test_ns_1 {
 550         proc foo {} {
 551             return "namespace foo"
 552         }
 553     }
 554     namespace eval test_ns_1 {
 555         proc foo {} {
 556             return "namespace foo"
 557         }
 558     }
 559     list [namespace eval test_ns_1 {namespace which -command foo}] \
 560          [rename test_ns_1::foo ""] \
 561          [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
 562 } {::test_ns_1::foo {} 0 {}}
 563
 564 test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
 565     catch {eval namespace delete [namespace children :: test_ns_*]}
 566     catch {unset l}
 567     proc {} {} {return {}}
 568     {}
 569     set l {}
 570     lindex {} 0
 571     {}
 572 } {}
 573
 574 test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
 575     proc {} {} {}
 576     proc { } {} {}
 577     proc p {} {
 578         set x {}
 579         $x
 580         append x { }
 581         $x
 582     }
 583     p
 584 } {}
 585
 586 # cleanup
 587 catch {eval namespace delete [namespace children :: test_ns_*]}
 588 catch {rename foo ""}
 589 catch {rename p ""}
 590 catch {rename {} ""}
 591 catch {rename { } ""}
 592 catch {unset x}
 593 catch {unset y}
 594 catch {unset msg}
 595 ::tcltest::cleanupTests
 596 return
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616