summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/chan.n153
-rw-r--r--doc/fcopy.n114
-rw-r--r--generic/tclCompile.h4
-rw-r--r--generic/tclEncoding.c8
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclIO.c110
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclLiteral.c2
-rw-r--r--generic/tclOO.c6
-rw-r--r--generic/tclOO.decls8
-rw-r--r--generic/tclOODefineCmds.c4
-rw-r--r--generic/tclOOIntDecls.h18
-rw-r--r--generic/tclObj.c20
-rw-r--r--generic/tclPathObj.c12
-rw-r--r--generic/tclUtil.c36
-rw-r--r--tests/chanio.test23
-rw-r--r--tests/io.test82
-rw-r--r--unix/dltest/pkgt.c4
-rw-r--r--unix/tclUnixInit.c2
-rw-r--r--win/tclWinInit.c2
20 files changed, 377 insertions, 253 deletions
diff --git a/doc/chan.n b/doc/chan.n
index e8601f6..14fa941 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -226,50 +226,119 @@ typically used on UNIX platforms,
.TP
\fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.
-Copies data from \fIinputChan\fR to \fIoutputChan\fR, leveraging internal
-buffers to avoid extra copies and to avoid buffering too much data in main
-memory when copying large files to slow destinations like network sockets.
+Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until
+all characters are copied, blocking until the copy is complete and returning
+the number of characters copied. Leverages internal buffers to avoid extra
+copies and to avoid buffering too much data in main memory when copying large
+files to slow destinations like network sockets.
.RS
.PP
-If \fB\-size\fR is given, the size is in bytes if the two channels have the
-same encoding and in characters otherwise, and only that amount is copied.
-Otherwise, all data until the end of the file is copied.
-
-\fBchan copy\fR blocks until the copy is complete and returns the number of
-bytes or characters written to \fIoutputChan\fR.
-.PP
-If \fB\-command\fR is given, \fBchan copy\fR returns immediately, the copy is
-carried out in the background, and then \fIcallback\fR is called with the
-number of bytes written to \fIoutputChan\fR as its first argument, and the
-error message for any error that occurred as its second argument.
-\fIinputChan\fR and \fIoutputChan\fR are automatically configured for
-non-blocking mode if needed. Background copying only works correctly if the
-event loop is active, e.g. via \fBvwait\fR or Tk.
-.PP
-During a background copy no other read or write operation may be performed on
-\fIinputChan\fR or \fIoutputChan\fR. If either \fIinputChan\fR or
-\fIoutputChan\fR is closed while the copy is in progress copying ceases and
-\fBno\fR callback is made. If \fIinputChan\fR is closed all data already queued
-is written to \fIoutputChan\fR.
-.PP
-The should be no event handler established for \fIinputChan\fR because it may
-become readable during a background copy. An attempt to read or write
-from within an event handler results result in the error, "channel busy".
-.PP
-Due to end-of-line translation the number of bytes read from \fIinputChan\fR
-may be different than the number of bytes written to \fIoutputChan\fR. Only
-the number of bytes written to \fIoutputChan\fR is reported.
-.PP
-\fBChan copy\fR reads the data according to the \fB\-encoding\fR,
-\fB\-translation\fR, and \fB\-eofchar\fR of the source and writes to the
-destination according to the configuration for that channel. If the encoding
-and translation of both channels is \fBbinary\fR and the \fB\-eofchar\fR of
-both channels is the empty string, an identical copy is made. If only the
-encoding of the destination is \fBbinary\fR, Tcl's internal modified UTF-8
-representation of the characters read from the source is written to the
-destination. If only the encoding of the source is \fBbinary\fR, each byte read
-becomes one Unicode character in the range of 0 to 255, and that character is
-subject to the encoding and translation of the destination as it is written.
+\fB\-size\fR limits the number of characters copied.
+.PP
+If \fB\-command\fR is gviven, \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
+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.
+.PP
+During a background copy no other read operation may be performed on
+\fIinputChan\fR, and no write operation may be performed on
+\fIoutputChan\fR. However, write operations may by performed on
+\fIinputChan\fR and read operations may be performed on \fIoutputChan\fR, as
+exhibited by the bidirectional copy example below.
+.PP
+If either \fIinputChan\fR or \fIoutputChan\fR is closed while the copy is in
+progress, copying ceases and \fBno\fR callback is made. If \fIinputChan\fR is
+closed all data already queued is written to \fIoutputChan\fR.
+.PP
+There should be no event handler established for \fIinputChan\fR because it
+may become readable during a background copy. An attempt to read or write from
+within an event handler results result in the error, "channel busy". Any
+wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results
+in a
+.QW "channel busy"
+error.
+.PP
+.PP
+.IP \fBEXAMPLES\fR
+.PP
+The first example transfers the contents of one channel exactly to
+another. Note that when copying one file to another, it is better to
+use \fBfile copy\fR which also copies file metadata (e.g. the file
+access permissions) where possible.
+.PP
+.CS
+fconfigure $in -translation binary
+fconfigure $out -translation binary
+\fBfcopy\fR $in $out
+.CE
+.PP
+This second example shows how the callback gets
+passed the number of bytes transferred.
+It also uses vwait to put the application into the event loop.
+Of course, this simplified example could be done without the command
+callback.
+.PP
+.CS
+proc Cleanup {in out bytes {error {}}} {
+ global total
+ set total $bytes
+ close $in
+ close $out
+ if {[string length $error] != 0} {
+ # error occurred during the copy
+ }
+}
+set in [open $file1]
+set out [socket $server $port]
+\fBfcopy\fR $in $out -command [list Cleanup $in $out]
+vwait total
+.CE
+.PP
+The third example copies in chunks and tests for end of file
+in the command callback.
+.PP
+.CS
+proc CopyMore {in out chunk bytes {error {}}} {
+ global total done
+ incr total $bytes
+ if {([string length $error] != 0) || [eof $in]} {
+ set done $total
+ close $in
+ close $out
+ } else {
+ \fBfcopy\fR $in $out -size $chunk \e
+ -command [list CopyMore $in $out $chunk]
+ }
+}
+set in [open $file1]
+set out [socket $server $port]
+set chunk 1024
+set total 0
+\fBfcopy\fR $in $out -size $chunk \e
+ -command [list CopyMore $in $out $chunk]
+vwait done
+.CE
+.PP
+The fourth example starts an asynchronous, bidirectional fcopy between
+two sockets. Those could also be pipes from two [open "|hal 9000" r+]
+(though their conversation would remain secret to the script, since
+all four fileevent slots are busy).
+.PP
+.CS
+set flows 2
+proc Done {dir args} {
+ global flows done
+ puts "$dir is over."
+ incr flows -1
+ if {$flows<=0} {set done 1}
+}
+\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
+\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
+vwait done
+.CE
.RE
.TP
\fBchan create \fImode cmdPrefix\fR
diff --git a/doc/fcopy.n b/doc/fcopy.n
index 477f242..b043898 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -12,90 +12,44 @@
.SH NAME
fcopy \- Copy data from one channel to another
.SH SYNOPSIS
-\fBfcopy \fIinchan\fR \fIoutchan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
+\fBfcopy \fIinputChan\fR \fIoutputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.BE
.SH DESCRIPTION
.PP
-The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR.
-The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to
-avoid extra copies and to avoid buffering too much data in
-main memory when copying large files to slow destinations like
-network sockets.
-.PP
-The \fBfcopy\fR
-command transfers data from \fIinchan\fR until end of file
-or \fIsize\fR bytes or characters have been
-transferred; \fIsize\fR is in bytes if the input channel is in binary mode,
-and is in characters otherwise.
-If no \fB\-size\fR argument is given,
-then the copy goes until end of file.
-All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
-Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
-and returns the number of bytes or characters (using the same rules as
-for the \fB\-size\fR option) written to \fIoutchan\fR.
-.PP
-The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
-In this case it returns immediately and the \fIcallback\fR is invoked
-later when the copy completes.
-The \fIcallback\fR is called with
-one or two additional
-arguments that indicates how many bytes were written to \fIoutchan\fR.
-If an error occurred during the background copy, the second argument is the
-error string associated with the error.
-With a background copy,
-it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
-non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
-However, it is necessary to enter the event loop by using
-the \fBvwait\fR command or by using Tk.
-.PP
-You are not allowed to do other input operations with \fIinchan\fR, or
-output operations with \fIoutchan\fR, during a background
-\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
-bidirectional fcopy example below.
-.PP
-If either \fIinchan\fR or \fIoutchan\fR get closed
-while the copy is in progress, the current copy is stopped
-and the command callback is \fInot\fR made.
-If \fIinchan\fR is closed,
-then all data already queued for \fIoutchan\fR is written out.
-.PP
-Note that \fIinchan\fR can become readable during a background copy.
-You should turn off any \fBfileevent\fR handlers during a background
-copy so those handlers do not interfere with the copy.
-Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
+Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until
+all characters are copied, blocking until the copy is complete and returning
+the number of characters copied. Leverages internal buffers to avoid extra
+copies and to avoid buffering too much data in main memory when copying large
+files to slow destinations like network sockets.
+.PP
+\fB\-size\fR limits the number of characters copied.
+.PP
+\fB\-command\fR makes \fBfcopy\fR return immediately, work in the background,
+and call \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 the 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.
+.PP
+During a background copy no other read operation may be performed on
+\fIinputChan\fR, and no other write operation may be performed on
+\fIoutputChan\fR. However, write operations may by performed on
+\fIinputChan\fR and read operations may be performed on \fIoutputChan\fR, as
+exhibited by the bidirectional copy example below.
+.PP
+If either \fIinputChan\fR or \fIoutputChan\fR is closed while the copy is in
+progress, copying ceases and \fBno\fR callback is made. If \fIinputChan\fR is
+closed all data already queued is written to \fIoutputChan\fR.
+.PP
+There should be no event handler established for \fIinputChan\fR because it
+may become readable during a background copy. An attempt to read or write from
+within an event handler results result in the error, "channel busy". Any
+wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results
+in a
.QW "channel busy"
error.
-.PP
-\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
-according to the \fB\-translation\fR option
-for these channels.
-See the manual entry for \fBfconfigure\fR for details on the
-\fB\-translation\fR option.
-The translations mean that the number of bytes read from \fIinchan\fR
-can be different than the number of bytes written to \fIoutchan\fR.
-Only the number of bytes written to \fIoutchan\fR is reported,
-either as the return value of a synchronous \fBfcopy\fR or
-as the argument to the callback for an asynchronous \fBfcopy\fR.
-.PP
-\fBFcopy\fR obeys the encodings and character translations configured
-for the channels. This
-means that the incoming characters are converted internally first
-UTF-8 and then into the encoding of the channel \fBfcopy\fR writes
-to. See the manual entry for \fBfconfigure\fR for details on the
-\fB\-encoding\fR and \fB\-translation\fR options. No conversion is
-done if both channels are
-set to encoding
-.QW binary
-and have matching translations. If only the output channel is set to encoding
-.QW binary
-the system will write the internal UTF-8 representation of the incoming
-characters. If only the input channel is set to encoding
-.QW binary
-the system will assume that the incoming
-bytes are valid UTF-8 characters and convert them according to the
-output encoding. The behaviour of the system for bytes which are not
-valid UTF-8 characters is undefined in this case.
.SH EXAMPLES
.PP
The first example transfers the contents of one channel exactly to
@@ -144,7 +98,7 @@ proc CopyMore {in out chunk bytes {error {}}} {
close $out
} else {
\fBfcopy\fR $in $out -size $chunk \e
- -command [list CopyMore $in $out $chunk]
+ -command [list CopyMore $in $out $chunk]
}
}
set in [open $file1]
@@ -152,7 +106,7 @@ set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
- -command [list CopyMore $in $out $chunk]
+ -command [list CopyMore $in $out $chunk]
vwait done
.CE
.PP
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5772dec..bb3c42e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1115,7 +1115,7 @@ MODULE_SCOPE Tcl_Size TclCreateExceptRange(ExceptionRangeType type,
CompileEnv *envPtr);
MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size);
MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes,
- Tcl_Size length, TCL_HASH_TYPE hash, int *newPtr,
+ Tcl_Size length, size_t hash, int *newPtr,
Namespace *nsPtr, int flags,
LiteralEntry **globalPtrPtr);
MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr);
@@ -1129,7 +1129,7 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
ByteCode *codePtr);
-MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, int index);
+MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, Tcl_Size index);
MODULE_SCOPE Tcl_Size TclFindCompiledLocal(const char *name, Tcl_Size nameChars,
int create, CompileEnv *envPtr);
MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 37e8638..f73666e 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2570,8 +2570,7 @@ UtfToUtfProc(
}
} else {
/*
- * Convert 0xC080 to real nulls when we are in output mode,
- * irrespective of the profile.
+ * For output convert 0xC080 to a real null.
*/
*dst++ = 0;
src += 2;
@@ -2822,6 +2821,11 @@ Utf32ToUtfProc(
if ((unsigned)ch - 1 < 0x7F) {
*dst++ = (ch & 0xFF);
} else {
+#if TCL_UTF_MAX < 4
+ if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) {
+ *dst = 0; /* In case of lower surrogate, don't try to combine */
+ }
+#endif
dst += Tcl_UniCharToUtf(ch, dst);
}
src += 4;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 047fff5..356f522 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1240,13 +1240,13 @@ void *
TclStackRealloc(
Tcl_Interp *interp,
void *ptr,
- size_t numBytes)
+ Tcl_Size numBytes)
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr;
ExecStack *esPtr;
Tcl_Obj **markerPtr;
- size_t numWords;
+ Tcl_Size numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
return Tcl_Realloc(ptr, numBytes);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2ae4290..c5e6965 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -174,6 +174,8 @@ static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void CommonGetsCleanup(Channel *chanPtr);
static int CopyData(CopyState *csPtr, int mask);
static void DeleteTimerHandler(ChannelState *statePtr);
+int Lossless(ChannelState *inStatePtr,
+ ChannelState *outStatePtr, long long toRead);
static int MoveBytes(CopyState *csPtr);
static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
@@ -196,7 +198,7 @@ static void DiscardOutputQueued(ChannelState *chanPtr);
static Tcl_Size DoRead(Channel *chanPtr, char *dst, Tcl_Size bytesToRead,
int allowShortReads);
static Tcl_Size DoReadChars(Channel *chan, Tcl_Obj *objPtr, Tcl_Size toRead,
- int appendFlag);
+ int allowShortReads, int appendFlag);
static int FilterInputBytes(Channel *chanPtr,
GetsState *statePtr);
static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
@@ -338,6 +340,9 @@ static const Tcl_ObjType chanObjType = {
TCL_OBJTYPE_V0
};
+#define GetIso88591() \
+ (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding)
+
#define ChanSetInternalRep(objPtr, resPtr) \
do { \
Tcl_ObjInternalRep ir; \
@@ -5899,7 +5904,7 @@ Tcl_ReadChars(
return TCL_INDEX_NONE;
}
- return DoReadChars(chanPtr, objPtr, toRead, appendFlag);
+ return DoReadChars(chanPtr, objPtr, toRead, 0, appendFlag);
}
/*
*---------------------------------------------------------------------------
@@ -5930,6 +5935,7 @@ DoReadChars(
Tcl_Size toRead, /* Maximum number of characters to store, or
* TCL_INDEX_NONE to read all available data (up to EOF or
* when channel blocks). */
+ int allowShortReads, /* Allow half-blocking (pipes,sockets) */
int appendFlag) /* If non-zero, data read from the channel
* will be appended to the object. Otherwise,
* the data will replace the existing contents
@@ -6070,8 +6076,8 @@ DoReadChars(
if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
- == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
+ && GotFlag(statePtr, CHANNEL_BLOCKED)) {
break;
}
result = GetInput(chanPtr);
@@ -9363,18 +9369,7 @@ TclCopyChannel(
ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED);
SetFlag(outStatePtr, CHANNEL_UNBUFFERED);
- /*
- * Test for conditions where we know we can just move bytes from input
- * channel to output channel with no transformation or even examination
- * of the bytes themselves.
- */
-
- moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */
- && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
- && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
- && inStatePtr->encoding == outStatePtr->encoding
- && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
- && CHANNEL_PROFILE_GET(outStatePtr->outputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8;
+ moveBytes = Lossless(inStatePtr, outStatePtr, toRead);
/*
* Allocate a new CopyState to maintain info about the current copy in
@@ -9681,8 +9676,7 @@ CopyData(
Tcl_WideInt total;
Tcl_WideInt size;
const char *buffer;
- int inBinary, outBinary, sameEncoding;
- /* Encoding control */
+ int moveBytes;
int underflow; /* Input underflow */
inChan = (Tcl_Channel) csPtr->readPtr;
@@ -9700,13 +9694,9 @@ CopyData(
* the bottom of the stack.
*/
- inBinary = (inStatePtr->encoding == NULL);
- outBinary = (outStatePtr->encoding == NULL);
- sameEncoding = inStatePtr->encoding == outStatePtr->encoding
- && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
- && CHANNEL_PROFILE_GET(outStatePtr->outputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8;
+ moveBytes = Lossless(inStatePtr, outStatePtr, csPtr->toRead);
- if (!(inBinary || sameEncoding)) {
+ if (!moveBytes) {
TclNewObj(bufObj);
Tcl_IncrRefCount(bufObj);
}
@@ -9747,7 +9737,7 @@ CopyData(
underflow = 1;
} else {
/*
- * Read up to bufSize bytes.
+ * Read up to bufSize characters.
*/
if ((csPtr->toRead == (Tcl_WideInt) -1)
@@ -9757,12 +9747,13 @@ CopyData(
sizeb = csPtr->toRead;
}
- if (inBinary || sameEncoding) {
+ if (moveBytes) {
size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
- 0 /* No append */);
+ !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
+ ,0 /* No append */);
}
underflow = (size >= 0) && (size < sizeb); /* Input underflow */
}
@@ -9823,25 +9814,20 @@ CopyData(
* Now write the buffer out.
*/
- if (inBinary || sameEncoding) {
+ if (moveBytes) {
buffer = csPtr->buffer;
- sizeb = size;
+ sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, size);
} else {
buffer = Tcl_GetStringFromObj(bufObj, &sizeb);
- }
-
- if (outBinary || sameEncoding) {
- sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
- } else {
sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
}
/*
* [Bug 2895565]. At this point 'size' still contains the number of
- * bytes or characters which have been read. We keep this to later to
+ * characters which have been read. We keep this to later to
* update the totals and toRead information, see marker (UP) below. We
* must not overwrite it with 'sizeb', which is the number of written
- * bytes or characters, and both EOL translation and encoding
+ * characters, and both EOL translation and encoding
* conversion may have changed this number unpredictably in relation
* to 'size' (It can be smaller or larger, in the latter case able to
* drive toRead below -1, causing infinite looping). Completely
@@ -9868,10 +9854,10 @@ CopyData(
}
/*
- * Update the current byte count. Do it now so the count is valid
+ * Update the current character count. Do it now so the count is valid
* before a return or break takes us out of the loop. The invariant at
* the top of the loop should be that csPtr->toRead holds the number
- * of bytes left to copy.
+ * of characters left to copy.
*/
if (csPtr->toRead != -1) {
@@ -9938,8 +9924,8 @@ CopyData(
}
/*
- * Make the callback or return the number of bytes transferred. The local
- * total is used because StopCopy frees csPtr.
+ * Make the callback or return the number of characters transferred. The
+ * local total is used because StopCopy frees csPtr.
*/
total = csPtr->total;
@@ -10262,6 +10248,50 @@ CopyEventProc(
/*
*----------------------------------------------------------------------
*
+ * Lossless --
+ *
+ * Determines whether copying characters between two channel states would
+ * be lossless, i.e. whether one byte corresponds to one character, every
+ * character appears in the Unicode character set, there are no
+ * translations to be performed, and no inline signals to respond to.
+ *
+ * Result:
+ * True if copying would be lossless.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Lossless(
+ ChannelState *inStatePtr,
+ ChannelState *outStatePtr,
+ long long toRead)
+{
+ return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */
+ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
+ && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
+ && (
+ (
+ (inStatePtr->encoding == NULL
+ || inStatePtr->encoding == GetBinaryEncoding()
+ )
+ &&
+ (outStatePtr->encoding == NULL
+ || outStatePtr->encoding == GetBinaryEncoding()
+ )
+ )
+ ||
+ (
+ toRead == -1
+ && inStatePtr->encoding == outStatePtr->encoding
+ && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
+ && CHANNEL_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
+ )
+ );
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* StopCopy --
*
* This routine halts a copy that is in progress.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5b9762d..e65a3ee 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3076,8 +3076,8 @@ MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
MODULE_SCOPE void TclAsyncMarkFromNotifier(void);
MODULE_SCOPE double TclBignumToDouble(const void *bignum);
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
- size_t strLen, const unsigned char *pattern,
- size_t ptnLen, int flags);
+ Tcl_Size strLen, const unsigned char *pattern,
+ Tcl_Size ptnLen, int flags);
MODULE_SCOPE double TclCeil(const void *a);
MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
@@ -3090,7 +3090,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr);
-MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, size_t num,
+MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
int start, int *clNext);
@@ -3220,7 +3220,7 @@ MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int TclIsDigitProc(int byte);
MODULE_SCOPE int TclIsBareword(int byte);
-MODULE_SCOPE Tcl_Obj * TclJoinPath(size_t elements, Tcl_Obj * const objv[],
+MODULE_SCOPE Tcl_Obj * TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[],
int forceRelative);
MODULE_SCOPE int MakeTildeRelativePath(Tcl_Interp *interp, const char *user,
const char *subPath, Tcl_DString *dsPtr);
@@ -3285,7 +3285,7 @@ MODULE_SCOPE Tcl_Obj * TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp,
Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
- size_t len);
+ Tcl_Size len);
MODULE_SCOPE void TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *TclpNotifierData(void);
MODULE_SCOPE void TclpServiceModeHook(int mode);
@@ -3360,9 +3360,9 @@ MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
- size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
+ Tcl_Size reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
int *quantifiersFoundPtr);
-MODULE_SCOPE TCL_HASH_TYPE TclScanElement(const char *string, Tcl_Size length,
+MODULE_SCOPE Tcl_Size TclScanElement(const char *string, Tcl_Size length,
char *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
@@ -3380,14 +3380,14 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
- size_t numBytes);
+ Tcl_Size numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
int checkEq, int nocase, Tcl_Size reqlength);
MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int *nocase,
int *reqlength);
-MODULE_SCOPE int TclStringMatch(const char *str, size_t strLen,
+MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
Tcl_Obj *patternObj, int flags);
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 9bc9d10..17546b8 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -351,7 +351,7 @@ Tcl_Obj *
TclFetchLiteral(
CompileEnv *envPtr, /* Points to the CompileEnv from which to
* fetch the registered literal value. */
- int index) /* Index of the desired literal, as returned
+ Tcl_Size index) /* Index of the desired literal, as returned
* by prior call to TclRegisterLiteral() */
{
if (index >= envPtr->literalArrayNext) {
diff --git a/generic/tclOO.c b/generic/tclOO.c
index b4c739e..64f769c 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -2556,7 +2556,7 @@ TclOOInvokeObject(
* (PRIVATE_METHOD), or a *really* private
* context (any other value; conventionally
* 0). */
- size_t objc, /* Number of arguments. */
+ Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Array of argument objects. It is assumed
* that the name of the method to invoke will
* be at index 1. */
@@ -2627,7 +2627,7 @@ int
TclOOObjectCmdCore(
Object *oPtr, /* The object being invoked. */
Tcl_Interp *interp, /* The interpreter containing the object. */
- size_t objc, /* How many arguments are being passed in. */
+ Tcl_Size objc, /* How many arguments are being passed in. */
Tcl_Obj *const *objv, /* The array of arguments. */
int flags, /* Whether this is an invocation through the
* public or the private command interface. */
@@ -2648,7 +2648,7 @@ TclOOObjectCmdCore(
* processing.
*/
- if (objc + 1 < 3) {
+ if (objc < 2) {
flags |= FORCE_UNKNOWN;
methodNamePtr = NULL;
goto noMapping;
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 44fda7d..2df34d0 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -184,7 +184,7 @@ declare 4 {
ProcedureMethod **pmPtrPtr)
}
declare 5 {
- int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, size_t objc,
+ int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const *objv, int publicOnly, Class *startCls)
}
declare 6 {
@@ -214,7 +214,7 @@ declare 10 {
}
declare 11 {
int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
- Tcl_Class startCls, int publicPrivate, size_t objc,
+ Tcl_Class startCls, int publicPrivate, Tcl_Size objc,
Tcl_Obj *const *objv)
}
declare 12 {
@@ -226,12 +226,12 @@ declare 13 {
Tcl_Size numFilters, Tcl_Obj *const *filters)
}
declare 14 {
- void TclOOObjectSetMixins(Object *oPtr, size_t numMixins,
+ void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins,
Class *const *mixins)
}
declare 15 {
void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
- size_t numMixins, Class *const *mixins)
+ Tcl_Size numMixins, Class *const *mixins)
}
return
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index f559786..bde8203 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -371,7 +371,7 @@ TclOOClassSetFilters(
void
TclOOObjectSetMixins(
Object *oPtr,
- size_t numMixins,
+ Tcl_Size numMixins,
Class *const *mixins)
{
Class *mixinPtr;
@@ -432,7 +432,7 @@ void
TclOOClassSetMixins(
Tcl_Interp *interp,
Class *classPtr,
- size_t numMixins,
+ Tcl_Size numMixins,
Class *const *mixins)
{
Class *mixinPtr;
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index 17c20b6..730a73a 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -42,7 +42,7 @@ TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
ProcedureMethod **pmPtrPtr);
/* 5 */
TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
- size_t objc, Tcl_Obj *const *objv,
+ Tcl_Size objc, Tcl_Obj *const *objv,
int publicOnly, Class *startCls);
/* 6 */
TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
@@ -75,7 +75,7 @@ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
/* 11 */
TCLAPI int TclOOInvokeObject(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class startCls,
- int publicPrivate, size_t objc,
+ int publicPrivate, Tcl_Size objc,
Tcl_Obj *const *objv);
/* 12 */
TCLAPI void TclOOObjectSetFilters(Object *oPtr,
@@ -85,11 +85,11 @@ TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp,
Class *classPtr, Tcl_Size numFilters,
Tcl_Obj *const *filters);
/* 14 */
-TCLAPI void TclOOObjectSetMixins(Object *oPtr, size_t numMixins,
- Class *const *mixins);
+TCLAPI void TclOOObjectSetMixins(Object *oPtr,
+ Tcl_Size numMixins, Class *const *mixins);
/* 15 */
TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp,
- Class *classPtr, size_t numMixins,
+ Class *classPtr, Tcl_Size numMixins,
Class *const *mixins);
typedef struct TclOOIntStubs {
@@ -101,17 +101,17 @@ typedef struct TclOOIntStubs {
Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */
Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
- int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, size_t objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
+ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
- int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, size_t objc, Tcl_Obj *const *objv); /* 11 */
+ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 11 */
void (*tclOOObjectSetFilters) (Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 12 */
void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */
- void (*tclOOObjectSetMixins) (Object *oPtr, size_t numMixins, Class *const *mixins); /* 14 */
- void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, size_t numMixins, Class *const *mixins); /* 15 */
+ void (*tclOOObjectSetMixins) (Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 14 */
+ void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;
extern const TclOOIntStubs *tclOOIntStubsPtr;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 0817686..d0daa24 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -346,6 +346,18 @@ typedef struct ResolvedCmdName {
* structure can be freed when refCount
* becomes zero. */
} ResolvedCmdName;
+
+#ifdef TCL_MEM_DEBUG
+/*
+ * Filler matches the value used for filling freed memory in tclCkalloc.
+ * On 32-bit systems, the ref counts do not cross 0x7fffffff. On 64-bit
+ * implementations, ref counts will never reach this value (unless explicitly
+ * incremented without actual references!)
+ */
+#define FREEDREFCOUNTFILLER \
+ (sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8)
+#endif
+
/*
*-------------------------------------------------------------------------
@@ -538,7 +550,7 @@ TclGetContLineTable(void)
ContLineLoc *
TclContinuationsEnter(
Tcl_Obj *objPtr,
- size_t num,
+ Tcl_Size num,
int *loc)
{
int newEntry;
@@ -3736,7 +3748,7 @@ Tcl_DbIncrRefCount(
int line) /* Line number in the source file; used for
* debugging. */
{
- if (objPtr->refCount == 0x61616161) {
+ if (objPtr->refCount == FREEDREFCOUNTFILLER) {
fprintf(stderr, "file = %s, line = %d\n", file, line);
fflush(stderr);
Tcl_Panic("incrementing refCount of previously disposed object");
@@ -3809,7 +3821,7 @@ Tcl_DbDecrRefCount(
int line) /* Line number in the source file; used for
* debugging. */
{
- if (objPtr->refCount == 0x61616161) {
+ if (objPtr->refCount == FREEDREFCOUNTFILLER) {
fprintf(stderr, "file = %s, line = %d\n", file, line);
fflush(stderr);
Tcl_Panic("decrementing refCount of previously disposed object");
@@ -3891,7 +3903,7 @@ Tcl_DbIsShared(
#endif
{
#ifdef TCL_MEM_DEBUG
- if (objPtr->refCount == 0x61616161) {
+ if (objPtr->refCount == FREEDREFCOUNTFILLER) {
fprintf(stderr, "file = %s, line = %d\n", file, line);
fflush(stderr);
Tcl_Panic("checking whether previously disposed object is shared");
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index df6f04b..aa678a0 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -813,13 +813,13 @@ Tcl_FSJoinPath(
Tcl_Obj *
TclJoinPath(
- size_t elements, /* Number of elements to use */
+ Tcl_Size elements, /* Number of elements to use */
Tcl_Obj * const objv[], /* Path elements to join */
int forceRelative) /* If non-zero, assume all more paths are
* relative (e. g. simple normalization) */
{
Tcl_Obj *res = NULL;
- size_t i;
+ Tcl_Size i;
const Tcl_Filesystem *fsPtr = NULL;
if (elements == 0) {
@@ -856,7 +856,7 @@ TclJoinPath(
TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
const char *str;
- size_t len;
+ Tcl_Size len;
str = Tcl_GetStringFromObj(tailObj, &len);
if (len == 0) {
@@ -1220,7 +1220,7 @@ Tcl_Obj *
TclNewFSPathObj(
Tcl_Obj *dirPtr,
const char *addStrRep,
- size_t len)
+ Tcl_Size len)
{
FsPath *fsPathPtr;
Tcl_Obj *pathPtr;
@@ -1273,7 +1273,7 @@ TclNewFSPathObj(
* things as needing more aggressive normalization that don't actually
* need it. No harm done.
*/
- for (p = addStrRep; len+1 > 1; p++, len--) {
+ for (p = addStrRep; len > 0; p++, len--) {
switch (state) {
case 0: /* So far only "." since last dirsep or start */
switch (*p) {
@@ -1317,7 +1317,7 @@ AppendPath(
{
const char *bytes;
Tcl_Obj *copy = Tcl_DuplicateObj(head);
- size_t length;
+ Tcl_Size length;
/*
* This is likely buggy when dealing with virtual filesystem drivers
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0e90b6a..9b5a1b1 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1022,7 +1022,7 @@ Tcl_ScanCountedElement(
*----------------------------------------------------------------------
*/
-TCL_HASH_TYPE
+Tcl_Size
TclScanElement(
const char *src, /* String to convert to Tcl list element. */
Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */
@@ -1465,7 +1465,7 @@ TclConvertElement(
}
*p = '}';
p++;
- return (size_t)(p - dst);
+ return (p - dst);
}
/* conversion == CONVERT_ESCAPE or CONVERT_MASK */
@@ -1972,7 +1972,7 @@ Tcl_ConcatObj(
*/
for (i = 0; i < objc; i++) {
- size_t length;
+ Tcl_Size length;
objPtr = objv[i];
if (TclListObjIsCanonical(objPtr)) {
@@ -2331,11 +2331,11 @@ Tcl_StringCaseMatch(
int
TclByteArrayMatch(
const unsigned char *string,/* String. */
- size_t strLen, /* Length of String */
+ Tcl_Size strLen, /* Length of String */
const unsigned char *pattern,
/* Pattern, which may contain special
* characters. */
- size_t ptnLen, /* Length of Pattern */
+ Tcl_Size ptnLen, /* Length of Pattern */
TCL_UNUSED(int) /*flags*/)
{
const unsigned char *stringEnd, *patternEnd;
@@ -2513,7 +2513,7 @@ TclStringMatchObj(
* 0. */
{
int match;
- size_t length = 0, plen = 0;
+ Tcl_Size length = 0, plen = 0;
/*
* Promote based on the type of incoming object.
@@ -3353,7 +3353,7 @@ GetWideForIndex(
* 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_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
@@ -3732,8 +3732,8 @@ GetEndOffsetFromObj(
* are possible. The value objPtr might be parsed as an absolute
* index value in the Tcl_Size range. Note that this includes
* index values that are integers as presented and it includes index
- * arithmetic expressions.
- *
+ * arithmetic expressions.
+ *
* The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX.
* This means the largest supported character length is also TCL_SIZE_MAX,
* and the index of the last character in a string of length TCL_SIZE_MAX
@@ -3741,8 +3741,8 @@ GetEndOffsetFromObj(
* directly meaningful as an index into either a list or a string are
* integer values in the range 0 to TCL_SIZE_MAX - 1.
*
- * This function however can only handle integer indices in the range
- * 0 : INT_MAX-1.
+ * This function however can only handle integer indices in the range
+ * 0 : INT_MAX-1.
*
* Any absolute index value parsed outside that range is encoded
* using the before and after values passed in by the
@@ -3808,18 +3808,18 @@ TclIndexEncode(
* (3) 2*INT_MAX:WIDE_MAX when
* (a,b) as above
* (c) objPtr was of the form end+N
- * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when
+ * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when
* (a,b) as above
* (c) objPtr was of the form end-N where N was in the range 0:TCL_SIZE_MAX
* (5) WIDE_MIN:(2*INT_MAX)-TCL_SIZE_MAX
* (a,b) as above
* (c) objPtr was of the form end-N where N was > TCL_SIZE_MAX
- *
+ *
* For all cases (b) and (c), the internal representation of objPtr
* will be shimmered to endOffsetType. That allows us to distinguish between
* (for example) 1a (encodable) and 1c (not encodable) though the computed
* index value is the same.
- *
+ *
* Further note, the values TCL_SIZE_MAX < N < WIDE_MAX come into play
* only in the 32-bit builds as TCL_SIZE_MAX == WIDE_MAX for 64-bits.
*/
@@ -3846,7 +3846,7 @@ TclIndexEncode(
* error is raised. On 32-bit systems, indices in that range indicate
* the position after the end and so do not raise an error.
*/
- if ((sizeof(int) != sizeof(size_t)) &&
+ if ((sizeof(int) != sizeof(size_t)) &&
(wide > INT_MAX) && (wide < WIDE_MAX-1)) {
/* 2(a,b) on 64-bit systems*/
goto rangeerror;
@@ -3876,7 +3876,7 @@ TclIndexEncode(
* indices in that range indicate the position before the beginning
* and so do not raise an error.
*/
- if ((sizeof(int) != sizeof(size_t)) &&
+ if ((sizeof(int) != sizeof(size_t)) &&
(wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) {
/* 1(c), 4(a,b) on 64-bit systems */
goto rangeerror;
@@ -4166,7 +4166,7 @@ TclGetProcessGlobalValue(
Tcl_Obj *value = NULL;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
- size_t epoch = pgvPtr->epoch;
+ Tcl_Size epoch = pgvPtr->epoch;
if (pgvPtr->encoding) {
Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
@@ -4373,7 +4373,7 @@ int
TclReToGlob(
Tcl_Interp *interp,
const char *reStr,
- size_t reStrLen,
+ Tcl_Size reStrLen,
Tcl_DString *dsPtr,
int *exactPtr,
int *quantifiersFoundPtr)
diff --git a/tests/chanio.test b/tests/chanio.test
index 09e71ca..c3caa1c 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6868,7 +6868,7 @@ test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
[file size $path(utf8-fcopy.txt)] \
[file size $path(utf8-rp.txt)]
} {3 5 5}
-test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
+test chan-io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} {
# encoding to binary (=> implies that the internal utf-8 is written)
set in [open $path(kyrillic.txt) r]
set out [open $path(utf8-fcopy.txt) w]
@@ -6886,18 +6886,23 @@ test chan-io-52.11 {TclCopyChannel & encodings} -setup {
puts $f АА
close $f
} -constraints {fcopy} -body {
- # binary to encoding => the input has to be in utf-8 to make sense to the
- # encoder
set in [open $path(utf8-fcopy.txt) r]
set out [open $path(kyrillic.txt) w]
# -translation binary is also -encoding binary
chan configure $in -translation binary
- chan configure $out -encoding koi8-r -translation lf
- chan copy $in $out
- chan close $in
- chan close $out
- file size $path(kyrillic.txt)
-} -result 3
+ chan configure $out -encoding koi8-r -translation lf -profile strict
+ catch {chan copy $in $out} cres copts
+ return $cres
+} -cleanup {
+ if {$in in [chan names]} {
+ close $in
+ }
+ if {$out in [chan names]} {
+ close $out
+ }
+ catch {unset cres}
+} -match glob -result {error writing "*": invalid or incomplete\
+ multibyte or wide character}
test chan-io-53.1 {CopyData} -setup {
file delete $path(test1)
diff --git a/tests/io.test b/tests/io.test
index 96e5ea6..5fd255c 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7500,7 +7500,7 @@ test io-52.9 {TclCopyChannel & encodings} {fcopy} {
[file size $path(utf8-fcopy.txt)] \
[file size $path(utf8-rp.txt)]
} {3 5 5}
-test io-52.10 {TclCopyChannel & encodings} {fcopy} {
+test io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} {
# encoding to binary (=> implies that the
# internal utf-8 is written)
@@ -7519,26 +7519,27 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} {
} 5
test io-52.11 {TclCopyChannel & encodings} -setup {
set out [open $path(utf8-fcopy.txt) w]
- fconfigure $out -encoding utf-8 -translation lf
- puts $out "АА"
+ fconfigure $out -encoding utf-8 -translation lf -profile strict
+ puts $out АА
close $out
} -constraints {fcopy} -body {
- # binary to encoding => the input has to be
- # in utf-8 to make sense to the encoder
-
set in [open $path(utf8-fcopy.txt) r]
set out [open $path(kyrillic.txt) w]
-
# -translation binary is also -encoding binary
fconfigure $in -translation binary
- fconfigure $out -encoding koi8-r -translation lf
-
- fcopy $in $out
- close $in
- close $out
-
- file size $path(kyrillic.txt)
-} -result 3
+ fconfigure $out -encoding koi8-r -translation lf -profile strict
+ catch {fcopy $in $out} cres copts
+ return $cres
+} -cleanup {
+ if {$in in [chan names]} {
+ close $in
+ }
+ if {$out in [chan names]} {
+ close $out
+ }
+ catch {unset cres}
+} -match glob -result {error writing "*": invalid or incomplete\
+ multibyte or wide character}
test io-52.12 {coverage of -translation auto} {
file delete $path(test1) $path(test2)
@@ -7780,6 +7781,29 @@ test io-52.23 {TclCopyChannel & encodings} -setup {
unset ::s0
} -match glob -result {0 {error writing "file*": invalid or incomplete multibyte or wide character}}
+test io-52.24 {fcopy -size should always be characters} -setup {
+ set out [open utf8-fcopy-52.24.txt w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "Á"
+ close $out
+} -constraints {fcopy} -body {
+ set in [open utf8-fcopy-52.24.txt r]
+ set out [open utf8-fcopy-52.24.out.txt w+]
+
+ fconfigure $in -encoding utf-8 -profile tcl8
+ fconfigure $out -encoding utf-8 -profile tcl8
+ fcopy $in $out -size 1
+ seek $out 0
+ # a result of \xc3 means that only the first byte of the utf-8 encoding of
+ # Á made it into to the output file.
+ read $out
+} -cleanup {
+ close $in
+ close $out
+ catch {file delete utf8-fcopy-52.24.txt}
+ catch {file delete utf8-fcopy-52.24.out.txt}
+} -result Á
+
test io-53.1 {CopyData} {fcopy} {
file delete $path(test1)
@@ -8276,7 +8300,7 @@ test io-53.11 {Bug 2895565} -setup {
removeFile out
removeFile in
} -result {40 bytes copied}
-test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
+test io-53.12.0 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts -nonewline $f1 {
@@ -8295,6 +8319,32 @@ test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fc
close $f1
list $::done $ch
} {ok A}
+test io-53.12.1 {
+ Issue 9ca87e6286262a62.
+ CopyData: foreground short reads via ReadChars().
+ Related to report 3096275 for ReadBytes().
+
+ Prior to the fix this test waited forever for read() to return.
+} {stdio unix fcopy} {
+ file delete $path(output)
+ set f1 [open $path(output) w]
+ puts -nonewline $f1 {
+ chan configure stdin -encoding iso8859-1 -translation lf -buffering none
+ fcopy stdin stdout
+ }
+ close $f1
+ set f1 [open "|[list [info nameofexecutable] $path(output)]" r+]
+ try {
+ chan configure $f1 -encoding utf-8 -buffering none
+ puts -nonewline $f1 A
+ set ch [read $f1 1]
+ } finally {
+ if {$f1 in [chan names]} {
+ close $f1
+ }
+ }
+ lindex $ch
+} A
test io-53.13 {TclCopyChannel: read error reporting} -setup {
proc driver {cmd args} {
variable buffer
diff --git a/unix/dltest/pkgt.c b/unix/dltest/pkgt.c
index 7a32c35..1f326f5 100644
--- a/unix/dltest/pkgt.c
+++ b/unix/dltest/pkgt.c
@@ -16,11 +16,11 @@
static int TraceProc2 (
void *clientData,
Tcl_Interp *interp,
- Tcl_Size level,
+ Tcl_Size level,
const char *command,
Tcl_Command commandInfo,
Tcl_Size objc,
- struct Tcl_Obj *const *objv)
+ struct Tcl_Obj *const *objv)
{
(void)clientData;
(void)interp;
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 376e72b..ed9058e 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -455,7 +455,7 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- size_t *lengthPtr,
+ TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index a466a30..bb9ef66 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -124,7 +124,7 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- size_t *lengthPtr,
+ TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 64
generated by cgit v0.12 at 2025-12-09 20:48:35 (GMT)