Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge 8.7 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk | main |
Files: | files | file ages | folders |
SHA3-256: |
bc2e65239403f9943b88137696949b92 |
User & Date: | sebres 2024-05-21 10:33:56 |
Context
2024-05-21
| ||
10:51 | merge 8.7 check-in: 780ab56525 user: sebres tags: trunk, main | |
10:33 | merge 8.7 check-in: bc2e652394 user: sebres tags: trunk, main | |
09:48 | merge 8.6 check-in: 5be1c6c979 user: sebres tags: core-8-branch | |
09:04 | b2 -> b3, as preparation for next release check-in: 84ecf75d3b user: jan.nijtmans tags: trunk, main | |
Changes
Changes to generic/tclIO.c.
︙ | ︙ | |||
93 94 95 96 97 98 99 100 101 102 103 104 105 106 | * copy. Note that the data buffer for the copy will be appended to this * structure. */ typedef struct CopyState { struct Channel *readPtr; /* Pointer to input channel. */ struct Channel *writePtr; /* Pointer to output channel. */ int readFlags; /* Original read channel flags. */ int writeFlags; /* Original write channel flags. */ 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. */ Tcl_Size bufSize; /* Size of appended buffer. */ | > | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | * copy. Note that the data buffer for the copy will be appended to this * structure. */ typedef struct CopyState { struct Channel *readPtr; /* Pointer to input channel. */ struct Channel *writePtr; /* Pointer to output channel. */ int refCount; /* Reference counter. */ int readFlags; /* Original read channel flags. */ int writeFlags; /* Original write channel flags. */ 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. */ Tcl_Size bufSize; /* Size of appended buffer. */ |
︙ | ︙ | |||
218 219 220 221 222 223 224 225 226 227 228 229 230 231 | int charsLeft, int *factorPtr); static void RecycleBuffer(ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard); static int StackSetBlockMode(Channel *chanPtr, int mode); static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr, int mode); static void StopCopy(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); static Tcl_Size Write(Channel *chanPtr, const char *src, Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); | > | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | int charsLeft, int *factorPtr); static void RecycleBuffer(ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard); static int StackSetBlockMode(Channel *chanPtr, int mode); static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr, int mode); static void StopCopy(CopyState *csPtr); static void CopyDecrRefCount(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); static Tcl_Size Write(Channel *chanPtr, const char *src, Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); |
︙ | ︙ | |||
2083 2084 2085 2086 2087 2088 2089 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not flush channel \"%s\"", Tcl_GetChannelName((Tcl_Channel) chanPtr))); } return TCL_ERROR; } | | | 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not flush channel \"%s\"", Tcl_GetChannelName((Tcl_Channel) chanPtr))); } return TCL_ERROR; } statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; } /* * Anything in the input queue and the push-back buffers of the * transformation going away is transformed data, but not yet read. As * unstacking means that the caller does not want to see transformed |
︙ | ︙ | |||
3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 | goto done; } done: TclChannelRelease((Tcl_Channel)chanPtr); return errorCode; } /* *---------------------------------------------------------------------- * * CloseChannel -- * * Utility procedure to close a channel and free associated resources. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 | goto done; } done: TclChannelRelease((Tcl_Channel)chanPtr); return errorCode; } static void FreeChannelState( void *blockPtr) /* Channel state to free. */ { ChannelState *statePtr = (ChannelState *)blockPtr; /* * Even after close some members can be filled again (in events etc). * Test in bug [79474c588] illustrates one leak (on remaining chanMsg). * Possible other fields need freeing on some constellations. */ DiscardInputQueued(statePtr, 1); if (statePtr->curOutPtr != NULL) { ReleaseChannelBuffer(statePtr->curOutPtr); } DiscardOutputQueued(statePtr); DeleteTimerHandler(statePtr); if (statePtr->chanMsg) { Tcl_DecrRefCount(statePtr->chanMsg); } if (statePtr->unreportedMsg) { Tcl_DecrRefCount(statePtr->unreportedMsg); } Tcl_Free(statePtr); } /* *---------------------------------------------------------------------- * * CloseChannel -- * * Utility procedure to close a channel and free associated resources. |
︙ | ︙ | |||
3177 3178 3179 3180 3181 3182 3183 | * There is only the TOP Channel, so we free the remaining pointers we * have and then ourselves. Since this is the last of the channels in the * stack, make sure to free the ChannelState structure associated with it. */ ChannelFree(chanPtr); | | | 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 | * There is only the TOP Channel, so we free the remaining pointers we * have and then ourselves. Since this is the last of the channels in the * stack, make sure to free the ChannelState structure associated with it. */ ChannelFree(chanPtr); Tcl_EventuallyFree(statePtr, FreeChannelState); return errorCode; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
3985 3986 3987 3988 3989 3990 3991 | } statePtr->chPtr = NULL; /* * Cancel any pending copy operation. */ | > | > > > | > > | 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 | } statePtr->chPtr = NULL; /* * Cancel any pending copy operation. */ if (statePtr->csPtrR) { StopCopy(statePtr->csPtrR); statePtr->csPtrR = NULL; } if (statePtr->csPtrW) { StopCopy(statePtr->csPtrW); statePtr->csPtrW = NULL; } /* * Must set the interest mask now to 0, otherwise infinite loops will * occur if Tcl_DoOneEvent is called before the channel is finally deleted * in FlushChannel. This can happen if the channel has a background flush * active. */ |
︙ | ︙ | |||
9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 | * completed. */ csPtr = (CopyState *)Tcl_Alloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; csPtr->toRead = toRead; csPtr->total = (Tcl_WideInt) 0; csPtr->interp = interp; if (cmdPtr) { Tcl_IncrRefCount(cmdPtr); } csPtr->cmdPtr = cmdPtr; | > > > > | | | 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 9463 9464 | * completed. */ csPtr = (CopyState *)Tcl_Alloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; csPtr->refCount = 2; /* two references below (inStatePtr, outStatePtr) */ csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; csPtr->toRead = toRead; csPtr->total = (Tcl_WideInt) 0; csPtr->interp = interp; if (cmdPtr) { Tcl_IncrRefCount(cmdPtr); } csPtr->cmdPtr = cmdPtr; TclChannelPreserve(inChan); TclChannelPreserve(outChan); inStatePtr->csPtrR = csPtr; outStatePtr->csPtrW = csPtr; if (moveBytes) { return MoveBytes(csPtr); } /* * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); return TCL_OK; } /* * Start copying data between the channels. */ return CopyData(csPtr, 0); |
︙ | ︙ | |||
9685 9686 9687 9688 9689 9690 9691 9692 9693 9694 9695 9696 9697 9698 | Tcl_Size sizePart; Tcl_WideInt total; Tcl_WideInt size; const char *buffer; int moveBytes; int underflow; /* Input underflow */ inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; outStatePtr = csPtr->writePtr->state; interp = csPtr->interp; cmdPtr = csPtr->cmdPtr; | > > | 9725 9726 9727 9728 9729 9730 9731 9732 9733 9734 9735 9736 9737 9738 9739 9740 | Tcl_Size sizePart; Tcl_WideInt total; Tcl_WideInt size; const char *buffer; int moveBytes; int underflow; /* Input underflow */ csPtr->refCount++; /* avoid freeing during handling */ inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; outStatePtr = csPtr->writePtr->state; interp = csPtr->interp; cmdPtr = csPtr->cmdPtr; |
︙ | ︙ | |||
9829 9830 9831 9832 9833 9834 9835 | continue; } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } | | | 9871 9872 9873 9874 9875 9876 9877 9878 9879 9880 9881 9882 9883 9884 9885 | continue; } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } goto done; } } /* * Now write the buffer out. */ |
︙ | ︙ | |||
9915 9916 9917 9918 9919 9920 9921 | Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } | | | 9957 9958 9959 9960 9961 9962 9963 9964 9965 9966 9967 9968 9969 9970 9971 | Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } goto done; } /* * For background copies, we only do one buffer per invocation so we * don't starve the rest of the system. */ |
︙ | ︙ | |||
9937 9938 9939 9940 9941 9942 9943 | Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } | | | 9979 9980 9981 9982 9983 9984 9985 9986 9987 9988 9989 9990 9991 9992 9993 | Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } goto done; } } /* while */ if (bufObj != NULL) { TclDecrRefCount(bufObj); bufObj = NULL; } |
︙ | ︙ | |||
9989 9990 9991 9992 9993 9994 9995 9996 9997 9998 9999 10000 10001 10002 | result = TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total)); } } } return result; } /* *---------------------------------------------------------------------- * * DoRead -- | > > > | 10031 10032 10033 10034 10035 10036 10037 10038 10039 10040 10041 10042 10043 10044 10045 10046 10047 | result = TCL_ERROR; } else { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total)); } } } done: CopyDecrRefCount(csPtr); return result; } /* *---------------------------------------------------------------------- * * DoRead -- |
︙ | ︙ | |||
10098 10099 10100 10101 10102 10103 10104 | * to fill the dst */ int code; moreData: code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; | < < | < | < | < < < | > > > > > > | 10143 10144 10145 10146 10147 10148 10149 10150 10151 10152 10153 10154 10155 10156 10157 10158 10159 10160 10161 10162 10163 10164 10165 10166 10167 10168 10169 10170 10171 10172 10173 10174 10175 10176 10177 10178 10179 | * to fill the dst */ int code; moreData: code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) { /* * Further reads cannot do any more. */ break; } if (code || !bufPtr) { /* Read error (or channel dead/closed) */ goto readErr; } assert(IsBufferFull(bufPtr)); } if (!bufPtr) { readErr: UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return -1; } bytesRead = BytesLeft(bufPtr); bytesWritten = bytesToRead; TranslateInputEOL(statePtr, p, RemovePoint(bufPtr), &bytesWritten, &bytesRead); bufPtr->nextRemoved += bytesRead; |
︙ | ︙ | |||
10363 10364 10365 10366 10367 10368 10369 10370 | Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); if (inChan != outChan) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); TclDecrRefCount(csPtr->cmdPtr); } | > > > > | > > > > | > > > > > > > > > > > > > > > | 10407 10408 10409 10410 10411 10412 10413 10414 10415 10416 10417 10418 10419 10420 10421 10422 10423 10424 10425 10426 10427 10428 10429 10430 10431 10432 10433 10434 10435 10436 10437 10438 10439 10440 10441 10442 10443 10444 10445 10446 | Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); if (inChan != outChan) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); TclDecrRefCount(csPtr->cmdPtr); csPtr->cmdPtr = NULL; } if (inStatePtr->csPtrR) { assert(inStatePtr->csPtrR == csPtr); inStatePtr->csPtrR = NULL; CopyDecrRefCount(csPtr); } if (outStatePtr->csPtrW) { assert(outStatePtr->csPtrW == csPtr); outStatePtr->csPtrW = NULL; CopyDecrRefCount(csPtr); } } static void CopyDecrRefCount( CopyState *csPtr) { if (csPtr->refCount-- > 1) { return; } TclChannelRelease((Tcl_Channel)csPtr->readPtr); TclChannelRelease((Tcl_Channel)csPtr->writePtr); Tcl_Free(csPtr); } /* *---------------------------------------------------------------------- * * StackSetBlockMode -- |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 | resObj = Tcl_ObjPrintf("rc%lu", rcCounter); rcCounter++; Tcl_MutexUnlock(&rcCounterMutex); return resObj; } static void FreeReflectedChannel( void *blockPtr) { ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; Channel *chanPtr = (Channel *) rcPtr->chan; TclChannelRelease((Tcl_Channel)chanPtr); | > > > > > > > > > > > > > > > > > > > > > > | < < < < < < < < | 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 | resObj = Tcl_ObjPrintf("rc%lu", rcCounter); rcCounter++; Tcl_MutexUnlock(&rcCounterMutex); return resObj; } static inline void CleanRefChannelInstance( ReflectedChannel *rcPtr) { if (rcPtr->name) { /* * Reset obj-type (channel is deleted or dead anyway) to avoid leakage * by cyclic references (see bug [79474c58800cdf94]). */ TclFreeInternalRep(rcPtr->name); Tcl_DecrRefCount(rcPtr->name); rcPtr->name = NULL; } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); rcPtr->methods = NULL; } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); rcPtr->cmd = NULL; } } static void FreeReflectedChannel( void *blockPtr) { ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; Channel *chanPtr = (Channel *) rcPtr->chan; TclChannelRelease((Tcl_Channel)chanPtr); CleanRefChannelInstance(rcPtr); Tcl_Free(rcPtr); } /* *---------------------------------------------------------------------- * * InvokeTclMethod -- |
︙ | ︙ | |||
2593 2594 2595 2596 2597 2598 2599 | static void MarkDead( ReflectedChannel *rcPtr) { if (rcPtr->dead) { return; } | | < < < < < < < < < < < | 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 | static void MarkDead( ReflectedChannel *rcPtr) { if (rcPtr->dead) { return; } CleanRefChannelInstance(rcPtr); rcPtr->dead = 1; } static void DeleteReflectedChannelMap( void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 | static inline void InitCallChain( CallChain *callPtr, Object *oPtr, int flags) { callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); if (oPtr->flags & USE_CLASS_CACHE) { | > > > > > > > | > | | | > > > > > | 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 | static inline void InitCallChain( CallChain *callPtr, Object *oPtr, int flags) { /* * Note that it's possible to end up with a NULL oPtr->selfCls here if * there is a call into stereotypical object after it has finished running * its destructor phase. Such things can't be cached for a long time so the * epoch can be bogus. [Bug 7842f33a5c] */ callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); if (oPtr->flags & USE_CLASS_CACHE) { oPtr = (oPtr->selfCls ? oPtr->selfCls->thisPtr : NULL); callPtr->flags |= USE_CLASS_CACHE; } if (oPtr) { callPtr->epoch = oPtr->fPtr->epoch; callPtr->objectCreationEpoch = oPtr->creationEpoch; callPtr->objectEpoch = oPtr->epoch; } else { callPtr->epoch = 0; callPtr->objectCreationEpoch = 0; callPtr->objectEpoch = 0; } callPtr->refCount = 1; callPtr->numChain = 0; callPtr->chain = callPtr->staticChain; } /* * ---------------------------------------------------------------------- |
︙ | ︙ | |||
1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 | IsStillValid( CallChain *callPtr, Object *oPtr, int flags, int mask) { if ((oPtr->flags & USE_CLASS_CACHE)) { oPtr = oPtr->selfCls->thisPtr; flags |= USE_CLASS_CACHE; } return ((callPtr->objectCreationEpoch == oPtr->creationEpoch) && (callPtr->epoch == oPtr->fPtr->epoch) && (callPtr->objectEpoch == oPtr->epoch) && ((callPtr->flags & mask) == (flags & mask))); | > > > > > > > | 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 | IsStillValid( CallChain *callPtr, Object *oPtr, int flags, int mask) { if ((oPtr->flags & USE_CLASS_CACHE)) { /* * If the object is in a weird state (due to stereotype tricks) then * just declare the cache invalid. [Bug 7842f33a5c] */ if (!oPtr->selfCls) { return 0; } oPtr = oPtr->selfCls->thisPtr; flags |= USE_CLASS_CACHE; } return ((callPtr->objectCreationEpoch == oPtr->creationEpoch) && (callPtr->epoch == oPtr->fPtr->epoch) && (callPtr->objectEpoch == oPtr->epoch) && ((callPtr->flags & mask) == (flags & mask))); |
︙ | ︙ | |||
1205 1206 1207 1208 1209 1210 1211 | if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_StoreInternalRep(cacheInThisObj, &methodNameType, NULL); } | > > > > > > > > | | | 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 | if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; } Tcl_StoreInternalRep(cacheInThisObj, &methodNameType, NULL); } /* * Note that it's possible to end up with a NULL oPtr->selfCls here if * there is a call into stereotypical object after it has finished * running its destructor phase. It's quite a tangle, but at that * point, we simply can't get stereotypes from the cache. * [Bug 7842f33a5c] */ if (oPtr->flags & USE_CLASS_CACHE && oPtr->selfCls) { if (oPtr->selfCls->classChainCache) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, methodNameObj); } else { hPtr = NULL; } } else { if (oPtr->chainCache != NULL) { |
︙ | ︙ | |||
1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 | CallChain *callPtr; struct ChainBuilder cb; Tcl_Size count; Foundation *fPtr = clsPtr->thisPtr->fPtr; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; Object obj; /* * Synthesize a temporary stereotypical object so that we can use existing * machinery to produce the stereotypical call chain. */ memset(&obj, 0, sizeof(Object)); | > > > > > > > > > > > | 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 | CallChain *callPtr; struct ChainBuilder cb; Tcl_Size count; Foundation *fPtr = clsPtr->thisPtr->fPtr; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; Object obj; /* * Note that it's possible to end up with a NULL clsPtr here if there is * a call into stereotypical object after it has finished running its * destructor phase. It's quite a tangle, but at that point, we simply * can't get stereotypes. [Bug 7842f33a5c] */ if (clsPtr == NULL) { return NULL; } /* * Synthesize a temporary stereotypical object so that we can use existing * machinery to produce the stereotypical call chain. */ memset(&obj, 0, sizeof(Object)); |
︙ | ︙ | |||
1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 | /* * We hard-code the tail-recursive form. It's by far the most common case * *and* it is much more gentle on the stack. * * Note that mixins must be processed before the main class hierarchy. * [Bug 1998221] */ tailRecurse: FOREACH(superPtr, classPtr->mixins) { if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl)) { return 1; } } | > > > > > > > | 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 | /* * We hard-code the tail-recursive form. It's by far the most common case * *and* it is much more gentle on the stack. * * Note that mixins must be processed before the main class hierarchy. * [Bug 1998221] * * Note also that it's possible to end up with a null classPtr here if * there is a call into stereotypical object after it has finished running * its destructor phase. [Bug 7842f33a5c] */ tailRecurse: if (classPtr == NULL) { return 0; } FOREACH(superPtr, classPtr->mixins) { if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl)) { return 1; } } |
︙ | ︙ |
Changes to tests/ioCmd.test.
︙ | ︙ | |||
2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 | child eval { proc no-op args {} proc driver {sub args} {return {initialize finalize watch read}} chan event [chan create read driver] readable no-op } interp delete child } {} # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. # -*- tcl -*- # ### ### ### ######### ######### ######### | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 | child eval { proc no-op args {} proc driver {sub args} {return {initialize finalize watch read}} chan event [chan create read driver] readable no-op } interp delete child } {} # 1st attempt without error in write, another with error in write: foreach ::writeErr {0 1} { test iocmd-32.3.$::writeErr {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup { proc test_chan {args} { set rest [lassign $args mode chan] lappend ::ret $mode switch -exact $mode { read {puts $chan "Test" ; close $chan} write {if {$::writeErr} {return "boom"}; set data [lindex $rest 0]; string length $data} finalize {after 20 {set ::done done}} initialize {return "initialize watch finalize read write"} } } set clchlst {} set toev [after 5000 {set ::done tout}] } -body { set ::ret {} set ch [chan create "read write" test_chan] lappend clchlst $ch lassign [chan pipe] in1 out1 lappend clchlst $in1 $out1 lassign [chan pipe] in2 out2 lappend clchlst $in2 $out2 lassign [chan pipe] in3 out3 lappend clchlst $in3 $out3 # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: fileevent $out2 writable [list apply {{cho che} { puts $cho test; close $cho; close $che }} $out2 $out3] # recopy to given chans in handler fileevent $in2 readable [list apply {{in out} { if {[catch { chan copy $in $out } msg]} { #puts err:$msg fileevent $in readable {} } }} $in2 $ch] fileevent $in3 readable [list apply {{in out} { if {[catch { chan copy $in $out } msg]} { #puts err:$msg fileevent $in readable {} } }} $in3 $ch] fileevent $out1 writable [list apply {{in out} { if {[catch { chan copy $in $out } msg]} { #puts err:$msg fileevent $out writable {} } }} $ch $out1] vwait ::done lappend ::ret $::done } -cleanup { foreach ch $clchlst { catch {close $ch} } after cancel $toev unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev clchlst } -result {initialize read write finalize done} }; unset ::writeErr # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. # -*- tcl -*- # ### ### ### ######### ######### ######### |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
4537 4538 4539 4540 4541 4542 4543 | rename obj2 {} rename obj1 {} # doesn't crash return done } -cleanup { rename obj {} } -result done | > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 | rename obj2 {} rename obj1 {} # doesn't crash return done } -cleanup { rename obj {} } -result done test oo-35.7.1 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { oo::class create base oo::class create RpcClient { superclass base method write name { lappend ::result "RpcClient -> $name" } method create_bug {} { MkObjectRpc create cfg [self] 111 } } oo::class create MkObjectRpc { superclass base variable hdl constructor {rpcHdl mqHdl} { set hdl $mqHdl oo::objdefine [self] forward rpc $rpcHdl } destructor { my rpc write otto-$hdl } } set ::result {} } -body { set FH [RpcClient new] $FH create_bug $FH destroy join $result \n } -cleanup { base destroy } -result {} test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { oo::class create base oo::class create RpcClient { superclass base method write name { lappend ::result "RpcClient -> $name" } method create_bug {} { MkObjectRpc create cfg [self] 111 } destructor { lappend ::result "Destroyed" } } oo::class create MkObjectRpc { superclass base variable hdl constructor {rpcHdl mqHdl} { set hdl $mqHdl oo::objdefine [self] forward rpc $rpcHdl } destructor { my rpc write otto-$hdl } } set ::result {} } -body { set FH [RpcClient new] $FH create_bug $FH destroy join $result \n } -cleanup { base destroy } -result {Destroyed} test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { oo::class create base oo::class create RpcClient { superclass base variable interiorObjects method write name { lappend ::result "RpcClient -> $name" } method create_bug {} { set obj [MkObjectRpc create cfg [self] 111] lappend interiorObjects $obj return $obj } destructor { lappend ::result "Destroyed" # Explicit destroy of interior objects foreach obj $interiorObjects { $obj destroy } } } oo::class create MkObjectRpc { superclass base variable hdl constructor {rpcHdl mqHdl} { set hdl $mqHdl oo::objdefine [self] forward rpc $rpcHdl } destructor { my rpc write otto-$hdl } } set ::result {} } -body { set FH [RpcClient new] $FH create_bug $FH destroy join $result \n } -cleanup { base destroy } -result "Destroyed\nRpcClient -> otto-111" test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object test oo-36.2 {TIP #470: introspection within oo::define} -setup { oo::class create Cls } -body { oo::define Cls self |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
156 157 158 159 160 161 162 | TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE}];\ package ifneeded registry 1.3.7 [list load ${REG_DLL_FILE}] TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE} Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll | | | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE}];\ package ifneeded registry 1.3.7 [list load ${REG_DLL_FILE}] TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE} Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll TOMMATH_DLL_FILE = libtommath.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} WINE = @WINE@ CAT32 = cat32$(EXEEXT) |
︙ | ︙ | |||
206 207 208 209 210 211 212 213 214 215 216 217 218 219 | RMDIR = rm -rf MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f COPY = cp LN = ln ### # Tip 430 - ZipFS Modifications ### TCL_ZIP_FILE = @TCL_ZIP_FILE@ TCL_VFS_PATH = libtcl.vfs/tcl_library | > | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 | RMDIR = rm -rf MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f COPY = cp LN = ln GDB = gdb ### # Tip 430 - ZipFS Modifications ### TCL_ZIP_FILE = @TCL_ZIP_FILE@ TCL_VFS_PATH = libtcl.vfs/tcl_library |
︙ | ︙ | |||
1021 1022 1023 1024 1025 1026 1027 | shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ $(WINE) ./$(TCLSH) $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: binaries @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run | | > > > > > > > > > | 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 | shell: binaries @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ $(WINE) ./$(TCLSH) $(SCRIPT) # This target can be used to run tclsh inside either gdb or insight gdb: binaries @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run $(GDB) ./$(TCLSH) --command=gdb.run rm gdb.run shquotequote = $(subst ',\",$(subst ",\",$(1))) gdb-test: tcltest @printf '%s ' 'set env TCL_LIBRARY=$(LIBRARY_DIR)' > gdb.run @printf '\n' >>gdb.run @printf '%s ' set args $(ROOT_DIR_NATIVE)/tests/all.tcl \ $(call shquotequote,$(TESTFLAGS)) -singleproc 1 >> gdb.run $(GDB) ${TEST_EXE_FILE} --command=gdb.run rm gdb.run depend: Makefile: $(SRC_DIR)/Makefile.in ./config.status |
︙ | ︙ |