Tcl Source Code

Check-in [e2f55d6060]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:merge fix for [7179c6724cd38271]: compilation of incr command on wide constant offset (no overflow) + test coverage
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: e2f55d60603a87a32c7ee89f9869cc4ce77e3e191b443722d3b97b301d6a4bbe
User & Date: sebres 2024-08-12 13:19:34.621
References
2024-08-31
00:50
Merge [5e8df6f2328b226d]: amend to [e2f55d6060] (fix for [7179c6724cd38271]): wideint-type dependenc... Closed-Leaf check-in: 517cb91ee8 user: pooryorick tags: mistake, INCOMPATIBLE_LICENSE
2024-08-12
16:12
amend to [e2f55d6060] (fix for [7179c6724cd38271]): wideint-type dependency check-in: 5e8df6f232 user: sebres tags: core-8-6-branch
13:39 Closed ticket [7179c6724c]: compilation of incr command is broken on wide constant offset by int overflow plus 8 other changes artifact: a7d60599c7 user: sebres
Context
2024-08-12
16:12
amend to [e2f55d6060] (fix for [7179c6724cd38271]): wideint-type dependency check-in: 5e8df6f232 user: sebres tags: core-8-6-branch
13:28
merge fix for [7179c6724cd38271]: compilation of incr command on wide constant offset (no overflow) ... check-in: cbabbeed51 user: sebres tags: core-8-branch
13:19
merge fix for [7179c6724cd38271]: compilation of incr command on wide constant offset (no overflow) ... check-in: e2f55d6060 user: sebres tags: core-8-6-branch
13:07
fixes [7179c6724cd38271]: compilation of incr command on wide constant offset (no overflow) check-in: 068a8b152e user: sebres tags: core-8-5-branch
2024-08-11
20:37
Update Unicode tables to version 16 (in BETA, Unicode release will be Sept 10) check-in: 34eb2eaf56 user: jan.nijtmans tags: core-8-6-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclCompCmdsGR.c.
503
504
505
506
507
508
509
510
511






512
513

514
515
516
517
518
519
520
	    const char *word = incrTokenPtr[1].start;
	    int numBytes = incrTokenPtr[1].size;
	    int code;
	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);

	    Tcl_IncrRefCount(intObj);
	    code = TclGetIntFromObj(NULL, intObj, &immValue);
	    TclDecrRefCount(intObj);
	    if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {






		haveImmValue = 1;
	    }

	    if (!haveImmValue) {
		PushLiteral(envPtr, word, numBytes);
	    }
	} else {
	    SetLineInformation(2);
	    CompileTokens(envPtr, incrTokenPtr, interp);
	}







|
|
>
>
>
>
>
>


>







503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
	    const char *word = incrTokenPtr[1].start;
	    int numBytes = incrTokenPtr[1].size;
	    int code;
	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);

	    Tcl_IncrRefCount(intObj);
	    code = TclGetIntFromObj(NULL, intObj, &immValue);
	    if ( (code == TCL_OK)
	      && (-127 <= immValue) && (immValue <= 127)
	      /* avoid overflow during string to int conversion (wide 0xFFFFFFFF to signed int -1): */
	      && ( (immValue >= 0)
	        || (intObj->typePtr != &tclWideIntType)
	        || ((-127 <= intObj->internalRep.wideValue) && (intObj->internalRep.wideValue <= 127))
	      )
	    ) {
		haveImmValue = 1;
	    }
	    TclDecrRefCount(intObj);
	    if (!haveImmValue) {
		PushLiteral(envPtr, word, numBytes);
	    }
	} else {
	    SetLineInformation(2);
	    CompileTokens(envPtr, incrTokenPtr, interp);
	}
Changes to tests/incr.test.
231
232
233
234
235
236
237
























































238
239
240
241
242
243
244
} -returnCodes error -result {expected integer but got "  -  "}
test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
    catch {unset array}
} -body {
    set array(\$foo) 4
    incr {array($foo)}
} -result 5

























































# Check "incr" and computed command names.

unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
    set i 5
    set z incr







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
} -returnCodes error -result {expected integer but got "  -  "}
test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
    catch {unset array}
} -body {
    set array(\$foo) 4
    incr {array($foo)}
} -result 5

test incr-1.31 {no overflow in TclCompileIncrCmd and Tcl_IncrObjCmd, bug [7179c6724cd38271]} {
    # TclCompileIncrCmd: compiled incr TEBC with immutable constant offs (INST_INCR_*_IMM instructions):
    lappend res [set i 0; incr i 0x7FFFFFFF]
    lappend res [set i 0; incr i 0xFFFFFF80]
    lappend res [set i 0; incr i 0xFFFFFF81]
    lappend res [set i 0; incr i 0xFFFFFFFF]
    lappend res [set i 0; incr i 0x10000007F]
    lappend res [set i 0; incr i 0x100000080]
    lappend res [set i 0; incr i 0x7FFFFFFFFFFFFFFF]
    lappend res [set i 0; incr i 0xFFFFFFFFFFFFFF80]
    lappend res [set i 0; incr i 0xFFFFFFFFFFFFFF81]
    lappend res [set i 0; incr i 0xFFFFFFFFFFFFFFFF]
    lappend res [set i 0; incr i 0x1000000000000007F]
    lappend res [set i 0; incr i 0x10000000000000080]
    # TclCompileIncrCmd: compiled incr TEBC with dynamic offs (INST_INCR_* instructions without _IMM):
    lappend res [set i 0; incr i [set x 0x7FFFFFFF]]
    lappend res [set i 0; incr i [set x 0xFFFFFF80]]
    lappend res [set i 0; incr i [set x 0xFFFFFF81]]
    lappend res [set i 0; incr i [set x 0xFFFFFFFF]]
    lappend res [set i 0; incr i [set x 0x10000007F]]
    lappend res [set i 0; incr i [set x 0x100000080]]
    lappend res [set i 0; incr i [set x 0x7FFFFFFFFFFFFFFF]]
    lappend res [set i 0; incr i [set x 0xFFFFFFFFFFFFFF80]]
    lappend res [set i 0; incr i [set x 0xFFFFFFFFFFFFFF81]]
    lappend res [set i 0; incr i [set x 0xFFFFFFFFFFFFFFFF]]
    lappend res [set i 0; incr i [set x 0x1000000000000007F]]
    lappend res [set i 0; incr i [set x 0x10000000000000080]]
    # Tcl_IncrObjCmd: non-compiled incr command (or NRE):
    set cmd incr
    lappend res [set i 0; $cmd i 0x7FFFFFFF]
    lappend res [set i 0; $cmd i 0xFFFFFF80]
    lappend res [set i 0; $cmd i 0xFFFFFF81]
    lappend res [set i 0; $cmd i 0xFFFFFFFF]
    lappend res [set i 0; $cmd i 0x10000007F]
    lappend res [set i 0; $cmd i 0x100000080]
    lappend res [set i 0; $cmd i 0x7FFFFFFFFFFFFFFF]
    lappend res [set i 0; $cmd i 0xFFFFFFFFFFFFFF80]
    lappend res [set i 0; $cmd i 0xFFFFFFFFFFFFFF81]
    lappend res [set i 0; $cmd i 0xFFFFFFFFFFFFFFFF]
    lappend res [set i 0; $cmd i 0x1000000000000007F]
    lappend res [set i 0; $cmd i 0x10000000000000080]
} [lrepeat 3 \
    [expr 0x7FFFFFFF] \
    [expr 0xFFFFFF80] \
    [expr 0xFFFFFF81] \
    [expr 0xFFFFFFFF] \
    [expr 0x10000007F] \
    [expr 0x100000080] \
    [expr 0x7FFFFFFFFFFFFFFF] \
    [expr 0xFFFFFFFFFFFFFF80] \
    [expr 0xFFFFFFFFFFFFFF81] \
    [expr 0xFFFFFFFFFFFFFFFF] \
    [expr 0x1000000000000007F] \
    [expr 0x10000000000000080] \
]

# Check "incr" and computed command names.

unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
    set i 5
    set z incr