Allow [fcopy] to move more than 2GB per call. Frederic Bonnet identified issue.

5 files changed, 77 insertions, 50 deletions

diff --git a/ChangeLog b/ChangeLog
index 9e2208b..76c0438 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,18 @@
+2010-03-20  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclIOCmd.c (Tcl_FcopyObjCmd):		Lift the restriction
+	* generic/tclIO.c (TclCopyChannel, CopyData):	on the [fcopy] command
+	* generic/tclIO.h (CopyState):			that forced it to only
+	copy up to 2GB per script-level callback. Now it is anything that can
+	fit in a (signed) 64-bit integer. Problem identified by Frederic
+	Bonnet on comp.lang.tcl. Note that individual low-level reads and
+	writes are still smaller as the optimal buffer size is smaller.
+
 2010-03-20  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* win/stub16.c          Don't hide that we use the ASCII API here.
+	* win/stub16.c:         Don't hide that we use the ASCII API here.
 	                        (does someone still use that?)
-	* win/tclWinPipe.c      2 unnecessary type casts.
+	* win/tclWinPipe.c:     2 unnecessary type casts.
 
 2010-03-19  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index bc94bb6..2ec35cc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.173 2010/03/17 16:35:42 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.174 2010/03/20 15:39:46 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -231,7 +231,7 @@ static const Tcl_ObjType tclChannelType = {
 #define SET_CHANNELINTERP(objPtr, storePtr) \
     ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
 
-#define BUSY_STATE(st,fl) \
+#define BUSY_STATE(st, fl) \
      ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
       (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
 
@@ -1726,9 +1726,9 @@ Tcl_UnstackChannel(
     if (chanPtr->downChanPtr != NULL) {
 	/*
 	 * Instead of manipulating the per-thread / per-interp list/hashtable
-	 * of registered channels we wind down the state of the transformation,
-	 * and then restore the state of underlying channel into the old
-	 * structure.
+	 * of registered channels we wind down the state of the
+	 * transformation, and then restore the state of underlying channel
+	 * into the old structure.
 	 */
 
 	Channel *downChanPtr = chanPtr->downChanPtr;
@@ -2653,7 +2653,7 @@ CloseChannel(
 
     if (statePtr->chanMsg != NULL) {
 	if (interp != NULL) {
-	    Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+	    Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
 	}
 	TclDecrRefCount(statePtr->chanMsg);
 	statePtr->chanMsg = NULL;
@@ -2709,7 +2709,7 @@ CloseChannel(
 	    statePtr->chanMsg = NULL;
 	}
 	if (interp) {
-	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
+	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
 	}
     }
     if (errorCode == 0) {
@@ -3051,7 +3051,7 @@ Tcl_Close(
 
 	if (statePtr->chanMsg != NULL) {
 	    if (interp != NULL) {
-		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
 	    }
 	    TclDecrRefCount(statePtr->chanMsg);
 	    statePtr->chanMsg = NULL;
@@ -3412,7 +3412,7 @@ CloseChannelPart(
 
 	if (statePtr->chanMsg != NULL) {
 	    if (interp != NULL) {
-		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
+		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
 	    }
 	    TclDecrRefCount(statePtr->chanMsg);
 	    statePtr->chanMsg = NULL;
@@ -3446,7 +3446,7 @@ CloseChannelPart(
 	    statePtr->chanMsg = NULL;
 	}
 	if (interp) {
-	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
+	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
 	}
     }
     if (errorCode == 0) {
@@ -6697,10 +6697,10 @@ GetInput(
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
     /*
-     * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for
-     * channels without BlockModeProc, by keeping track of true fileevents
-     * generated by the OS == Data waiting and reading if and only if we are
-     * sure to have data.
+     * [Bug 943274]: Better emulation of non-blocking channels for channels
+     * without BlockModeProc, by keeping track of true fileevents generated by
+     * the OS == Data waiting and reading if and only if we are sure to have
+     * data.
      */
 
     if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
@@ -6735,8 +6735,7 @@ GetInput(
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	if (nread <= toRead) {
 	    /*
-	     * [SF Tcl Bug 943274] We have read the available data, clear
-	     * flag.
+	     * [Bug 943274]: We have read the available data, clear flag.
 	     */
 
 	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
@@ -7207,7 +7206,7 @@ CheckChannelErrors(
      * retrieving and transforming the data to copy.
      */
 
-    if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+    if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
 	Tcl_SetErrno(EBUSY);
 	return -1;
     }
@@ -7865,12 +7864,10 @@ Tcl_SetChannelOption(
 		(strncmp(newValue, "none", len) == 0)) {
 	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
 	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
-	} else {
-	    if (interp) {
-		Tcl_AppendResult(interp, "bad value for -buffering: "
-			"must be one of full, line, or none", NULL);
-		return TCL_ERROR;
-	    }
+	} else if (interp) {
+            Tcl_AppendResult(interp, "bad value for -buffering: "
+		    "must be one of full, line, or none", NULL);
+            return TCL_ERROR;
 	}
 	return TCL_OK;
     } else if (HaveOpt(7, "-buffersize")) {
@@ -8937,13 +8934,25 @@ Tcl_FileEventObjCmd(
  */
 
 int
-TclCopyChannel(
+TclCopyChannelOld(
     Tcl_Interp *interp,		/* Current interpreter. */
     Tcl_Channel inChan,		/* Channel to read from. */
     Tcl_Channel outChan,	/* Channel to write to. */
     int toRead,			/* Amount of data to copy, or -1 for all. */
     Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
 {
+    return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
+            cmdPtr);
+}
+
+int
+TclCopyChannel(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Channel inChan,		/* Channel to read from. */
+    Tcl_Channel outChan,	/* Channel to write to. */
+    Tcl_WideInt toRead,		/* Amount of data to copy, or -1 for all. */
+    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
+{
     Channel *inPtr = (Channel *) inChan;
     Channel *outPtr = (Channel *) outChan;
     ChannelState *inStatePtr, *outStatePtr;
@@ -8954,14 +8963,14 @@ TclCopyChannel(
     inStatePtr = inPtr->state;
     outStatePtr = outPtr->state;
 
-    if (BUSY_STATE(inStatePtr,TCL_READABLE)) {
+    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "channel \"",
 		    Tcl_GetChannelName(inChan), "\" is busy", NULL);
 	}
 	return TCL_ERROR;
     }
-    if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
+    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "channel \"",
 		    Tcl_GetChannelName(outChan), "\" is busy", NULL);
@@ -9013,7 +9022,7 @@ TclCopyChannel(
     csPtr->readFlags = readFlags;
     csPtr->writeFlags = writeFlags;
     csPtr->toRead = toRead;
-    csPtr->total = 0;
+    csPtr->total = (Tcl_WideInt) 0;
     csPtr->interp = interp;
     if (cmdPtr) {
 	Tcl_IncrRefCount(cmdPtr);
@@ -9056,7 +9065,8 @@ CopyData(
     Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
     Tcl_Channel inChan, outChan;
     ChannelState *inStatePtr, *outStatePtr;
-    int result = TCL_OK, size, total, sizeb;
+    int result = TCL_OK, size, sizeb;
+    Tcl_WideInt total;
     const char *buffer;
     int inBinary, outBinary, sameEncoding;
 				/* Encoding control */
@@ -9086,7 +9096,7 @@ CopyData(
 	Tcl_IncrRefCount(bufObj);
     }
 
-    while (csPtr->toRead != 0) {
+    while (csPtr->toRead != (Tcl_WideInt) 0) {
 	/*
 	 * Check for unreported background errors.
 	 */
@@ -9117,17 +9127,18 @@ CopyData(
 	     * Read up to bufSize bytes.
 	     */
 
-	    if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
+	    if ((csPtr->toRead == (Tcl_WideInt) -1)
+                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
 		sizeb = csPtr->bufSize;
 	    } else {
-		sizeb = csPtr->toRead;
+		sizeb = (int) csPtr->toRead;
 	    }
 
 	    if (inBinary || sameEncoding) {
 		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
 	    } else {
 		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
-				   0 /* No append */);
+			0 /* No append */);
 	    }
 	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
 	}
@@ -9161,7 +9172,7 @@ CopyData(
 		break;
 	    }
 	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
-		!(mask & TCL_READABLE)) {
+		    !(mask & TCL_READABLE)) {
 		if (mask & TCL_WRITABLE) {
 		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 		}
@@ -9315,7 +9326,7 @@ CopyData(
 	StopCopy(csPtr);
 	Tcl_Preserve(interp);
 
-	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
+	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
 	if (errObj) {
 	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
 	}
@@ -9346,9 +9357,8 @@ CopyData(
  *
  * DoRead --
  *
- *	Reads a given number of bytes from a channel.
- *
- *	No encoding conversions are applied to the bytes being read.
+ *	Reads a given number of bytes from a channel. No encoding conversions
+ *	are applied to the bytes being read.
  *
  * Results:
  *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
@@ -11273,7 +11283,7 @@ DumpFlags(
     char buf[20];
     int i = 0;
 
-#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
+#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
 
     ChanFlag('r', TCL_READABLE);
     ChanFlag('w', TCL_WRITABLE);
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 5f330f5..5ff855f 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.h,v 1.16 2009/02/27 23:03:42 nijtmans Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.17 2010/03/20 15:39:46 dkf Exp $
  */
 
 /*
@@ -42,8 +42,8 @@ typedef struct CopyState {
     struct Channel *writePtr;	/* Pointer to output channel. */
     int readFlags;		/* Original read channel flags. */
     int writeFlags;		/* Original write channel flags. */
-    int toRead;			/* Number of bytes to copy, or -1. */
-    int total;			/* Total bytes transferred (written). */
+    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
+    Tcl_WideInt total;		/* Total bytes transferred (written). */
     Tcl_Interp *interp;		/* Interp that started the copy. */
     Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
     int bufSize;		/* Size of appended buffer. */
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index ae6fe62..2b45169 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.67 2010/02/24 10:32:17 dkf Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.68 2010/03/20 15:39:46 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1462,7 +1462,7 @@ Tcl_SocketObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     static const char *const socketOptions[] = {
-	"-async", "-myaddr", "-myport","-server", NULL
+	"-async", "-myaddr", "-myport", "-server", NULL
     };
     enum socketOptions {
 	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
@@ -1640,7 +1640,8 @@ Tcl_FcopyObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Channel inChan, outChan;
-    int mode, i, toRead, index;
+    int mode, i, index;
+    Tcl_WideInt toRead;
     Tcl_Obj *cmdPtr;
     static const char *const switches[] = { "-size", "-command", NULL };
     enum { FcopySize, FcopyCommand };
@@ -1682,16 +1683,17 @@ Tcl_FcopyObjCmd(
 	}
 	switch (index) {
 	case FcopySize:
-	    if (TclGetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
+	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (toRead<0) {
+	    if (toRead < 0) {
 		/*
 		 * Handle all negative sizes like -1, meaning 'copy all'. By
 		 * resetting toRead we avoid changes in the core copying
 		 * functions (which explicitly check for -1 and crash on any
 		 * other negative value).
 		 */
+
 		toRead = -1;
 	    }
 	    break;
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 0f2e275..79a68e1 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tclInt.decls,v 1.144 2010/02/05 10:03:23 nijtmans Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.145 2010/03/20 15:39:46 dkf Exp $
 
 library tcl
 
@@ -54,7 +54,7 @@ declare 7 generic {
     int TclCopyAndCollapse(int count, const char *src, char *dst)
 }
 declare 8 generic {
-    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
+    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
 	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
 }
 
@@ -990,6 +990,11 @@ declare 246 generic {
 declare 247 generic {
     void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
 }
+
+declare 248 generic {
+    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
+	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
+}
 
 ##############################################################################