diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob index 306d5a54a7fe..656e184477ed 100644 --- a/.fossil-settings/ignore-glob +++ b/.fossil-settings/ignore-glob @@ -48,9 +48,11 @@ libtommath/*.tex macosx/configure unix/autoMkindex.tcl unix/dltest.marker +unix/dltest/embtest unix/dltest/*.bundle unix/dltest/*.dll unix/dltest/*.dylib +unix/dltest/*.exe unix/dltest/*.o unix/dltest/*.sl unix/dltest/*.so diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index 29aa98be41cd..81f3e7ef11b8 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -4,6 +4,7 @@ on: branches: - "main" - "core-8-branch" + - "core-8-6-branch" tags: - "core-**" permissions: @@ -28,6 +29,7 @@ jobs: steps: - name: Checkout uses: actions/checkout@v3 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -38,23 +40,30 @@ jobs: ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: ${{ matrix.cfgopt }} + timeout-minutes: 5 - name: Build run: | make all + timeout-minutes: 5 - name: Build Test Harness run: | make tcltest + timeout-minutes: 5 - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 + timeout-minutes: 30 - name: Test-Drive Installation run: | make install + timeout-minutes: 5 - name: Create Distribution Package run: | make dist + timeout-minutes: 5 - name: Convert Documentation to HTML run: | make html-tcl + timeout-minutes: 5 diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index 462bd9236cdd..7772ebe1edb2 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -4,6 +4,7 @@ on: branches: - "main" - "core-8-branch" + - "core-8-6-branch" tags: - "core-**" permissions: @@ -18,6 +19,7 @@ jobs: steps: - name: Checkout uses: actions/checkout@v3 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -26,11 +28,13 @@ jobs: run: make all env: CFLAGS: -arch x86_64 -arch arm64 + timeout-minutes: 15 - name: Run Tests run: make test styles=develop env: ERROR_ON_FAILURES: 1 MAC_CI: 1 + timeout-minutes: 15 clang: runs-on: macos-11 strategy: @@ -48,6 +52,7 @@ jobs: steps: - name: Checkout uses: actions/checkout@v3 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -59,14 +64,17 @@ jobs: env: CFLAGS: -arch x86_64 -arch arm64 CFGOPT: ${{ matrix.cfgopt }} + timeout-minutes: 5 - name: Build run: | make all tcltest env: CFLAGS: -arch x86_64 -arch arm64 + timeout-minutes: 15 - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 MAC_CI: 1 + timeout-minutes: 15 diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 5c90701f3471..01b11534b0fc 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -15,6 +15,7 @@ jobs: defaults: run: shell: bash + timeout-minutes: 10 steps: - name: Checkout uses: actions/checkout@v3 @@ -50,6 +51,7 @@ jobs: defaults: run: shell: bash + timeout-minutes: 10 steps: - name: Checkout uses: actions/checkout@v3 @@ -112,6 +114,7 @@ jobs: defaults: run: shell: msys2 {0} + timeout-minutes: 10 env: CC: gcc CFGOPT: --disable-symbols --disable-shared diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 4c7fafc3971c..532033dcb240 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -4,6 +4,7 @@ on: branches: - "main" - "core-8-branch" + - "core-8-6-branch" tags: - "core-**" permissions: @@ -29,26 +30,31 @@ jobs: steps: - name: Checkout uses: actions/checkout@v3 + timeout-minutes: 5 - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 + timeout-minutes: 5 - name: Build ${{ matrix.cfgopt }} run: | &nmake -f makefile.vc ${{ matrix.cfgopt }} all if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } + timeout-minutes: 5 - name: Build Test Harness ${{ matrix.cfgopt }} run: | &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } + timeout-minutes: 5 - name: Run Tests ${{ matrix.cfgopt }} run: | &nmake -f makefile.vc ${{ matrix.cfgopt }} test if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } + timeout-minutes: 30 gcc: runs-on: windows-2022 defaults: @@ -71,8 +77,10 @@ jobs: with: msystem: MINGW64 install: git mingw-w64-x86_64-toolchain make + timeout-minutes: 10 - name: Checkout uses: actions/checkout@v3 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -83,12 +91,16 @@ jobs: ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: --enable-64bit ${{ matrix.cfgopt }} + timeout-minutes: 5 - name: Build run: make all + timeout-minutes: 5 - name: Build Test Harness run: make tcltest + timeout-minutes: 5 - name: Run Tests run: make test + timeout-minutes: 30 # If you add builds with Wine, be sure to define the environment variable # CI_USING_WINE when running them so that broken tests know not to run. diff --git a/.gitignore b/.gitignore index 504f1e454ac2..d55ab1c6baae 100644 --- a/.gitignore +++ b/.gitignore @@ -53,6 +53,7 @@ libtommath/*.tex macosx/configure unix/autoMkindex.tcl unix/dltest.marker +unix/dltest/embtest unix/tcl.pc unix/tclIndex unix/pkgs/* diff --git a/changes b/changes index 334930512842..5afd2f4ce10c 100644 --- a/changes +++ b/changes @@ -8247,7 +8247,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows) 2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows) -2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans) +2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans) 2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 0d70658ea537..19e7fabdd0d1 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -547,13 +547,13 @@ encoding: E init {} final {} -iso8859-1 \ex1b(B -jis0201 \ex1b(J -jis0208 \ex1b$@ -jis0208 \ex1b$B -jis0212 \ex1b$(D -gb2312 \ex1b$A -ksc5601 \ex1b$(C +iso8859-1 \ex1B(B +jis0201 \ex1B(J +jis0208 \ex1B$@ +jis0208 \ex1B$B +jis0212 \ex1B$(D +gb2312 \ex1B$A +ksc5601 \ex1B$(C .CE .PP In the file, the first column represents an option and the second column @@ -565,7 +565,7 @@ marks that encoding. Tcl syntax is used for the values; in the above example, for instance, .QW \fB{}\fR represents the empty string and -.QW \fB\ex1b\fR +.QW \fB\ex1B\fR represents character 27. .PP When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not diff --git a/doc/binary.n b/doc/binary.n index c54bcc928689..864b0f911967 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -241,7 +241,7 @@ which returns a binary string equivalent to: \fB\e254\fR .CE .PP -(i.e. \fB\exac\fR) by +(i.e. \fB\exAC\fR) by truncating the high-bits of the character, and which is probably not what is desired. .RE @@ -299,7 +299,7 @@ high-to-low order within each byte. For example, will return a binary string equivalent to: .PP .CS -\fB\exe0\exe1\exa0\fR +\fB\exE0\exE1\exA0\fR .CE .RE .IP \fBH\fR 5 @@ -326,7 +326,7 @@ remaining bits of the last byte will be zeros. For example, will return a binary string equivalent to: .PP .CS -\fB\exab\ex00\exde\exf0\ex98\fR +\fB\exAB\ex00\exDE\exF0\ex98\fR .CE .RE .IP \fBh\fR 5 @@ -341,7 +341,7 @@ low-to-high order within each byte. This is seldom required. For example, will return a binary string equivalent to: .PP .CS -\fB\exba\ex00\exed\ex0f\ex89\fR +\fB\exBA\ex00\exED\ex0F\ex89\fR .CE .RE .IP \fBc\fR 5 @@ -363,7 +363,7 @@ than \fIcount\fR, then the extra elements are ignored. For example, will return a binary string equivalent to: .PP .CS -\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR +\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR .CE .PP whereas: @@ -389,7 +389,7 @@ example, will return a binary string equivalent to: .PP .CS -\fB\ex03\ex00\exfd\exff\ex02\ex01\fR +\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR .CE .RE .IP \fBS\fR 5 @@ -405,7 +405,7 @@ example, will return a binary string equivalent to: .PP .CS -\fB\ex00\ex03\exff\exfd\ex01\ex02\fR +\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR .CE .RE .IP \fBt\fR 5 @@ -429,7 +429,7 @@ example, will return a binary string equivalent to: .PP .CS -\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR +\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR .CE .RE .IP \fBI\fR 5 @@ -445,7 +445,7 @@ For example, will return a binary string equivalent to: .PP .CS -\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR +\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR .CE .RE .IP \fBn\fR 5 @@ -510,7 +510,7 @@ on a Windows system running on an Intel Pentium processor, will return a binary string equivalent to: .PP .CS -\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR +\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR .CE .RE .IP \fBr\fR 5 @@ -536,7 +536,7 @@ Windows system running on an Intel Pentium processor, will return a binary string equivalent to: .PP .CS -\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR +\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR .CE .RE .IP \fBq\fR 5 @@ -788,7 +788,7 @@ scanned. For example, .RS .PP .CS -\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2 +\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2 .CE .PP will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and @@ -839,7 +839,7 @@ example, .RS .PP .CS -\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2 +\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2 .CE .PP will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR @@ -853,7 +853,7 @@ order. For example, .RS .PP .CS -\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2 +\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2 .CE .PP will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR @@ -878,7 +878,7 @@ example, .RS .PP .CS -set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff +set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF \fBbinary scan\fR $str i2i* var1 var2 .CE .PP @@ -894,7 +894,7 @@ immediately after the \fBI\fR. For example, .RS .PP .CS -set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0 +set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0 \fBbinary scan\fR $str I2I* var1 var2 .CE .PP @@ -920,7 +920,7 @@ example, .RS .PP .CS -set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff +set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF \fBbinary scan\fR $str wi* var1 var2 .CE .PP @@ -935,7 +935,7 @@ immediately after the \fBW\fR. For example, .RS .PP .CS -set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0 +set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0 \fBbinary scan\fR $str WI* var1 var2 .CE .PP @@ -966,7 +966,7 @@ Intel Pentium processor, .RS .PP .CS -\fBbinary scan\fR \ex3f\excc\excc\excd f var1 +\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1 .CE .PP will return \fB1\fR with \fB1.6000000238418579\fR stored in @@ -990,7 +990,7 @@ running on an Intel Pentium processor, .RS .PP .CS -\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1 +\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1 .CE .PP will return \fB1\fR with \fB1.6000000000000001\fR diff --git a/doc/chan.n b/doc/chan.n index 538f86db25d0..75615b6a2eb2 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -152,7 +152,7 @@ If \fIchar\fR is the empty string, there is no special character that marks the end of the data. The default value is the empty string. The acceptable range is \ex01 - -\ex7f. A value outside this range results in an error. +\ex7F. A value outside this range results in an error. .VS "TCL8.7 TIP656" .TP \fB\-profile\fR \fIprofile\fR @@ -245,10 +245,10 @@ files to slow destinations like network sockets. .PP \fB\-size\fR limits the number of characters copied. .PP -If \fB\-command\fR is gviven, \fBchan copy\fR returns immediately, works in the +If \fB\-command\fR is given, \fBchan copy\fR returns immediately, works in the background, and calls \fIcallback\fR when the copy completes, providing as an additional argument the number of characters written to \fIoutputChan\fR. If -an error occurres during the background copy, another argument provides message +an error occurs during the background copy, another argument provides message for the error. \fIinputChan\fR and \fIoutputChan\fR are automatically configured for non-blocking mode if needed. Background copying only works correctly if events are being processed, e.g. via \fBvwait\fR or Tk. diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index fcc5343c3b5c..5c3d0f69897d 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -72,6 +72,9 @@ ArithSeriesGetInternalRep(Tcl_Obj *objPtr) return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; } +/* + * Compute number of significant factional digits + */ static inline int Precision(double d) { @@ -81,10 +84,13 @@ Precision(double d) off = strchr(tmp, '.'); return (off ? strlen(off+1) : 0); } + +/* + * Find longest number of digits after the decimal point. + */ static inline int maxPrecision(double start, double end, double step) { - // Find longest number of digits after the decimal point. int dp = Precision(step); int i = Precision(start); dp = i>dp ? i : dp; @@ -178,15 +184,17 @@ ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) } static Tcl_WideInt -ArithSeriesLenDbl(double start, double end, double step) +ArithSeriesLenDbl(double start, double end, double step, int precision) { - Tcl_WideInt len; - + double istart, iend, istep, ilen; if (step == 0) { return 0; } - len = ((end-start+step)/step); - return (len < 0) ? -1 : len; + istart = start * pow(10,precision); + iend = end * pow(10,precision); + istep = step * pow(10,precision); + ilen = ((iend-istart+istep)/istep); + return floor(ilen); } /* @@ -420,7 +428,8 @@ TclNewArithSeriesObj( assert(dstep!=0); if (!lenObj) { if (useDoubles) { - len = ArithSeriesLenDbl(dstart, dend, dstep); + int precision = maxPrecision(dstart,dend,dstep); + len = ArithSeriesLenDbl(dstart, dend, dstep, precision); } else { len = ArithSeriesLenInt(start, end, step); } @@ -619,6 +628,7 @@ DupArithSeriesInternalRep( { ArithSeries *srcArithSeriesRepPtr = (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1; + /* * Allocate a new ArithSeries structure. */ @@ -859,7 +869,8 @@ TclArithSeriesObjRange( arithSeriesDblRepPtr->end = end; arithSeriesDblRepPtr->step = step; arithSeriesDblRepPtr->precision = maxPrecision(start, end, step); - arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step); + arithSeriesDblRepPtr->len = + ArithSeriesLenDbl(start, end, step, arithSeriesDblRepPtr->precision); arithSeriesDblRepPtr->elements = NULL; } else { diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index b02a4229f9a0..e47b52171222 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -10,6 +10,7 @@ */ #include "tclInt.h" +#include typedef size_t (LengthProc)(const char *src); @@ -571,8 +572,8 @@ TclInitEncodingSubsystem(void) unsigned size; unsigned short i; union { - char c; - short s; + char c; + short s; } isLe; int leFlags; @@ -3476,30 +3477,28 @@ TableToUtfProc( } byte = *((unsigned char *) src); if (prefixBytes[byte]) { - src++; - if (src >= srcEnd) { + if (src >= srcEnd-1) { + /* Prefix byte but nothing after it */ if (!(flags & TCL_ENCODING_END)) { - src--; + /* More data to come */ result = TCL_CONVERT_MULTIBYTE; break; } else if (PROFILE_STRICT(flags)) { - src--; result = TCL_CONVERT_SYNTAX; break; } else if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { - src--; /* See bug [bdcb5126c0] */ - result = TCL_CONVERT_MULTIBYTE; - break; + ch = (Tcl_UniChar)byte; } } else { - ch = toUnicode[byte][*((unsigned char *)src)]; + ch = toUnicode[byte][*((unsigned char *)++src)]; } } else { ch = pageZero[byte]; } if ((ch == 0) && (byte != 0)) { + /* Prefix+suffix pair is invalid */ if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; break; @@ -3526,6 +3525,7 @@ TableToUtfProc( src++; } + assert(src <= srcEnd); *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 9da987d606b5..2494bf9785b5 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -8960,7 +8960,7 @@ ValidatePcAndStackTop( } if (checkStack && (stackTop > stackUpperBound)) { - size_t numChars; + Tcl_Size numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)", diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index ff3f2505c1d0..c7aee293ec7b 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -29,6 +29,7 @@ namespace eval tcltest { # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] + variable fullutf [package vsatisfies $version 8.7-] ##### Export the public tcltest procs; several categories # @@ -1150,16 +1151,17 @@ proc tcltest::SafeFetch {n1 n2 op} { # None. proc tcltest::Asciify {s} { + variable fullutf set print "" foreach c [split $s ""] { if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} { append print $c - } elseif {$c <= "\xFF"} { + } elseif {$c < "\u0100"} { append print \\x[format %02X [scan $c %c]] - } elseif {$c <= "\xFFFF"} { - append print \\u[format %04X [scan $c %c]] - } else { + } elseif {$fullutf && ($c >= "\U10000")} { append print \\U[format %08X [scan $c %c]] + } else { + append print \\u[format %04X [scan $c %c]] } } return $print diff --git a/tests/binary.test b/tests/binary.test index be8dd10e1b3d..a7ce33717552 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -2017,10 +2017,10 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} { } \xCD\xCC\xCC\x3F test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} { binary format R Inf -} \x7f\x80\x00\x00 +} \x7F\x80\x00\x00 test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} { binary format r Inf -} \x00\x00\x80\x7f +} \x00\x00\x80\x7F test binary-53.22 {Binary float Inf round trip} -body { binary scan [binary format R Inf] R inf binary scan [binary format R -Inf] R inf_ diff --git a/tests/chanio.test b/tests/chanio.test index cdd58169353a..5a793d6a9f8d 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -1104,7 +1104,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { lappend x [chan gets $f line] $line } -cleanup { chan close $f -} -result [list 15 "1234567890123０１" 18 0 1 -1 ""] +} -result [list 16 "1234567890123０１\x82" 18 0 1 -1 ""] test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup { variable x "" } -constraints {stdio fileevent} -body { diff --git a/tests/cmdAH.test b/tests/cmdAH.test index cc0af64d2eeb..555c70fdc5ca 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -207,24 +207,6 @@ proc endianUtf {enc} { return "" } -# Map arbitrary strings to printable form in ASCII. -proc printable {s} { - set print "" - foreach c [split $s ""] { - set i [scan $c %c] - if {[string is print $c] && ($i <= 127)} { - append print $c - } elseif {$i <= 0xff} { - append print \\x[format %02X $i] - } elseif {$i <= 0xffff} { - append print \\u[format %04X $i] - } else { - append print \\U[format %08X $i] - } - } - return $print -} - # # Check errors for invalid number of arguments proc badnumargs {id cmd cmdargs} { @@ -354,7 +336,7 @@ unknownencodingtest cmdAH-4.3.9 {convertfrom -failindex VAR -profile ABC} unknownencodingtest cmdAH-4.3.10 {convertfrom -profile strict -failindex ABC} testconvert cmdAH-4.3.11 { encoding convertfrom jis0208 \x38\x43 -} \u4e4e -setup { +} 乎 -setup { set system [encoding system] encoding system iso8859-1 } -cleanup { @@ -364,7 +346,7 @@ testconvert cmdAH-4.3.11 { # Verify single arg defaults to system encoding testconvert cmdAH-4.3.12 { encoding convertfrom \x38\x43 -} \u4e4e -setup { +} 乎 -setup { set system [encoding system] encoding system jis0208 } -cleanup { @@ -516,7 +498,7 @@ unknownencodingtest cmdAH-4.4.8 {convertto nosuchencoding ABC} unknownencodingtest cmdAH-4.4.9 {convertto -failindex VAR -profile ABC} unknownencodingtest cmdAH-4.4.10 {convertto -profile strict -failindex ABC} testconvert cmdAH-4.4.11 { - encoding convertto jis0208 \u4e4e + encoding convertto jis0208 乎 } \x38\x43 -setup { set system [encoding system] encoding system iso8859-1 @@ -526,7 +508,7 @@ testconvert cmdAH-4.4.11 { # Verify single arg defaults to system encoding testconvert cmdAH-4.4.12 { - encoding convertto \u4e4e + encoding convertto 乎 } \x38\x43 -setup { set system [encoding system] encoding system jis0208 @@ -539,7 +521,7 @@ testconvert cmdAH-4.4.12 { foreach {enc str hex ctrl comment} $encValidStrings { if {"knownBug" in $ctrl} continue set bytes [binary decode hex $hex] - set printable [printable $str] + set printable [tcltest::Asciify $str] set prefix A set suffix B set prefix_bytes [encoding convertto $enc A] @@ -556,7 +538,7 @@ foreach {enc str hex ctrl comment} $encValidStrings { foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings { if {"knownBug" in $ctrl} continue set bytes [binary decode hex $hex] - set printable [printable $str] + set printable [tcltest::Asciify $str] set prefix A set suffix B set prefix_bytes [encoding convertto $enc $prefix] @@ -605,7 +587,7 @@ foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings { foreach {enc str hex ctrl comment} $encValidStrings { if {"knownBug" in $ctrl} continue set bytes [binary decode hex $hex] - set printable [printable $str] + set printable [tcltest::Asciify $str] set prefix A set suffix B set prefix_bytes [encoding convertto $enc A] @@ -622,7 +604,7 @@ foreach {enc str hex ctrl comment} $encValidStrings { foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings { if {"knownBug" in $ctrl} continue set bytes [binary decode hex $hex] - set printable [printable $str] + set printable [tcltest::Asciify $str] set prefix A set suffix B set prefixLen [string length [encoding convertto $enc $prefix]] diff --git a/tests/encoding.test b/tests/encoding.test index 6220cb279736..c7575cb6b5d3 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -232,18 +232,6 @@ test encoding-10.1 {Tcl_UtfToExternal} { return $x } "ab\x8C\xC1g" -proc viewable {str} { - set res "" - foreach c [split $str {}] { - if {[string is print $c] && [string is ascii $c]} { - append res $c - } else { - append res "\\u[format %4.4X [scan $c %c]]" - } - } - return "$str ($res)" -} - test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} { set system [encoding system] set path [encoding dirs] @@ -265,11 +253,11 @@ test encoding-11.4 {LoadEncodingFile: multi-byte} { encoding convertfrom shiftjis \x8C\xC1 } 乎 test encoding-11.5 {LoadEncodingFile: escape file} { - viewable [encoding convertto iso2022 乎] -} [viewable "\x1B\$B8C\x1B(B"] + encoding convertto iso2022 乎 +} \x1B\$B8C\x1B(B test encoding-11.5.1 {LoadEncodingFile: escape file} { - viewable [encoding convertto iso2022-jp 乎] -} [viewable "\x1B\$B8C\x1B(B"] + encoding convertto iso2022-jp 乎 +} \x1B\$B8C\x1B(B test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup { set system [encoding system] set path [encoding dirs] @@ -293,17 +281,17 @@ test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} encoding system $system } -result {invalid encoding file "splat"} test encoding-11.8 {encoding: extended Unicode UTF-16} { - viewable [encoding convertto utf-16le 😹] -} {=Ø9Þ (=\u00D89\u00DE)} + encoding convertto utf-16le 😹 +} =Ø9Þ test encoding-11.9 {encoding: extended Unicode UTF-16} { - viewable [encoding convertto utf-16be 😹] -} {Ø=Þ9 (\u00D8=\u00DE9)} + encoding convertto utf-16be 😹 +} Ø=Þ9 test encoding-11.10 {encoding: extended Unicode UTF-32} { - viewable [encoding convertto utf-32le 😹] -} "9\xF6\x01\x00 (9\\u00F6\\u0001\\u0000)" + encoding convertto utf-32le 😹 +} 9\xF6\x01\x00 test encoding-11.11 {encoding: extended Unicode UTF-32} { - viewable [encoding convertto utf-32be 😹] -} "\x00\x01\xF69 (\\u0000\\u0001\\u00F69)" + encoding convertto utf-32be 😹 +} \x00\x01\xF69 # OpenEncodingFile is fully tested by the rest of the tests in this file. test encoding-12.1 {LoadTableEncoding: normal encoding} { @@ -330,8 +318,8 @@ test encoding-12.5 {LoadTableEncoding: symbol encoding} { } "ggγ" test encoding-13.1 {LoadEscapeTable} { - viewable [set x [encoding convertto iso2022 ab乎棙g]] -} [viewable "ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg"] + encoding convertto iso2022 ab乎棙g +} ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg test encoding-15.1 {UtfToUtfProc} { encoding convertto utf-8 £ @@ -755,14 +743,14 @@ test encoding-24.1 {EscapeFreeProc on open channels} exec { } {} test encoding-24.2 {EscapeFreeProc on open channels} {exec} { # Bug #524674 output - viewable [runInSubprocess { + runInSubprocess { encoding system cp1252; # Bug #2891556 crash revelator fconfigure stdout -encoding iso2022-jp puts ab乎棙g set env(TCL_FINALIZE_ON_EXIT) 1 exit - }] -} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(Bg)" + } +} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg" test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { # Bug #219314 - if we don't free escape encodings correctly on channel # closure, we go boom @@ -776,8 +764,8 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { set count [gets $f line] close $f removeFile iso2022.tcl - list $count [viewable $line] -} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"] + list $count $line +} [list 3 乎乞也] test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body { encoding convertfrom -profile strict utf-8 "\xC0\x80" @@ -1088,30 +1076,30 @@ runtests test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { - # Note - buffers are initialized to \xff + # Note - buffers are initialized to \xFF list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result -} -result [list 0 [list nospace {} \xff]] +} -result [list 0 [list nospace {} \xFF]] test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { - # Note - buffers are initialized to \xff + # Note - buffers are initialized to \xFF list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result } -result [list 0 [list nospace {} {}]] test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { - # Note - buffers are initialized to \xff + # Note - buffers are initialized to \xFF list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result } -result [list 0 [list nospace {} \x00\x00]] test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding } -body { - # Note - buffers are initialized to \xff + # Note - buffers are initialized to \xFF list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result -} -result [list 0 [list nospace {} \x00\x00\xff]] +} -result [list 0 [list nospace {} \x00\x00\xFF]] test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { testencoding ucs2 knownBug @@ -1119,7 +1107,7 @@ test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExtern # The knownBug constraint is because test depends on TCL_UTF_MAX and # also UtfToUtf16 assumes space required in destination buffer is # sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4 - # Note - buffers are initialized to \xff + # Note - buffers are initialized to \xFF list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result } -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]] @@ -1163,15 +1151,37 @@ test encoding-30.3 {encoding convertfrom large strings > 4GB} -constraints { } -result {4294967296 1} test encoding-bug-6a3e2cb0f0-1 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body { - encoding convertfrom -profile tcl8 iso2022-jp x\x1b\x7aaby + encoding convertfrom -profile tcl8 iso2022-jp x\x1B\x7Aaby } -result x\uFFFDy test encoding-bug-6a3e2cb0f0-2 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body { - encoding convertfrom -profile strict iso2022-jp x\x1b\x7aaby + encoding convertfrom -profile strict iso2022-jp x\x1B\x7Aaby } -returnCodes error -result {unexpected byte sequence starting at index 1: '\x1B'} test encoding-bug-6a3e2cb0f0-3 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body { - encoding convertfrom -profile replace iso2022-jp x\x1b\x7aaby + encoding convertfrom -profile replace iso2022-jp x\x1B\x7Aaby } -result x\uFFFDy +test encoding-bug-66ffafd309-1-tcl8 {Bug [66ffafd309] - truncated DBCS} -body { + encoding convertfrom -profile tcl8 gb12345 x +} -result x +test encoding-bug-66ffafd309-1-strict {Bug [66ffafd309] - truncated DBCS} -body { + encoding convertfrom -profile strict gb12345 x +} -result {unexpected byte sequence starting at index 0: '\x78'} -returnCodes error +test encoding-bug-66ffafd309-1-replace {Bug [66ffafd309] - truncated DBCS} -body { + encoding convertfrom -profile replace gb12345 x +} -result \uFFFD +test encoding-bug-66ffafd309-2-tcl8 {Bug [66ffafd309] - invalid DBCS} -body { + # Not truncated but invalid + encoding convertfrom -profile tcl8 jis0208 \x78\x79 +} -result \x78\x79 +test encoding-bug-66ffafd309-2-strict {Bug [66ffafd309] - invalid DBCS} -body { + # Not truncated but invalid + encoding convertfrom -profile strict jis0208 \x78\x79 +} -result {unexpected byte sequence starting at index 1: '\x79'} -returnCodes error +test encoding-bug-66ffafd309-2-replace {Bug [66ffafd309] - invalid DBCS} -body { + # Not truncated but invalid + encoding convertfrom -profile replace jis0208 \x78\x79 +} -result \uFFFD\uFFFD + # cleanup namespace delete ::tcl::test::encoding ::tcltest::cleanupTests diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index 1b569a1ec13d..38b3da5cb216 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -32,7 +32,7 @@ set encValidStrings {}; # Reset the table lappend encValidStrings {*}{ ascii \u0000 00 {} {Lowest ASCII} - ascii \u007F 7F knownBug {Highest ASCII} + ascii \u007F 7F {} {Highest ASCII} ascii \u007D 7D {} {Brace - just to verify test scripts are escaped correctly} ascii \u007B 7B {} {Terminating brace - just to verify test scripts are escaped correctly} @@ -593,11 +593,11 @@ lappend encInvalidBytes {*}{ utf-32le 00D8000000DC0000 tcl8 \uD800\uDC00 -1 {} {High-low-surrogate-pair} utf-32le 00D8000000DC0000 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair} utf-32le 00D8000000DC0000 strict {} 0 {} {High-low-surrogate-pair} - utf-32le 00001100 tcl8 \UFFFD -1 {} {Out of range} - utf-32le 00001100 replace \UFFFD -1 {} {Out of range} + utf-32le 00001100 tcl8 \uFFFD -1 {} {Out of range} + utf-32le 00001100 replace \uFFFD -1 {} {Out of range} utf-32le 00001100 strict {} 0 {} {Out of range} - utf-32le FFFFFFFF tcl8 \UFFFD -1 {} {Out of range} - utf-32le FFFFFFFF replace \UFFFD -1 {} {Out of range} + utf-32le FFFFFFFF tcl8 \uFFFD -1 {} {Out of range} + utf-32le FFFFFFFF replace \uFFFD -1 {} {Out of range} utf-32le FFFFFFFF strict {} 0 {} {Out of range} utf-32be 41 tcl8 \uFFFD -1 {solo tail} {Truncated} @@ -618,11 +618,11 @@ lappend encInvalidBytes {*}{ utf-32be 0000D8000000DC00 tcl8 \uD800\uDC00 -1 {} {High-low-surrogate-pair} utf-32be 0000D8000000DC00 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair} utf-32be 0000D8000000DC00 strict {} 0 {} {High-low-surrogate-pair} - utf-32be 00110000 tcl8 \UFFFD -1 {} {Out of range} - utf-32be 00110000 replace \UFFFD -1 {} {Out of range} + utf-32be 00110000 tcl8 \uFFFD -1 {} {Out of range} + utf-32be 00110000 replace \uFFFD -1 {} {Out of range} utf-32be 00110000 strict {} 0 {} {Out of range} - utf-32be FFFFFFFF tcl8 \UFFFD -1 {} {Out of range} - utf-32be FFFFFFFF replace \UFFFD -1 {} {Out of range} + utf-32be FFFFFFFF tcl8 \uFFFD -1 {} {Out of range} + utf-32be FFFFFFFF replace \uFFFD -1 {} {Out of range} utf-32be FFFFFFFF strict {} 0 {} {Out of range} } diff --git a/tests/io.test b/tests/io.test index a88ee993e572..0fed043c5e46 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1201,7 +1201,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { lappend x [gets $f line] $line close $f set x -} [list 15 "1234567890123０１" 18 0 1 -1 ""] +} [list 16 "1234567890123０１\x82" 18 0 1 -1 ""] test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} { set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none diff --git a/tests/lseq.test b/tests/lseq.test index c7b0079aef56..3561d441a464 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -18,6 +18,7 @@ testConstraint arithSeriesDouble 1 testConstraint arithSeriesShimmer 1 testConstraint arithSeriesShimmerOk 1 testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}] +testConstraint has32BitLengths [expr {$tcl_platform(pointerSize) == 4}] # Arg errors test lseq-1.1 {error cases} -body { @@ -436,7 +437,7 @@ test lseq-3.30 {lreverse with double values} -constraints arithSeriesDouble -bod arithseries 18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5} -test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble has64BitLengths} { +test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble} { lreverse [lseq 1.1 29.9 0.3] } {29.9 29.6 29.3 29.0 28.7 28.4 28.1 27.8 27.5 27.2 26.9 26.6 26.3 26.0 25.7 25.4 25.1 24.8 24.5 24.2 23.9 23.6 23.3 23.0 22.7 22.4 22.1 21.8 21.5 21.2 20.9 20.6 20.3 20.0 19.7 19.4 19.1 18.8 18.5 18.2 17.9 17.6 17.3 17.0 16.7 16.4 16.1 15.8 15.5 15.2 14.9 14.6 14.3 14.0 13.7 13.4 13.1 12.8 12.5 12.2 11.9 11.6 11.3 11.0 10.7 10.4 10.1 9.8 9.5 9.2 8.9 8.6 8.3 8.0 7.7 7.4 7.1 6.8 6.5 6.2 5.9 5.6 5.3 5.0 4.7 4.4 4.1 3.8 3.5 3.2 2.9 2.6 2.3 2.0 1.7 1.4 1.1} @@ -540,6 +541,25 @@ test lseq-4.4 {lseq corner case} -constraints has64BitLengths -body { unset res s e tcmd } -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638} +test lseq-4.4.32 {lseq corner case} -constraints has32BitLengths -body { + set tcmd { + set res {} + set s [catch {lindex [lseq 10 100] 0} e] + lappend res $s $e + set s [catch {lindex [lseq 10 9223372036854775000] 0} e] + lappend res $s $e + set s [catch {llength [lseq 10 9223372036854775000]} e] + lappend res $s $e + set s [catch {lindex [lseq 10 2147483647] 0} e] + lappend res $s $e + set s [catch {llength [lseq 10 2147483647]} e] + lappend res $s $e + } + eval $tcmd +} -cleanup { + unset res s e tcmd +} -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638} + # Ticket 99e834bf33 - lseq, lindex end off by one test lseq-4.5 {lindex off by one} -body { @@ -590,7 +610,7 @@ test lseq-4.10 {panic using variable index} -body { lindex [lseq 10] $i } -cleanup {unset i} -result {0} -test lseq-4.11 {bug lseq / lindex discrepancies} -constraints has64BitLengths -body { +test lseq-4.11 {bug lseq / lindex discrepancies} -body { lindex [lseq 0x7fffffff] 0x80000000 } -result {} @@ -598,7 +618,11 @@ test lseq-4.12 {bug lseq} -constraints has64BitLengths -body { llength [lseq 0x100000000] } -result {4294967296} -test lseq-4.13 {bug lseq} -constraints {has64BitLengths knownBug} -body { +test lseq-4.12.32 {bug lseq} -constraints has32BitLengths -body { + llength [lseq 0x100000000] +} -returnCodes 1 -result {max length of a Tcl list exceeded} + +test lseq-4.13 {bug lseq} -constraints knownBug -body { set l [lseq 0x7fffffffffffffff] list \ [llength $l] \ @@ -607,12 +631,12 @@ test lseq-4.13 {bug lseq} -constraints {has64BitLengths knownBug} -body { } -cleanup {unset l} -result {9223372036854775807 9223372036854775806 9223372036854775800} -test lseq-4.14 {bug lseq - inconsistent rounding} has64BitLengths { +test lseq-4.14 {bug lseq - inconsistent rounding} { # using a non-integer increment, [lseq] rounding seems to be not consistent: lseq 4 40 0.1 } {4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9 6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0} -test lseq-4.15 {bug lseq - inconsistent rounding} has64BitLengths { +test lseq-4.15 {bug lseq - inconsistent rounding} { # using a non-integer increment, [lseq] rounding seems to be not consistent: lseq 6 40 0.1 } {6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0} diff --git a/tests/utfext.test b/tests/utfext.test index b980800c8d61..06705025601d 100644 --- a/tests/utfext.test +++ b/tests/utfext.test @@ -24,25 +24,6 @@ lappend utfExtMap {*}{ ascii 414243 414243 } -if {[info commands printable] eq ""} { - proc printable {s} { - set print "" - foreach c [split $s ""] { - set i [scan $c %c] - if {[string is print $c] && ($i <= 127)} { - append print $c - } elseif {$i <= 0xff} { - append print \\x[format %02X $i] - } elseif {$i <= 0xffff} { - append print \\u[format %04X $i] - } else { - append print \\U[format %08X $i] - } - } - return $print - } -} - # Simple test with basic flags proc testbasic {direction enc hexin hexout {flags {start end}}} { if {$direction eq "toutf"} { @@ -93,6 +74,14 @@ test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body { # % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv # nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ +test TableToUtf-bug-5be203d6ca {Bug 5be203d6ca - truncated prefix in table encoding} -body { + set src \x82\x4f\x82\x50\x82 + lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] buf + set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] + lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end} 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] + + ::tcltest::cleanupTests return diff --git a/tests/winConsole.test b/tests/winConsole.test index 3104184d3e16..5aa130b9da1d 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -218,7 +218,7 @@ test console-fconfigure-get-1.[incr testnum] { Console get stdin option -eofchar } -constraints {win interactive} -body { fconfigure stdin -eofchar -} -result \x1a +} -result \x1A test console-fconfigure-get-1.[incr testnum] { fconfigure -winsize diff --git a/tests/winDde.test b/tests/winDde.test index 93b92420303e..8f4da11a526e 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -130,104 +130,104 @@ test winDde-2.4 {Checking for existence, with only the topic specified} \ # ------------------------------------------------------------------------- test winDde-3.1 {DDE execute locally} -constraints dde -body { - set \xe1 "" - dde execute TclEval self [list set \xe1 foo] - set \xe1 + set \xE1 "" + dde execute TclEval self [list set \xE1 foo] + set \xE1 } -result foo test winDde-3.2 {DDE execute -async locally} -constraints dde -body { - set \xe1 "" - dde execute -async TclEval self [list set \xe1 foo] + set \xE1 "" + dde execute -async TclEval self [list set \xE1 foo] update - set \xe1 + set \xE1 } -result foo test winDde-3.3 {DDE request locally} -constraints dde -body { - set \xe1 "" - dde execute TclEval self [list set \xe1 foo] - dde request TclEval self \xe1 + set \xE1 "" + dde execute TclEval self [list set \xE1 foo] + dde request TclEval self \xE1 } -result foo test winDde-3.4 {DDE eval locally} -constraints dde -body { - set \xe1 "" - dde eval self set \xe1 foo + set \xE1 "" + dde eval self set \xE1 foo } -result foo test winDde-3.5 {DDE request locally} -constraints dde -body { - set \xe1 "" - dde execute TclEval self [list set \xe1 foo] - dde request -binary TclEval self \xe1 + set \xE1 "" + dde execute TclEval self [list set \xE1 foo] + dde request -binary TclEval self \xE1 } -result "foo\x00" # Set variable a to A with diaeresis (Unicode C4) by relying on the fact # that utf-8 is sent (e.g. "c3 84" on the wire) test winDde-3.6 {DDE request utf-8} -constraints dde -body { - set \xe1 "not set" - dde execute TclEval self "set \xe1 \xc4" - scan [set \xe1] %c + set \xE1 "not set" + dde execute TclEval self "set \xE1 \xC4" + scan [set \xE1] %c } -result 196 # Set variable a to A with diaeresis (Unicode C4) using binary execute # and compose utf-8 (e.g. "c3 84" ) manually test winDde-3.7 {DDE request binary} -constraints {dde notWine} -body { - set \xe1 "not set" - dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00] - scan [set \xe1] %c + set \xE1 "not set" + dde execute -binary TclEval self [list set \xC3\xA1 \xC3\x84\x00] + scan [set \xE1] %c } -result 196 test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body { - set \xe1 "" - dde poke TclEval self \xe1 \xc4 - dde request TclEval self \xe1 -} -result \xc4 + set \xE1 "" + dde poke TclEval self \xE1 \xC4 + dde request TclEval self \xE1 +} -result \xC4 test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body { - set \xe1 "" - dde poke -binary TclEval self \xe1 \xc3\x84\x00 - dde request TclEval self \xe1 -} -result \xc4 + set \xE1 "" + dde poke -binary TclEval self \xE1 \xC3\x84\x00 + dde request TclEval self \xE1 +} -result \xC4 # ------------------------------------------------------------------------- test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body { - set \xe1 "" + set \xE1 "" set name ch\xEDld-4.1 set child [createChildProcess $name] - dde execute TclEval $name [list set \xe1 foo] + dde execute TclEval $name [list set \xE1 foo] dde execute TclEval $name {set done 1} update - set \xe1 + set \xE1 } -result "" test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body { - set \xe1 "" + set \xE1 "" set name ch\xEDld-4.2 set child [createChildProcess $name] - dde execute -async TclEval $name [list set \xe1 foo] + dde execute -async TclEval $name [list set \xE1 foo] update dde execute TclEval $name {set done 1} update - set \xe1 + set \xE1 } -result "" test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body { - set \xe1 "" + set \xE1 "" set name ch\xEDld-4.3 set child [createChildProcess $name] - dde execute TclEval $name [list set \xe1 foo] - set \xe1 [dde request TclEval $name \xe1] + dde execute TclEval $name [list set \xE1 foo] + set \xE1 [dde request TclEval $name \xE1] dde execute TclEval $name {set done 1} update - set \xe1 + set \xE1 } -result foo test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body { - set \xe1 "" + set \xE1 "" set name ch\xEDld-4.4 set child [createChildProcess $name] - set \xe1 [dde eval $name set \xe1 foo] + set \xE1 [dde eval $name set \xE1 foo] dde execute TclEval $name {set done 1} update - set \xe1 + set \xE1 } -result foo test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body { - set \xe1 "" + set \xE1 "" set name ch\xEDld-4.5 set child [createChildProcess $name] - dde poke TclEval $name \xe1 foo - set \xe1 [dde request TclEval $name \xe1] + dde poke TclEval $name \xE1 foo + set \xE1 [dde request TclEval $name \xE1] dde execute TclEval $name {set done 1} update - set \xe1 + set \xE1 } -result foo # ------------------------------------------------------------------------- @@ -402,8 +402,8 @@ test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup { child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} child invokehidden dde servername -handler DDEACCEPT child } -body { - dde eval child set \xe1 1 - child eval set \xe1 + dde eval child set \xE1 1 + child eval set \xE1 } -cleanup {interp delete child} -result 1 test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup { interp create -safe child diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 05d9ebb2fc86..e42b4e89b29a 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -22,7 +22,7 @@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ -CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ +CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \ @@ -67,7 +67,7 @@ pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c embtest: embtest.o - $(CC) -o $@ embtest.o ${SHLIB_LD_LIBS} + $(CC) $(CC_SWITCHES) -o $@ embtest.o ${SHLIB_LD_LIBS} tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o ${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 2907ec21f89e..cb35b7c2387c 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -1,7 +1,7 @@ /* * pkgb.c -- * - * This file contains a simple Tcl package "Pkgb" that is intended for + * This file contains a simple Tcl package "pkgb" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. * diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 8ceafcd8fc78..886c8f8c8287 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -1,7 +1,7 @@ /* * pkgd.c -- * - * This file contains a simple Tcl package "PKGD" that is intended for + * This file contains a simple Tcl package "pkgd" that is intended for * testing the Tcl dynamic loading facilities. It can be used in both * safe and unsafe interpreters. *