summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/clock.n5
-rw-r--r--generic/tclIO.c46
-rw-r--r--generic/tclIORTrans.c34
-rw-r--r--tests/chanio.test2
-rw-r--r--tests/io.test84
-rw-r--r--unix/Makefile.in2
-rwxr-xr-xunix/configure3
-rw-r--r--unix/configure.in3
-rw-r--r--win/Makefile.in2
-rw-r--r--win/tclWinFile.c11
10 files changed, 159 insertions, 33 deletions
diff --git a/doc/clock.n b/doc/clock.n
index 42dca80..910ebb8 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -637,8 +637,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
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0ba4098..8545912 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5904,7 +5904,6 @@ ReadChars(
* record \r or \n yet.
*/
- assert(dstRead + 1 == dstDecoded);
assert(dst[dstRead] == '\r');
assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
@@ -5925,7 +5924,6 @@ ReadChars(
assert(dstWrote == 0);
assert(dstRead == 0);
- assert(dstDecoded == 1);
/*
* We decoded only the bare cr, and we cannot read a
@@ -5980,6 +5978,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) */
}
@@ -6006,16 +6011,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) {
@@ -6052,6 +6079,7 @@ ReadChars(
statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ consume:
bufPtr->nextRemoved += srcRead;
if (dstWrote > srcRead + 1) {
*factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
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;
}
diff --git a/tests/chanio.test b/tests/chanio.test
index 5b77f54..e53f059 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -44,7 +44,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 a072bd4..1beb099 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -45,7 +45,7 @@ testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# 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.
@@ -1563,6 +1563,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
@@ -3984,6 +4023,46 @@ 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.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]
@@ -6849,6 +6928,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
@@ -6863,6 +6943,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
@@ -6877,6 +6958,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
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 69dd14f..f151ebb 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -2089,9 +2089,11 @@ alldist: dist
html: ${NATIVE_TCLSH}
$(BUILD_HTML)
@EXTRA_BUILD_HTML@
+
html-tcl: ${NATIVE_TCLSH}
$(BUILD_HTML) --tcl
@EXTRA_BUILD_HTML@
+
html-tk: ${NATIVE_TCLSH}
$(BUILD_HTML) --tk
@EXTRA_BUILD_HTML@
diff --git a/unix/configure b/unix/configure
index ce5db6a..bd85ba4 100755
--- a/unix/configure
+++ b/unix/configure
@@ -1338,6 +1338,9 @@ TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL=".1"
VERSION=${TCL_VERSION}
+EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
+EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}
+
#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
#------------------------------------------------------------------------
diff --git a/unix/configure.in b/unix/configure.in
index 61ad30f..cb6cf82 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -28,6 +28,9 @@ TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL=".1"
VERSION=${TCL_VERSION}
+EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
+EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}
+
#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
#------------------------------------------------------------------------
diff --git a/win/Makefile.in b/win/Makefile.in
index fd80010..67cf66a 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -850,8 +850,10 @@ TOOL_DIR=$(ROOT_DIR)/tools
HTML_INSTALL_DIR=$(ROOT_DIR)/html
html:
$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"
+
html-tcl: $(TCLSH)
$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl"
+
html-tk: $(TCLSH)
$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk"
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 5761eeb..ad4a5c4 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -2962,18 +2962,17 @@ TclNativeCreateNativeRep(
** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
**/
if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
- && str[1]==':' && (str[2]=='\\' || str[2]=='/')) {
- if (wp==nativePathPtr && len>MAX_PATH) {
+ && str[1]==':') {
+ if (wp==nativePathPtr && len>MAX_PATH && (str[2]=='\\' || str[2]=='/')) {
memmove(wp+4, wp, len*sizeof(WCHAR));
memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR));
wp += 4;
}
/*
- ** If (remainder of) path starts with "<drive>:/" or "<drive>:\",
- ** leave the ':' intact but translate the backslash to a slash.
+ ** If (remainder of) path starts with "<drive>:",
+ ** leave the ':' intact.
*/
- wp[2] = '\\';
- wp += 3;
+ wp += 2;
} else if (wp==nativePathPtr && len>MAX_PATH
&& (str[0]=='\\' || str[0]=='/')
&& (str[1]=='\\' || str[1]=='/') && str[2]!='?') {
generated by cgit v0.12 at 2024-11-09 14:47:44 (GMT)