From d7461d07ad79630ccb7605ea15e47e50aaea44a9 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 May 2014 16:31:06 +0000 Subject: Tests (chan)io-34.21 are constrained for largefileSupport, and that's disabled by default, which means never tested, which means the ridiculous bugs in them are never found and fixed. Fixed the bugs, changed the default. Large File Suppport (4GB) is commonplace now. Let those without it suffer a few failing tests reporting that fact to them. --- tests/chanio.test | 6 +++--- tests/io.test | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index b195f7b..5ea7ec1 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -41,7 +41,7 @@ namespace eval ::tcl::test::io { # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... - testConstraint largefileSupport 0 + testConstraint largefileSupport 1 # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. @@ -4427,10 +4427,10 @@ test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} { chan puts -nonewline $f abcdef lappend l [chan tell $f] chan close $f - lappend l [file size $f] + lappend l [file size $path(test3)] # truncate... chan close [open $path(test3) w] - lappend l [file size $f] + lappend l [file size $path(test3)] set l } {0 6 6 4294967296 4294967302 4294967302 0} diff --git a/tests/io.test b/tests/io.test index 7707a28..7f1a357 100644 --- a/tests/io.test +++ b/tests/io.test @@ -41,7 +41,7 @@ testConstraint testthread [llength [info commands testthread]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... -testConstraint largefileSupport 0 +testConstraint largefileSupport 1 # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. @@ -4433,10 +4433,10 @@ test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} { puts -nonewline $f abcdef lappend l [tell $f] close $f - lappend l [file size $f] + lappend l [file size $path(test3)] # truncate... close [open $path(test3) w] - lappend l [file size $f] + lappend l [file size $path(test3)] set l } {0 6 6 4294967296 4294967302 4294967302 0} -- cgit v0.12 From 8b4cb6f5d95d707abacdcfbcb75153cd12edb59f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 May 2014 16:38:23 +0000 Subject: Added comment explaining the "knownBug" in iogt-6.1 --- tests/iogt.test | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/iogt.test b/tests/iogt.test index d4291b3..20d7538 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -968,6 +968,15 @@ test iogt-6.0 {Push back} testchannel { } {xxx} test iogt-6.1 {Push back and up} {testchannel knownBug} { + + # This test demonstrates the bug/misfeature in the stacked + # channel implementation that data can be discarded if it is + # read into the buffers of one channel in the stack, and then + # that channel is popped before anything above it reads. + # + # This bug can be worked around by always setting -buffersize + # to 1, but who wants to do that? + set f [open $path(dummy) r] # contents of dummy = "abcdefghi..." -- cgit v0.12 From 1b7b5e839ce087299e2b57ad508743da5c88b0ea Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 May 2014 16:55:34 +0000 Subject: Correct namespace bugs in normally skipped tests. Constrain them as "knownBug" rather than "unknownFailure". --- tests/iogt.test | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/iogt.test b/tests/iogt.test index 20d7538..0e2eb3c 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -159,8 +159,8 @@ proc fevent {fdelay idelay blocks script data} { #puts stdout ">>>>>" ; flush stdout - uplevel #0 set sock $sk - set res [uplevel #0 $script] + uplevel 1 set sock $sk + set res [uplevel 1 $script] catch {close $sk} return $res @@ -686,7 +686,7 @@ test iogt-2.5 {basic I/O, mixed trail} {testchannel} { } {} test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ - {testchannel unknownFailure} { + {testchannel knownBug} { # This test to check the validity of aquired Tcl_Channel references is # not possible because even a backgrounded fcopy will immediately start # to copy data, without waiting for the event loop. This is done only in @@ -703,6 +703,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ set fin [open $path(dummy) r] fevent 1000 500 {20 20 20 10 1 1} { + variable copy close $fin set fout [open dummyout w] @@ -740,7 +741,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ } {1 {create/write create/read write flush/write flush/read delete/write delete/read}} -test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} { +test iogt-4.0 {fileevent readable, after transform} {testchannel knownBug} { set fin [open $path(dummy) r] set data [read $fin] close $fin @@ -770,10 +771,11 @@ test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} } fevent 1000 500 {20 20 20 10 1} { + variable stop audit_flow trail -attach $sock rblocks_t rbuf trail 23 -attach $sock - fileevent $sock readable [list Get $sock] + fileevent $sock readable [namespace code [list Get $sock]] flush $sock ; # now, or fcopy will error us out # But the 1 second delay should be enough to @@ -871,7 +873,7 @@ delete/write {} *ignored* delete/read {} *ignored*} ; # catch unescaped quote " -test iogt-5.0 {EOF simulation} {testchannel unknownFailure} { +test iogt-5.0 {EOF simulation} {testchannel knownBug} { set fin [open $path(dummy) r] set fout [open $path(dummyout) w] -- cgit v0.12 From 73f53667edbf72a3b3f591e5af3fe5abbc405377 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 May 2014 17:46:45 +0000 Subject: Repair another "impossible" test and the segfault it reveals. --- generic/tclIORTrans.c | 2 ++ tests/ioTrans.test | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1de635f..1dff4b3 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -2010,6 +2010,7 @@ InvokeTclMethod( sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */); Tcl_Preserve(rtPtr); + Tcl_Preserve(rtPtr->interp); result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL); /* @@ -2054,6 +2055,7 @@ InvokeTclMethod( Tcl_IncrRefCount(resObj); } Tcl_RestoreInterpState(rtPtr->interp, sr); + Tcl_Release(rtPtr->interp); Tcl_Release(rtPtr); /* diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 7f4f7f0..c40621b 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -1034,7 +1034,7 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces # Magic to get the test* commands in the slaves load {} Tcltest $ida load {} Tcltest $idb -} -constraints {testchannel impossible} -match glob -body { +} -constraints {testchannel} -match glob -body { # Set up channel in thread set chan [interp eval $ida $helperscript] set chan [interp eval $ida { @@ -1042,14 +1042,14 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces handle.initialize clear drain flush limit? read write handle.finalize lappend ::res $args - # Destroy interpreter during channel access. Actually not - # possible for an interp to destroy itself. - interp delete {} - return} + # Destroy interpreter during channel access. + suicide + } set chan [chan push [tempchan] foo] fconfigure $chan -buffering none set chan }] + interp alias $ida suicide {} interp delete $ida # Move channel to 2nd thread, transform goes with it. interp eval $ida [list testchannel cut $chan] interp eval $idb [list testchannel splice $chan] -- cgit v0.12 From a4eef46453e48d4ee14d21d20e9b484c4da21e4d Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 11 May 2014 10:39:14 +0000 Subject: [6d2f249a01] Handle a failure to comprehend half-way through the compilation of a chain of compileable ensembles. --- generic/tclEnsemble.c | 24 +++++++++++++++++------- tests/namespace.test | 4 ++++ 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 9bb7a0c..022dafa 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2751,13 +2751,6 @@ TclCompileEnsemble( const char *word; Tcl_IncrRefCount(replaced); - - /* - * This is where we return to if we are parsing multiple nested compiled - * ensembles. [info object] is such a beast. - */ - - checkNextWord: if (parsePtr->numWords < depth + 1) { goto failed; } @@ -2769,6 +2762,12 @@ TclCompileEnsemble( goto failed; } + /* + * This is where we return to if we are parsing multiple nested compiled + * ensembles. [info object] is such a beast. + */ + + checkNextWord: word = tokenPtr[1].start; numBytes = tokenPtr[1].size; @@ -2979,6 +2978,17 @@ TclCompileEnsemble( if (cmdPtr->compileProc == TclCompileEnsemble) { tokenPtr = TokenAfter(tokenPtr); + if (parsePtr->numWords < depth + 1 + || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + /* + * Too hard because the user has done something unpleasant like + * omitting the sub-ensemble's command name or used a non-constant + * name for a sub-ensemble's command name; we respond by bailing + * out completely (this is a rare case). [Bug 6d2f249a01] + */ + + goto cleanup; + } ensemble = (Tcl_Command) cmdPtr; goto checkNextWord; } diff --git a/tests/namespace.test b/tests/namespace.test index fab0040..cded1f4 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2949,6 +2949,10 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ rename getbytes {} unset i ns start end } -result 0 + +test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} { + info class [format %s constructor] oo::object +} "" # cleanup catch {rename cmd1 {}} -- cgit v0.12 From 7156085860588c9eeff8cbef15d94d3d4db8da0c Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 12 May 2014 17:19:16 +0000 Subject: Have the [chan push] machinery ReadRaw() directly into the argument to be passed to the read method of the channel transformation command. Save a copy. --- generic/tclIORTrans.c | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1dff4b3..b9dd1d6 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -457,8 +457,7 @@ static void TimerKill(ReflectedTransform *rtPtr); static void TimerSetup(ReflectedTransform *rtPtr); static void TimerRun(ClientData clientData); static int TransformRead(ReflectedTransform *rtPtr, - int *errorCodePtr, unsigned char *buf, - int toRead); + int *errorCodePtr, Tcl_Obj *bufObj); static int TransformWrite(ReflectedTransform *rtPtr, int *errorCodePtr, unsigned char *buf, int toWrite); @@ -1063,6 +1062,7 @@ ReflectInput( { ReflectedTransform *rtPtr = clientData; int gotBytes, copied, readBytes; + Tcl_Obj *bufObj; /* * The following check can be done before thread redirection, because we @@ -1078,6 +1078,9 @@ ReflectInput( Tcl_Preserve(rtPtr); + /* TODO: Consider a more appropriate buffer size. */ + bufObj = Tcl_NewByteArrayObj(NULL, toRead); + Tcl_IncrRefCount(bufObj); gotBytes = 0; while (toRead > 0) { /* @@ -1129,7 +1132,9 @@ ReflectInput( goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead); + + readBytes = Tcl_ReadRaw(rtPtr->parent, + (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { /* * Report errors to caller. The state of the seek system is @@ -1213,12 +1218,20 @@ ReflectInput( * iteration will put it into the result. */ - if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) { + Tcl_SetByteArrayLength(bufObj, readBytes); + if (!TransformRead(rtPtr, errorCodePtr, bufObj)) { goto error; } + if (Tcl_IsShared(bufObj)) { + Tcl_DecrRefCount(bufObj); + bufObj = Tcl_NewObj(); + Tcl_IncrRefCount(bufObj); + } + Tcl_SetByteArrayLength(bufObj, 0); } /* while toRead > 0 */ stop: + Tcl_DecrRefCount(bufObj); Tcl_Release(rtPtr); return gotBytes; @@ -3067,10 +3080,8 @@ static int TransformRead( ReflectedTransform *rtPtr, int *errorCodePtr, - unsigned char *buf, - int toRead) + Tcl_Obj *bufObj) { - Tcl_Obj *bufObj; Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -3083,8 +3094,8 @@ TransformRead( if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - p.transform.buf = (char *) buf; - p.transform.size = toRead; + p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, + &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); @@ -3104,12 +3115,8 @@ TransformRead( /* ASSERT: rtPtr->method & FLAG(METH_READ) */ /* ASSERT: rtPtr->mode & TCL_READABLE */ - bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead); - Tcl_IncrRefCount(bufObj); - if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); - Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; @@ -3118,7 +3125,6 @@ TransformRead( bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); - Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } -- cgit v0.12 From 29055898b0e66169e5fa34f0299b603afcdbb49c Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 12 May 2014 21:50:55 +0000 Subject: Restore the largefileSupport constraint on Darwin, where tests (chan)io-34.21 take an unbearable 90 seconds each to complete. --- tests/chanio.test | 2 +- tests/io.test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index 5ea7ec1..2f2540e 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -41,7 +41,7 @@ namespace eval ::tcl::test::io { # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... - testConstraint largefileSupport 1 + testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. diff --git a/tests/io.test b/tests/io.test index 7f1a357..f692e43 100644 --- a/tests/io.test +++ b/tests/io.test @@ -41,7 +41,7 @@ testConstraint testthread [llength [info commands testthread]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... -testConstraint largefileSupport 1 +testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. -- cgit v0.12 From 7974460313615cd1fa65bf570b8e5d87d01d2add Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 13 May 2014 11:23:40 +0000 Subject: [958bc05fbe]: Clarify "clock format" using "%R" --- doc/clock.n | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/clock.n b/doc/clock.n index 7c4c3df..a0cc63e 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -626,8 +626,9 @@ On output, produces a locale-dependent time of day representation on a 12-hour clock. On input, accepts whatever \fB%r\fR produces. .TP \fB%R\fR -On output, produces a locale-dependent time of day representation on a -24-hour clock. On input, accepts whatever \fB%R\fR produces. +On output, the time in 24-hour notation (%H:%M). For a version +including the seconds, see \fB%T\fR below. On input, accepts whatever +\fB%R\fR produces. .TP \fB%s\fR On output, simply formats the \fItimeVal\fR argument as a decimal -- cgit v0.12 From 2e71d669fe81b7911acde1deb7df892f531d1c8d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 14 May 2014 09:11:42 +0000 Subject: Fix 3 test-cases which started failing on Windows --- tests/io.test | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/io.test b/tests/io.test index f692e43..b99c4e9 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6825,6 +6825,7 @@ test io-52.12 {coverage of -translation auto} { set in [open $path(test1)] chan configure $in -buffersize 8 set out [open $path(test2) w] + chan configure $out -translation lf fcopy $in $out close $in close $out @@ -6839,6 +6840,7 @@ test io-52.13 {coverage of -translation cr} { set in [open $path(test1)] chan configure $in -buffersize 8 -translation cr set out [open $path(test2) w] + chan configure $out -translation lf fcopy $in $out close $in close $out @@ -6853,6 +6855,7 @@ test io-52.14 {coverage of -translation crlf} { set in [open $path(test1)] chan configure $in -buffersize 8 -translation crlf set out [open $path(test2) w] + chan configure $out -translation lf fcopy $in $out close $in close $out -- cgit v0.12 From c6cd29b3f9a97c7692732aad516cbd176870261a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 15 May 2014 14:54:45 +0000 Subject: Fix [3118489]: NUL in filenames. (On Windows, protect against invalid use of ':' in filenames as well) --- tests/cmdAH.test | 3 +++ unix/tclUnixFile.c | 6 ++++++ win/tclWinFile.c | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 70 insertions(+), 2 deletions(-) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index dc61ac6..4ca90c6 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -104,6 +104,9 @@ test cmdAH-2.6.1 {Tcl_CdObjCmd} { list [catch {cd ""} msg] $msg } {1 {couldn't change working directory to "": no such file or directory}} +test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body { + cd .\0 +} -result "couldn't change working directory to \".\0\": no such file or directory" test cmdAH-2.7 {Tcl_ConcatObjCmd} { concat } {} diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 29f1aba..c5f75a7 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -1111,6 +1111,12 @@ TclNativeCreateNativeRep( str = Tcl_GetStringFromObj(validPathPtr, &len); Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); + if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { + /* See bug [3118489]: NUL in filenames */ + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } Tcl_DecrRefCount(validPathPtr); nativePathPtr = ckalloc((unsigned) len); memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index ed0c40f..9bf63b1 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1856,6 +1856,9 @@ TclpObjChdir( nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr); + if (!nativePath) { + return -1; + } result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); if (result == 0) { @@ -3200,13 +3203,69 @@ TclNativeCreateNativeRep( Tcl_WinUtfToTChar(str, len, &ds); if (tclWinProcs->useWide) { WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds); - for (; *wp; ++wp) { - if (*wp=='/') { + len = Tcl_DStringLength(&ds)>>1; + /* + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but accept the '?' as being valid. + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + wp[0] = wp[1] = wp[3] = '\\'; + str += 4; + wp += 4; + len -= 4; + } + /* + ** If there is a drive prefix, the ':' must be considered valid. + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':') { + wp += 2; + len -= 2; + } + while (len-->0) { + if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } else if (*wp=='/') { *wp = '\\'; } + ++wp; } len = Tcl_DStringLength(&ds) + sizeof(WCHAR); } else { + char *p = Tcl_DStringValue(&ds); + len = Tcl_DStringLength(&ds); + /* + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but accept the '?' as being valid. + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + p[0] = p[1] = p[3] = '\\'; + str += 4; + p += 4; + len -= 4; + } + /* + ** If there is a drive prefix, the ':' must be considered valid. + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':') { + p += 2; + len -= 2; + } + while (len-->0) { + if ((*p < ' ') || strchr("\"*:<>?|", *p)) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } else if (*p=='/') { + *p = '\\'; + } + ++p; + } len = Tcl_DStringLength(&ds) + sizeof(char); } Tcl_DecrRefCount(validPathPtr); -- cgit v0.12 From b4ca74a5629b1e6ef5e8af2fc3db7f04cb3cbef9 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 May 2014 16:48:43 +0000 Subject: Portable test to demo bug otherwise seen only on Windows. --- tests/io.test | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/io.test b/tests/io.test index b99c4e9..b82f403 100644 --- a/tests/io.test +++ b/tests/io.test @@ -3960,6 +3960,26 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} { } {{hello } {hello }} +test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} { + file delete $path(pipe) + set f1 [open $path(pipe) w] + puts $f1 {chan configure stdout -translation crlf} + puts $f1 {puts [gets stdin]} + puts $f1 {puts [gets stdin]} + close $f1 + set f1 [open "|[list [interpreter] $path(pipe)]" r+] + puts $f1 hello + flush $f1 + set x "" + lappend x [read $f1 6] + puts $f1 hello + flush $f1 + lappend x [read $f1] + close $f1 + set x +} {{hello +} {hello +}} test io-32.12 {Tcl_Read, -nonewline} { file delete $path(test1) set f1 [open $path(test1) w] -- cgit v0.12 From 61f362f9a4c262856f8b21eade121e61cb1fd697 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 May 2014 18:38:22 +0000 Subject: Branch to demo bug introduced in the parent commit. --- tests/io.test | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/io.test b/tests/io.test index c325809..b28566b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -3960,6 +3960,26 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} { } {{hello } {hello }} +test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} { + file delete $path(pipe) + set f1 [open $path(pipe) w] + puts $f1 {chan configure stdout -translation crlf} + puts $f1 {puts [gets stdin]} + puts $f1 {puts [gets stdin]} + close $f1 + set f1 [open "|[list [interpreter] $path(pipe)]" r+] + puts $f1 hello + flush $f1 + set x "" + lappend x [read $f1 6] + puts $f1 hello + flush $f1 + lappend x [read $f1] + close $f1 + set x +} {{hello +} {hello +}} test io-32.12 {Tcl_Read, -nonewline} { file delete $path(test1) set f1 [open $path(test1) w] -- cgit v0.12 From d32b2d81713aeb33ff38dabe354908a4c9fc38a2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 May 2014 12:56:01 +0000 Subject: More tests to demo the bug more directly. --- tests/io.test | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/tests/io.test b/tests/io.test index b28566b..53b7105 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1559,6 +1559,45 @@ test io-13.8 {TranslateInputEOL: auto mode: \r\n} { close $f set x } "abcd\ndef" +test io-13.8.1 {TranslateInputEOL: auto mode: \r\n} { + set f [open $path(test1) w] + fconfigure $f -translation lf + puts -nonewline $f "abcd\r\ndef" + close $f + set f [open $path(test1)] + fconfigure $f -translation auto + set x {} + lappend x [read $f 5] + lappend x [read $f] + close $f + set x +} [list "abcd\n" "def"] +test io-13.8.2 {TranslateInputEOL: auto mode: \r\n} { + set f [open $path(test1) w] + fconfigure $f -translation lf + puts -nonewline $f "abcd\r\ndef" + close $f + set f [open $path(test1)] + fconfigure $f -translation auto -buffersize 6 + set x {} + lappend x [read $f 5] + lappend x [read $f] + close $f + set x +} [list "abcd\n" "def"] +test io-13.8.3 {TranslateInputEOL: auto mode: \r\n} { + set f [open $path(test1) w] + fconfigure $f -translation lf + puts -nonewline $f "abcd\r\n\r\ndef" + close $f + set f [open $path(test1)] + fconfigure $f -translation auto -buffersize 7 + set x {} + lappend x [read $f 5] + lappend x [read $f] + close $f + set x +} [list "abcd\n" "\ndef"] test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} { set f [open $path(test1) w] fconfigure $f -translation lf -- cgit v0.12 From 47912a0cab3f90ca4c7bad70f007885b7c82fa4f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 May 2014 14:40:39 +0000 Subject: Bug fix - accept consumption of the trailing newline in crlf with no characters produced. Also delete false assertions. --- generic/tclIO.c | 46 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 37 insertions(+), 9 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 139a05e..16fc685 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5400,7 +5400,6 @@ ReadChars( * record \r or \n yet. */ - assert(dstRead + 1 == dstDecoded); assert(dst[dstRead] == '\r'); assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF); @@ -5421,7 +5420,6 @@ ReadChars( assert(dstWrote == 0); assert(dstRead == 0); - assert(dstDecoded == 1); /* * We decoded only the bare cr, and we cannot read a @@ -5476,6 +5474,13 @@ ReadChars( return 1; } + /* + * Revise the dstRead value so that the numChars calc + * below correctly computes zero characters read. + */ + + dstRead = numChars; + /* FALL THROUGH - get more data (dstWrote == 0) */ } @@ -5502,16 +5507,38 @@ ReadChars( } if (dstWrote == 0) { + ChannelBuffer *nextPtr; - /* - * We were not able to read any chars. Maybe there were - * not enough src bytes to decode into a char. Maybe - * a lone \r could not be translated (crlf mode). Need - * to combine any unused src bytes we have in the first - * buffer with subsequent bytes to try again. + /* We were not able to read any chars. */ + + assert (numChars == 0); + + /* + * There is one situation where this is the correct final + * result. If the src buffer contains only a single \n + * byte, and we are in TCL_TRANSLATE_AUTO mode, and + * when the translation pass was made the INPUT_SAW_CR + * flag was set on the channel. In that case, the + * correct behavior is to consume that \n and produce the + * empty string. + */ + + if (dst[0] == '\n') { + assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO); + assert(dstRead == 1); + + goto consume; + } + + /* Otherwise, reading zero characters indicates there's + * something incomplete at the end of the src buffer. + * Maybe there were not enough src bytes to decode into + * a char. Maybe a lone \r could not be translated (crlf + * mode). Need to combine any unused src bytes we have + * in the first buffer with subsequent bytes to try again. */ - ChannelBuffer *nextPtr = bufPtr->nextPtr; + nextPtr = bufPtr->nextPtr; if (nextPtr == NULL) { if (srcLen > 0) { @@ -5548,6 +5575,7 @@ ReadChars( statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; + consume: bufPtr->nextRemoved += srcRead; if (dstWrote > srcRead + 1) { *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead; -- cgit v0.12