Tcl Source Code

2008-04-07  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (BUSY_STATE, CheckChannelErrors,
	  TclCopyChannel): New macro, and the places using it. This change
	  allows for bi-directional fcopy on channels. Thanks to Alexandre
	  Ferrieux <[email protected]> for the patch.

	* tests/io.test (io-53.9): Made test cleanup robust against the
	  possibility of slow process shutdown on Windows. Backported from
	  Kevin Kenny's change to the same test on the 8.5 and head
	  branches.

2008-04-04  Andreas Kupries  <[email protected]>

	* tests/io.test (io-53.9): Added testcase for [Bug 780533], based
	  on Alexandre's test script. Also fixed problem with timer in
	  preceding test, was not canceled properly in the ok case.

2008-04-03  Andreas Kupries  <[email protected]>

/* 
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIO.c,v 1.61.2.26 2008/04/07 19:40:58 andreas_kupries Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclIO.h"
#include <assert.h>

				int *dstLenPtr, int *srcLenPtr));
static void		UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
static int		WriteBytes _ANSI_ARGS_((Channel *chanPtr,
				CONST char *src, int srcLen));
static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,
				CONST char *src, int srcLen));

#define BUSY_STATE(st,fl) \
    ((st)->csPtr && \
     ( (((fl)&TCL_READABLE)&&((st)->csPtr->readPtr ==(st)->topChanPtr)) || \
       (((fl)&TCL_WRITABLE)&&((st)->csPtr->writePtr==(st)->topChanPtr))))

/*
 *---------------------------------------------------------------------------
 *
 * TclInitIOSubsystem --
 *
 *	Initialize all resources used by this subsystem on a per-process

     * Fail if the channel is in the middle of a background copy.
     *
     * Don't do this tests for raw channels here or else the chaining in the
     * transformation drivers will fail with 'file busy' error instead of
     * retrieving and transforming the data to copy.
     */

    if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
	Tcl_SetErrno(EBUSY);
	return -1;
    }

    if (direction == TCL_READABLE) {
	/*
	 * If we have not encountered a sticky EOF, clear the EOF bit

    int readFlags, writeFlags;
    CopyState *csPtr;
    int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;

    inStatePtr	= inPtr->state;
    outStatePtr	= outPtr->state;

    if (BUSY_STATE(inStatePtr,TCL_READABLE)) {
	if (interp) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
		    Tcl_GetChannelName(inChan), "\" is busy", NULL);
	}
	return TCL_ERROR;
    }
    if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
	if (interp) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
		    Tcl_GetChannelName(outChan), "\" is busy", NULL);
	}
	return TCL_ERROR;
    }

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.40.2.15 2008/04/07 19:41:00 andreas_kupries Exp $

if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
namespace eval ::tcl::test::io {

    }]
    vwait ::forever
    catch {after cancel $token}
    set ::forever
} -cleanup {
    close $pipe
    rename ::done {}
    after 1000 ;# Give Windows time to kill the process
    removeFile out
    removeFile err
    catch {unset ::forever}
} -result OK

test io-54.1 {Recursive channel events} {socket fileevent} {
    # This test checks to see if file events are delivered during recursive