Tcl Source Code

	     * events too. This compiles on all platforms, and also passes the
	     * testsuite on all of them.
	     */

	    mask &= ~TCL_EXCEPTION;

	    if (!statePtr->timer) {
		TclChannelPreserve((Tcl_Channel)chanPtr);
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                        ChannelTimerProc, chanPtr);
	    }
	}
    }
    ChanWatch(chanPtr, mask);
}

ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = (Channel *)clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    if (chanPtr->typePtr == NULL) {
	TclChannelRelease((Tcl_Channel)chanPtr);
    } else {
	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
		&& (statePtr->interestMask & TCL_READABLE)
		&& (statePtr->inQueueHead != NULL)
		&& IsBufferReady(statePtr->inQueueHead)) {
	    /*
	     * 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);
	    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
	    Tcl_Release(statePtr);
	} else {
	    statePtr->timer = NULL;
	    UpdateInterest(chanPtr);
	    TclChannelRelease((Tcl_Channel)chanPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --

                if {[string length $result] == 0} {
                    driver finalize $chan
                }
                return $result
            }
        }
    }



namespace eval reflector {
    proc initialize {_ chan mode} {
	return {initialize finalize watch read}
    }


    proc finalize {_ chan} {
	namespace delete $_
    }


    proc read {_ chan count} {
	namespace upvar $_ source source
	set res [string range $source 0 $count-1]
	set source [string range $source $count end]
	return $res
    }


    proc watch {_ chan events} {
	after 0 [list chan postevent $chan read]
	return read
    }

    namespace ensemble create -parameters _
    namespace export *
}




namespace eval inputfilter {
    proc initialize {chan mode} {
	return {initialize finalize read}
    }
    
    proc read {chan buffer} {
	return $buffer
    }

    proc finalize chan {
	namespace delete $chan
    }

    namespace ensemble create
    namespace export *
}



# Channel read transform that is just the identity - pass all through
    proc idxform {cmd handle args} {
      switch -- $cmd {
        initialize {
            return {initialize finalize read}
        }

    vwait ::res
    set res
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {Owner lost}


test iortrans-ea69b0258a9833cb {
    Crash when using a channel transformation on TCP client socket

    "line two" does not make it into result.  This issue should probably be
    addressed, but it is outside the scope of this test.
} -setup {
    set res {}
    set read 0
} -body {
    namespace eval reflector1 {
	variable source "line one\nline two"
	interp alias {} [namespace current]::dispatch {} [
	    namespace parent]::reflector [namespace current]
    }
    set chan [chan create read [namespace which reflector1::dispatch]]
    chan configure $chan -blocking 0
    chan push $chan inputfilter
    chan event $chan read [list ::apply [list chan {
	variable res
	variable read
	set gets [gets $chan]
	append res $gets
	incr read
    } [namespace current]] $chan]
    vwait [namespace current]::read
    chan pop $chan
    vwait [namespace current]::read
    return $res
} -cleanup {
    catch {unset read}
    close $chan
} -result {line one}

cleanupTests
return