summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-06-07 21:31:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-06-07 21:31:46 (GMT)
commitc2e9dac276543c87f90a314405d70427e7a9e642 (patch)
tree49b6f683f3b6054e5c1f32bcbe074c6e932c808f
parent2fcbb37a1b10ceee78d909cf4dc036e54651d058 (diff)
downloadtcl-c2e9dac276543c87f90a314405d70427e7a9e642.zip
tcl-c2e9dac276543c87f90a314405d70427e7a9e642.tar.gz
tcl-c2e9dac276543c87f90a314405d70427e7a9e642.tar.bz2
Added (untested!) implementation of truncation for Windows
-rw-r--r--ChangeLog5
-rw-r--r--tests/chan.test7
-rw-r--r--win/tclWinChan.c75
3 files changed, 83 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 145e740..cbe2c25 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-06-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * win/tclWinChan.c (FileTruncateProc): Added implementation of
+ file truncation for Windows.
+
2005-06-07 Don Porter <dgp@users.sourceforge.net>
* generic/tclObj.c: Restored registration of the "procbody"
diff --git a/tests/chan.test b/tests/chan.test
index cf83820..dd2fea6 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -7,7 +7,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: chan.test,v 1.3 2005/06/07 20:52:25 dkf Exp $
+# RCS: @(#) $Id: chan.test,v 1.4 2005/06/07 21:31:53 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -76,11 +76,12 @@ test chan-14.1 {chan command: tell subcommand} -body {
test chan-15.1 {chan command: truncate subcommand} -body {
chan truncate foo bar foo bar
} -returnCodes error -result "wrong \# args: should be \"chan truncate channelId ?length?\""
-test chan-15.2 {chan command: truncate subcommand} -constraints unix -setup {
+test chan-15.2 {chan command: truncate subcommand} -setup {
set file [makeFile {} testTruncate]
set f [open $file w+]
-} -body {
fconfigure $f -translation binary
+} -body {
+ seek $f 0
puts -nonewline $f 12345
seek $f 0
chan truncate $f 2
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 7cee496..673cd6a 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinChan.c,v 1.40 2005/05/10 18:35:37 kennykb Exp $
+ * RCS: @(#) $Id: tclWinChan.c,v 1.41 2005/06/07 21:31:53 dkf Exp $
*/
#include "tclWinInt.h"
@@ -100,6 +100,8 @@ static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static void FileThreadActionProc _ANSI_ARGS_ ((
ClientData instanceData, int action));
+static void FileTruncateProc _ANSI_ARGS_ ((
+ ClientData instanceData, Tcl_WideInt length));
/*
* This structure describes the channel type structure for file based IO.
@@ -122,6 +124,7 @@ static Tcl_ChannelType fileChannelType = {
NULL, /* handler proc. */
FileWideSeekProc, /* Wide seek proc. */
FileThreadActionProc, /* Thread action proc. */
+ FileTruncateProc, /* Truncate proc. */
};
#if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG)
@@ -577,6 +580,76 @@ FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
/*
*----------------------------------------------------------------------
*
+ * FileTruncateProc --
+ *
+ * Truncates a file-based channel. Returns the error code.
+ *
+ * Results:
+ * 0 if successful, POSIX-y error code if it failed.
+ *
+ * Side effects:
+ * Truncates the file, may move file pointers too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileTruncateProc(instanceData, length)
+ ClientData instanceData; /* File state. */
+ Tcl_WideInt length; /* Length to truncate at. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ LONG newPos, newPosHigh, oldPos, oldPosHigh;
+
+ /*
+ * Save where we were...
+ */
+ oldPosHigh = 0;
+ oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
+ if (oldPos == INVALID_SET_FILE_POINTER) {
+ DWORD winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ return errno;
+ }
+ }
+
+ /*
+ * Move to where we want to truncate
+ */
+ newPosHigh = Tcl_WideAsLong(length >> 32);
+ newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
+ &newPosHigh, FILE_BEGIN);
+ if (newPos == INVALID_SET_FILE_POINTER) {
+ DWORD winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ return errno;
+ }
+ }
+
+ /*
+ * Perform the truncation (unlike POSIX ftruncate(), we needed to
+ * move to the location to truncate at first).
+ */
+ if (!SetEndOfFile(infoPtr->handle)) {
+ TclWinConvertError(GetLastError());
+ return errno;
+ }
+
+ /*
+ * Move back. If this last step fails, we don't care; it's just a
+ * "best effort" attempt to restore our file pointer to where it
+ * was.
+ */
+ SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FileInputProc --
*
* Reads input from the IO channel into the buffer given. Returns