diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclIORChan.c | 382 | ||||
| -rw-r--r-- | tests/ioCmd.test | 179 |
3 files changed, 523 insertions, 49 deletions
@@ -1,3 +1,14 @@ +2008-04-24 Andreas Kupries <andreask@activestate.com> + + * tests/ioCmd.test: Extended testsuite for reflected channel + implementation. Added test cases about how it handles if the rug + is pulled out from under a channel (= killing threads, + interpreters containing the tcl command for a channel, and channel + sitting in a different interpreter/thread.) + + * generic/tclIORChan.c: Fixed the bugs exposed by the new + testcases, redone most of the cleanup and exit handling. + 2008-04-21 Don Porter <dgp@users.sourceforge.net> * generic/tclIOUtil.c: Removed all code delimited by diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index b57d157..0c9c96b 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIORChan.c,v 1.30 2008/04/04 17:18:31 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.31 2008/04/24 18:51:01 andreas_kupries Exp $ */ #include <tclInt.h> @@ -85,7 +85,11 @@ typedef struct { Tcl_Channel chan; /* Back reference to generic channel * structure. */ Tcl_Interp *interp; /* Reference to the interpreter containing the - * Tcl level part of the channel. */ + * Tcl level part of the channel. NULL here + * signals the channel is dead because the + * interpreter/thread containing its Tcl + * command is gone. + */ #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ #endif @@ -338,6 +342,13 @@ typedef struct ForwardingEvent { struct ForwardingResult { Tcl_ThreadId src; /* Originating thread. */ Tcl_ThreadId dst; /* Thread the op was forwarded to. */ + Tcl_Interp* dsti; /* Interpreter in the thread the op was forwarded to. */ + /* + * Note regarding 'dsti' above: Its information is also available via the + * chain evPtr->rcPtr->interp, however, as can be seen, two more + * indirections are needed to retrieve it. And the evPtr may be gone, + * breaking the chain. + */ Tcl_Condition done; /* Condition variable the forwarder blocks * on. */ int result; /* TCL_OK or TCL_ERROR */ @@ -347,6 +358,17 @@ struct ForwardingResult { * results. */ }; +typedef struct ThreadSpecificData { + /* + * Table of all reflected channels owned by this thread. This is the + * per-thread version of the per-interpreter map. + */ + + ReflectedChannelMap* rcmPtr; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + /* * List of forwarded operations which have not completed yet, plus the mutex * to protect the access to this process global list. @@ -361,16 +383,15 @@ TCL_DECLARE_MUTEX(rcForwardMutex) * the event function executed by the thread receiving a forwarding event * (which executes the appropriate function and collects the result, if any). * - * The two ExitProcs are handlers so that things do not deadlock when either - * thread involved in the forwarding exits. They also clean things up so that - * we don't leak resources when threads go away. + * The ExitProc ensures that things do not deadlock when the sending thread + * involved in the forwarding exits. It also clean things up so that we don't + * leak resources when threads go away. */ static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, ForwardedOperation op, const VOID *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); -static void DstExitProc(ClientData clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ @@ -395,6 +416,10 @@ static void DstExitProc(ClientData clientData); (p)->base.msgStr = (char *) (emsg) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); + +static ReflectedChannelMap * GetThreadReflectedChannelMap(void); +static void DeleteThreadReflectedChannelMap(ClientData clientData); + #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ @@ -437,9 +462,10 @@ static const char *msg_write_toomuch = "{write wrote more than requested}"; static const char *msg_write_nothing = "{write wrote nothing}"; static const char *msg_seek_beforestart = "{Tried to seek before origin}"; #ifdef TCL_THREADS -static const char *msg_send_originlost = "{Origin thread lost}"; -static const char *msg_send_dstlost = "{Destination thread lost}"; +static const char *msg_send_originlost = "{Channel thread lost}"; +static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ +static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; /* * Main methods to plug into the 'chan' ensemble'. ================== @@ -696,6 +722,12 @@ TclChanCreateObjCmd( } } Tcl_SetHashValue(hPtr, chan); +#ifdef TCL_THREADS + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_CreateHashEntry(&rcmPtr->map, + chanPtr->state->channelName, &isNew); + Tcl_SetHashValue(hPtr, chan); +#endif /* * Return handle as result of command. @@ -1026,8 +1058,8 @@ ReflectClose( /* * THREADED => Forward this to the origin thread * - * Note: Have a thread delete handler for the origin thread. Use this - * to clean up the structure! + * Note: DeleteThreadReflectedChannelMap() is the thread exit handler for the origin + * thread. Use this to clean up the structure? Except if lost? */ #ifdef TCL_THREADS @@ -1098,12 +1130,26 @@ ReflectClose( * Remove the channel from the map before releasing the memory, to * prevent future accesses (like by 'postevent') from finding and * dereferencing a dangling pointer. + * + * NOTE: The channel may not be in the map. This is ok, that happens + * when the channel was created in a different interpreter and/or + * thread and then was moved here. */ rcmPtr = GetReflectedChannelMap (interp); hPtr = Tcl_FindHashEntry (&rcmPtr->map, Tcl_GetChannelName (rcPtr->chan)); - Tcl_DeleteHashEntry (hPtr); + if (hPtr) { + Tcl_DeleteHashEntry (hPtr); + } +#ifdef TCL_THREADS + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + if (hPtr) { + Tcl_DeleteHashEntry (hPtr); + } +#endif FreeReflectedChannel(rcPtr); #ifdef TCL_THREADS @@ -1169,6 +1215,7 @@ ReflectInput( if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.input.toRead = -1; } else { *errorCodePtr = EOK; } @@ -1263,6 +1310,7 @@ ReflectOutput( if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.output.toWrite = -1; } else { *errorCodePtr = EOK; } @@ -1361,6 +1409,7 @@ ReflectSeekWide( if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.seek.offset = -1; } else { *errorCodePtr = EOK; } @@ -2066,9 +2115,24 @@ InvokeTclMethod( int result; /* Result code of method invokation */ Tcl_Obj *resObj = NULL; /* Result of method invokation. */ + if (!rcPtr->interp) { + /* + * The channel is marked as dead. Bail out immediately, with an + * appropriate error. + */ + + if (resultObjPtr != NULL) { + resObj = Tcl_NewStringObj(msg_dstlost,-1); + *resultObjPtr = resObj; + Tcl_IncrRefCount(resObj); + } + return TCL_ERROR; + } + /* * NOTE (5): Decide impl. issue: Cache objects with method names? Needs * TSD data as reflections can be created in many different threads. + * NO: Caching of command resolutions means storage per channel. */ /* @@ -2242,11 +2306,25 @@ DeleteReflectedChannelMap( ReflectedChannelMap* rcmPtr; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ + ReflectedChannel* rcPtr; + Tcl_Channel chan; + +#ifdef TCL_THREADS + ForwardingResult *resultPtr; + ForwardingEvent *evPtr; + ForwardParam *paramPtr; +#endif /* - * Delete all entries. The channels may have been closed alreay, or will + * Delete all entries. The channels may have been closed already, or will * be closed later, by the standard IO finalization of an interpreter - * under destruction. + * under destruction. Except for the channels which were moved to a + * different interpreter and/or thread. They do not exist from the IO + * systems point of view and will not get closed. Therefore mark all as + * dead so that any future access will cause a proper error. For channels + * in a different thread we actually do the same as + * DeleteThreadReflectedChannelMap(), just restricted to the channels of + * this interp. */ rcmPtr = clientData; @@ -2254,13 +2332,208 @@ DeleteReflectedChannelMap( hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + + rcPtr->interp = NULL; + Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); ckfree((char *) &rcmPtr->map); + +#ifdef TCL_THREADS + /* + * The origin interpreter for one or more reflected channels is gone. + */ + + /* + * Go through the list of pending results and cancel all whose events were + * destined for this interpreter. While this is in progress we block any + * other access to the list of pending results. + */ + + Tcl_MutexLock(&rcForwardMutex); + + for (resultPtr = forwardList; + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { + if (resultPtr->dsti != interp) { + /* Ignore results/events for other interpreters. */ + continue; + } + + /* + * The receiver for the event exited, before processing the event. We + * detach the result now, wake the originator up and signal failure. + */ + + evPtr = resultPtr->evPtr; + paramPtr = evPtr->param; + + evPtr->resultPtr = NULL; + resultPtr->evPtr = NULL; + resultPtr->result = TCL_ERROR; + + ForwardSetStaticError(paramPtr, msg_send_dstlost); + + Tcl_ConditionNotify(&resultPtr->done); + } + + /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go + * through the channels and remove all which were handled by this + * interpreter. They have already been marked as dead. + */ + + rcmPtr = GetThreadReflectedChannelMap(); + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + + if (rcPtr->interp != interp) { + /* Ignore entries for other interpreters */ + continue; + } + + Tcl_DeleteHashEntry(hPtr); + } + + Tcl_MutexUnlock(&rcForwardMutex); +#endif } #ifdef TCL_THREADS +/* + *---------------------------------------------------------------------- + * + * GetThreadReflectedChannelMap -- + * + * Gets and potentially initializes the reflected channel map for a + * thread. + * + * Results: + * A pointer to the map created, for use by the caller. + * + * Side effects: + * Initializes the reflected channel map for a thread. + * + *---------------------------------------------------------------------- + */ + +static ReflectedChannelMap * +GetThreadReflectedChannelMap() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->rcmPtr) { + tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap)); + Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); + Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); + } + + return tsdPtr->rcmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteThreadReflectedChannelMap -- + * + * Deletes the channel table for a thread. This procedure is invoked when + * a thread is deleted. The channels have already been marked as dead, in + * DeleteReflectedChannelMap(). + * + * Results: + * None. + * + * Side effects: + * Deletes the hash table of channels. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteThreadReflectedChannelMap( + ClientData clientData) /* The per-thread data structure. */ +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_ThreadId self = Tcl_GetCurrentThread(); + + ReflectedChannelMap* rcmPtr; /* The map */ + Tcl_Channel chan; + ReflectedChannel* rcPtr; + ForwardingResult *resultPtr; + ForwardingEvent *evPtr; + ForwardParam *paramPtr; + + /* + * The origin thread for one or more reflected channels is gone. + * NOTE: If this function is called due to a thread getting killed the + * per-interp DeleteReflectedChannelMap is apparently not called. + */ + + /* + * Go through the list of pending results and cancel all whose events were + * destined for this thread. While this is in progress we block any + * other access to the list of pending results. + */ + + Tcl_MutexLock(&rcForwardMutex); + + for (resultPtr = forwardList; + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { + if (resultPtr->dst != self) { + /* Ignore results/events for other threads. */ + continue; + } + + /* + * The receiver for the event exited, before processing the event. We + * detach the result now, wake the originator up and signal failure. + */ + + evPtr = resultPtr->evPtr; + paramPtr = evPtr->param; + + evPtr->resultPtr = NULL; + resultPtr->evPtr = NULL; + resultPtr->result = TCL_ERROR; + + ForwardSetStaticError(paramPtr, msg_send_dstlost); + + Tcl_ConditionNotify(&resultPtr->done); + } + + /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go + * through the channels, remove all, mark them as dead. + */ + + rcmPtr = GetThreadReflectedChannelMap(); + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + + rcPtr->interp = NULL; + + Tcl_DeleteHashEntry(hPtr); + } + + Tcl_MutexUnlock(&rcForwardMutex); +} + static void ForwardOpToOwnerThread( ReflectedChannel *rcPtr, /* Channel instance */ @@ -2273,6 +2546,24 @@ ForwardOpToOwnerThread( int result; /* + * We gather the lock early. This allows us to check the liveness of the + * channel without interference from DeleteThreadReflectedChannelMap(). + */ + + Tcl_MutexLock(&rcForwardMutex); + + if (rcPtr->interp == NULL) { + /* + * The channel is marked as dead. Bail out immediately, with an + * appropriate error. Do not forget to unlock the mutex on this path. + */ + + ForwardSetStaticError((ForwardParam *)param, msg_send_dstlost); + Tcl_MutexUnlock(&rcForwardMutex); + return; + } + + /* * Create and initialize the event and data structures. */ @@ -2285,8 +2576,9 @@ ForwardOpToOwnerThread( evPtr->rcPtr = rcPtr; evPtr->param = (ForwardParam *) param; - resultPtr->src = Tcl_GetCurrentThread(); - resultPtr->dst = dst; + resultPtr->src = Tcl_GetCurrentThread(); + resultPtr->dst = dst; + resultPtr->dsti = rcPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; resultPtr->evPtr = evPtr; @@ -2295,16 +2587,18 @@ ForwardOpToOwnerThread( * Now execute the forward. */ - Tcl_MutexLock(&rcForwardMutex); TclSpliceIn(resultPtr, forwardList); + /* Do not unlock here. That is done by the ConditionWait */ /* - * Ensure cleanup of the event if any of the two involved threads exits - * while this event is pending or in progress. + * Ensure cleanup of the event if the origin thread exits while this event + * is pending or in progress. Exitus of the destination thread is handled + * by DeleteThreadReflectionChannelMap(), this is set up by + * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' + * (see above) for. */ Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr); - Tcl_CreateThreadExitHandler(DstExitProc, (ClientData) evPtr); /* * Queue the event and poke the other thread's notifier. @@ -2323,6 +2617,9 @@ ForwardOpToOwnerThread( * NOTE (1): Is it possible that the current thread goes away while * waiting here? IOW Is it possible that "SrcExitProc" is called while * we are here? See complementary note (2) in "SrcExitProc" + * + * The ConditionWait unlocks the mutex during the wait and relocks it + * immediately after. */ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL); @@ -2330,6 +2627,7 @@ ForwardOpToOwnerThread( /* * Unlink result from the forwarder list. + * No need to lock. Either still locked, or locked by the ConditionWait */ TclSpliceOut(resultPtr, forwardList); @@ -2341,14 +2639,13 @@ ForwardOpToOwnerThread( Tcl_ConditionFinalize(&resultPtr->done); /* - * Kill the cleanup handlers now, and the result structure as well, before + * Kill the cleanup handler now, and the result structure as well, before * returning the success code. * * Note: The event structure has already been deleted. */ Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr); - Tcl_DeleteThreadExitHandler(DstExitProc, (ClientData) evPtr); result = resultPtr->result; ckfree((char*) resultPtr); @@ -2378,6 +2675,8 @@ ForwardProc( Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ + ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */ + Tcl_HashEntry* hPtr; /* Entry in the above map */ /* * Ignore the event if no one is waiting for its result anymore. @@ -2411,8 +2710,22 @@ ForwardProc( * Freeing is done here, in the origin thread, because the argv[] * objects belong to this thread. Deallocating them in a different * thread is not allowed + * + * We remove the channel from both interpreter and thread maps before + * releasing the memory, to prevent future accesses (like by + * 'postevent') from finding and dereferencing a dangling pointer. */ + rcmPtr = GetReflectedChannelMap (interp); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + Tcl_DeleteHashEntry (hPtr); + + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + Tcl_DeleteHashEntry (hPtr); + FreeReflectedChannel(rcPtr); break; @@ -2674,33 +2987,6 @@ SrcExitProc( } static void -DstExitProc( - ClientData clientData) -{ - ForwardingEvent *evPtr = (ForwardingEvent *) clientData; - ForwardingResult *resultPtr = evPtr->resultPtr; - ForwardParam *paramPtr = evPtr->param; - - /* - * NOTE (3): It is not clear if the event still exists when this handler - * is called. We might have to use 'resultPtr' as our clientData instead. - */ - - /* - * The receiver for the event exited, before processing the event. We - * detach the result now, wake the originator up and signal failure. - */ - - evPtr->resultPtr = NULL; - resultPtr->evPtr = NULL; - resultPtr->result = TCL_ERROR; - - ForwardSetStaticError(paramPtr, msg_send_dstlost); - - Tcl_ConditionNotify(&resultPtr->done); -} - -static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 5a0d1ba..82c9645 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.41 2008/04/21 16:26:39 dgp Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.42 2008/04/24 18:51:01 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -779,6 +779,11 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g # --- --- --- --------- --------- --------- # Helper commands to record the arguments to handler methods. +# Stored in a script so that the threads and interpreters needing this +# code do not need their own copy but can access this variable. + +set helperscript { + proc note {item} {global res; lappend res $item; return} proc track {} {upvar args item; note $item; return} proc notes {items} {foreach i $items {note $i}} @@ -806,6 +811,10 @@ proc onfinal {} { if {[lindex $hargs 0] ne "finalize"} {return} return -code return "" } +} + +# Set everything up in the main thread. +eval $helperscript # --- --- --- --------- --------- --------- # method finalize @@ -1829,6 +1838,90 @@ test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { rename dummy {} } -returnCodes error -result {can not find reflected channel named "rc*"} +# --- === *** ########################### +# 'Pull the rug' tests. Create channel in a interpreter A, move to +# other interpreter B, destroy the origin interpreter (A) before or +# during access from B. Must not crash, must return proper errors. + +test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body { + + set ida [interp create];#puts <<$ida>> + set idb [interp create];#puts <<$idb>> + + # Magic to get the test* commands in the slaves + load {} Tcltest $ida + load {} Tcltest $idb + + # Set up channel in interpreter + interp eval $ida $helperscript + set chan [interp eval $ida { + proc foo {args} {oninit seek; onfinal; track; return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd interpreter. + interp eval $ida [list testchannel cut $chan] + interp eval $idb [list testchannel splice $chan] + + # Kill origin interpreter, then access channel from 2nd interpreter. + interp delete $ida + + set res {} + lappend res [catch {interp eval $idb [list puts $chan shoo]} msg] $msg + lappend res [catch {interp eval $idb [list tell $chan]} msg] $msg + lappend res [catch {interp eval $idb [list seek $chan 1]} msg] $msg + lappend res [catch {interp eval $idb [list gets $chan]} msg] $msg + lappend res [catch {interp eval $idb [list close $chan]} msg] $msg + set res + +} -constraints {testchannel} \ + -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} + +test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body { + + set ida [interp create];#puts <<$ida>> + set idb [interp create];#puts <<$idb>> + + # Magic to get the test* commands in the slaves + load {} Tcltest $ida + load {} Tcltest $idb + + # Set up channel in thread + set chan [interp eval $ida $helperscript] + set chan [interp eval $ida { + proc foo {args} { + oninit; onfinal; track; + # destroy interpreter during channel access + # Actually not possible for an interp to destory itself. + interp delete {} + return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd thread. + interp eval $ida [list testchannel cut $chan] + interp eval $idb [list testchannel splice $chan] + + # Run access from interpreter B, this will give us a synchronous + # response. + + interp eval $idb [list set chan $chan] + interp eval $idb [list set mid $tcltest::mainThread] + set res [interp eval $idb { + # wait a bit, give the main thread the time to start its event + # loop to wait for the response from B + after 2000 + catch { puts $chan shoo } res + set res + }] + set res +} -constraints {testchannel impossible} \ + -result {Owner lost} + # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. @@ -3217,6 +3310,90 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body { } -constraints {testchannel testthread} \ -result {{can not find reflected channel named "rc*"}} +# --- === *** ########################### +# 'Pull the rug' tests. Create channel in a thread A, move to other +# thread B, destroy the origin thread (A) before or during access from +# B. Must not crash, must return proper errors. + +test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body { + + #puts <<$tcltest::mainThread>>main + set tida [testthread create];#puts <<$tida>> + set tidb [testthread create];#puts <<$tidb>> + + # Set up channel in thread + testthread send $tida $helperscript + set chan [testthread send $tida { + proc foo {args} {oninit seek; onfinal; track; return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd thread. + testthread send $tida [list testchannel cut $chan] + testthread send $tidb [list testchannel splice $chan] + + # Kill origin thread, then access channel from 2nd thread. + testthread send -async $tida {testthread exit} + after 100 + + set res {} + lappend res [catch {testthread send $tidb [list puts $chan shoo]} msg] $msg + + lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg + lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg + lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg + lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg + tcltest::threadReap + set res + +} -constraints {testchannel testthread} \ + -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} + +test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body { + + #puts <<$tcltest::mainThread>>main + set tida [testthread create];#puts <<$tida>> + set tidb [testthread create];#puts <<$tidb>> + + # Set up channel in thread + set chan [testthread send $tida $helperscript] + set chan [testthread send $tida { + proc foo {args} { + oninit; onfinal; track; + # destroy thread during channel access + testthread exit + return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd thread. + testthread send $tida [list testchannel cut $chan] + testthread send $tidb [list testchannel splice $chan] + + # Run access from thread B, wait for response from A (A is not + # using event loop at this point, so the event pile up in the + # queue. + + testthread send $tidb [list set chan $chan] + testthread send $tidb [list set mid $tcltest::mainThread] + testthread send -async $tidb { + # wait a bit, give the main thread the time to start its event + # loop to wait for the response from B + after 2000 + catch { puts $chan shoo } res + testthread send -async $mid [list set ::res $res] + } + vwait ::res + + tcltest::threadReap + set res +} -constraints {testchannel testthread} \ + -result {Owner lost} + # ### ### ### ######### ######### ######### # ### ### ### ######### ######### ######### |