execute.test
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:24k
源码类别:

通讯编程

开发平台:

Visual C++

  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: execute.test,v 1.13.2.2 2004/10/28 00:01:07 dgp Exp $
  18. if {[lsearch [namespace children] ::tcltest] == -1} {
  19.     package require tcltest 2
  20.     namespace import -force ::tcltest::*
  21. }
  22. catch {eval namespace delete [namespace children :: test_ns_*]}
  23. catch {rename foo ""}
  24. catch {unset x}
  25. catch {unset y}
  26. catch {unset msg}
  27. ::tcltest::testConstraint testobj 
  28. [expr {[info commands testobj] != {} 
  29. && [info commands testdoubleobj] != {} 
  30. && [info commands teststringobj] != {} 
  31. && [info commands testobj] != {}}]
  32. ::tcltest::testConstraint longIs32bit 
  33. [expr {int(0x80000000) < 0}]
  34. # Tests for the omnibus TclExecuteByteCode function:
  35. # INST_DONE not tested
  36. # INST_PUSH1 not tested
  37. # INST_PUSH4 not tested
  38. # INST_POP not tested
  39. # INST_DUP not tested
  40. # INST_CONCAT1 not tested
  41. # INST_INVOKE_STK4 not tested
  42. # INST_INVOKE_STK1 not tested
  43. # INST_EVAL_STK not tested
  44. # INST_EXPR_STK not tested
  45. # INST_LOAD_SCALAR1
  46. test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
  47.     proc foo {} {
  48. set x 1
  49. return $x
  50.     }
  51.     foo
  52. } 1
  53. test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {
  54.     # Bug: 2243
  55.     set body {}
  56.     for {set i 0} {$i < 129} {incr i} {
  57. append body "set x$i xn"
  58.     }
  59.     append body {
  60. set y 1
  61. return $y
  62.     }
  63.     proc foo {} $body
  64.     foo
  65. } 1
  66. test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
  67.     proc foo {} {
  68. set x 1
  69. unset x
  70. return $x
  71.     }
  72.     list [catch {foo} msg] $msg
  73. } {1 {can't read "x": no such variable}}
  74. # INST_LOAD_SCALAR4
  75. test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
  76.     set body {}
  77.     for {set i 0} {$i < 256} {incr i} {
  78. append body "set x$i xn"
  79.     }
  80.     append body {
  81. set y 1
  82. return $y
  83.     }
  84.     proc foo {} $body
  85.     foo
  86. } 1
  87. test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {
  88.     set body {}
  89.     for {set i 0} {$i < 256} {incr i} {
  90. append body "set x$i xn"
  91.     }
  92.     append body {
  93. set y 1
  94. unset y
  95. return $y
  96.     }
  97.     proc foo {} $body
  98.     list [catch {foo} msg] $msg
  99. } {1 {can't read "y": no such variable}}
  100. # INST_LOAD_SCALAR_STK not tested
  101. # INST_LOAD_ARRAY4 not tested
  102. # INST_LOAD_ARRAY1 not tested
  103. # INST_LOAD_ARRAY_STK not tested
  104. # INST_LOAD_STK not tested
  105. # INST_STORE_SCALAR4 not tested
  106. # INST_STORE_SCALAR1 not tested
  107. # INST_STORE_SCALAR_STK not tested
  108. # INST_STORE_ARRAY4 not tested
  109. # INST_STORE_ARRAY1 not tested
  110. # INST_STORE_ARRAY_STK not tested
  111. # INST_STORE_STK not tested
  112. # INST_INCR_SCALAR1 not tested
  113. # INST_INCR_SCALAR_STK not tested
  114. # INST_INCR_STK not tested
  115. # INST_INCR_ARRAY1 not tested
  116. # INST_INCR_ARRAY_STK not tested
  117. # INST_INCR_SCALAR1_IMM not tested
  118. # INST_INCR_SCALAR_STK_IMM not tested
  119. # INST_INCR_STK_IMM not tested
  120. # INST_INCR_ARRAY1_IMM not tested
  121. # INST_INCR_ARRAY_STK_IMM not tested
  122. # INST_JUMP1 not tested
  123. # INST_JUMP4 not tested
  124. # INST_JUMP_TRUE4 not tested
  125. # INST_JUMP_TRUE1 not tested
  126. # INST_JUMP_FALSE4 not tested
  127. # INST_JUMP_FALSE1 not tested
  128. # INST_LOR not tested
  129. # INST_LAND not tested
  130. # INST_EQ not tested
  131. # INST_NEQ not tested
  132. # INST_LT not tested
  133. # INST_GT not tested
  134. # INST_LE not tested
  135. # INST_GE not tested
  136. # INST_MOD not tested
  137. # INST_LSHIFT not tested
  138. # INST_RSHIFT not tested
  139. # INST_BITOR not tested
  140. # INST_BITXOR not tested
  141. # INST_BITAND not tested
  142. # INST_ADD is partially tested:
  143. test execute-3.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {
  144.     set x [testintobj set 0 1]
  145.     expr {$x + 1}
  146. } 2
  147. test execute-3.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {
  148.     set x [testdoubleobj set 0 1]
  149.     expr {$x + 1}
  150. } 2.0
  151. test execute-3.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} {
  152.     set x [testintobj set 0 1]
  153.     testobj convert 0 double
  154.     expr {$x + 1}
  155. } 2
  156. test execute-3.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {
  157.     set x [teststringobj set 0 1]
  158.     expr {$x + 1}
  159. } 2
  160. test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
  161.     set x [teststringobj set 0 1.0]
  162.     expr {$x + 1}
  163. } 2.0
  164. test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
  165.     set x [teststringobj set 0 foo]
  166.     list [catch {expr {$x + 1}} msg] $msg
  167. } {1 {can't use non-numeric string as operand of "+"}}
  168. test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
  169.     set x [testintobj set 0 1]
  170.     expr {1 + $x}
  171. } 2
  172. test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
  173.     set x [testdoubleobj set 0 1]
  174.     expr {1 + $x}
  175. } 2.0
  176. test execute-3.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} {
  177.     set x [testintobj set 0 1]
  178.     testobj convert 0 double
  179.     expr {1 + $x}
  180. } 2
  181. test execute-3.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {
  182.     set x [teststringobj set 0 1]
  183.     expr {1 + $x}
  184. } 2
  185. test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
  186.     set x [teststringobj set 0 1.0]
  187.     expr {1 + $x}
  188. } 2.0
  189. test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
  190.     set x [teststringobj set 0 foo]
  191.     list [catch {expr {1 + $x}} msg] $msg
  192. } {1 {can't use non-numeric string as operand of "+"}}
  193. # INST_SUB is partially tested:
  194. test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
  195.     set x [testintobj set 0 1]
  196.     expr {$x - 1}
  197. } 0
  198. test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
  199.     set x [testdoubleobj set 0 1]
  200.     expr {$x - 1}
  201. } 0.0
  202. test execute-3.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} {
  203.     set x [testintobj set 0 1]
  204.     testobj convert 0 double
  205.     expr {$x - 1}
  206. } 0
  207. test execute-3.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {
  208.     set x [teststringobj set 0 1]
  209.     expr {$x - 1}
  210. } 0
  211. test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
  212.     set x [teststringobj set 0 1.0]
  213.     expr {$x - 1}
  214. } 0.0
  215. test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
  216.     set x [teststringobj set 0 foo]
  217.     list [catch {expr {$x - 1}} msg] $msg
  218. } {1 {can't use non-numeric string as operand of "-"}}
  219. test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
  220.     set x [testintobj set 0 1]
  221.     expr {1 - $x}
  222. } 0
  223. test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
  224.     set x [testdoubleobj set 0 1]
  225.     expr {1 - $x}
  226. } 0.0
  227. test execute-3.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} {
  228.     set x [testintobj set 0 1]
  229.     testobj convert 0 double
  230.     expr {1 - $x}
  231. } 0
  232. test execute-3.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {
  233.     set x [teststringobj set 0 1]
  234.     expr {1 - $x}
  235. } 0
  236. test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
  237.     set x [teststringobj set 0 1.0]
  238.     expr {1 - $x}
  239. } 0.0
  240. test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
  241.     set x [teststringobj set 0 foo]
  242.     list [catch {expr {1 - $x}} msg] $msg
  243. } {1 {can't use non-numeric string as operand of "-"}}
  244. # INST_MULT is partially tested:
  245. test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
  246.     set x [testintobj set 1 1]
  247.     expr {$x * 1}
  248. } 1
  249. test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
  250.     set x [testdoubleobj set 1 2.0]
  251.     expr {$x * 1}
  252. } 2.0
  253. test execute-3.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} {
  254.     set x [testintobj set 1 2]
  255.     testobj convert 1 double
  256.     expr {$x * 1}
  257. } 2
  258. test execute-3.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {
  259.     set x [teststringobj set 1 1]
  260.     expr {$x * 1}
  261. } 1
  262. test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
  263.     set x [teststringobj set 1 1.0]
  264.     expr {$x * 1}
  265. } 1.0
  266. test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
  267.     set x [teststringobj set 1 foo]
  268.     list [catch {expr {$x * 1}} msg] $msg
  269. } {1 {can't use non-numeric string as operand of "*"}}
  270. test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
  271.     set x [testintobj set 1 1]
  272.     expr {1 * $x}
  273. } 1
  274. test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
  275.     set x [testdoubleobj set 1 2.0]
  276.     expr {1 * $x}
  277. } 2.0
  278. test execute-3.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} {
  279.     set x [testintobj set 1 2]
  280.     testobj convert 1 double
  281.     expr {1 * $x}
  282. } 2
  283. test execute-3.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {
  284.     set x [teststringobj set 1 1]
  285.     expr {1 * $x}
  286. } 1
  287. test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
  288.     set x [teststringobj set 1 1.0]
  289.     expr {1 * $x}
  290. } 1.0
  291. test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
  292.     set x [teststringobj set 1 foo]
  293.     list [catch {expr {1 * $x}} msg] $msg
  294. } {1 {can't use non-numeric string as operand of "*"}}
  295. # INST_DIV is partially tested:
  296. test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
  297.     set x [testintobj set 1 1]
  298.     expr {$x / 1}
  299. } 1
  300. test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
  301.     set x [testdoubleobj set 1 2.0]
  302.     expr {$x / 1}
  303. } 2.0
  304. test execute-3.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} {
  305.     set x [testintobj set 1 2]
  306.     testobj convert 1 double
  307.     expr {$x / 1}
  308. } 2
  309. test execute-3.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {
  310.     set x [teststringobj set 1 1]
  311.     expr {$x / 1}
  312. } 1
  313. test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
  314.     set x [teststringobj set 1 1.0]
  315.     expr {$x / 1}
  316. } 1.0
  317. test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
  318.     set x [teststringobj set 1 foo]
  319.     list [catch {expr {$x / 1}} msg] $msg
  320. } {1 {can't use non-numeric string as operand of "/"}}
  321. test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
  322.     set x [testintobj set 1 1]
  323.     expr {2 / $x}
  324. } 2
  325. test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
  326.     set x [testdoubleobj set 1 1.0]
  327.     expr {2 / $x}
  328. } 2.0
  329. test execute-3.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} {
  330.     set x [testintobj set 1 1]
  331.     testobj convert 1 double
  332.     expr {2 / $x}
  333. } 2
  334. test execute-3.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {
  335.     set x [teststringobj set 1 1]
  336.     expr {2 / $x}
  337. } 2
  338. test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
  339.     set x [teststringobj set 1 1.0]
  340.     expr {2 / $x}
  341. } 2.0
  342. test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
  343.     set x [teststringobj set 1 foo]
  344.     list [catch {expr {1 / $x}} msg] $msg
  345. } {1 {can't use non-numeric string as operand of "/"}}
  346. # INST_UPLUS is partially tested:
  347. test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
  348.     set x [testintobj set 1 1]
  349.     expr {+ $x}
  350. } 1
  351. test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
  352.     set x [testdoubleobj set 1 1.0]
  353.     expr {+ $x}
  354. } 1.0
  355. test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} {
  356.     set x [testintobj set 1 1]
  357.     testobj convert 1 double
  358.     expr {+ $x}
  359. } 1
  360. test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
  361.     set x [teststringobj set 1 1]
  362.     expr {+ $x}
  363. } 1
  364. test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
  365.     set x [teststringobj set 1 1.0]
  366.     expr {+ $x}
  367. } 1.0
  368. test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
  369.     set x [teststringobj set 1 foo]
  370.     list [catch {expr {+ $x}} msg] $msg
  371. } {1 {can't use non-numeric string as operand of "+"}}
  372. # INST_UMINUS is partially tested:
  373. test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
  374.     set x [testintobj set 1 1]
  375.     expr {- $x}
  376. } -1
  377. test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
  378.     set x [testdoubleobj set 1 1.0]
  379.     expr {- $x}
  380. } -1.0
  381. test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} {
  382.     set x [testintobj set 1 1]
  383.     testobj convert 1 double
  384.     expr {- $x}
  385. } -1
  386. test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
  387.     set x [teststringobj set 1 1]
  388.     expr {- $x}
  389. } -1
  390. test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
  391.     set x [teststringobj set 1 1.0]
  392.     expr {- $x}
  393. } -1.0
  394. test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
  395.     set x [teststringobj set 1 foo]
  396.     list [catch {expr {- $x}} msg] $msg
  397. } {1 {can't use non-numeric string as operand of "-"}}
  398. # INST_LNOT is partially tested:
  399. test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
  400.     set x [testintobj set 1 2]
  401.     expr {! $x}
  402. } 0
  403. test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
  404.     set x [testintobj set 1 0]
  405.     expr {! $x}
  406. } 1
  407. test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
  408.     set x [testdoubleobj set 1 1.0]
  409.     expr {! $x}
  410. } 0
  411. test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
  412.     set x [testdoubleobj set 1 0.0]
  413.     expr {! $x}
  414. } 1
  415. test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
  416.     set x [testintobj set 1 1]
  417.     testobj convert 1 double
  418.     expr {! $x}
  419. } 0
  420. test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
  421.     set x [testintobj set 1 0]
  422.     testobj convert 1 double
  423.     expr {! $x}
  424. } 1
  425. test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
  426.     set x [teststringobj set 1 1]
  427.     expr {! $x}
  428. } 0
  429. test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
  430.     set x [teststringobj set 1 0]
  431.     expr {! $x}
  432. } 1
  433. test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
  434.     set x [teststringobj set 1 1.0]
  435.     expr {! $x}
  436. } 0
  437. test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
  438.     set x [teststringobj set 1 0.0]
  439.     expr {! $x}
  440. } 1
  441. test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
  442.     set x [teststringobj set 1 foo]
  443.     list [catch {expr {! $x}} msg] $msg
  444. } {1 {can't use non-numeric string as operand of "!"}}
  445. # INST_BITNOT not tested
  446. # INST_CALL_BUILTIN_FUNC1 not tested
  447. # INST_CALL_FUNC1 not tested
  448. # INST_TRY_CVT_TO_NUMERIC is partially tested:
  449. test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
  450.     set x [testintobj set 1 1]
  451.     expr {$x}
  452. } 1
  453. test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
  454.     set x [testdoubleobj set 1 1.0]
  455.     expr {$x}
  456. } 1.0
  457. test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} {
  458.     set x [testintobj set 1 1]
  459.     testobj convert 1 double
  460.     expr {$x}
  461. } 1
  462. test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
  463.     set x [teststringobj set 1 1]
  464.     expr {$x}
  465. } 1
  466. test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} {
  467.     set x [teststringobj set 1 1.0]
  468.     expr {$x}
  469. } 1.0
  470. test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} {
  471.     set x [teststringobj set 1 foo]
  472.     expr {$x}
  473. } foo
  474. # INST_BREAK not tested
  475. # INST_CONTINUE not tested
  476. # INST_FOREACH_START4 not tested
  477. # INST_FOREACH_STEP4 not tested
  478. # INST_BEGIN_CATCH4 not tested
  479. # INST_END_CATCH not tested
  480. # INST_PUSH_RESULT not tested
  481. # INST_PUSH_RETURN_CODE not tested
  482. test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
  483.     catch {eval namespace delete [namespace children :: test_ns_*]}
  484.     catch {unset x}
  485.     catch {unset y}
  486.     namespace eval test_ns_1 {
  487.         namespace export cmd1
  488.         proc cmd1 {args} {return "cmd1: $args"}
  489.         proc cmd2 {args} {return "cmd2: $args"}
  490.     }
  491.     namespace eval test_ns_1::test_ns_2 {
  492.         namespace import ::test_ns_1::*
  493.     }
  494.     set x "test_ns_1::"
  495.     set y "test_ns_2::"
  496.     list [namespace which -command ${x}${y}cmd1] 
  497.          [catch {namespace which -command ${x}${y}cmd2} msg] $msg 
  498.          [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
  499. } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
  500. test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
  501.     catch {eval namespace delete [namespace children :: test_ns_*]}
  502.     catch {rename foo ""}
  503.     catch {unset l}
  504.     proc foo {} {
  505.         return "global foo"
  506.     }
  507.     namespace eval test_ns_1 {
  508.         proc whichFoo {} {
  509.             return [namespace which -command foo]
  510.         }
  511.     }
  512.     set l ""
  513.     lappend l [test_ns_1::whichFoo]
  514.     namespace eval test_ns_1 {
  515.         proc foo {} {
  516.             return "namespace foo"
  517.         }
  518.     }
  519.     lappend l [test_ns_1::whichFoo]
  520.     set l
  521. } {::foo ::test_ns_1::foo}
  522. test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
  523.     catch {eval namespace delete [namespace children :: test_ns_*]}
  524.     catch {rename foo ""}
  525.     namespace eval test_ns_1 {
  526.         proc foo {} {
  527.             return "namespace foo"
  528.         }
  529.     }
  530.     namespace eval test_ns_1 {
  531.         proc foo {} {
  532.             return "namespace foo"
  533.         }
  534.     }
  535.     list [namespace eval test_ns_1 {namespace which -command foo}] 
  536.          [rename test_ns_1::foo ""] 
  537.          [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
  538. } {::test_ns_1::foo {} 0 {}}
  539. test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
  540.     catch {eval namespace delete [namespace children :: test_ns_*]}
  541.     catch {unset l}
  542.     proc {} {} {return {}}
  543.     {}
  544.     set l {}
  545.     lindex {} 0
  546.     {}
  547. } {}
  548. test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
  549.     proc {} {} {}
  550.     proc { } {} {}
  551.     proc p {} {
  552.         set x {}
  553.         $x
  554.         append x { }
  555.         $x
  556.     }
  557.     p
  558. } {}
  559. test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {
  560.     set w {3*5}
  561.     proc a {obj} {expr $obj}
  562.     set res "[a $w]:[a $w]"
  563. } {15:15}
  564. test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
  565.     set x 0x100000000
  566.     expr {$x && 1}
  567. } 1
  568. test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
  569.     expr {0x100000000 && 1}
  570. } 1
  571. test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
  572.     expr {1 && 0x100000000}
  573. } 1
  574. test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
  575.     expr {wide(0x100000000) && 1}
  576. } 1
  577. test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
  578.     expr {1 && wide(0x100000000)}
  579. } 1
  580. test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {
  581.     expr {4 == (wide(1)+wide(3))}
  582. } 1
  583. test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
  584.     set x 399999999999
  585.     expr {400000000000 == [incr x]}
  586. } 1
  587. # wide ints have more bits of precision than doubles, but we convert anyway
  588. test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
  589.     set x [expr {wide(1)<<62}]
  590.     set y [expr {$x+1}]
  591.     expr {double($x) == double($y)}
  592. } 1
  593. test execute-7.8 {Wide int conversions can change sign} {longIs32bit} {
  594.     set x 0x80000000
  595.     expr {int($x) < wide($x)}
  596. } 1
  597. test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {
  598.     expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
  599. } 316659348800185
  600. test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {
  601.     expr {((wide(1)<<60)-1) % 0x400000000}
  602. } 17179869183
  603. test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {
  604.     expr wide(42)<<30
  605. } 45097156608
  606. test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {
  607.     expr 12345678901<<3
  608. } 98765431208
  609. test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {
  610.     expr 0x543210febcda9876>>7
  611. } 47397893236700464
  612. test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {
  613.     expr 0x9876543210febcda>>7
  614. } -58286587177206407
  615. test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {
  616.     expr 0x9876543210febcda | 0x543210febcda9876
  617. } -2560765885044310786
  618. test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {
  619.     expr 0x9876543210febcda ^ 0x543210febcda9876
  620. } -3727778945703861076
  621. test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {
  622.     expr 0x9876543210febcda & 0x543210febcda9876
  623. } 1167013060659550290
  624. test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {
  625.     expr wide(0x7fffffff)+wide(0x7fffffff)
  626. } 4294967294
  627. test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {
  628.     expr 0x7fffffff+wide(0x7fffffff)
  629. } 4294967294
  630. test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {
  631.     expr wide(0x7fffffff)+0x7fffffff
  632. } 4294967294
  633. test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {
  634.     expr double(0x7fffffff)+wide(0x7fffffff)
  635. } 4294967294.0
  636. test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {
  637.     expr wide(0x7fffffff)+double(0x7fffffff)
  638. } 4294967294.0
  639. test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {
  640.     expr 0x123456789a-0x20406080a
  641. } 69530054800
  642. test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {
  643.     expr 0x123456789a*193
  644. } 15090186251290
  645. test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {
  646.     expr 0x123456789a/193
  647. } 405116546
  648. test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {
  649.     set x 0x123456871234568
  650.     expr {+ $x}
  651. } 81985533099853160
  652. test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {
  653.     set x 0x123456871234568
  654.     expr {- $x}
  655. } -81985533099853160
  656. test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {
  657.     set x 0x123456871234568
  658.     expr {! $x}
  659. } 0
  660. test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {
  661.     set x 0x123456871234568
  662.     expr {~ $x}
  663. } -81985533099853161
  664. test execute-7.30 {Wide int handling in function call} {longIs32bit} {
  665.     set x 0x12345687123456
  666.     incr x
  667.     expr {log($x) == log(double($x))}
  668. } 1
  669. test execute-7.31 {Wide int handling in abs()} {longIs32bit} {
  670.     set x 0xa23456871234568
  671.     incr x
  672.     set y 0x123456871234568
  673.     concat [expr {abs($x)}] [expr {abs($y)}]
  674. } {730503879441204585 81985533099853160}
  675. test execute-7.32 {Wide int handling} {longIs32bit} {
  676.     expr {1024 * 1024 * 1024 * 1024}
  677. } 0
  678. test execute-7.33 {Wide int handling} {longIs32bit} {
  679.     expr {0x1 * 1024 * 1024 * 1024 * 1024}
  680. } 0
  681. test execute-7.34 {Wide int handling} {longIs32bit} {
  682.     expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
  683. } 1099511627776
  684. test execute-8.1 {Stack protection} -setup {
  685.     # If [Bug #804681] has not been properly
  686.     # taken care of, this should segfault
  687.     proc whatever args {llength $args}
  688.     trace add variable ::errorInfo {write unset} whatever
  689. } -body {
  690.     expr {1+9/0}
  691. } -cleanup {
  692.     trace remove variable ::errorInfo {write unset} whatever
  693.     rename whatever {}
  694. } -returnCodes error -match glob -result *
  695. # cleanup
  696. if {[info commands testobj] != {}} {
  697.    testobj freeallvars
  698. }
  699. catch {eval namespace delete [namespace children :: test_ns_*]}
  700. catch {rename foo ""}
  701. catch {rename p ""}
  702. catch {rename {} ""}
  703. catch {rename { } ""}
  704. catch {unset x}
  705. catch {unset y}
  706. catch {unset msg}
  707. ::tcltest::cleanupTests
  708. return