Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | * tests/execute.test: * generic/tclExecute.c (TclExecuteByteCode): Fixed expression code that incorrectly returned floating point values for integers if the internal rep happened to be a double. Now we check to see if the object has a string rep that looks like an integer before using the double internal rep. [Bug: 1516] |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
| Files: | files | file ages | folders |
| SHA1: |
d1a8033603cbcf4675f0b9331fc90c97 |
| User & Date: | stanton 1999-03-25 03:55:31 |
Context
|
1999-03-25
| ||
| 04:32 | Fixed bugs 1521, 1578, 1608--tests were failing due to bad test construction and failure to use cons... check-in: b21b173086 user: hershey tags: core-8-1-branch-old | |
| 03:55 | * tests/execute.test: * generic/tclExecute.c (TclExecuteByteCode): Fixed expression code that incorr... check-in: d1a8033603 user: stanton tags: core-8-1-branch-old | |
| 01:34 | Minor adjustment. check-in: 655b052ea2 user: rjohnson tags: core-8-1-branch-old | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 |
1999-03-24 <[email protected]> * generic/tclAlloc.c: * generic/tclEncoding.c: * generic/tclProc.c: * unix/tclUnixTime.c: * win/tclWinSerial.c: Fixed compilation warnings/errors for VC++ |
> > > > > > > > > |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
1999-03-24 <[email protected]> * tests/execute.test: * generic/tclExecute.c (TclExecuteByteCode): Fixed expression code that incorrectly returned floating point values for integers if the internal rep happened to be a double. Now we check to see if the object has a string rep that looks like an integer before using the double internal rep. [Bug: 1516] 1999-03-24 <[email protected]> * generic/tclAlloc.c: * generic/tclEncoding.c: * generic/tclProc.c: * unix/tclUnixTime.c: * win/tclWinSerial.c: Fixed compilation warnings/errors for VC++ |
Changes to generic/tclExecute.c.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 .... 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 .... 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 .... 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 .... 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 |
* commands. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclExecute.c,v 1.1.2.9 1999/02/10 23:31:16 stanton Exp $ */ #include "tclInt.h" #include "tclCompile.h" #ifdef NO_FLOAT_H # include "../compat/float.h" ................................................................................ value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; if (t1Ptr == &tclIntType) { i = valuePtr->internalRep.longValue; } else if (t1Ptr == &tclDoubleType) { d1 = valuePtr->internalRep.doubleValue; } else { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1); } if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", s, O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); Tcl_DecrRefCount(valuePtr); Tcl_DecrRefCount(value2Ptr); goto checkForCatch; } t1Ptr = valuePtr->typePtr; } if (t2Ptr == &tclIntType) { i2 = value2Ptr->internalRep.longValue; } else if (t2Ptr == &tclDoubleType) { d2 = value2Ptr->internalRep.doubleValue; } else { char *s = Tcl_GetStringFromObj(value2Ptr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2); } if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), s, (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, value2Ptr); Tcl_DecrRefCount(valuePtr); Tcl_DecrRefCount(value2Ptr); goto checkForCatch; } ................................................................................ */ double d; Tcl_ObjType *tPtr; valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); ................................................................................ */ double d; Tcl_ObjType *tPtr; valuePtr = POP_OBJECT(); tPtr = valuePtr->typePtr; if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); ................................................................................ char *s; Tcl_ObjType *tPtr; int converted, shared; valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; converted = 0; if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) { s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); |
| | > > > > > > > | | > > > > > > > | | > | > | > |
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 .... 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 .... 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 .... 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 .... 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 |
* commands. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclExecute.c,v 1.1.2.10 1999/03/25 03:55:31 stanton Exp $ */ #include "tclInt.h" #include "tclCompile.h" #ifdef NO_FLOAT_H # include "../compat/float.h" ................................................................................ value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; if (t1Ptr == &tclIntType) { i = valuePtr->internalRep.longValue; } else if ((t1Ptr == &tclDoubleType) && (valuePtr->bytes == NULL)) { /* * We can only use the internal rep directly if there is * no string rep. Otherwise the string rep might actually * look like an integer, which is preferred. */ d1 = valuePtr->internalRep.doubleValue; } else { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1); } if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", s, O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); Tcl_DecrRefCount(valuePtr); Tcl_DecrRefCount(value2Ptr); goto checkForCatch; } t1Ptr = valuePtr->typePtr; } if (t2Ptr == &tclIntType) { i2 = value2Ptr->internalRep.longValue; } else if ((t2Ptr == &tclDoubleType) && (value2Ptr->bytes == NULL)) { /* * We can only use the internal rep directly if there is * no string rep. Otherwise the string rep might actually * look like an integer, which is preferred. */ d2 = value2Ptr->internalRep.doubleValue; } else { char *s = Tcl_GetStringFromObj(value2Ptr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2); } if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(value2Ptr), s, (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, value2Ptr); Tcl_DecrRefCount(valuePtr); Tcl_DecrRefCount(value2Ptr); goto checkForCatch; } ................................................................................ */ double d; Tcl_ObjType *tPtr; valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); ................................................................................ */ double d; Tcl_ObjType *tPtr; valuePtr = POP_OBJECT(); tPtr = valuePtr->typePtr; if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); ................................................................................ char *s; Tcl_ObjType *tPtr; int converted, shared; valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; converted = 0; if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); |
Changes to tests/execute.test.
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 .. 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 .. 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 .. 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 ... 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 |
# # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: execute.test,v 1.1.2.5 1999/03/24 02:49:07 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} catch {unset x} catch {unset y} catch {unset msg} test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {unset x} catch {unset y} namespace eval test_ns_1 { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} ................................................................................ } set x "test_ns_1::" set y "test_ns_2::" list [namespace which -command ${x}${y}cmd1] \ [catch {namespace which -command ${x}${y}cmd2} msg] $msg \ [catch {namespace which -command ${x}${y}:cmd2} msg] $msg } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}} test execute-1.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} catch {unset l} proc foo {} { return "global foo" } namespace eval test_ns_1 { ................................................................................ proc foo {} { return "namespace foo" } } lappend l [test_ns_1::whichFoo] set l } {::foo ::test_ns_1::foo} test execute-1.3 {Tcl_GetCommandFromObj, command never found} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} namespace eval test_ns_1 { proc foo {} { return "namespace foo" } } ................................................................................ } } list [namespace eval test_ns_1 {namespace which -command foo}] \ [rename test_ns_1::foo ""] \ [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg } {::test_ns_1::foo {} 0 {}} test execute-2.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {unset l} proc {} {} {return {}} {} set l {} lindex {} 0 {} } {} test execute-3.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} { proc {} {} {} proc { } {} {} proc p {} { set x {} $x append x { } $x ................................................................................ catch {rename {} ""} catch {rename { } ""} catch {unset x} catch {unset y} catch {unset msg} ::tcltest::cleanupTests return |
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | > > > > |
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 ... 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 ... 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 ... 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 ... 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 |
# # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: execute.test,v 1.1.2.6 1999/03/25 03:55:33 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} catch {unset x} catch {unset y} catch {unset msg} set ::tcltest::testConfig(testobj) \ [expr {[info commands testobj] != {} \ && [info commands testdoubleobj] != {} \ && [info commands teststringobj] != {} \ && [info commands testobj] != {}}] # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested # INST_PUSH1 not tested # INST_PUSH4 not tested # INST_POP not tested # INST_DUP not tested # INST_CONCAT1 not tested # INST_INVOKE_STK4 not tested # INST_INVOKE_STK1 not tested # INST_EVAL_STK not tested # INST_EXPR_STK not tested # INST_LOAD_SCALAR1 not tested # INST_LOAD_SCALAR4 not tested # INST_LOAD_SCALAR_STK not tested # INST_LOAD_ARRAY4 not tested # INST_LOAD_ARRAY1 not tested # INST_LOAD_ARRAY_STK not tested # INST_LOAD_STK not tested # INST_STORE_SCALAR4 not tested # INST_STORE_SCALAR1 not tested # INST_STORE_SCALAR_STK not tested # INST_STORE_ARRAY4 not tested # INST_STORE_ARRAY1 not tested # INST_STORE_ARRAY_STK not tested # INST_STORE_STK not tested # INST_INCR_SCALAR1 not tested # INST_INCR_SCALAR_STK not tested # INST_INCR_STK not tested # INST_INCR_ARRAY1 not tested # INST_INCR_ARRAY_STK not tested # INST_INCR_SCALAR1_IMM not tested # INST_INCR_SCALAR_STK_IMM not tested # INST_INCR_STK_IMM not tested # INST_INCR_ARRAY1_IMM not tested # INST_INCR_ARRAY_STK_IMM not tested # INST_JUMP1 not tested # INST_JUMP4 not tested # INST_JUMP_TRUE4 not tested # INST_JUMP_TRUE1 not tested # INST_JUMP_FALSE4 not tested # INST_JUMP_FALSE1 not tested # INST_LOR not tested # INST_LAND not tested # INST_EQ not tested # INST_NEQ not tested # INST_LT not tested # INST_GT not tested # INST_LE not tested # INST_GE not tested # INST_MOD not tested # INST_LSHIFT not tested # INST_RSHIFT not tested # INST_BITOR not tested # INST_BITXOR not tested # INST_BITAND not tested # INST_ADD is partially tested: test execute-1.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} { set x [testintobj set 0 1] expr {$x + 1} } 2 test execute-1.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} { set x [testdoubleobj set 0 1] expr {$x + 1} } 2.0 test execute-1.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {$x + 1} } 2 test execute-1.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} { set x [teststringobj set 0 1] expr {$x + 1} } 2 test execute-1.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {$x + 1} } 2.0 test execute-1.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} test execute-1.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} } 2 test execute-1.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} { set x [testdoubleobj set 0 1] expr {1 + $x} } 2.0 test execute-1.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {1 + $x} } 2 test execute-1.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} { set x [teststringobj set 0 1] expr {1 + $x} } 2 test execute-1.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {1 + $x} } 2.0 test execute-1.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} # INST_SUB is partially tested: test execute-1.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { set x [testintobj set 0 1] expr {$x - 1} } 0 test execute-1.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} { set x [testdoubleobj set 0 1] expr {$x - 1} } 0.0 test execute-1.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {$x - 1} } 0 test execute-1.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} { set x [teststringobj set 0 1] expr {$x - 1} } 0 test execute-1.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {$x - 1} } 0.0 test execute-1.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} test execute-1.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} } 0 test execute-1.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} { set x [testdoubleobj set 0 1] expr {1 - $x} } 0.0 test execute-1.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} { set x [testintobj set 0 1] testobj convert 0 double expr {1 - $x} } 0 test execute-1.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} { set x [teststringobj set 0 1] expr {1 - $x} } 0 test execute-1.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {1 - $x} } 0.0 test execute-1.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} # INST_MULT is partially tested: test execute-1.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { set x [testintobj set 1 1] expr {$x * 1} } 1 test execute-1.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} { set x [testdoubleobj set 1 2.0] expr {$x * 1} } 2.0 test execute-1.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} { set x [testintobj set 1 2] testobj convert 1 double expr {$x * 1} } 2 test execute-1.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} { set x [teststringobj set 1 1] expr {$x * 1} } 1 test execute-1.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x * 1} } 1.0 test execute-1.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} test execute-1.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} } 1 test execute-1.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} { set x [testdoubleobj set 1 2.0] expr {1 * $x} } 2.0 test execute-1.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} { set x [testintobj set 1 2] testobj convert 1 double expr {1 * $x} } 2 test execute-1.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} { set x [teststringobj set 1 1] expr {1 * $x} } 1 test execute-1.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {1 * $x} } 1.0 test execute-1.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg } {1 {can't use non-numeric string as operand of "*"}} # INST_DIV is partially tested: test execute-1.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { set x [testintobj set 1 1] expr {$x / 1} } 1 test execute-1.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} { set x [testdoubleobj set 1 2.0] expr {$x / 1} } 2.0 test execute-1.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} { set x [testintobj set 1 2] testobj convert 1 double expr {$x / 1} } 2 test execute-1.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} { set x [teststringobj set 1 1] expr {$x / 1} } 1 test execute-1.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x / 1} } 1.0 test execute-1.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} test execute-1.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} } 2 test execute-1.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {2 / $x} } 2.0 test execute-1.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {2 / $x} } 2 test execute-1.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} { set x [teststringobj set 1 1] expr {2 / $x} } 2 test execute-1.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {2 / $x} } 2.0 test execute-1.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg } {1 {can't use non-numeric string as operand of "/"}} # INST_UPLUS is partially tested: test execute-1.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { set x [testintobj set 1 1] expr {+ $x} } 1 test execute-1.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {+ $x} } 1.0 test execute-1.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {+ $x} } 1 test execute-1.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} { set x [teststringobj set 1 1] expr {+ $x} } 1 test execute-1.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {+ $x} } 1.0 test execute-1.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg } {1 {can't use non-numeric string as operand of "+"}} # INST_UMINUS is partially tested: test execute-1.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { set x [testintobj set 1 1] expr {- $x} } -1 test execute-1.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {- $x} } -1.0 test execute-1.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {- $x} } -1 test execute-1.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} { set x [teststringobj set 1 1] expr {- $x} } -1 test execute-1.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {- $x} } -1.0 test execute-1.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg } {1 {can't use non-numeric string as operand of "-"}} # INST_LNOT is partially tested: test execute-1.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { set x [testintobj set 1 2] expr {! $x} } 0 test execute-1.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { set x [testintobj set 1 0] expr {! $x} } 1 test execute-1.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {! $x} } 0 test execute-1.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} { set x [testdoubleobj set 1 0.0] expr {! $x} } 1 test execute-1.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {! $x} } 0 test execute-1.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} { set x [testintobj set 1 0] testobj convert 1 double expr {! $x} } 1 test execute-1.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} { set x [teststringobj set 1 1] expr {! $x} } 0 test execute-1.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} { set x [teststringobj set 1 0] expr {! $x} } 1 test execute-1.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {! $x} } 0 test execute-1.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} { set x [teststringobj set 1 0.0] expr {! $x} } 1 test execute-1.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg } {1 {can't use non-numeric string as operand of "!"}} # INST_BITNOT not tested # INST_CALL_BUILTIN_FUNC1 not tested # INST_CALL_FUNC1 not tested # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-1.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { set x [testintobj set 1 1] expr {$x} } 1 test execute-1.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} { set x [testdoubleobj set 1 1.0] expr {$x} } 1.0 test execute-1.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} { set x [testintobj set 1 1] testobj convert 1 double expr {$x} } 1 test execute-1.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} { set x [teststringobj set 1 1] expr {$x} } 1 test execute-1.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x} } 1.0 test execute-1.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] expr {$x} } foo # INST_BREAK not tested # INST_CONTINUE not tested # INST_FOREACH_START4 not tested # INST_FOREACH_STEP4 not tested # INST_BEGIN_CATCH4 not tested # INST_END_CATCH not tested # INST_PUSH_RESULT not tested # INST_PUSH_RETURN_CODE not tested test execute-2.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {unset x} catch {unset y} namespace eval test_ns_1 { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} proc cmd2 {args} {return "cmd2: $args"} ................................................................................ } set x "test_ns_1::" set y "test_ns_2::" list [namespace which -command ${x}${y}cmd1] \ [catch {namespace which -command ${x}${y}cmd2} msg] $msg \ [catch {namespace which -command ${x}${y}:cmd2} msg] $msg } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}} test execute-2.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} catch {unset l} proc foo {} { return "global foo" } namespace eval test_ns_1 { ................................................................................ proc foo {} { return "namespace foo" } } lappend l [test_ns_1::whichFoo] set l } {::foo ::test_ns_1::foo} test execute-2.3 {Tcl_GetCommandFromObj, command never found} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} namespace eval test_ns_1 { proc foo {} { return "namespace foo" } } ................................................................................ } } list [namespace eval test_ns_1 {namespace which -command foo}] \ [rename test_ns_1::foo ""] \ [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg } {::test_ns_1::foo {} 0 {}} test execute-3.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {unset l} proc {} {} {return {}} {} set l {} lindex {} 0 {} } {} test execute-4.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} { proc {} {} {} proc { } {} {} proc p {} { set x {} $x append x { } $x ................................................................................ catch {rename {} ""} catch {rename { } ""} catch {unset x} catch {unset y} catch {unset msg} ::tcltest::cleanupTests return |