From 5d722018bad4420f72308bd15a9f9617661bc5da Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sun, 25 May 2025 17:27:37 +0000 Subject: Start on [7346adc50f]. Now raise error on truncated encoding. Still have to handle replace and tcl8 profiles. --- generic/tclEncoding.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 5842a0b..bdf06c9 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1228,7 +1228,7 @@ Tcl_ExternalToUtfDStringEx( * and loop. Otherwise, return the result we got. */ if ((result != TCL_CONVERT_NOSPACE) && - !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { + (result != TCL_CONVERT_MULTIBYTE || (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); Tcl_DStringSetLength(dstPtr, soFar); -- cgit v0.12 From c4618712a008b8d0377029f7991ee60deba4fb0a Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 26 May 2025 05:12:10 +0000 Subject: Handle tcl8 and replace profiles for truncated escape encodings. Add tests. --- generic/tclEncoding.c | 26 +++++++++++++++++++++++++- tests/encoding.test | 21 ++++++++++++++++++++- tests/utfext.test | 42 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index bdf06c9..3f26ab7 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1544,7 +1544,7 @@ Tcl_UtfToExternalDStringEx( * and loop. Otherwise, return the result we got. */ if ((result != TCL_CONVERT_NOSPACE) && - !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { + (result != TCL_CONVERT_MULTIBYTE || (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); Tcl_Size i = soFar + encodingPtr->nullSize - 1; /* Loop as DStringSetLength only stores one nul byte at a time */ @@ -4067,6 +4067,30 @@ EscapeToUtfProc( numChars++; } + if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) { + /* We have a code fragment left-over at the end */ + if (dst > dstEnd) { + result = TCL_CONVERT_NOSPACE; + } else { + /* destination is not full, so we really are at the end now */ + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_SYNTAX; + } else { + /* + * PROFILE_REPLACE or PROFILE_TCL8. The latter is treated + * similar to former because Tcl8 was broken in this regard + * as it just ignored the byte and truncated which is really + * a no-no as per Unicode recommendations. + */ + result = TCL_OK; + dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); + numChars++; + /* TCL_CONVERT_MULTIBYTE means all source consumed */ + src = srcEnd; + } + } + } + *statePtr = (Tcl_EncodingState) INT2PTR(state); *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; diff --git a/tests/encoding.test b/tests/encoding.test index a754f72..b20b18d 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -1057,7 +1057,7 @@ test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body { encoding dirs "\{not a list" } -result "expected directory list but got \"\{not a list\"" -} +}; # proc runtests test encoding-28.0 {all encodings load} -body { @@ -1194,6 +1194,25 @@ test encoding-bug-201c7a3aa6-tcl8 {Crash encoding non-BMP to iso2022} -body { encoding convertto -profile tcl8 iso2022 \U1f600 } -result ? +test encoding-bug-7346adc50f-strict {OOM on convertfrom truncated iso2022 - strict} -body { + encoding convertfrom -profile strict iso2022-jp "\x1b\$B\$*;n\$" +} -result {unexpected byte sequence starting at index 7: '\x24'} -returnCodes error + +test encoding-bug-7346adc50f-failindex {OOM on convertfrom truncated iso2022 - failindex} -body { + list [encoding convertfrom -failindex failix iso2022-jp "\x1b\$B\$*;n\$"] $failix +} -cleanup { + unset -nocomplain failix +} -result [list \u304A\u8A66 7] + +test encoding-bug-7346adc50f-strict {OOM on convertfrom truncated iso2022 - replace} -body { + encoding convertfrom -profile replace iso2022-jp "\x1b\$B\$*;n\$" +} -result \u304A\u8A66\uFFFD + +test encoding-bug-7346adc50f-tcl8 {OOM on convertfrom truncated iso2022 - tcl8} -body { + encoding convertfrom -profile tcl8 iso2022-jp "\x1b\$B\$*;n\$" +} -result \u304A\u8A66\uFFFD + + # cleanup namespace delete ::tcl::test::encoding ::tcltest::cleanupTests diff --git a/tests/utfext.test b/tests/utfext.test index ca74229..8ab4bc4 100644 --- a/tests/utfext.test +++ b/tests/utfext.test @@ -320,6 +320,48 @@ namespace eval utftest { set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start tcl8} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end tcl8} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] } -result [list [list multibyte 0 \xEF\xBC\x90\xEF\xBC\x91\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 4 6 2 [list ok 0 \xC2\x82\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 1 2 1] -constraints testencoding + + test Tcl_ExternalToUtf-bug-7346adc50f-strict-0 { + truncated input in escape encoding (strict) + } -body { + set src [binary decode hex 1b2442242a3b6e24] + list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start end strict} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten + } -result [list syntax 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2] + + test Tcl_ExternalToUtf-bug-7346adc50f-strict-1 { + truncated input in escape encoding (strict, partial) + } -body { + set src [binary decode hex 1b2442242a3b6e24] + list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start strict} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten + } -result [list multibyte 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2] + + test Tcl_ExternalToUtf-bug-7346adc50f-replace-0 { + truncated input in escape encoding (replace) + } -body { + set src [binary decode hex 1b2442242a3b6e24] + list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start end replace} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten + } -result [list ok 2 [binary decode hex e3818ae8a9a6efbfbd00ffffffffffff] 8 9 3] + + test Tcl_ExternalToUtf-bug-7346adc50f-replace-1 { + truncated input in escape encoding (replace, partial) + } -body { + set src [binary decode hex 1b2442242a3b6e24] + list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start replace} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten + } -result [list multibyte 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2] + + test Tcl_ExternalToUtf-bug-7346adc50f-tcl8-0 { + truncated input in escape encoding (tcl8) + } -body { + set src [binary decode hex 1b2442242a3b6e24] + list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start end tcl8} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten + } -result [list ok 2 [binary decode hex e3818ae8a9a6efbfbd00ffffffffffff] 8 9 3] + + test Tcl_ExternalToUtf-bug-7346adc50f-tcl8-1 { + truncated input in escape encoding (tcl8, partial) + } -body { + set src [binary decode hex 1b2442242a3b6e24] + list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start tcl8} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten + } -result [list multibyte 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2] } namespace delete utftest -- cgit v0.12 From 9087f5508221aa8a81802d3a7c5aedf325246c20 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 26 May 2025 06:12:50 +0000 Subject: Add table driven truncation at end test --- tests/utfext.test | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/tests/utfext.test b/tests/utfext.test index 8ab4bc4..bfbb2db 100644 --- a/tests/utfext.test +++ b/tests/utfext.test @@ -185,7 +185,7 @@ namespace eval utftest { set out [binary decode hex $hexout] set dstlen 40 ;# Should be enough for all encoding tests - test $cmd-$enc-$id "$cmd - $enc - $hexin - frag" -constraints testencoding -body { + test $cmd-$enc-$id-0 "$cmd - $enc - $hexin - frag=$fragindex" -constraints testencoding -body { set frag1Result [testencoding $cmd $enc [string range $in 0 $fragindex-1] {start} 0 $dstlen frag1Read frag1Written] lassign $frag1Result frag1Status frag1State frag1Decoded set frag2Result [testencoding $cmd $enc [string range $in $frag1Read end] {end} $frag1State $dstlen frag2Read frag2Written] @@ -195,6 +195,16 @@ namespace eval utftest { $frag2Status [expr {$frag1Read+$frag2Read}] \ [expr {$frag1Written+$frag2Written}] $decoded } -result [list $status1 1 ok [string length $in] [string length $out] $out] + + if {$direction eq "toutf"} { + # Fragmentation but with no more data. + # Only check status. Content output is already checked in above test. + test $cmd-$enc-$id-1 "$cmd - $enc - $hexin - frag=$fragindex - no more data" -constraints testencoding -body { + set frag1Result [testencoding $cmd $enc [string range $in 0 $fragindex-1] {start end} 0 $dstlen frag1Read frag1Written] + lassign $frag1Result frag1Status frag1State frag1Decoded + set frag1Status + } -result syntax + } } proc testcharlimit {direction enc comment hexin hexout} { -- cgit v0.12 From 352041bd8313f05bf9c04c1300067d318075b0ea Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 May 2025 11:37:48 +0000 Subject: Indenting (backported from 9.1) --- generic/tclExecute.c | 4 +- generic/tclHash.c | 2 - generic/tclInt.h | 17 ++-- generic/tclInterp.c | 4 +- generic/tclUtil.c | 267 ++++++++++++++++++++++++++------------------------- 5 files changed, 149 insertions(+), 145 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a1121ab..37d5041 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -937,8 +937,8 @@ static inline int wordSkip( void *ptr) { - int mask = TCL_ALLOCALIGN-1; - int base = PTR2INT(ptr) & mask; + size_t mask = TCL_ALLOCALIGN-1; + size_t base = PTR2UINT(ptr) & mask; return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *); } diff --git a/generic/tclHash.c b/generic/tclHash.c index 7e2a876..4db576e 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -238,8 +238,6 @@ FindHashEntry( *---------------------------------------------------------------------- */ -#define TCL_HASH_FIND ((int *)-1) - static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 75608ae..9231087 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -751,6 +751,8 @@ typedef struct VarInHash { #define VAR_IS_ARGS 0x400 #define VAR_RESOLVED 0x8000 +#define TCL_HASH_FIND ((int *)-1) + /* * Macros to ensure that various flag bits are set properly for variables. * The ANSI C "prototypes" for these macros are: @@ -1432,7 +1434,7 @@ typedef struct CFWordBC { typedef struct ContLineLoc { Tcl_Size num; /* Number of entries in loc, not counting the * final -1 marker entry. */ - Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets. + Tcl_Size loc[TCLFLEXARRAY]; /* Table of locations, as character offsets. * The table is allocated as part of the * structure, extending behind the nominal end * of the structure. An entry containing the @@ -4012,9 +4014,10 @@ MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr, MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); /* Flag values for the [string] ensemble functions. */ - -#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */ -#define TCL_STRING_IN_PLACE (1<<1) +enum StringOpFlags { + TCL_STRING_MATCH_NOCASE = TCL_MATCH_NOCASE, /* (1<<0) in tcl.h */ + TCL_STRING_IN_PLACE = (1<<1) /* Do in-place surgery on Tcl_Obj */ +}; /* * Functions defined in generic/tclVar.c and currently exported only for use @@ -4418,7 +4421,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, * * MODULE_SCOPE void TclInitEmptyStringRep(Tcl_Obj *objPtr); * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len); - * MODULE_SCOPE void TclAttemptInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len); + * MODULE_SCOPE const char *TclAttemptInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len); * *---------------------------------------------------------------- */ @@ -4443,7 +4446,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ (objPtr)->length = ((objPtr)->bytes) ? \ (memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \ - (objPtr)->bytes[len] = '\0', (len)) : (-1) \ + (objPtr)->bytes[len] = '\0', (Tcl_Size)(len)) : (-1) \ )), (objPtr)->bytes) /* @@ -4546,7 +4549,7 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; do { \ Tcl_Obj *bignumObj = (objPtr); \ int bignumPayload = \ - PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ + (int)PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ } else { \ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 8ccaa65..91e9814 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -340,8 +340,8 @@ Tcl_Init( * pre-init and init scripts are running. The real version of this struct * is in tclPkg.c. */ - typedef struct PkgName { - struct PkgName *nextPtr;/* Next in list of package names being + typedef struct PkgName_ { + struct PkgName_ *nextPtr;/* Next in list of package names being * initialized. */ char name[4]; /* Enough space for "tcl". The *real* version * of this structure uses a flex array. */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index bab734e..385a966 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1056,7 +1056,7 @@ TclScanElement( Tcl_Size extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - Tcl_Size bytesNeeded; /* Buffer length computed to complete the + Tcl_Size bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ @@ -1103,96 +1103,97 @@ TclScanElement( } while (length) { - if (CHAR_TYPE(*p) != TYPE_NORMAL) { - switch (*p) { - case '{': /* TYPE_BRACE */ + if (CHAR_TYPE(*p) != TYPE_NORMAL) { + switch (*p) { + case '{': /* TYPE_BRACE */ #if COMPAT - braceCount++; + braceCount++; #endif /* COMPAT */ - extra++; /* Escape '{' => '\{' */ - nestingLevel++; - break; - case '}': /* TYPE_BRACE */ + extra++; /* Escape '{' => '\{' */ + nestingLevel++; + break; + case '}': /* TYPE_BRACE */ #if COMPAT - braceCount++; + braceCount++; #endif /* COMPAT */ - extra++; /* Escape '}' => '\}' */ - if (nestingLevel-- < 1) { - /* - * Unbalanced braces! Cannot format with brace quoting. - */ + extra++; /* Escape '}' => '\}' */ + if (nestingLevel-- < 1) { + /* + * Unbalanced braces! Cannot format with brace quoting. + */ - requireEscape = 1; - } - break; - case ']': /* TYPE_CLOSE_BRACK */ - case '"': /* TYPE_SPACE */ + requireEscape = 1; + } + break; + case ']': /* TYPE_CLOSE_BRACK */ + case '"': /* TYPE_SPACE */ #if COMPAT - forbidNone = 1; - extra++; /* Escapes all just prepend a backslash */ - preferEscape = 1; - break; + forbidNone = 1; + extra++; /* Escapes all just prepend a backslash */ + preferEscape = 1; + break; #else - /* FLOW THROUGH */ + /* FLOW THROUGH */ #endif /* COMPAT */ - case '[': /* TYPE_SUBS */ - case '$': /* TYPE_SUBS */ - case ';': /* TYPE_COMMAND_END */ - forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ + case '[': /* TYPE_SUBS */ + case '$': /* TYPE_SUBS */ + case ';': /* TYPE_COMMAND_END */ + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ #if COMPAT - preferBrace = 1; + preferBrace = 1; #endif /* COMPAT */ - break; - case '\\': /* TYPE_SUBS */ - extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { - /* - * Final backslash. Cannot format with brace quoting. - */ - - requireEscape = 1; break; - } - if (p[1] == '\n') { - extra++; /* Escape newline => '\n', one byte longer */ + case '\\': /* TYPE_SUBS */ + extra++; /* Escape '\' => '\\' */ + if ((length == 1) || + ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { + /* + * Final backslash. Cannot format with brace quoting. + */ + + requireEscape = 1; + break; + } + if (p[1] == '\n') { + extra++; /* Escape newline => '\n', one byte longer */ - /* - * Backslash newline sequence. Brace quoting not permitted. - */ + /* + * Backslash newline sequence. Brace quoting not permitted. + */ - requireEscape = 1; - length -= (length > 0); - p++; - break; - } - if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { - extra++; /* Escape sequences all one byte longer. */ - length -= (length > 0); - p++; - } - forbidNone = 1; -#if COMPAT - preferBrace = 1; -#endif /* COMPAT */ - break; - case '\0': /* TYPE_SUBS */ - if (length == TCL_INDEX_NONE) { - goto endOfString; - } - /* TODO: Panic on improper encoding? */ - break; - default: - if (TclIsSpaceProcM(*p)) { + requireEscape = 1; + length -= (length > 0); + p++; + break; + } + if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { + extra++; /* Escape sequences all one byte longer. */ + length -= (length > 0); + p++; + } forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ #if COMPAT preferBrace = 1; +#endif /* COMPAT */ + break; + case '\0': /* TYPE_SUBS */ + if (length == TCL_INDEX_NONE) { + goto endOfString; + } + /* TODO: Panic on improper encoding? */ + break; + default: + if (TclIsSpaceProcM(*p)) { + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ +#if COMPAT + preferBrace = 1; #endif + } + break; } - break; } - } length -= (length > 0); p++; } @@ -1343,9 +1344,9 @@ TclScanElement( Tcl_Size Tcl_ConvertElement( - const char *src, /* Source information for list element. */ - char *dst, /* Place to put list-ified element. */ - int flags) /* Flags produced by Tcl_ScanElement. */ + const char *src, /* Source information for list element. */ + char *dst, /* Place to put list-ified element. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, TCL_INDEX_NONE, dst, flags); } @@ -1373,7 +1374,7 @@ Tcl_ConvertElement( Tcl_Size Tcl_ConvertCountedElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1406,7 +1407,7 @@ Tcl_ConvertCountedElement( Tcl_Size TclConvertElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1587,7 +1588,7 @@ TclConvertElement( char * Tcl_Merge( - Tcl_Size argc, /* How many strings to merge. */ + Tcl_Size argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 @@ -1632,7 +1633,9 @@ Tcl_Merge( result = (char *)Tcl_Alloc(bytesNeeded); dst = result; for (i = 0; i < argc; i++) { - flagPtr[i] |= ( i ? DONT_QUOTE_HASH : 0 ); + if (i) { + flagPtr[i] |= DONT_QUOTE_HASH; + } dst += TclConvertElement(argv[i], TCL_INDEX_NONE, dst, flagPtr[i]); *dst = ' '; dst++; @@ -1664,14 +1667,14 @@ Tcl_Merge( Tcl_Size TclTrimRight( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *pp, *p = bytes + numBytes; int ch1, ch2; @@ -1743,14 +1746,14 @@ TclTrimRight( Tcl_Size TclTrimLeft( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; int ch1, ch2; @@ -1817,14 +1820,14 @@ TclTrimLeft( Tcl_Size TclTrim( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (trim[numTrim] == '\0'). */ Tcl_Size *trimRightPtr) /* Offset from the end of the string. */ { Tcl_Size trimLeft = 0, trimRight = 0; @@ -1879,7 +1882,7 @@ TclTrim( char * Tcl_Concat( - Tcl_Size argc, /* Number of strings to concatenate. */ + Tcl_Size argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { Tcl_Size i, needSpace = 0, bytesNeeded = 0; @@ -2126,8 +2129,8 @@ Tcl_StringCaseMatch( * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { - int p, charLen; - int ch1 = 0, ch2 = 0; + Tcl_Size charLen; + int p, ch1 = 0, ch2 = 0; while (1) { p = *pattern; @@ -2357,11 +2360,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - Tcl_Size strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - Tcl_Size ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2632,8 +2635,8 @@ Tcl_DStringAppend( if (length > (TCL_SIZE_MAX - dsPtr->length - 1)) { Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER - "d bytes) exceeded", - TCL_SIZE_MAX); + "d bytes) exceeded", + TCL_SIZE_MAX); return NULL; /* NOTREACHED */ } newSize = length + dsPtr->length + 1; @@ -2775,7 +2778,7 @@ Tcl_DStringAppendElement( memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - int offset = -1; + Tcl_Size offset = -1; /* See [16896d49fd] */ if (element >= dsPtr->string @@ -2829,7 +2832,7 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - Tcl_Size length) /* New length for dynamic string. */ + Tcl_Size length) /* New length for dynamic string. */ { Tcl_Size newsize; @@ -3318,7 +3321,7 @@ Tcl_Size TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ - Tcl_WideInt n) /* The integer to format. */ + Tcl_WideInt n) /* The integer to format. */ { Tcl_WideUInt intVal; int i = 0, numFormatted, j; @@ -3380,14 +3383,14 @@ TclFormatInt( static int GetWideForIndex( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - Tcl_Obj *objPtr, /* Points to the value to be parsed */ - Tcl_WideInt endValue, /* The value to be stored at *widePtr if + Tcl_Obj *objPtr, /* Points to the value to be parsed */ + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ - Tcl_WideInt *widePtr) /* Location filled in with a wide integer + Tcl_WideInt *widePtr) /* Location filled in with a wide integer * representing an index. */ { int numType; @@ -3515,10 +3518,10 @@ Tcl_GetIntForIndex( static int GetEndOffsetFromObj( Tcl_Interp *interp, - Tcl_Obj *objPtr, /* Pointer to the object to parse */ - Tcl_WideInt endValue, /* The value to be stored at "widePtr" if + Tcl_Obj *objPtr, /* Pointer to the object to parse */ + Tcl_WideInt endValue, /* The value to be stored at "widePtr" if * "objPtr" holds "end". */ - Tcl_WideInt *widePtr) /* Location filled in with an integer + Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ { Tcl_ObjInternalRep *irPtr; @@ -3814,11 +3817,11 @@ GetEndOffsetFromObj( int TclIndexEncode( - Tcl_Interp *interp, /* For error reporting, may be NULL */ - Tcl_Obj *objPtr, /* Index value to parse */ - int before, /* Value to return for index before beginning */ - int after, /* Value to return for index after end */ - int *indexPtr) /* Where to write the encoded answer, not NULL */ + Tcl_Interp *interp, /* For error reporting, may be NULL */ + Tcl_Obj *objPtr, /* Index value to parse */ + int before, /* Value to return for index before beginning */ + int after, /* Value to return for index after end */ + int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; @@ -3901,7 +3904,7 @@ TclIndexEncode( idx = (int)wide; } } else { - /* objPtr is not purely numeric (end etc.) */ + /* objPtr is not purely numeric (end etc.) */ /* * On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX @@ -3960,8 +3963,8 @@ rangeerror: Tcl_Size TclIndexDecode( - int encoded, /* Value to decode */ - Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + int encoded, /* Value to decode */ + Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded > TCL_INDEX_END) { return encoded; @@ -3990,8 +3993,8 @@ TclIndexDecode( */ int TclCommandWordLimitError( - Tcl_Interp *interp, /* May be NULL */ - Tcl_Size count) /* If <= 0, "unknown" */ + Tcl_Interp *interp, /* May be NULL */ + Tcl_Size count) /* If <= 0, "unknown" */ { if (interp) { if (count > 0) { @@ -4670,9 +4673,9 @@ TclMSB( * clzll() = Count of Leading Zeroes in a Long Long * NOTE: we rely on input constraint (n != 0). */ - + return 63 - __builtin_clzll(n); - + #else /* -- cgit v0.12 From 72c2ffce203c148cc673595012dd8cd9d6671312 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 May 2025 11:40:28 +0000 Subject: Fix [1dcda0e862]: Build broken (trunk branch) tclCompExpr.c tclOOCall.c. Just by disabling the warning. --- win/tclWinPort.h | 1 + 1 file changed, 1 insertion(+) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 0f22138..afb76df 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -461,6 +461,7 @@ typedef DWORD_PTR * PDWORD_PTR; #endif # pragma warning(disable:4267) # pragma warning(disable:4996) +# pragma warning(disable:5287) /* See [1dcda0e862] */ #endif /* -- cgit v0.12 From 7a6af69ba84c0afb4808851f1f657b1461dbec0a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 May 2025 11:41:49 +0000 Subject: Update changes.md --- changes.md | 1 + 1 file changed, 1 insertion(+) diff --git a/changes.md b/changes.md index 503725c..c777875 100644 --- a/changes.md +++ b/changes.md @@ -27,6 +27,7 @@ to the userbase. - ["encoding system": wrong result without manifest](https://core.tcl-lang.org/tcl/tktview/8ffd8c) - [lseq crash on out-of-range index](https://core.tcl-lang.org/tcl/tktview/7d3101) - [lseq crash on nested indices](https://core.tcl-lang.org/tcl/tktview/452b10) + - [Build broken (trunk branch) tclCompExpr.c tclOOCall.c](https://core.tcl-lang.org/tcl/tktview/1dcda0) # Incompatibilities - No known incompatibilities with the Tcl 9.0.0 public interface. -- cgit v0.12 From 5c2cca7db27655219083d176c5d2d5a54031ee1b Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 26 May 2025 11:56:49 +0000 Subject: Update changes for fixed tickets --- changes.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/changes.md b/changes.md index c777875..2523ad7 100644 --- a/changes.md +++ b/changes.md @@ -28,6 +28,8 @@ to the userbase. - [lseq crash on out-of-range index](https://core.tcl-lang.org/tcl/tktview/7d3101) - [lseq crash on nested indices](https://core.tcl-lang.org/tcl/tktview/452b10) - [Build broken (trunk branch) tclCompExpr.c tclOOCall.c](https://core.tcl-lang.org/tcl/tktview/1dcda0) + - [Memory allocation runaway on truncated iso2022 encoding](https://core.tcl-lang.org/tcl/tktview/7346adc50) + - [Missing include dir for extensions in non-default locations](https://core.tcl-lang.org/tcl/tktview/3335120320) # Incompatibilities - No known incompatibilities with the Tcl 9.0.0 public interface. -- cgit v0.12 From a6a2d6ced9304f67486d4ee9cb39ce672ad604e0 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 27 May 2025 05:01:08 +0000 Subject: Disable unsupported icu tests for valgrind as dl_load of icu muddies valgrind output --- tests/icu.test | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/tests/icu.test b/tests/icu.test index a86a985..6b26107 100644 --- a/tests/icu.test +++ b/tests/icu.test @@ -7,9 +7,14 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -# Force late loading of ICU if present -catch {::tcl::unsupported::icu} -testConstraint icu [llength [info commands ::tcl::unsupported::icu::detect]] +# Disable ICU tests in the presence of valgrind since the dl_load +# allocations interfere with valgrind output and icu is anyways an +# unsupported component. +if {![testConstraint valgrind]} { + # Force late loading of ICU if present + catch {::tcl::unsupported::icu} + testConstraint icu [llength [info commands ::tcl::unsupported::icu::detect]] +} namespace eval icu { namespace path {::tcl::unsupported ::tcl::mathop} -- cgit v0.12