Tcl Source Code

    statePtr->saveInBufPtr	= NULL;
    statePtr->inQueueHead	= NULL;
    statePtr->inQueueTail	= NULL;
    statePtr->chPtr		= NULL;
    statePtr->interestMask	= 0;
    statePtr->scriptRecordPtr	= NULL;
    statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;

    statePtr->timerChanPtr	= NULL;
    statePtr->csPtrR		= NULL;
    statePtr->csPtrW		= NULL;
    statePtr->outputStage	= NULL;

    /*
     * As we are creating the channel, it is obviously the top for now.

	     * Our solution here is to drop the interest in the EXCEPTION
	     * events too. This compiles on all platforms, and also passes the
	     * testsuite on all of them.
	     */

	    mask &= ~TCL_EXCEPTION;

	    if (!statePtr->timerChanPtr) {
		TclChannelPreserve((Tcl_Channel)chanPtr);
		statePtr->timerChanPtr = chanPtr;

		Tcl_DoWhenIdle(ChannelTimerProc, chanPtr);
	    }
	}
    }

    if (!statePtr->timerChanPtr
	    && mask & TCL_WRITABLE
	    && GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
	TclChannelPreserve((Tcl_Channel)chanPtr);
	statePtr->timerChanPtr = chanPtr;

	Tcl_DoWhenIdle(ChannelTimerProc,chanPtr);
    }


    ChanWatch(chanPtr, mask);
}

/*
 *----------------------------------------------------------------------
 *

     * until ChannelTimerProc is later called again.
     */

    if (chanPtr->typePtr == NULL) {
	CleanupTimerHandler(statePtr);
    } else {
	Tcl_Preserve(statePtr);

	if (statePtr->interestMask & TCL_WRITABLE
		&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
		&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * Restart the timer in case a channel handler reenters the event loop
	     * before UpdateInterest gets called by Tcl_NotifyChannel.
	     */

	    Tcl_DoWhenIdle(ChannelTimerProc,chanPtr);
	    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
	} else {
	    /* The channel may have just been closed from within Tcl_NotifyChannel */
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE)) {
		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.
		     */


		    Tcl_DoWhenIdle(ChannelTimerProc,chanPtr);
		    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
		} else {
		    CleanupTimerHandler(statePtr);
		    UpdateInterest(chanPtr);
		}
	    } else {
		CleanupTimerHandler(statePtr);
	    }
	}
	Tcl_Release(statePtr);
    }
}

static void
DeleteTimerHandler(
    ChannelState *statePtr
)
{
    if (statePtr->timerChanPtr != NULL) {
	Tcl_CancelIdleCall(ChannelTimerProc,statePtr->timerChanPtr);
	CleanupTimerHandler(statePtr);
    }
}
static void
CleanupTimerHandler(
    ChannelState *statePtr
){
    TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);

    statePtr->timerChanPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --

				  * this channel. */
    int interestMask;		/* Mask of all events this channel has
				 * handlers for. */
    EventScriptRecord *scriptRecordPtr;
				/* Chain of all scripts registered for event
				 * handlers ("fileevent") on this channel. */
    Tcl_Size bufSize;		/* What size buffers to allocate? */

    Channel *timerChanPtr;	/* Needed in order to decrement the refCount of
				   the right channel when the timer is
				   deleted. */
    struct CopyState *csPtrR;	/* State of background copy for which channel
				 * is input, or NULL. */
    struct CopyState *csPtrW;	/* State of background copy for which channel
				 * is output, or NULL. */

} -cleanup {
    close $f4
} -result {initial foo eof}

close $f

test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup {
} -constraints {stdio fileevent} -body {

    namespace eval refchan {
	namespace ensemble create
	namespace export *


	proc finalize {chan args} {

	puts $f $data
	incr count [string length $data]
	if {$count > 262144} {
	    chan event $f writable {}
	    set x done
	}
    }]
    set token [after 10000 [namespace code {
	set x timeout
    }]]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    after cancel $token
    catch {chan close $f}
} -result done


test io-44.7 {
    FileEventProc procedure: write-only non-blocking channel postevent idle
} -setup {
} -constraints {stdio fileevent} -body {

    namespace eval refchan {
	namespace ensemble create
	namespace export *

	proc finalize {chan args} {
	    namespace delete c_$chan
	}

	proc initialize {chan args} {
	    namespace eval c_$chan {}
	    namespace upvar c_$chan watching watching
	    set watching {}
	    list finalize initialize seek watch write
	}

	proc watch {chan args} {
	    namespace upvar c_$chan watching watching
	    foreach arg $args {
		switch $arg {
		    write {
			if {$arg ni $watching} {
			    lappend watching $arg
			}
			after idle after 0 chan postevent $chan $arg
		    }
		}
	    }
	}

	proc write {chan args} {
	    incr ::counter
	    after idle after 0 chan postevent $chan write
	    return 1
	}
    }

    set f [chan create w [namespace which refchan]]
    chan configure $f -blocking 0
    chan event $f writable [namespace code {
	puts $f X
    }]

    variable x {}

    apply [list {} {
	set script {
	    set lambda [list ::apply [list script {
		variable count
		variable x
		if {[incr count] < 1000} {
		    try $script
		} else {
		    set x done
		}
	    } [namespace current]] $script]
	    after idle [list after 0 $lambda]
	}
	try $script
    } [namespace current]]


    set token [after 10000 [namespace code {
	set x timeout
    }]]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    after cancel $token