static int ChanTruncateObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; Tcl_WideInt length; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { /* * User is supplying an explicit length. */ if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (length < 0) { Tcl_AppendResult(interp, "cannot truncate to negative length of file", NULL); return TCL_ERROR; } } else { /* * User wants to truncate to the current file position. */ length = Tcl_Tell(chan); if (length == Tcl_WideAsLong(-1)) { Tcl_AppendResult(interp, "could not determine current location in \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } } if (Tcl_TruncateChannel(chan, length) != TCL_OK) { Tcl_AppendResult(interp, "error during truncate on \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } return TCL_OK; }
static int FileSeekProc( ClientData instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_SET or SEEK_END. */ int *errorCodePtr) /* To store error code. */ { FileState *fsPtr = instanceData; Tcl_WideInt oldLoc, newLoc; /* * Save our current place in case we need to roll-back the seek. */ oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR); if (oldLoc == Tcl_LongAsWide(-1)) { /* * Bad things are happening. Error out... */ *errorCodePtr = errno; return -1; } newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); /* * Check for expressability in our return type, and roll-back otherwise. */ if (newLoc > Tcl_LongAsWide(INT_MAX)) { *errorCodePtr = EOVERFLOW; TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET); return -1; } else { *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0; } return (int) Tcl_WideAsLong(newLoc); }
static Tcl_WideInt TransformWideSeekProc( ClientData instanceData, /* The channel to manipulate. */ Tcl_WideInt offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ { TransformChannelData *dataPtr = instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); Tcl_DriverWideSeekProc *parentWideSeekProc = Tcl_ChannelWideSeekProc(parentType); ClientData parentData = Tcl_GetChannelInstanceData(parent); if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) { /* * This is no seek but a request to tell the caller the current * location. Simply pass the request down. */ if (parentWideSeekProc != NULL) { return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode, errorCodePtr)); } /* * It is a real request to change the position. Flush all data waiting for * output and discard everything in the input buffers. Then pass the * request down, unchanged. */ PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE); } if (dataPtr->mode & TCL_READABLE) { ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; dataPtr->eofPending = 0; } ReleaseData(dataPtr); /* * If we have a wide seek capability, we should stick with that. */ if (parentWideSeekProc != NULL) { return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } /* * We're transferring to narrow seeks at this point; this is a bit complex * because we have to check whether the seek is possible first (i.e. * whether we are losing information in truncating the bits of the * offset). Luckily, there's a defined error for what happens when trying * to go out of the representable range. */ if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) { *errorCodePtr = EOVERFLOW; return Tcl_LongAsWide(-1); } return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset), mode, errorCodePtr)); }