os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/execute.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/execute.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,741 @@
1.4 +# This file contains tests for the tclExecute.c source file. Tests appear
1.5 +# in the same order as the C code that they test. The set of tests is
1.6 +# currently incomplete since it currently includes only new tests for
1.7 +# code changed for the addition of Tcl namespaces. Other execution-
1.8 +# related tests appear in several other test files including
1.9 +# namespace.test, basic.test, eval.test, for.test, etc.
1.10 +#
1.11 +# Sourcing this file into Tcl runs the tests and generates output for
1.12 +# errors. No output means no errors were found.
1.13 +#
1.14 +# Copyright (c) 1997 Sun Microsystems, Inc.
1.15 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.16 +#
1.17 +# See the file "license.terms" for information on usage and redistribution
1.18 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.19 +#
1.20 +# RCS: @(#) $Id: execute.test,v 1.13.2.2 2004/10/28 00:01:07 dgp Exp $
1.21 +
1.22 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.23 + package require tcltest 2
1.24 + namespace import -force ::tcltest::*
1.25 +}
1.26 +
1.27 +catch {eval namespace delete [namespace children :: test_ns_*]}
1.28 +catch {rename foo ""}
1.29 +catch {unset x}
1.30 +catch {unset y}
1.31 +catch {unset msg}
1.32 +
1.33 +::tcltest::testConstraint testobj \
1.34 + [expr {[info commands testobj] != {} \
1.35 + && [info commands testdoubleobj] != {} \
1.36 + && [info commands teststringobj] != {} \
1.37 + && [info commands testobj] != {}}]
1.38 +
1.39 +::tcltest::testConstraint longIs32bit \
1.40 + [expr {int(0x80000000) < 0}]
1.41 +
1.42 +# Tests for the omnibus TclExecuteByteCode function:
1.43 +
1.44 +# INST_DONE not tested
1.45 +# INST_PUSH1 not tested
1.46 +# INST_PUSH4 not tested
1.47 +# INST_POP not tested
1.48 +# INST_DUP not tested
1.49 +# INST_CONCAT1 not tested
1.50 +# INST_INVOKE_STK4 not tested
1.51 +# INST_INVOKE_STK1 not tested
1.52 +# INST_EVAL_STK not tested
1.53 +# INST_EXPR_STK not tested
1.54 +
1.55 +# INST_LOAD_SCALAR1
1.56 +
1.57 +test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
1.58 + proc foo {} {
1.59 + set x 1
1.60 + return $x
1.61 + }
1.62 + foo
1.63 +} 1
1.64 +test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {
1.65 + # Bug: 2243
1.66 + set body {}
1.67 + for {set i 0} {$i < 129} {incr i} {
1.68 + append body "set x$i x\n"
1.69 + }
1.70 + append body {
1.71 + set y 1
1.72 + return $y
1.73 + }
1.74 +
1.75 + proc foo {} $body
1.76 + foo
1.77 +} 1
1.78 +test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
1.79 + proc foo {} {
1.80 + set x 1
1.81 + unset x
1.82 + return $x
1.83 + }
1.84 + list [catch {foo} msg] $msg
1.85 +} {1 {can't read "x": no such variable}}
1.86 +
1.87 +
1.88 +# INST_LOAD_SCALAR4
1.89 +
1.90 +test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
1.91 + set body {}
1.92 + for {set i 0} {$i < 256} {incr i} {
1.93 + append body "set x$i x\n"
1.94 + }
1.95 + append body {
1.96 + set y 1
1.97 + return $y
1.98 + }
1.99 +
1.100 + proc foo {} $body
1.101 + foo
1.102 +} 1
1.103 +test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {
1.104 + set body {}
1.105 + for {set i 0} {$i < 256} {incr i} {
1.106 + append body "set x$i x\n"
1.107 + }
1.108 + append body {
1.109 + set y 1
1.110 + unset y
1.111 + return $y
1.112 + }
1.113 +
1.114 + proc foo {} $body
1.115 + list [catch {foo} msg] $msg
1.116 +} {1 {can't read "y": no such variable}}
1.117 +
1.118 +
1.119 +# INST_LOAD_SCALAR_STK not tested
1.120 +# INST_LOAD_ARRAY4 not tested
1.121 +# INST_LOAD_ARRAY1 not tested
1.122 +# INST_LOAD_ARRAY_STK not tested
1.123 +# INST_LOAD_STK not tested
1.124 +# INST_STORE_SCALAR4 not tested
1.125 +# INST_STORE_SCALAR1 not tested
1.126 +# INST_STORE_SCALAR_STK not tested
1.127 +# INST_STORE_ARRAY4 not tested
1.128 +# INST_STORE_ARRAY1 not tested
1.129 +# INST_STORE_ARRAY_STK not tested
1.130 +# INST_STORE_STK not tested
1.131 +# INST_INCR_SCALAR1 not tested
1.132 +# INST_INCR_SCALAR_STK not tested
1.133 +# INST_INCR_STK not tested
1.134 +# INST_INCR_ARRAY1 not tested
1.135 +# INST_INCR_ARRAY_STK not tested
1.136 +# INST_INCR_SCALAR1_IMM not tested
1.137 +# INST_INCR_SCALAR_STK_IMM not tested
1.138 +# INST_INCR_STK_IMM not tested
1.139 +# INST_INCR_ARRAY1_IMM not tested
1.140 +# INST_INCR_ARRAY_STK_IMM not tested
1.141 +# INST_JUMP1 not tested
1.142 +# INST_JUMP4 not tested
1.143 +# INST_JUMP_TRUE4 not tested
1.144 +# INST_JUMP_TRUE1 not tested
1.145 +# INST_JUMP_FALSE4 not tested
1.146 +# INST_JUMP_FALSE1 not tested
1.147 +# INST_LOR not tested
1.148 +# INST_LAND not tested
1.149 +# INST_EQ not tested
1.150 +# INST_NEQ not tested
1.151 +# INST_LT not tested
1.152 +# INST_GT not tested
1.153 +# INST_LE not tested
1.154 +# INST_GE not tested
1.155 +# INST_MOD not tested
1.156 +# INST_LSHIFT not tested
1.157 +# INST_RSHIFT not tested
1.158 +# INST_BITOR not tested
1.159 +# INST_BITXOR not tested
1.160 +# INST_BITAND not tested
1.161 +
1.162 +# INST_ADD is partially tested:
1.163 +test execute-3.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {
1.164 + set x [testintobj set 0 1]
1.165 + expr {$x + 1}
1.166 +} 2
1.167 +test execute-3.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {
1.168 + set x [testdoubleobj set 0 1]
1.169 + expr {$x + 1}
1.170 +} 2.0
1.171 +test execute-3.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} {
1.172 + set x [testintobj set 0 1]
1.173 + testobj convert 0 double
1.174 + expr {$x + 1}
1.175 +} 2
1.176 +test execute-3.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {
1.177 + set x [teststringobj set 0 1]
1.178 + expr {$x + 1}
1.179 +} 2
1.180 +test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
1.181 + set x [teststringobj set 0 1.0]
1.182 + expr {$x + 1}
1.183 +} 2.0
1.184 +test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
1.185 + set x [teststringobj set 0 foo]
1.186 + list [catch {expr {$x + 1}} msg] $msg
1.187 +} {1 {can't use non-numeric string as operand of "+"}}
1.188 +test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
1.189 + set x [testintobj set 0 1]
1.190 + expr {1 + $x}
1.191 +} 2
1.192 +test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
1.193 + set x [testdoubleobj set 0 1]
1.194 + expr {1 + $x}
1.195 +} 2.0
1.196 +test execute-3.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} {
1.197 + set x [testintobj set 0 1]
1.198 + testobj convert 0 double
1.199 + expr {1 + $x}
1.200 +} 2
1.201 +test execute-3.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {
1.202 + set x [teststringobj set 0 1]
1.203 + expr {1 + $x}
1.204 +} 2
1.205 +test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
1.206 + set x [teststringobj set 0 1.0]
1.207 + expr {1 + $x}
1.208 +} 2.0
1.209 +test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
1.210 + set x [teststringobj set 0 foo]
1.211 + list [catch {expr {1 + $x}} msg] $msg
1.212 +} {1 {can't use non-numeric string as operand of "+"}}
1.213 +
1.214 +# INST_SUB is partially tested:
1.215 +test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
1.216 + set x [testintobj set 0 1]
1.217 + expr {$x - 1}
1.218 +} 0
1.219 +test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
1.220 + set x [testdoubleobj set 0 1]
1.221 + expr {$x - 1}
1.222 +} 0.0
1.223 +test execute-3.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} {
1.224 + set x [testintobj set 0 1]
1.225 + testobj convert 0 double
1.226 + expr {$x - 1}
1.227 +} 0
1.228 +test execute-3.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {
1.229 + set x [teststringobj set 0 1]
1.230 + expr {$x - 1}
1.231 +} 0
1.232 +test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
1.233 + set x [teststringobj set 0 1.0]
1.234 + expr {$x - 1}
1.235 +} 0.0
1.236 +test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
1.237 + set x [teststringobj set 0 foo]
1.238 + list [catch {expr {$x - 1}} msg] $msg
1.239 +} {1 {can't use non-numeric string as operand of "-"}}
1.240 +test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
1.241 + set x [testintobj set 0 1]
1.242 + expr {1 - $x}
1.243 +} 0
1.244 +test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
1.245 + set x [testdoubleobj set 0 1]
1.246 + expr {1 - $x}
1.247 +} 0.0
1.248 +test execute-3.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} {
1.249 + set x [testintobj set 0 1]
1.250 + testobj convert 0 double
1.251 + expr {1 - $x}
1.252 +} 0
1.253 +test execute-3.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {
1.254 + set x [teststringobj set 0 1]
1.255 + expr {1 - $x}
1.256 +} 0
1.257 +test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
1.258 + set x [teststringobj set 0 1.0]
1.259 + expr {1 - $x}
1.260 +} 0.0
1.261 +test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
1.262 + set x [teststringobj set 0 foo]
1.263 + list [catch {expr {1 - $x}} msg] $msg
1.264 +} {1 {can't use non-numeric string as operand of "-"}}
1.265 +
1.266 +# INST_MULT is partially tested:
1.267 +test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
1.268 + set x [testintobj set 1 1]
1.269 + expr {$x * 1}
1.270 +} 1
1.271 +test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
1.272 + set x [testdoubleobj set 1 2.0]
1.273 + expr {$x * 1}
1.274 +} 2.0
1.275 +test execute-3.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} {
1.276 + set x [testintobj set 1 2]
1.277 + testobj convert 1 double
1.278 + expr {$x * 1}
1.279 +} 2
1.280 +test execute-3.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {
1.281 + set x [teststringobj set 1 1]
1.282 + expr {$x * 1}
1.283 +} 1
1.284 +test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
1.285 + set x [teststringobj set 1 1.0]
1.286 + expr {$x * 1}
1.287 +} 1.0
1.288 +test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
1.289 + set x [teststringobj set 1 foo]
1.290 + list [catch {expr {$x * 1}} msg] $msg
1.291 +} {1 {can't use non-numeric string as operand of "*"}}
1.292 +test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
1.293 + set x [testintobj set 1 1]
1.294 + expr {1 * $x}
1.295 +} 1
1.296 +test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
1.297 + set x [testdoubleobj set 1 2.0]
1.298 + expr {1 * $x}
1.299 +} 2.0
1.300 +test execute-3.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} {
1.301 + set x [testintobj set 1 2]
1.302 + testobj convert 1 double
1.303 + expr {1 * $x}
1.304 +} 2
1.305 +test execute-3.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {
1.306 + set x [teststringobj set 1 1]
1.307 + expr {1 * $x}
1.308 +} 1
1.309 +test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
1.310 + set x [teststringobj set 1 1.0]
1.311 + expr {1 * $x}
1.312 +} 1.0
1.313 +test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
1.314 + set x [teststringobj set 1 foo]
1.315 + list [catch {expr {1 * $x}} msg] $msg
1.316 +} {1 {can't use non-numeric string as operand of "*"}}
1.317 +
1.318 +# INST_DIV is partially tested:
1.319 +test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
1.320 + set x [testintobj set 1 1]
1.321 + expr {$x / 1}
1.322 +} 1
1.323 +test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
1.324 + set x [testdoubleobj set 1 2.0]
1.325 + expr {$x / 1}
1.326 +} 2.0
1.327 +test execute-3.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} {
1.328 + set x [testintobj set 1 2]
1.329 + testobj convert 1 double
1.330 + expr {$x / 1}
1.331 +} 2
1.332 +test execute-3.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {
1.333 + set x [teststringobj set 1 1]
1.334 + expr {$x / 1}
1.335 +} 1
1.336 +test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
1.337 + set x [teststringobj set 1 1.0]
1.338 + expr {$x / 1}
1.339 +} 1.0
1.340 +test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
1.341 + set x [teststringobj set 1 foo]
1.342 + list [catch {expr {$x / 1}} msg] $msg
1.343 +} {1 {can't use non-numeric string as operand of "/"}}
1.344 +test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
1.345 + set x [testintobj set 1 1]
1.346 + expr {2 / $x}
1.347 +} 2
1.348 +test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
1.349 + set x [testdoubleobj set 1 1.0]
1.350 + expr {2 / $x}
1.351 +} 2.0
1.352 +test execute-3.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} {
1.353 + set x [testintobj set 1 1]
1.354 + testobj convert 1 double
1.355 + expr {2 / $x}
1.356 +} 2
1.357 +test execute-3.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {
1.358 + set x [teststringobj set 1 1]
1.359 + expr {2 / $x}
1.360 +} 2
1.361 +test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
1.362 + set x [teststringobj set 1 1.0]
1.363 + expr {2 / $x}
1.364 +} 2.0
1.365 +test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
1.366 + set x [teststringobj set 1 foo]
1.367 + list [catch {expr {1 / $x}} msg] $msg
1.368 +} {1 {can't use non-numeric string as operand of "/"}}
1.369 +
1.370 +# INST_UPLUS is partially tested:
1.371 +test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
1.372 + set x [testintobj set 1 1]
1.373 + expr {+ $x}
1.374 +} 1
1.375 +test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
1.376 + set x [testdoubleobj set 1 1.0]
1.377 + expr {+ $x}
1.378 +} 1.0
1.379 +test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} {
1.380 + set x [testintobj set 1 1]
1.381 + testobj convert 1 double
1.382 + expr {+ $x}
1.383 +} 1
1.384 +test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
1.385 + set x [teststringobj set 1 1]
1.386 + expr {+ $x}
1.387 +} 1
1.388 +test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
1.389 + set x [teststringobj set 1 1.0]
1.390 + expr {+ $x}
1.391 +} 1.0
1.392 +test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
1.393 + set x [teststringobj set 1 foo]
1.394 + list [catch {expr {+ $x}} msg] $msg
1.395 +} {1 {can't use non-numeric string as operand of "+"}}
1.396 +
1.397 +# INST_UMINUS is partially tested:
1.398 +test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
1.399 + set x [testintobj set 1 1]
1.400 + expr {- $x}
1.401 +} -1
1.402 +test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
1.403 + set x [testdoubleobj set 1 1.0]
1.404 + expr {- $x}
1.405 +} -1.0
1.406 +test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} {
1.407 + set x [testintobj set 1 1]
1.408 + testobj convert 1 double
1.409 + expr {- $x}
1.410 +} -1
1.411 +test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
1.412 + set x [teststringobj set 1 1]
1.413 + expr {- $x}
1.414 +} -1
1.415 +test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
1.416 + set x [teststringobj set 1 1.0]
1.417 + expr {- $x}
1.418 +} -1.0
1.419 +test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
1.420 + set x [teststringobj set 1 foo]
1.421 + list [catch {expr {- $x}} msg] $msg
1.422 +} {1 {can't use non-numeric string as operand of "-"}}
1.423 +
1.424 +# INST_LNOT is partially tested:
1.425 +test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
1.426 + set x [testintobj set 1 2]
1.427 + expr {! $x}
1.428 +} 0
1.429 +test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
1.430 + set x [testintobj set 1 0]
1.431 + expr {! $x}
1.432 +} 1
1.433 +test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
1.434 + set x [testdoubleobj set 1 1.0]
1.435 + expr {! $x}
1.436 +} 0
1.437 +test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
1.438 + set x [testdoubleobj set 1 0.0]
1.439 + expr {! $x}
1.440 +} 1
1.441 +test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
1.442 + set x [testintobj set 1 1]
1.443 + testobj convert 1 double
1.444 + expr {! $x}
1.445 +} 0
1.446 +test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
1.447 + set x [testintobj set 1 0]
1.448 + testobj convert 1 double
1.449 + expr {! $x}
1.450 +} 1
1.451 +test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
1.452 + set x [teststringobj set 1 1]
1.453 + expr {! $x}
1.454 +} 0
1.455 +test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
1.456 + set x [teststringobj set 1 0]
1.457 + expr {! $x}
1.458 +} 1
1.459 +test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
1.460 + set x [teststringobj set 1 1.0]
1.461 + expr {! $x}
1.462 +} 0
1.463 +test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
1.464 + set x [teststringobj set 1 0.0]
1.465 + expr {! $x}
1.466 +} 1
1.467 +test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
1.468 + set x [teststringobj set 1 foo]
1.469 + list [catch {expr {! $x}} msg] $msg
1.470 +} {1 {can't use non-numeric string as operand of "!"}}
1.471 +
1.472 +# INST_BITNOT not tested
1.473 +# INST_CALL_BUILTIN_FUNC1 not tested
1.474 +# INST_CALL_FUNC1 not tested
1.475 +
1.476 +# INST_TRY_CVT_TO_NUMERIC is partially tested:
1.477 +test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
1.478 + set x [testintobj set 1 1]
1.479 + expr {$x}
1.480 +} 1
1.481 +test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
1.482 + set x [testdoubleobj set 1 1.0]
1.483 + expr {$x}
1.484 +} 1.0
1.485 +test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} {
1.486 + set x [testintobj set 1 1]
1.487 + testobj convert 1 double
1.488 + expr {$x}
1.489 +} 1
1.490 +test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
1.491 + set x [teststringobj set 1 1]
1.492 + expr {$x}
1.493 +} 1
1.494 +test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} {
1.495 + set x [teststringobj set 1 1.0]
1.496 + expr {$x}
1.497 +} 1.0
1.498 +test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} {
1.499 + set x [teststringobj set 1 foo]
1.500 + expr {$x}
1.501 +} foo
1.502 +
1.503 +# INST_BREAK not tested
1.504 +# INST_CONTINUE not tested
1.505 +# INST_FOREACH_START4 not tested
1.506 +# INST_FOREACH_STEP4 not tested
1.507 +# INST_BEGIN_CATCH4 not tested
1.508 +# INST_END_CATCH not tested
1.509 +# INST_PUSH_RESULT not tested
1.510 +# INST_PUSH_RETURN_CODE not tested
1.511 +
1.512 +test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
1.513 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.514 + catch {unset x}
1.515 + catch {unset y}
1.516 + namespace eval test_ns_1 {
1.517 + namespace export cmd1
1.518 + proc cmd1 {args} {return "cmd1: $args"}
1.519 + proc cmd2 {args} {return "cmd2: $args"}
1.520 + }
1.521 + namespace eval test_ns_1::test_ns_2 {
1.522 + namespace import ::test_ns_1::*
1.523 + }
1.524 + set x "test_ns_1::"
1.525 + set y "test_ns_2::"
1.526 + list [namespace which -command ${x}${y}cmd1] \
1.527 + [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
1.528 + [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
1.529 +} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
1.530 +test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
1.531 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.532 + catch {rename foo ""}
1.533 + catch {unset l}
1.534 + proc foo {} {
1.535 + return "global foo"
1.536 + }
1.537 + namespace eval test_ns_1 {
1.538 + proc whichFoo {} {
1.539 + return [namespace which -command foo]
1.540 + }
1.541 + }
1.542 + set l ""
1.543 + lappend l [test_ns_1::whichFoo]
1.544 + namespace eval test_ns_1 {
1.545 + proc foo {} {
1.546 + return "namespace foo"
1.547 + }
1.548 + }
1.549 + lappend l [test_ns_1::whichFoo]
1.550 + set l
1.551 +} {::foo ::test_ns_1::foo}
1.552 +test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
1.553 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.554 + catch {rename foo ""}
1.555 + namespace eval test_ns_1 {
1.556 + proc foo {} {
1.557 + return "namespace foo"
1.558 + }
1.559 + }
1.560 + namespace eval test_ns_1 {
1.561 + proc foo {} {
1.562 + return "namespace foo"
1.563 + }
1.564 + }
1.565 + list [namespace eval test_ns_1 {namespace which -command foo}] \
1.566 + [rename test_ns_1::foo ""] \
1.567 + [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
1.568 +} {::test_ns_1::foo {} 0 {}}
1.569 +
1.570 +test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
1.571 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.572 + catch {unset l}
1.573 + proc {} {} {return {}}
1.574 + {}
1.575 + set l {}
1.576 + lindex {} 0
1.577 + {}
1.578 +} {}
1.579 +
1.580 +test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
1.581 + proc {} {} {}
1.582 + proc { } {} {}
1.583 + proc p {} {
1.584 + set x {}
1.585 + $x
1.586 + append x { }
1.587 + $x
1.588 + }
1.589 + p
1.590 +} {}
1.591 +
1.592 +test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {
1.593 + set w {3*5}
1.594 + proc a {obj} {expr $obj}
1.595 + set res "[a $w]:[a $w]"
1.596 +} {15:15}
1.597 +
1.598 +test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
1.599 + set x 0x100000000
1.600 + expr {$x && 1}
1.601 +} 1
1.602 +test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
1.603 + expr {0x100000000 && 1}
1.604 +} 1
1.605 +test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
1.606 + expr {1 && 0x100000000}
1.607 +} 1
1.608 +test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
1.609 + expr {wide(0x100000000) && 1}
1.610 +} 1
1.611 +test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
1.612 + expr {1 && wide(0x100000000)}
1.613 +} 1
1.614 +test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {
1.615 + expr {4 == (wide(1)+wide(3))}
1.616 +} 1
1.617 +test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
1.618 + set x 399999999999
1.619 + expr {400000000000 == [incr x]}
1.620 +} 1
1.621 +# wide ints have more bits of precision than doubles, but we convert anyway
1.622 +test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
1.623 + set x [expr {wide(1)<<62}]
1.624 + set y [expr {$x+1}]
1.625 + expr {double($x) == double($y)}
1.626 +} 1
1.627 +test execute-7.8 {Wide int conversions can change sign} {longIs32bit} {
1.628 + set x 0x80000000
1.629 + expr {int($x) < wide($x)}
1.630 +} 1
1.631 +test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {
1.632 + expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
1.633 +} 316659348800185
1.634 +test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {
1.635 + expr {((wide(1)<<60)-1) % 0x400000000}
1.636 +} 17179869183
1.637 +test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {
1.638 + expr wide(42)<<30
1.639 +} 45097156608
1.640 +test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {
1.641 + expr 12345678901<<3
1.642 +} 98765431208
1.643 +test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {
1.644 + expr 0x543210febcda9876>>7
1.645 +} 47397893236700464
1.646 +test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {
1.647 + expr 0x9876543210febcda>>7
1.648 +} -58286587177206407
1.649 +test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {
1.650 + expr 0x9876543210febcda | 0x543210febcda9876
1.651 +} -2560765885044310786
1.652 +test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {
1.653 + expr 0x9876543210febcda ^ 0x543210febcda9876
1.654 +} -3727778945703861076
1.655 +test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {
1.656 + expr 0x9876543210febcda & 0x543210febcda9876
1.657 +} 1167013060659550290
1.658 +test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {
1.659 + expr wide(0x7fffffff)+wide(0x7fffffff)
1.660 +} 4294967294
1.661 +test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {
1.662 + expr 0x7fffffff+wide(0x7fffffff)
1.663 +} 4294967294
1.664 +test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {
1.665 + expr wide(0x7fffffff)+0x7fffffff
1.666 +} 4294967294
1.667 +test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {
1.668 + expr double(0x7fffffff)+wide(0x7fffffff)
1.669 +} 4294967294.0
1.670 +test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {
1.671 + expr wide(0x7fffffff)+double(0x7fffffff)
1.672 +} 4294967294.0
1.673 +test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {
1.674 + expr 0x123456789a-0x20406080a
1.675 +} 69530054800
1.676 +test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {
1.677 + expr 0x123456789a*193
1.678 +} 15090186251290
1.679 +test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {
1.680 + expr 0x123456789a/193
1.681 +} 405116546
1.682 +test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {
1.683 + set x 0x123456871234568
1.684 + expr {+ $x}
1.685 +} 81985533099853160
1.686 +test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {
1.687 + set x 0x123456871234568
1.688 + expr {- $x}
1.689 +} -81985533099853160
1.690 +test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {
1.691 + set x 0x123456871234568
1.692 + expr {! $x}
1.693 +} 0
1.694 +test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {
1.695 + set x 0x123456871234568
1.696 + expr {~ $x}
1.697 +} -81985533099853161
1.698 +test execute-7.30 {Wide int handling in function call} {longIs32bit} {
1.699 + set x 0x12345687123456
1.700 + incr x
1.701 + expr {log($x) == log(double($x))}
1.702 +} 1
1.703 +test execute-7.31 {Wide int handling in abs()} {longIs32bit} {
1.704 + set x 0xa23456871234568
1.705 + incr x
1.706 + set y 0x123456871234568
1.707 + concat [expr {abs($x)}] [expr {abs($y)}]
1.708 +} {730503879441204585 81985533099853160}
1.709 +test execute-7.32 {Wide int handling} {longIs32bit} {
1.710 + expr {1024 * 1024 * 1024 * 1024}
1.711 +} 0
1.712 +test execute-7.33 {Wide int handling} {longIs32bit} {
1.713 + expr {0x1 * 1024 * 1024 * 1024 * 1024}
1.714 +} 0
1.715 +test execute-7.34 {Wide int handling} {longIs32bit} {
1.716 + expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
1.717 +} 1099511627776
1.718 +
1.719 +test execute-8.1 {Stack protection} -setup {
1.720 + # If [Bug #804681] has not been properly
1.721 + # taken care of, this should segfault
1.722 + proc whatever args {llength $args}
1.723 + trace add variable ::errorInfo {write unset} whatever
1.724 +} -body {
1.725 + expr {1+9/0}
1.726 +} -cleanup {
1.727 + trace remove variable ::errorInfo {write unset} whatever
1.728 + rename whatever {}
1.729 +} -returnCodes error -match glob -result *
1.730 +
1.731 +# cleanup
1.732 +if {[info commands testobj] != {}} {
1.733 + testobj freeallvars
1.734 +}
1.735 +catch {eval namespace delete [namespace children :: test_ns_*]}
1.736 +catch {rename foo ""}
1.737 +catch {rename p ""}
1.738 +catch {rename {} ""}
1.739 +catch {rename { } ""}
1.740 +catch {unset x}
1.741 +catch {unset y}
1.742 +catch {unset msg}
1.743 +::tcltest::cleanupTests
1.744 +return