From 183d4d8c9b9d44e6db615dac01f6858b9cdbb4ba Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Apr 2024 11:48:02 +0000 Subject: More code cleanup, backported from 8.7 --- generic/tclIO.c | 242 +++++++++++++++++++------------------- generic/tclIORChan.c | 319 ++++++++++++++++++++++++++------------------------- 2 files changed, 283 insertions(+), 278 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 6654059..6b77749 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -105,7 +105,7 @@ typedef struct CopyState { Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ int bufSize; /* Size of appended buffer. */ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last - * field. */ + * field. */ } CopyState; /* @@ -227,7 +227,7 @@ static int Write(Channel *chanPtr, const char *src, static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); -static int WillRead(Channel *chanPtr); +static int WillRead(Channel *chanPtr); #define WriteChars(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, chanPtr->state->encoding) @@ -412,12 +412,12 @@ ChanRead( */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (WillRead(chanPtr) < 0) { - return -1; + return -1; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, @@ -428,11 +428,20 @@ ChanRead( */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (bytesRead > 0) { + if (bytesRead < 0) { + if ((result == EWOULDBLOCK) || (result == EAGAIN)) { + SetFlag(chanPtr->state, CHANNEL_BLOCKED); + result = EAGAIN; + } + Tcl_SetErrno(result); + } else if (bytesRead == 0) { + SetFlag(chanPtr->state, CHANNEL_EOF); + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; + } else { /* * If we get a short read, signal up that we may be BLOCKED. We should * avoid calling the driver because on some platforms we will block in @@ -443,15 +452,6 @@ ChanRead( if (bytesRead < dstSize) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); } - } else if (bytesRead == 0) { - SetFlag(chanPtr->state, CHANNEL_EOF); - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; - } else if (bytesRead < 0) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - SetFlag(chanPtr->state, CHANNEL_BLOCKED); - result = EAGAIN; - } - Tcl_SetErrno(result); } return bytesRead; } @@ -473,13 +473,12 @@ ChanSeek( offset, mode, errnoPtr); } - if (offsetTcl_LongAsWide(LONG_MAX)) { - *errnoPtr = EOVERFLOW; - return Tcl_LongAsWide(-1); + if ((offset >= LONG_MIN) && (offset <= LONG_MAX)) { + return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, + offset, mode, errnoPtr); } - - return Tcl_LongAsWide(Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, - Tcl_WideAsLong(offset), mode, errnoPtr)); + *errnoPtr = EOVERFLOW; + return -1; } static inline void @@ -574,14 +573,14 @@ TclFinalizeIOSubsystem(void) */ { - const char *s; - Tcl_DString ds; + const char *s; + Tcl_DString ds; - s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); - doflushnb = ((s != NULL) && strcmp(s, "0")); - if (s != NULL) { - Tcl_DStringFree(&ds); - } + s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); + doflushnb = ((s != NULL) && strcmp(s, "0")); + if (s != NULL) { + Tcl_DStringFree(&ds); + } } /* @@ -601,12 +600,12 @@ TclFinalizeIOSubsystem(void) statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; - if (GotFlag(statePtr, CHANNEL_DEAD)) { - continue; - } + if (GotFlag(statePtr, CHANNEL_DEAD)) { + continue; + } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { - ResetFlag(statePtr, BG_FLUSH_SCHEDULED); + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; } @@ -621,20 +620,20 @@ TclFinalizeIOSubsystem(void) /* * TIP #398: by default, we no longer set the channel back into - * blocking mode. To restore the old blocking behavior, the - * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set - * and not be "0". + * blocking mode. To restore the old blocking behavior, the + * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set + * and not be "0". */ - if (doflushnb) { - /* - * Set the channel back into blocking mode to ensure that we - * wait for all data to flush out. - */ + if (doflushnb) { + /* + * Set the channel back into blocking mode to ensure that we + * wait for all data to flush out. + */ - (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); - } + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, + "-blocking", "on"); + } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || @@ -1217,8 +1216,8 @@ Tcl_UnregisterChannel( if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal recursive call to close through close-handler" - " of channel", -1)); + "illegal recursive call to close through close-handler" + " of channel", -1)); } return TCL_ERROR; } @@ -1445,7 +1444,7 @@ Tcl_GetChannel( hPtr = Tcl_FindHashEntry(hTblPtr, name); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can not find channel named \"%s\"", chanName)); + "can not find channel named \"%s\"", chanName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL); return NULL; } @@ -1641,9 +1640,9 @@ Tcl_CreateChannel( unsigned len = strlen(chanName) + 1; /* - * Make sure we allocate at least 7 bytes, so it fits for "stdout" - * later. - */ + * Make sure we allocate at least 7 bytes, so it fits for "stdout" + * later. + */ tmp = (char *)ckalloc((len < 7) ? 7 : len); strcpy(tmp, chanName); @@ -1830,7 +1829,7 @@ Tcl_StackChannel( if (statePtr == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't find state for channel \"%s\"", + "couldn't find state for channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; @@ -1881,7 +1880,7 @@ Tcl_StackChannel( statePtr->csPtrW = csPtrW; if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not flush channel \"%s\"", + "could not flush channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; @@ -2076,7 +2075,7 @@ Tcl_UnstackChannel( if (!TclChanCaughtErrorBypass(interp, chan) && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not flush channel \"%s\"", + "could not flush channel \"%s\"", Tcl_GetChannelName((Tcl_Channel) chanPtr))); } return TCL_ERROR; @@ -2406,9 +2405,9 @@ Tcl_GetChannelHandle( chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { - Tcl_SetChannelError(chan, Tcl_ObjPrintf( - "channel \"%s\" does not support OS handles", - Tcl_GetChannelName(chan))); + Tcl_SetChannelError(chan, Tcl_ObjPrintf( + "channel \"%s\" does not support OS handles", + Tcl_GetChannelName(chan))); return TCL_ERROR; } result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, @@ -2641,7 +2640,7 @@ CheckForDeadChannel( Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to access channel: invalid channel", -1)); + "unable to access channel: invalid channel", -1)); } return 1; } @@ -2939,7 +2938,7 @@ FlushChannel( ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, - TCL_CLOSE_WRITE); + TCL_CLOSE_WRITE); goto done; } @@ -3399,8 +3398,8 @@ Tcl_Close( if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal recursive call to close through close-handler" - " of channel", -1)); + "illegal recursive call to close through close-handler" + " of channel", -1)); } return TCL_ERROR; } @@ -3612,8 +3611,8 @@ Tcl_CloseEx( msg = "write"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Half-close of %s-side not possible, side not opened or" - " already closed", msg)); + "Half-close of %s-side not possible, side not opened or" + " already closed", msg)); return TCL_ERROR; } @@ -3625,8 +3624,8 @@ Tcl_CloseEx( if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal recursive call to close through close-handler" - " of channel", -1)); + "illegal recursive call to close through close-handler" + " of channel", -1)); } return TCL_ERROR; } @@ -3687,8 +3686,8 @@ static int CloseWrite( Tcl_Interp *interp, /* Interpreter for errors. */ Channel *chanPtr) /* The channel whose write side is being - * closed. May still be used by some - * interpreter */ + * closed. May still be used by some + * interpreter */ { /* * Notes: clear-channel-handlers - write side only ? or keep around, just @@ -3698,7 +3697,7 @@ CloseWrite( */ ChannelState *statePtr = chanPtr->state; - /* State of real IO channel. */ + /* State of real IO channel. */ int flushcode; int result = 0; @@ -4205,8 +4204,8 @@ WillWrite( { int inputBuffered; - if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && - ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ + if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) + && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; DiscardInputQueued(chanPtr->state, 0); @@ -4229,7 +4228,6 @@ WillRead( } if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { - /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a @@ -4272,7 +4270,7 @@ static int Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ - int srcLen, /* Length of UTF-8 string in bytes. */ + int srcLen, /* Length of UTF-8 string in bytes. */ Tcl_Encoding encoding) { ChannelState *statePtr = chanPtr->state; @@ -4284,7 +4282,7 @@ Write( int encodingError = 0; if (srcLen) { - WillWrite(chanPtr); + WillWrite(chanPtr); } /* @@ -5008,7 +5006,7 @@ TclGetsObjBinary( * coming back here. When we are not dealing with * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer. * Here the buffer is non-empty so we know we're a non-EOF. - */ + */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); @@ -5306,7 +5304,7 @@ FilterInputBytes( * coming back here. When we are not dealing with CHANNEL_STICKY_EOF, * a CHANNEL_EOF implies an empty buffer. Here the buffer is * non-empty so we know we're a non-EOF. - */ + */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); @@ -5661,8 +5659,8 @@ Tcl_ReadRaw( bytesToRead -= toCopy; /* - * If the current buffer is empty recycle it. - */ + * If the current buffer is empty recycle it. + */ if (IsBufferEmpty(bufPtr)) { chanPtr->inQueueHead = bufPtr->nextPtr; @@ -5691,13 +5689,7 @@ Tcl_ReadRaw( if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); - if (nread > 0) { - /* - * Successful read (short is OK) - add to bytes copied. - */ - - copied += nread; - } else if (nread < 0) { + if (nread < 0) { /* * An error signaled. If CHANNEL_BLOCKED, then the error is not * real, but an indication of blocked state. In that case, retain @@ -5711,6 +5703,12 @@ Tcl_ReadRaw( if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } + } else if (nread > 0) { + /* + * Successful read (short is OK) - add to bytes copied. + */ + + copied += nread; } else { /* * nread == 0. Driver is at EOF. Let that state filter up. @@ -5970,7 +5968,7 @@ DoReadChars( || GotFlag(statePtr, CHANNEL_STICKY_EOF) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) - == (CHANNEL_EOF|CHANNEL_BLOCKED))); + == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); @@ -6106,7 +6104,9 @@ ReadChars( int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; - if (dstLimit <= 0) dstLimit = INT_MAX; /* avoid overflow */ + if (dstLimit <= 0) { + dstLimit = INT_MAX; /* avoid overflow */ + } (void) TclGetStringFromObj(objPtr, &numBytes); TclAppendUtfToUtf(objPtr, NULL, dstLimit); if (toRead == srcLen) { @@ -6901,7 +6901,7 @@ GetInput( * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done to honor * dynamic changes of the buffersize made by the user. - * + * * TODO: Tests to cover this. */ @@ -6931,15 +6931,17 @@ GetInput( PreserveChannelBuffer(bufPtr); nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead); + ReleaseChannelBuffer(bufPtr); if (nread < 0) { result = Tcl_GetErrno(); } else { result = 0; - bufPtr->nextAdded += nread; + if (statePtr->inQueueTail != NULL) { + statePtr->inQueueTail->nextAdded += nread; + } } - ReleaseChannelBuffer(bufPtr); return result; } @@ -7297,7 +7299,7 @@ Tcl_TruncateChannel( WillWrite(chanPtr); if (WillRead(chanPtr) < 0) { - return TCL_ERROR; + return TCL_ERROR; } /* @@ -7702,7 +7704,7 @@ Tcl_BadChannelOption( const char **argv; int argc, i; Tcl_DString ds; - Tcl_Obj *errObj; + Tcl_Obj *errObj; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); @@ -7716,13 +7718,13 @@ Tcl_BadChannelOption( } Tcl_ResetResult(interp); errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", - optionName ? optionName : ""); + optionName ? optionName : ""); argc--; for (i = 0; i < argc; i++) { Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); } Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); - Tcl_SetObjResult(interp, errObj); + Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); ckfree(argv); } @@ -8003,8 +8005,8 @@ Tcl_SetChannelOption( if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to set channel options: background copy in" - " progress", -1)); + "unable to set channel options: background copy in" + " progress", -1)); } return TCL_ERROR; } @@ -8053,10 +8055,10 @@ Tcl_SetChannelOption( ResetFlag(statePtr, CHANNEL_LINEBUFFERED); SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -buffering: must be one of" - " full, line, or none", -1)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad value for -buffering: must be one of" + " full, line, or none", -1)); + return TCL_ERROR; } return TCL_OK; } else if (HaveOpt(7, "-buffersize")) { @@ -8114,8 +8116,8 @@ Tcl_SetChannelOption( if (inValue & 0x80 || outValue & 0x80) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -eofchar: must be non-NUL ASCII" - " character", -1)); + "bad value for -eofchar: must be non-NUL ASCII" + " character", -1)); } ckfree(argv); return TCL_ERROR; @@ -8198,7 +8200,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform", -1)); } ckfree(argv); return TCL_ERROR; @@ -8248,7 +8250,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform", -1)); } ckfree(argv); return TCL_ERROR; @@ -8619,7 +8621,6 @@ ChannelTimerProc( * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc,chanPtr); Tcl_Preserve(statePtr); @@ -8959,17 +8960,17 @@ TclChannelEventScriptInvoker( void *clientData, /* The script+interp record. */ int mask) /* Not used. */ { - Tcl_Interp *interp; /* Interpreter in which to eval the script. */ - Channel *chanPtr; /* The channel for which this handler is - * registered. */ - EventScriptRecord *esPtr; /* The event script + interpreter to eval it + EventScriptRecord *esPtr = (EventScriptRecord *)clientData; + /* The event script + interpreter to eval it * in. */ + Channel *chanPtr = esPtr->chanPtr; + /* The channel for which this handler is + * registered. */ + Tcl_Interp *interp = esPtr->interp; + /* Interpreter in which to eval the script. */ int result; /* Result of call to eval script. */ - esPtr = (EventScriptRecord *)clientData; - chanPtr = esPtr->chanPtr; mask = esPtr->mask; - interp = esPtr->interp; /* * Be sure event executed in managed channel (covering bugs similar [f583715154]). @@ -9158,7 +9159,7 @@ TclCopyChannelOld( Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ { return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, - cmdPtr); + cmdPtr); } int @@ -9183,14 +9184,14 @@ TclCopyChannel( if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); + "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); } return TCL_ERROR; } if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); + "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); } return TCL_ERROR; } @@ -9270,8 +9271,8 @@ TclCopyChannel( */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { - Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); - return 0; + Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); + return 0; } /* @@ -9602,7 +9603,7 @@ CopyData( */ if ((csPtr->toRead == (Tcl_WideInt) -1) - || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { + || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { sizeb = (int) csPtr->toRead; @@ -9610,7 +9611,7 @@ CopyData( if (inBinary || sameEncoding) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); @@ -9789,8 +9790,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 bytes transferred. The + * local total is used because StopCopy frees csPtr. */ total = csPtr->total; @@ -10269,7 +10270,7 @@ SetBlockMode( if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error setting blocking mode: %s", + "error setting blocking mode: %s", Tcl_PosixError(interp))); } } else { @@ -10594,7 +10595,8 @@ Tcl_ChannelVersion( * Side effects: * None. * - *---------------------------------------------------------------------- */ + *---------------------------------------------------------------------- + */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 7a4b250..727239b 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -78,7 +78,7 @@ static const Tcl_ChannelType tclRChannelType = { NULL, /* Handle events. NULL'able */ ReflectSeekWide, /* Move access point (64 bit). NULL'able */ #ifdef TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else NULL, /* thread action */ #endif @@ -193,7 +193,8 @@ typedef enum { (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH)) #define NULLABLE_METHODS \ (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \ - FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL)) + FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \ + FLAG(METH_CGETALL)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) @@ -409,7 +410,7 @@ static void SrcExitProc(void *clientData); static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); static ReflectedChannelMap * GetThreadReflectedChannelMap(void); -static void DeleteThreadReflectedChannelMap(void *clientData); +static Tcl_ExitProc DeleteThreadReflectedChannelMap; #endif /* TCL_THREADS */ @@ -436,8 +437,7 @@ static int InvokeTclMethod(ReflectedChannel *rcPtr, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); -static void DeleteReflectedChannelMap(void *clientData, - Tcl_Interp *interp); +static Tcl_InterpDeleteProc DeleteReflectedChannelMap; static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); static void MarkDead(ReflectedChannel *rcPtr); @@ -563,6 +563,9 @@ TclChanCreateObjCmd( rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); + if (!rcPtr) { + return TCL_ERROR; + } /* * Invoke 'initialize' and validate that the handler is present and ok. @@ -593,9 +596,9 @@ TclChanCreateObjCmd( */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + TclGetString(cmdObj), TclGetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } @@ -619,37 +622,37 @@ TclChanCreateObjCmd( Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + TclGetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" lacks a \"read\" method", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"read\" method", + TclGetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" lacks a \"write\" method", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"write\" method", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", + TclGetString(cmdObj))); goto error; } @@ -720,7 +723,7 @@ TclChanCreateObjCmd( */ Tcl_SetObjResult(interp, - Tcl_NewStringObj(chanPtr->state->channelName, -1)); + Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: @@ -793,7 +796,7 @@ ReflectEventDelete( ReflectEvent *e = (ReflectEvent *) ev; if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) { - return 0; + return 0; } return 1; } @@ -853,7 +856,7 @@ TclChanPostEventObjCmd( if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can not find reflected channel named \"%s\"", chanId)); + "can not find reflected channel named \"%s\"", chanId)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, (char *)NULL); return TCL_ERROR; } @@ -917,8 +920,8 @@ TclChanPostEventObjCmd( if (events & ~rcPtr->interest) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "tried to post events channel \"%s\" is not interested in", - chanId)); + "tried to post events channel \"%s\" is not interested in", + chanId)); return TCL_ERROR; } @@ -929,40 +932,40 @@ TclChanPostEventObjCmd( #ifdef TCL_THREADS if (rcPtr->owner == rcPtr->thread) { #endif - Tcl_NotifyChannel(chan, events); + Tcl_NotifyChannel(chan, events); #ifdef TCL_THREADS } else { - ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); - - ev->header.proc = ReflectEventRun; - ev->events = events; - ev->rcPtr = rcPtr; - - /* - * We are not preserving the structure here. When the channel is - * closed any pending events are deleted, see ReflectClose(), and - * ReflectEventDelete(). Trying to preserve and later release when the - * event is run may generate a situation where the channel structure - * is deleted but not our structure, crashing in - * FreeReflectedChannel(). - * - * Force creation of the RCM, for proper cleanup on thread teardown. - * The teardown of unprocessed events is currently coupled to the - * thread reflected channel map - */ - - (void) GetThreadReflectedChannelMap(); - - /* - * XXX Race condition !! - * XXX The destination thread may not exist anymore already. - * XXX (Delayed postevent executed after channel got removed). - * XXX Can we detect this ? (check the validity of the owner threadid ?) - * XXX Actually, in that case the channel should be dead also ! - */ - - Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL); - Tcl_ThreadAlert(rcPtr->owner); + ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); + + ev->header.proc = ReflectEventRun; + ev->events = events; + ev->rcPtr = rcPtr; + + /* + * We are not preserving the structure here. When the channel is + * closed any pending events are deleted, see ReflectClose(), and + * ReflectEventDelete(). Trying to preserve and later release when the + * event is run may generate a situation where the channel structure + * is deleted but not our structure, crashing in + * FreeReflectedChannel(). + * + * Force creation of the RCM, for proper cleanup on thread teardown. + * The teardown of unprocessed events is currently coupled to the + * thread reflected channel map + */ + + (void) GetThreadReflectedChannelMap(); + + /* + * XXX Race condition !! + * XXX The destination thread may not exist anymore already. + * XXX (Delayed postevent executed after channel got removed). + * XXX Can we detect this ? (check the validity of the owner threadid ?) + * XXX Actually, in that case the channel should be dead also ! + */ + + Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL); + Tcl_ThreadAlert(rcPtr->owner); } #endif @@ -1105,7 +1108,7 @@ TclChanCaughtErrorBypass( * ReflectClose/ReflectClose2 -- * * This function is invoked when the channel is closed, to delete the - * driver specific instance data. + * driver-specific instance data. * * Results: * A Posix error. @@ -1153,11 +1156,11 @@ ReflectClose( ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * Now squash the pending reflection events for this channel. - */ + /* + * Now squash the pending reflection events for this channel. + */ - Tcl_DeleteEvents(ReflectEventDelete, rcPtr); + Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); @@ -1185,11 +1188,11 @@ ReflectClose( ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * Now squash the pending reflection events for this channel. - */ + /* + * Now squash the pending reflection events for this channel. + */ - Tcl_DeleteEvents(ReflectEventDelete, rcPtr); + Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); @@ -1330,18 +1333,18 @@ ReflectInput( if (code < 0) { *errorCodePtr = -code; - goto error; + goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); - goto invalid; + goto invalid; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; @@ -1411,9 +1414,9 @@ ReflectOutput( *errorCodePtr = -p.base.code; } else { - PassReceivedError(rcPtr->chan, &p); - *errorCodePtr = EINVAL; - } + PassReceivedError(rcPtr->chan, &p); + *errorCodePtr = EINVAL; + } p.output.toWrite = -1; } else { *errorCodePtr = EOK; @@ -1437,11 +1440,11 @@ ReflectOutput( if (code < 0) { *errorCodePtr = -code; - goto error; + goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); - goto invalid; + goto invalid; } if (Tcl_InterpDeleted(rcPtr->interp)) { @@ -1450,11 +1453,11 @@ ReflectOutput( */ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost); - goto invalid; + goto invalid; } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); - goto invalid; + goto invalid; } if ((written == 0) && (toWrite > 0)) { @@ -1464,7 +1467,7 @@ ReflectOutput( */ SetChannelErrorStr(rcPtr->chan, msg_write_nothing); - goto invalid; + goto invalid; } if (toWrite < written) { /* @@ -1474,7 +1477,7 @@ ReflectOutput( */ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; @@ -1550,24 +1553,24 @@ ReflectSeekWide( offObj = Tcl_NewWideIntObj(offset); baseObj = Tcl_NewStringObj( - (seekMode == SEEK_SET) ? "start" : - (seekMode == SEEK_CUR) ? "current" : "end", -1); + (seekMode == SEEK_SET) ? "start" : + (seekMode == SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); - goto invalid; + goto invalid; } - if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { + if (TclGetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); - goto invalid; + goto invalid; } if (newLoc < 0) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); - goto invalid; + goto invalid; } *errorCodePtr = EOK; @@ -1766,14 +1769,14 @@ ReflectThread( switch (action) { case TCL_CHANNEL_THREAD_INSERT: - rcPtr->owner = Tcl_GetCurrentThread(); - break; + rcPtr->owner = Tcl_GetCurrentThread(); + break; case TCL_CHANNEL_THREAD_REMOVE: - rcPtr->owner = NULL; - break; + rcPtr->owner = NULL; + break; default: - Tcl_Panic("Unknown thread action code."); - break; + Tcl_Panic("Unknown thread action code."); + break; } } @@ -1932,14 +1935,14 @@ ReflectGetOption( method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); - Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(optionObj); } Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) { UnmarshallErrorResult(interp, resObj); - goto error; + goto error; } /* @@ -1949,7 +1952,7 @@ ReflectGetOption( if (optionObj != NULL) { TclDStringAppendObj(dsPtr, resObj); - goto ok; + goto ok; } /* @@ -1964,7 +1967,7 @@ ReflectGetOption( */ if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { - goto error; + goto error; } if ((listc % 2) == 1) { @@ -1977,7 +1980,7 @@ ReflectGetOption( "Expected list with even number of " "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); - goto error; + goto error; } else { int len; const char *str = TclGetStringFromObj(resObj, &len); @@ -1986,14 +1989,14 @@ ReflectGetOption( TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } - goto ok; + goto ok; } ok: result = TCL_OK; stop: if (optionObj) { - Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(optionObj); } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); @@ -2153,7 +2156,6 @@ NewReflectedChannel( rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ - /* ASSERT: cmdpfxObj is a Tcl List */ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); @@ -2279,10 +2281,10 @@ InvokeTclMethod( Tcl_IncrRefCount(resObj); } - /* - * Not touching argOneObj, argTwoObj, they have not been used. - * See the contract as well. - */ + /* + * Not touching argOneObj, argTwoObj, they have not been used. + * See the contract as well. + */ return TCL_ERROR; } @@ -2293,7 +2295,6 @@ InvokeTclMethod( */ cmd = TclListObjCopy(NULL, rcPtr->cmd); - Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); Tcl_ListObjAppendElement(NULL, cmd, methObj); Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); @@ -2464,8 +2465,7 @@ GetReflectedChannelMap( if (rcmPtr == NULL) { rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); - Tcl_SetAssocData(interp, RCMKEY, - (Tcl_InterpDeleteProc *)DeleteReflectedChannelMap, rcmPtr); + Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr); } return rcmPtr; } @@ -2580,11 +2580,11 @@ DeleteReflectedChannelMap( /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. - * - * Attention: Results may have been detached already, by either the - * receiver, or this thread, as part of other parts in the thread - * teardown. Such results are ignored. See ticket [b47b176adf] for the - * identical race condition in Tcl 8.6 IORTrans. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; @@ -2732,11 +2732,11 @@ DeleteThreadReflectedChannelMap( /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. - * - * Attention: Results may have been detached already, by either the - * receiver, or this thread, as part of other parts in the thread - * teardown. Such results are ignored. See ticket [b47b176adf] for the - * identical race condition in Tcl 8.6 IORTrans. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; @@ -2945,7 +2945,7 @@ ForwardProc( ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in - * this interp. */ + * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ (void)mask; @@ -2989,12 +2989,12 @@ ForwardProc( rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); MarkDead(rcPtr); break; @@ -3036,17 +3036,17 @@ ForwardProc( paramPtr->input.toRead = bytec; } } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(toReadObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(toReadObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) - paramPtr->output.buf, paramPtr->output.toWrite); - Tcl_IncrRefCount(bufObj); + paramPtr->output.buf, paramPtr->output.toWrite); + Tcl_IncrRefCount(bufObj); - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); @@ -3075,16 +3075,19 @@ ForwardProc( paramPtr->output.toWrite = written; } } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(bufObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(bufObj); break; } case ForwardedSeek: { - Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset); - Tcl_Obj *baseObj = Tcl_NewStringObj( - (paramPtr->seek.seekMode==SEEK_SET) ? "start" : - (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); + Tcl_Obj *offObj; + Tcl_Obj *baseObj; + + offObj = Tcl_NewWideIntObj(paramPtr->seek.offset); + baseObj = Tcl_NewStringObj( + (paramPtr->seek.seekMode==SEEK_SET) ? "start" : + (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); @@ -3101,7 +3104,7 @@ ForwardProc( Tcl_WideInt newLoc; - if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { + if (TclGetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { if (newLoc < 0) { ForwardSetStaticError(paramPtr, msg_seek_beforestart); paramPtr->seek.offset = -1; @@ -3115,35 +3118,35 @@ ForwardProc( paramPtr->seek.offset = -1; } } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(offObj); - Tcl_DecrRefCount(baseObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(offObj); + Tcl_DecrRefCount(baseObj); break; } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); - /* assert maskObj.refCount == 1 */ + /* assert maskObj.refCount == 1 */ - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); rcPtr->interest = paramPtr->watch.mask; (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); - Tcl_Release(rcPtr); + Tcl_Release(rcPtr); break; } case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); - Tcl_IncrRefCount(blockObj); - Tcl_Preserve(rcPtr); + Tcl_IncrRefCount(blockObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, - &resObj) != TCL_OK) { + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(blockObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(blockObj); break; } @@ -3151,16 +3154,16 @@ ForwardProc( Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); - Tcl_IncrRefCount(optionObj); - Tcl_IncrRefCount(valueObj); - Tcl_Preserve(rcPtr); + Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(valueObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, - &resObj) != TCL_OK) { + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(optionObj); - Tcl_DecrRefCount(valueObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(valueObj); break; } @@ -3171,15 +3174,15 @@ ForwardProc( Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); - Tcl_IncrRefCount(optionObj); - Tcl_Preserve(rcPtr); + Tcl_IncrRefCount(optionObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(optionObj); + Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); break; } @@ -3188,7 +3191,7 @@ ForwardProc( * Retrieve all options. */ - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { @@ -3201,7 +3204,7 @@ ForwardProc( Tcl_Obj **listv; if (TclListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { + &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); @@ -3226,7 +3229,7 @@ ForwardProc( } } } - Tcl_Release(rcPtr); + Tcl_Release(rcPtr); break; default: -- cgit v0.12 From 921b236885f4e4bff055356a5524c6d52b1fb8f5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Apr 2024 11:49:16 +0000 Subject: Reserve 2 more stub entries for TIP #648 --- generic/tcl.decls | 2 +- generic/tclDecls.h | 12 +++++++++--- generic/tclStubInit.c | 4 +++- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 2f21fa5..5cef47a 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2327,7 +2327,7 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # -declare 688 { +declare 690 { void TclUnusedStubEntry(void) } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8a226a9..7bcf534 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1872,7 +1872,9 @@ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( /* Slot 685 is reserved */ /* Slot 686 is reserved */ /* Slot 687 is reserved */ -/* 688 */ +/* Slot 688 is reserved */ +/* Slot 689 is reserved */ +/* 690 */ EXTERN void TclUnusedStubEntry(void); typedef struct { @@ -2597,7 +2599,9 @@ typedef struct TclStubs { void (*reserved685)(void); void (*reserved686)(void); void (*reserved687)(void); - void (*tclUnusedStubEntry) (void); /* 688 */ + void (*reserved688)(void); + void (*reserved689)(void); + void (*tclUnusedStubEntry) (void); /* 690 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3947,8 +3951,10 @@ extern const TclStubs *tclStubsPtr; /* Slot 685 is reserved */ /* Slot 686 is reserved */ /* Slot 687 is reserved */ +/* Slot 688 is reserved */ +/* Slot 689 is reserved */ #define TclUnusedStubEntry \ - (tclStubsPtr->tclUnusedStubEntry) /* 688 */ + (tclStubsPtr->tclUnusedStubEntry) /* 690 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0a7fb01..cd6d46b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1688,7 +1688,9 @@ const TclStubs tclStubs = { 0, /* 685 */ 0, /* 686 */ 0, /* 687 */ - TclUnusedStubEntry, /* 688 */ + 0, /* 688 */ + 0, /* 689 */ + TclUnusedStubEntry, /* 690 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12