diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | tests/chan.test | 7 | ||||
| -rw-r--r-- | win/tclWinChan.c | 75 |
3 files changed, 83 insertions, 4 deletions
@@ -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 |