Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | TIP #697: 32-bit truncation in format and scan (let's gain some time) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk | main |
Files: | files | file ages | folders |
SHA3-256: |
810eb78647bbdf9b965f4cd43d52b5be |
User & Date: | jan.nijtmans 2024-06-19 10:32:39 |
Context
2024-06-19
| ||
10:55 | TIP 696 - partition return codes between core and non-core check-in: 458efeb505 user: apnadkarni tags: trunk, main | |
10:32 | TIP #697: 32-bit truncation in format and scan (let's gain some time) check-in: 810eb78647 user: jan.nijtmans tags: trunk, main | |
10:04 | Add back tests for inject crashes adapted for coroinject check-in: 7c62723a17 user: apnadkarni tags: trunk, main | |
09:25 | Merge trunk Closed-Leaf check-in: 19ff51752b user: jan.nijtmans tags: tip-697 | |
Changes
Changes to doc/format.n.
︙ | ︙ | |||
137 138 139 140 141 142 143 | function of the \fBexpr\fR command (at least a 64-bit range). If it is \fBz\fR or \fBt\fR it specifies that the integer value is truncated to the range determined by the value of the \fBpointerSize\fR element of the \fBtcl_platform\fR array. If it is \fBL\fR it specifies that an integer or double value is taken without truncation for conversion to a formatted substring. If neither of those are present, the integer value is | | < | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | function of the \fBexpr\fR command (at least a 64-bit range). If it is \fBz\fR or \fBt\fR it specifies that the integer value is truncated to the range determined by the value of the \fBpointerSize\fR element of the \fBtcl_platform\fR array. If it is \fBL\fR it specifies that an integer or double value is taken without truncation for conversion to a formatted substring. If neither of those are present, the integer value is truncated to a 32-bit range. .SS "MANDATORY CONVERSION TYPE" .PP The last thing in a conversion specifier is an alphabetic character that determines what kind of conversion to perform. The following conversion characters are currently supported: .IP \fBd\fR 10 Convert integer to signed decimal string. |
︙ | ︙ |
Changes to doc/scan.n.
︙ | ︙ | |||
69 70 71 72 73 74 75 | at most once and the empty positions will be filled in with empty strings. .SS "OPTIONAL SIZE MODIFIER" .PP The size modifier field is used only when scanning a substring into one of Tcl's integer values. The size modifier field dictates the integer range acceptable to be stored in a variable, or, for the inline case, in a position in the result list. | | | | | | < | | > | | | > | 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 | at most once and the empty positions will be filled in with empty strings. .SS "OPTIONAL SIZE MODIFIER" .PP The size modifier field is used only when scanning a substring into one of Tcl's integer values. The size modifier field dictates the integer range acceptable to be stored in a variable, or, for the inline case, in a position in the result list. The syntactically valid values for the size modifier are \fBh\fR, \fBl\fR, \fBz\fR, \fBt\fR, \fBq\fR, \fBj\fR, \fBll\fR, and \fBL\fR. The \fBh\fR size modifier value is equivalent to the absence of a size modifier in the the conversion specifier. Either one indicates the integer range to be stored is limited to the 32-bit range. The \fBL\fR size modifier is equivalent to the \fBll\fR size modifier. Either one indicates the integer range to be stored is unlimited. The \fBl\fR (or \fBq\fR or \fBj\fR) size modifier indicates that the integer range to be stored is limited to the same range produced by the \fBwide()\fR function of the \fBexpr\fR command. The \fBz\fR and \fBt\fR modifiers indicate the integer range to be the same as for either \fBh\fR or \fBl\fR, depending on the value of the \fBpointerSize\fR element of the \fBtcl_platform\fR array. .SS "MANDATORY CONVERSION CHARACTER" .PP The following conversion characters are supported: .IP \fBd\fR The input substring must be a decimal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. |
︙ | ︙ | |||
244 245 246 247 248 249 250 | puts "X=$x, Y=$y" .CE .PP An interactive session demonstrating the truncation of integer values determined by size modifiers: .PP .CS | < < | 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | puts "X=$x, Y=$y" .CE .PP An interactive session demonstrating the truncation of integer values determined by size modifiers: .PP .CS \fI%\fR scan 20000000000000000000 %d 2147483647 \fI%\fR scan 20000000000000000000 %ld 9223372036854775807 \fI%\fR scan 20000000000000000000 %lld 20000000000000000000 .CE |
︙ | ︙ |
Changes to generic/tclArithSeries.c.
︙ | ︙ | |||
508 509 510 511 512 513 514 | Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj) { void *clientData; int tcl_number_type; | | | 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 | Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj) { void *clientData; int tcl_number_type; if (Tcl_GetNumberFromObj(interp, numberObj, &clientData, &tcl_number_type) != TCL_OK) { return TCL_ERROR; } if (tcl_number_type == TCL_NUMBER_BIG) { /* bignum is not supported yet. */ Tcl_WideInt w; (void)Tcl_GetWideIntFromObj(interp, numberObj, &w); |
︙ | ︙ |
Changes to generic/tclEnsemble.c.
︙ | ︙ | |||
273 274 275 276 277 278 279 | * * Side effects: * Creates the ensemble for the namespace if one did not previously * exist. * * Note: * Can't use SetEnsembleConfigOptions() here. Different (but overlapping) | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | * * Side effects: * Creates the ensemble for the namespace if one did not previously * exist. * * Note: * Can't use SetEnsembleConfigOptions() here. Different (but overlapping) * options are supported. * *---------------------------------------------------------------------- */ static Tcl_Command InitEnsembleFromOptions( Tcl_Interp *interp, int objc, |
︙ | ︙ | |||
882 883 884 885 886 887 888 | * Reports an error in the interpreter (if non-NULL) if the command is * not an ensemble. * *---------------------------------------------------------------------- */ static inline EnsembleConfig * GetEnsembleFromCommand( | | | 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 | * Reports an error in the interpreter (if non-NULL) if the command is * not an ensemble. * *---------------------------------------------------------------------- */ static inline EnsembleConfig * GetEnsembleFromCommand( Tcl_Interp *interp, /* Where to report an error. May be NULL. */ Tcl_Command token) /* What to check for ensemble-ness. */ { Command *cmdPtr = (Command *) token; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( |
︙ | ︙ |
Changes to generic/tclScan.c.
︙ | ︙ | |||
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 | case 'z': case 't': if (sizeof(void *) > sizeof(int)) { flags |= SCAN_LONGER; } format += TclUtfToUniChar(format, &ch); break; case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } /* FALLTHRU */ | > > > > < | 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 | case 'z': case 't': if (sizeof(void *) > sizeof(int)) { flags |= SCAN_LONGER; } format += TclUtfToUniChar(format, &ch); break; case 'L': flags |= SCAN_BIG; format += TclUtfToUniChar(format, &ch); break; case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += TclUtfToUniChar(format, &ch); break; } /* FALLTHRU */ case 'j': case 'q': flags |= SCAN_LONGER; /* FALLTHRU */ case 'h': format += TclUtfToUniChar(format, &ch); } |
︙ | ︙ | |||
597 598 599 600 601 602 603 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; | | | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; int value; const char *string, *end, *baseString; char op = 0; int underflow = 0; Tcl_Size width; Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; |
︙ | ︙ | |||
990 991 992 993 994 995 996 | "unsigned bignum scans are invalid", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED", (char *)NULL); return TCL_ERROR; } } } else { | | | | | 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 | "unsigned bignum scans are invalid", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED", (char *)NULL); return TCL_ERROR; } } } else { if (TclGetIntFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { value = INT_MIN; } else { value = INT_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { #ifdef TCL_WIDE_INT_IS_LONG mp_int big; if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) { Tcl_SetObjResult(interp, Tcl_NewStringObj( |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
1871 1872 1873 1874 1875 1876 1877 | */ while (*format != '\0') { char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int gotPrecision, sawFlag, useShort = 0, useBig = 0; Tcl_WideInt width, precision; | < < | 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 | */ while (*format != '\0') { char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int gotPrecision, sawFlag, useShort = 0, useBig = 0; Tcl_WideInt width, precision; int useWide = 0; int newXpg, allocSegment = 0; Tcl_Size numChars, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); format += step; if (ch != '%') { |
︙ | ︙ | |||
2078 2079 2080 2081 2082 2083 2084 | } else if (ch == 'l') { format += step; step = TclUtfToUniChar(format, &ch); if (ch == 'l') { useBig = 1; format += step; step = TclUtfToUniChar(format, &ch); | < < < < < < < < | 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 | } else if (ch == 'l') { format += step; step = TclUtfToUniChar(format, &ch); if (ch == 'l') { useBig = 1; format += step; step = TclUtfToUniChar(format, &ch); } else { useWide = 1; } } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); useWide = 1; } else if ((format[1] == '3') && (format[2] == '2')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); } else { format += step; step = TclUtfToUniChar(format, &ch); } } else if ((ch == 'q') || (ch == 'j')) { format += step; step = TclUtfToUniChar(format, &ch); useWide = 1; } else if ((ch == 't') || (ch == 'z')) { format += step; step = TclUtfToUniChar(format, &ch); if (sizeof(void *) > sizeof(int)) { useWide = 1; } } else if (ch == 'L') { format += step; step = TclUtfToUniChar(format, &ch); useBig = 1; } format += step; |
︙ | ︙ | |||
2176 2177 2178 2179 2180 2181 2182 | case 'o': case 'p': case 'x': case 'X': case 'b': { short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ | | < < < < | | | | | | | 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 | case 'o': case 'p': case 'x': case 'X': case 'b': { short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ int l; Tcl_WideInt w; mp_int big; int isNegative = 0; Tcl_Size toAppend; if ((ch == 'p') && (sizeof(void *) > sizeof(int))) { useWide = 1; } if (useBig) { int cmpResult; if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { goto error; } cmpResult = mp_cmp_d(&big, 0); isNegative = (cmpResult == MP_LT); if (cmpResult == MP_EQ) { gotHash = 0; } if (ch == 'u') { if (isNegative) { mp_clear(&big); msg = "unsigned bignum format is invalid"; errCode = "BADUNSIGNED"; goto errorMsg; } else { ch = 'd'; } } } else if (useWide) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; } isNegative = (w < (Tcl_WideInt) 0); if (w == (Tcl_WideInt) 0) { gotHash = 0; } } else if (TclGetIntFromObj(NULL, segment, &l) != TCL_OK) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; } else { l = (int) w; } if (useShort) { s = (short) l; isNegative = (s < (short) 0); if (s == (short) 0) { gotHash = 0; } } else { isNegative = (l < (int) 0); if (l == (int) 0) { gotHash = 0; } } } else if (useShort) { s = (short) l; isNegative = (s < (short) 0); if (s == (short) 0) { gotHash = 0; } } else { isNegative = (l < (int) 0); if (l == (int) 0) { gotHash = 0; } } TclNewObj(segment); allocSegment = 1; segmentLimit = TCL_SIZE_MAX; |
︙ | ︙ | |||
2290 2291 2292 2293 2294 2295 2296 | case 'd': { Tcl_Size length; Tcl_Obj *pure; const char *bytes; if (useShort) { TclNewIntObj(pure, s); | < < | 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 | case 'd': { Tcl_Size length; Tcl_Obj *pure; const char *bytes; if (useShort) { TclNewIntObj(pure, s); } else if (useWide) { TclNewIntObj(pure, w); } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { TclNewIntObj(pure, l); } Tcl_IncrRefCount(pure); bytes = TclGetStringFromObj(pure, &length); |
︙ | ︙ | |||
2378 2379 2380 2381 2382 2383 2384 | unsigned short us = (unsigned short) s; bits = (Tcl_WideUInt) us; while (us) { numDigits++; us /= base; } | < < | | 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 | unsigned short us = (unsigned short) s; bits = (Tcl_WideUInt) us; while (us) { numDigits++; us /= base; } } else if (useWide) { Tcl_WideUInt uw = (Tcl_WideUInt) w; bits = uw; while (uw) { numDigits++; uw /= base; } } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); numDigits = 1 + (((Tcl_WideInt) big.used * MP_DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; mask >>= numBits; } if (numDigits > INT_MAX) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } } else if (!useBig) { unsigned ul = (unsigned) l; bits = (Tcl_WideUInt) ul; while (ul) { numDigits++; ul /= base; } } |
︙ | ︙ |
Changes to tests/expr.test.
︙ | ︙ | |||
5838 5839 5840 5841 5842 5843 5844 | [expr {$max_long_str + 0}] \ [expr {$max_long + 0}] \ [expr {2147483647 + 0}] \ [expr {$max_long == $max_long_hex}] \ [expr {int(2147483647 + 1) > 0}] \ } {2147483647 2147483647 2147483647 2147483647 1 1} | | | 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 | [expr {$max_long_str + 0}] \ [expr {$max_long + 0}] \ [expr {2147483647 + 0}] \ [expr {$max_long == $max_long_hex}] \ [expr {int(2147483647 + 1) > 0}] \ } {2147483647 2147483647 2147483647 2147483647 1 1} test expr-33.2 {parse smallest long value} { set min_long_str -2147483648 set min_long_hex "-0x80000000 " set min_long -2147483648 # This will convert to integer (not wide) internal rep string is integer $min_long |
︙ | ︙ |
Changes to tests/format.test.
︙ | ︙ | |||
11 12 13 14 15 16 17 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } | | < < < | < < < | < < < | < < < | < < < | < < < | < < < | 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 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # %z/%t/%p output depends on pointerSize, so some tests are not portable. testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] # MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain # particularly in Continuous Integration, and there isn't anything much we can # do about it. testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}] test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 } { 6 34 16923 -12 -1 0xe 0xC} test format-1.3 {integer formatting} { format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 } { 6 34 16923 4294967284 -1 0} test format-1.4 {integer formatting} { format "%-4d %-4i %-4d %-4ld" 6 34 16923 -12 -1 } {6 34 16923 -12 } test format-1.5 {integer formatting} { format "%04d %04d %04d %04i" 6 34 16923 -12 -1 } {0006 0034 16923 -012} test format-1.6 {integer formatting} { format "%00*d" 6 34 } {000034} # Printing negative numbers in hex or octal format depends on word # length, so these tests are not portable. test format-1.7 {integer formatting} { format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffff4} test format-1.8 {integer formatting} { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 } {0 0x6 0x22 0x421B 0xfffffff4} test format-1.9 {integer formatting} { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 } { 0 0x6 0x22 0x421b 0xfffffff4} test format-1.10 {integer formatting} { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 } {0 0x6 0x22 0x421b 0xfffffff4 } test format-1.11 {integer formatting} { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 } {0 0o6 0o42 0o41033 0o37777777764 } test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] } {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} test format-1.13 {integer formatting} { format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1 } {0 0d6 0d34 0d16923 -0d12} test format-1.14 {integer formatting} { |
︙ | ︙ | |||
552 553 554 555 556 557 558 | for {set i 290} {$i < 400} {incr i} { test format-16.[expr {$i -289}] {testing MAX_FLOAT_SIZE} { format {%s} $b } $b append b "x" } | | | | | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | for {set i 290} {$i < 400} {incr i} { test format-16.[expr {$i -289}] {testing MAX_FLOAT_SIZE} { format {%s} $b } $b append b "x" } test format-17.1 {testing %d with wide} { format %d 7810179016327718216 } 1819043144 test format-17.2 {testing %ld with wide} { format %ld 7810179016327718216 } 7810179016327718216 test format-17.3 {testing %ld with non-wide} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { format %lf 1 } 1.000000 test format-17.5 {testing %llu with positive bignum} -body { format %llu 0xabcdef0123456789abcdef |
︙ | ︙ | |||
585 586 587 588 589 590 591 | lappend result [expr {$a == $b}] set b 0xaaaa append b aaaa lappend result [expr {$a == $b}] format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} | | | < | 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 | lappend result [expr {$a == $b}] set b 0xaaaa append b aaaa lappend result [expr {$a == $b}] format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} test format-18.2 {do not demote existing numeric values} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] } {aaaaaaab 1} test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body { set x 0x8fedc654 list [expr { ~ $x }] [format %08x [expr { ~$x }]] } -match regexp -result {-2414724693 f*701239ab} test format-19.2 {Bug 1867855} { format %llx 0 } 0 test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} -body { # in case of overflow into negative, it produces width -2 (and limit exceeded), # in case of width will be unsigned, it will be outside limit (2GB for 32bit)... # and it don't throw an error in case the bug is not fixed (and probably no segfault). format %[expr {0xffffffff - 1}]g 0 } -returnCodes error -result "max size for a Tcl value exceeded" test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body { |
︙ | ︙ |
Changes to tests/obj.test.
︙ | ︙ | |||
16 17 18 19 20 21 22 | namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] | < | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 foreach {t} { bytecode cmdName |
︙ | ︙ | |||
543 544 545 546 547 548 549 | set x {} for {set i 0} {$i<100000} {incr i} { set x [list $x {}] } unset x } {} | | | | | | | 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 | set x {} for {set i 0} {$i<100000} {incr i} { set x [list $x {}] } unset x } {} test obj-33.1 {integer overflow on input} {wideIs64bit} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} test obj-33.2 {integer overflow on input} {wideIs64bit} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 4294967296} test obj-33.4 {integer overflow on input} {wideIs64bit} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} test obj-33.5 {integer overflow on input} {wideIs64bit} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} test obj-33.6 {integer overflow on input} {wideIs64bit} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} test obj-33.7 {integer overflow on input} { set x -0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -4294967296} |
︙ | ︙ |
Changes to tests/scan.test.
︙ | ︙ | |||
78 79 80 81 82 83 84 | default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] | < | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | default { return 0 } } } testConstraint ieeeFloatingPoint [testIEEE] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x } {1 f} test scan-1.2 {BuildCharSet, CharInSet} { list [scan \]foo {%[]f]} x] $x } {1 \]f} |
︙ | ︙ | |||
513 514 515 516 517 518 519 | # test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { set a {}; set b {} } -body { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} | | | 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 | # test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { set a {}; set b {} } -body { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} test scan-5.12 {integer scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ %ld,%lx,%lo a b c] $a $b $c } -result {3 7810179016327718216 7810179016327718216 7810179016327718216} test scan-5.13 {integer scanning and overflow} { # This test used to fail on some 64-bit systems. [Bug 1011860] |
︙ | ︙ |