Tcl Source Code

Check-in [b65985a504]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-5d170b5ca5
Files: files | file ages | folders
SHA1: b65985a504a14319071136f2cef5dc25f314f512
User & Date: jan.nijtmans 2015-09-24 10:03:20
Context
2015-09-24
10:54
Fix [5d170b5ca5]: checkin 9f8b7bea5344f1b0 broke netbsd's t... check-in: f30afc36b5 user: jan.nijtmans tags: core-8-5-branch
10:03
merge trunk Closed-Leaf check-in: b65985a504 user: jan.nijtmans tags: bug-5d170b5ca5
10:01
merge-mark (almost, just a few cosmetic changes) check-in: 0b3d2ed4aa user: jan.nijtmans tags: trunk
2015-09-23
12:19
Merge trunk check-in: d58c269d4e user: jan.nijtmans tags: bug-5d170b5ca5
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclIO.c.

98
99
100
101
102
103
104


105
106
107
108

















109
110
111
112
113
114
115
....
5750
5751
5752
5753
5754
5755
5756

5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767

5768
5769
5770
5771
5772
5773
5774
....
8322
8323
8324
8325
8326
8327
8328





8329
8330
8331
8332
8333
8334
8335
....
9081
9082
9083
9084
9085
9086
9087


9088
9089

9090

9091
9092
9093
9094
9095
9096
9097
....
9369
9370
9371
9372
9373
9374
9375





9376
9377
9378
9379
9380
9381
9382
....
9431
9432
9433
9434
9435
9436
9437

9438
9439
9440
9441
9442
9443
9444
....
9486
9487
9488
9489
9490
9491
9492

9493
9494
9495
9496
9497
9498
9499
....
9506
9507
9508
9509
9510
9511
9512

9513
9514
9515
9516
9517
9518
9519
....
9577
9578
9579
9580
9581
9582
9583

9584
9585
9586
9587
9588
9589
9590
....
9599
9600
9601
9602
9603
9604
9605

9606
9607
9608
9609
9610
9611
9612
....
9614
9615
9616
9617
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
9636
9637
....
9651
9652
9653
9654
9655
9656
9657

9658
9659
9660
9661
9662
9663
9664
....
9712
9713
9714
9715
9716
9717
9718

9719
9720
9721
9722
9723
9724
9725
9726
9727
9728
9729

9730
9731
9732
9733
9734
9735
9736
....
9789
9790
9791
9792
9793
9794
9795
9796
9797
9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
....
9823
9824
9825
9826
9827
9828
9829
9830
9831
9832
9833
9834
9835
9836
9837
....
9875
9876
9877
9878
9879
9880
9881

9882
9883
9884
9885
9886
9887
9888
....
9968
9969
9970
9971
9972
9973
9974

9975




9976

9977
9978
9979
9980
9981
9982
9983
9984
9985
    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. */


    int bufSize;		/* Size of appended buffer. */
    char buffer[1];		/* Copy buffer, this must be the last
                                 * field. */
} CopyState;


















/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
................................................................................
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );


	UpdateInterest(chanPtr);
	return 0;
    }

    /* Special handling for zero-char read request. */
    if (toRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */
................................................................................
    /*
     * Update the notifier interest, since it may have changed after invoking
     * event handlers. Skip that if the channel was deleted in the call to the
     * channel handler.
     */

    if (chanPtr->typePtr != NULL) {





	UpdateInterest(chanPtr);
    }

    Tcl_Release(statePtr);
    TclChannelRelease(channel);

    tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
................................................................................
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
    csPtr->interp = interp;
    if (cmdPtr) {
	Tcl_IncrRefCount(cmdPtr);
    }
    csPtr->cmdPtr = cmdPtr;



    inStatePtr->csPtrR  = csPtr;

    outStatePtr->csPtrW = csPtr;


    if (moveBytes) {
	return MoveBytes(csPtr);
    }

    /*
     * Special handling of -size 0 async transfers, so that the -command is
................................................................................
    int result = TCL_OK, size, sizeb;
    Tcl_WideInt total;
    const char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    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;

................................................................................
	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = (int) csPtr->toRead;
	    }


	    if (inBinary || sameEncoding) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			0 /* No append */);
	    }
................................................................................
		    /* We allowed a short read.  Keep trying. */
		    continue;
		}
		if (bufObj != NULL) {
		    TclDecrRefCount(bufObj);
		    bufObj = NULL;
		}

		return TCL_OK;
	    }
	}

	/*
	 * Now write the buffer out.
	 */
................................................................................
	}

	if (outBinary || sameEncoding) {
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
	} else {
	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}


	/*
	 * [Bug 2895565]. At this point 'size' still contains the number of
	 * bytes or characters which have been read. We keep this to later to
	 * update the totals and toRead information, see marker (UP) below. We
	 * must not overwrite it with 'sizeb', which is the number of written
	 * bytes or characters, and both EOL translation and encoding
................................................................................
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
			CopyEventProc, csPtr);
	    }
	    if (bufObj != NULL) {
		TclDecrRefCount(bufObj);
		bufObj = NULL;
	    }

	    return TCL_OK;
	}

	/*
	 * For background copies, we only do one buffer per invocation so we
	 * don't starve the rest of the system.
	 */
................................................................................
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc,
			csPtr);
	    }
	    if (bufObj != NULL) {
		TclDecrRefCount(bufObj);
		bufObj = NULL;
	    }

	    return TCL_OK;
	}
    } /* while */

    if (bufObj != NULL) {
	TclDecrRefCount(bufObj);
	bufObj = NULL;
................................................................................

    /*
     * Make the callback or return the number of bytes transferred. The local
     * total is used because StopCopy frees csPtr.
     */

    total = csPtr->total;
    if (cmdPtr && interp) {
	int code;

	/*
	 * Get a private copy of the command so we can mutate it by adding
	 * arguments. Note that StopCopy frees our saved reference to the
	 * original command obj.
	 */

	cmdPtr = Tcl_DuplicateObj(cmdPtr);
	Tcl_IncrRefCount(cmdPtr);
	StopCopy(csPtr);
	Tcl_Preserve(interp);

	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
	if (errObj) {
	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
................................................................................
		result = TCL_ERROR;
	    } else {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
	    }
	}
    }

    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * DoRead --
................................................................................
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );


	UpdateInterest(chanPtr);
	return 0;
    }

    /* Special handling for zero-char read request. */
    if (bytesToRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

	UpdateInterest(chanPtr);
	return 0;
    }

    TclChannelPreserve((Tcl_Channel)chanPtr);
    while (bytesToRead) {
	/*
................................................................................
	     * Buffer is not empty.  How can that be?
	     *
	     * 0) We stopped early because we got all the bytes
	     *    we were seeking.  That's fine.
	     */

	    if (bytesToRead == 0) {
		UpdateInterest(chanPtr);
		break;
	    }

	    /*
	     * 1) We're @EOF because we saw eof char.
	     */

	    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
		UpdateInterest(chanPtr);
		break;
	    }

	    /*
	     * 2) The buffer holds a \r while in CRLF translation,
	     *    followed by the end of the buffer.
	     */
................................................................................

		    *p++ = '\r';
		    bytesToRead--;
		    bufPtr->nextRemoved++;
		} else if (statePtr->flags & CHANNEL_BLOCKED) {
		    /* ...and we cannot get more now. */
		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
		    UpdateInterest(chanPtr);
		    break;
		} else {
		    /* ... so we need to get some. */
		    goto moreData;
		}
	    }

................................................................................
    }

	assert(!GotFlag(statePtr, CHANNEL_EOF)
		|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
		|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
	assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
		== (CHANNEL_EOF|CHANNEL_BLOCKED)) );

    TclChannelRelease((Tcl_Channel)chanPtr);
    return (int)(p - dst);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	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);

    }




    inStatePtr->csPtrR = NULL;

    outStatePtr->csPtrW = NULL;
    ckfree(csPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *






>
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>











>







 







>
>
>
>
>







 







>
>


>

>







 







>
>
>
>
>







 







>







 







>







 







>







 







>







 







>







 







|







<
|







 







>







 







>











>







 







<








<







 







<







 







>







 







>

>
>
>
>

>

|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
....
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
....
8343
8344
8345
8346
8347
8348
8349
8350
8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361
....
9107
9108
9109
9110
9111
9112
9113
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
....
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414
9415
9416
9417
....
9466
9467
9468
9469
9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
....
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
....
9543
9544
9545
9546
9547
9548
9549
9550
9551
9552
9553
9554
9555
9556
9557
....
9615
9616
9617
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
....
9638
9639
9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
....
9654
9655
9656
9657
9658
9659
9660
9661
9662
9663
9664
9665
9666
9667
9668

9669
9670
9671
9672
9673
9674
9675
9676
....
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
9700
9701
9702
9703
9704
....
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762
9763
9764
9765
9766
9767
9768
9769
9770
9771
9772
9773
9774
9775
9776
9777
9778
....
9831
9832
9833
9834
9835
9836
9837

9838
9839
9840
9841
9842
9843
9844
9845

9846
9847
9848
9849
9850
9851
9852
....
9863
9864
9865
9866
9867
9868
9869

9870
9871
9872
9873
9874
9875
9876
....
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
.....
10008
10009
10010
10011
10012
10013
10014
10015
10016
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
    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. */
    int refCount;		/* Claim count on the struct */
    int bufInUse;		/* Flag to govern access to buffer */
    int bufSize;		/* Size of appended buffer. */
    char buffer[1];		/* Copy buffer, this must be the last
                                 * field. */
} CopyState;

static void
PreserveCopyState(
    CopyState *csPtr)
{
    csPtr->refCount++;
}

static void
ReleaseCopyState(
    CopyState *csPtr)
{
    if (--csPtr->refCount) {
	return;
    }
    ckfree(csPtr);
}

/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
................................................................................
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );

	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /* Special handling for zero-char read request. */
    if (toRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */
................................................................................
    /*
     * Update the notifier interest, since it may have changed after invoking
     * event handlers. Skip that if the channel was deleted in the call to the
     * channel handler.
     */

    if (chanPtr->typePtr != NULL) {
	/*
	 * TODO: This call may not be needed.  If a handler induced a
	 * change in interest, that handler should have made its own
	 * UpdateInterest() call, one would think.
	 */
	UpdateInterest(chanPtr);
    }

    Tcl_Release(statePtr);
    TclChannelRelease(channel);

    tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
................................................................................
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
    csPtr->interp = interp;
    if (cmdPtr) {
	Tcl_IncrRefCount(cmdPtr);
    }
    csPtr->cmdPtr = cmdPtr;
    csPtr->refCount = 1;
    csPtr->bufInUse = 0;

    inStatePtr->csPtrR  = csPtr;
    PreserveCopyState(csPtr);
    outStatePtr->csPtrW = csPtr;
    PreserveCopyState(csPtr);

    if (moveBytes) {
	return MoveBytes(csPtr);
    }

    /*
     * Special handling of -size 0 async transfers, so that the -command is
................................................................................
    int result = TCL_OK, size, sizeb;
    Tcl_WideInt total;
    const char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    int underflow;		/* Input underflow */

    if (csPtr->bufInUse) {
	return TCL_OK;
    }
    PreserveCopyState(csPtr);

    inChan	= (Tcl_Channel) csPtr->readPtr;
    outChan	= (Tcl_Channel) csPtr->writePtr;
    inStatePtr	= csPtr->readPtr->state;
    outStatePtr	= csPtr->writePtr->state;
    interp	= csPtr->interp;
    cmdPtr	= csPtr->cmdPtr;

................................................................................
	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = (int) csPtr->toRead;
	    }

	    csPtr->bufInUse = 1;
	    if (inBinary || sameEncoding) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			0 /* No append */);
	    }
................................................................................
		    /* We allowed a short read.  Keep trying. */
		    continue;
		}
		if (bufObj != NULL) {
		    TclDecrRefCount(bufObj);
		    bufObj = NULL;
		}
		ReleaseCopyState(csPtr);
		return TCL_OK;
	    }
	}

	/*
	 * Now write the buffer out.
	 */
................................................................................
	}

	if (outBinary || sameEncoding) {
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
	} else {
	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}
	csPtr->bufInUse = 0;

	/*
	 * [Bug 2895565]. At this point 'size' still contains the number of
	 * bytes or characters which have been read. We keep this to later to
	 * update the totals and toRead information, see marker (UP) below. We
	 * must not overwrite it with 'sizeb', which is the number of written
	 * bytes or characters, and both EOL translation and encoding
................................................................................
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
			CopyEventProc, csPtr);
	    }
	    if (bufObj != NULL) {
		TclDecrRefCount(bufObj);
		bufObj = NULL;
	    }
	    ReleaseCopyState(csPtr);
	    return TCL_OK;
	}

	/*
	 * For background copies, we only do one buffer per invocation so we
	 * don't starve the rest of the system.
	 */
................................................................................
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc,
			csPtr);
	    }
	    if (bufObj != NULL) {
		TclDecrRefCount(bufObj);
		bufObj = NULL;
	    }
	    ReleaseCopyState(csPtr);
	    return TCL_OK;
	}
    } /* while */

    if (bufObj != NULL) {
	TclDecrRefCount(bufObj);
	bufObj = NULL;
................................................................................

    /*
     * Make the callback or return the number of bytes transferred. The local
     * total is used because StopCopy frees csPtr.
     */

    total = csPtr->total;
    if (cmdPtr && interp && csPtr->cmdPtr) {
	int code;

	/*
	 * Get a private copy of the command so we can mutate it by adding
	 * arguments. Note that StopCopy frees our saved reference to the
	 * original command obj.
	 */

	cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
	Tcl_IncrRefCount(cmdPtr);
	StopCopy(csPtr);
	Tcl_Preserve(interp);

	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
	if (errObj) {
	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
................................................................................
		result = TCL_ERROR;
	    } else {
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
	    }
	}
    }
    ReleaseCopyState(csPtr);
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * DoRead --
................................................................................
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );

	/* TODO: Don't need this call */
	UpdateInterest(chanPtr);
	return 0;
    }

    /* Special handling for zero-char read request. */
    if (bytesToRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	/* TODO: Don't need this call */
	UpdateInterest(chanPtr);
	return 0;
    }

    TclChannelPreserve((Tcl_Channel)chanPtr);
    while (bytesToRead) {
	/*
................................................................................
	     * Buffer is not empty.  How can that be?
	     *
	     * 0) We stopped early because we got all the bytes
	     *    we were seeking.  That's fine.
	     */

	    if (bytesToRead == 0) {

		break;
	    }

	    /*
	     * 1) We're @EOF because we saw eof char.
	     */

	    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {

		break;
	    }

	    /*
	     * 2) The buffer holds a \r while in CRLF translation,
	     *    followed by the end of the buffer.
	     */
................................................................................

		    *p++ = '\r';
		    bytesToRead--;
		    bufPtr->nextRemoved++;
		} else if (statePtr->flags & CHANNEL_BLOCKED) {
		    /* ...and we cannot get more now. */
		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);

		    break;
		} else {
		    /* ... so we need to get some. */
		    goto moreData;
		}
	    }

................................................................................
    }

	assert(!GotFlag(statePtr, CHANNEL_EOF)
		|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
		|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
	assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
		== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return (int)(p - dst);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	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 == NULL) {
	return;
    }
    ReleaseCopyState(inStatePtr->csPtrR);
    inStatePtr->csPtrR = NULL;
    ReleaseCopyState(outStatePtr->csPtrW);
    outStatePtr->csPtrW = NULL;
    ReleaseCopyState(csPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *

Changes to generic/tclIORChan.c.

1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
     * We restrict the interest to what the channel can support. IOW there
     * will never be write events for a channel which is not writable.
     * Analoguously for read events and non-readable channels.
     */

    mask &= rcPtr->mode;

    if (mask == rcPtr->interest) {
	/*
	 * Same old, same old, why should we do something?
	 */

	return;
    }

    rcPtr->interest = mask;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS






<
<
<
<
<
<
<
<







1597
1598
1599
1600
1601
1602
1603








1604
1605
1606
1607
1608
1609
1610
     * We restrict the interest to what the channel can support. IOW there
     * will never be write events for a channel which is not writable.
     * Analoguously for read events and non-readable channels.
     */

    mask &= rcPtr->mode;









    rcPtr->interest = mask;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS

Changes to tests/io.test.

7999
8000
8001
8002
8003
8004
8005

























































































































































































8006
8007
8008
8009
8010
8011
8012
} -body {
    list [gets $c] [chan copy $c $outChan -size 100] [gets $c]
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result {line 100 line}


























































































































































































test io-54.1 {Recursive channel events} {socket fileevent} {
    # This test checks to see if file events are delivered during recursive
    # event loops when there is buffered data on the channel.

    proc accept {s a p} {
	variable as






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
8111
8112
8113
8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
8141
8142
8143
8144
8145
8146
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177
8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197
} -body {
    list [gets $c] [chan copy $c $outChan -size 100] [gets $c]
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result {line 100 line}
test io-53.18 {[32ae34e63a] recursive CopyData} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat a 100]]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {
                if {"read" in [lindex $args 1]} {
                    chan postevent $chan read
                }
                return
            }
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    proc more {c outChan bytes args} {
        if {[eof $c]} {
            set ::done eof
            catch {close $c}
            return
        }
        if {[llength $args]} {
            set ::done error
        } else  {
            chan copy $c $outChan -command [list [namespace which more] $c $outChan]
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    set out [makeFile {} out]
    set outChan [open $out w]
    # Different encoding to force use of DoReadChars()
    chan configure $outChan -encoding iso8859-1
} -body {
    after 100 {set ::done timeout}
    chan copy $c $outChan -size 99 -command [list [namespace which more] $c $outChan]
    vwait ::done
    set ::done
} -cleanup {
    close $outChan
    removeFile out
    rename driver {}
    rename more {}
    unset ::done
} -result eof

test io-53.19 {[32ae34e63a] stop ReflectWatch filtering} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat a 100]]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {
                if {"read" in [lindex $args 1]} {
                    chan postevent $chan read
                }
                return
            }
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    proc more {c outChan bytes args} {
        if {[eof $c]} {
            set ::done eof
            catch {close $c}
            return
        }
        if {[llength $args]} {
            set ::done error
        } else  {
            chan copy $c $outChan -size 30 -command [list [namespace which more] $c $outChan]
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -buffersize 20
    set out [makeFile {} out]
    set outChan [open $out w]
    # Different encoding to force use of DoReadChars()
    chan configure $outChan -encoding iso8859-1
} -body {
    after 100 {set ::done timeout}
    chan copy $c $outChan -size 30 -command [list [namespace which more] $c $outChan]
    vwait ::done
    set ::done
} -cleanup {
    catch {close $outChan}
    removeFile out
    rename driver {}
    rename more {}
    unset ::done
} -result eof

test io-53.20 {[e0a7b3e5f8] DoRead calls to UpdateInterest} -constraints knownBug -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat a 100]]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {
                if {"read" in [lindex $args 1]} {
                    chan postevent $chan read
                }
                return
            }
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    proc more {c outChan bytes args} {
        if {[eof $c]} {
            set ::done eof
            catch {close $c}
            return
        }
        if {[llength $args]} {
            set ::done error
        } else  {
            chan copy $c $outChan -size 10 -command [list [namespace which more] $c $outChan]
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -buffersize 20
    set out [makeFile {} out]
    set outChan [open $out w]
    # Same encoding to force use of DoRead()
    chan configure $outChan -encoding utf-8
} -body {
    after 100 {set ::done timeout}
    chan copy $c $outChan -size 10 -command [list [namespace which more] $c $outChan]
    vwait ::done
    set ::done
} -cleanup {
    catch {close $outChan}
    removeFile out
    rename driver {}
    rename more {}
    unset ::done
} -result eof

test io-54.1 {Recursive channel events} {socket fileevent} {
    # This test checks to see if file events are delivered during recursive
    # event loops when there is buffered data on the channel.

    proc accept {s a p} {
	variable as

Changes to tests/ioCmd.test.

1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
....
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
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
1105
1106
1107
1108
1109
1110
1111
1112
....
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
....
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
....
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
....
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
....
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
....
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
....
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
....
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
....
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
....
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
....
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
....
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
....
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
....
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
	return snarf
    }
    set c [chan create {r w} foo]
    note [read $c 10]
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} 1 {read delivered more than requested}}
test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track; note MUST_NOT_HAPPEN
    }
    set c [chan create {w} foo]
    note [catch {read $c 2} msg]; note $msg
................................................................................
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} 1 BOOM!}
test iocmd-23.5 {chan read, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code break BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*}
test iocmd-23.6 {chan read, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code continue BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*}
test iocmd-23.7 {chan read, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*}
test iocmd-23.8 {chan read, level is squashed} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -level 55 -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return ""
    }
    set c [chan create {r w} foo]
................................................................................
    note [read $c 2]
    note [eof $c]
    set res
} -cleanup {
    close $c
    rename foo {}
    unset res
} -result {{read rc* 4096} {} 1}
test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	error EAGAIN
    }
    set c [chan create {r w} foo]
................................................................................
    note [read $c 2]
    note [eof $c]
    set res
} -cleanup {
    close $c
    rename foo {}
    unset res
} -result {{read rc* 4096} {} 0}
test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	set args [lassign $args sub id]
	if {$sub ne "read"} {return}
	close $id
................................................................................

# --- === *** ###########################
# method configure

test iocmd-26.1 {chan configure, set standard option} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
    }
    set c [chan create {r w} foo]
    note [fconfigure $c -translation lf]
    close $c
    rename foo {}
    set res
} -result {{}}
test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
................................................................................
    set stop [after 10000 {note TIMEOUT}]
    after  1000 {note [chan postevent $c r]}
    vwait ::res
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    note [fileevent $c writable {note TOCK}]
    set stop [after 10000 {note TIMEOUT}]
    after  1000 {note [chan postevent $c w]}
    vwait ::res
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
    proc foo {args} {oninit; onfinal; track; return}
    proc dummy args { return }
    set c [chan create {r w} foo]
    fileevent $c readable dummy
} -body {
    close $c
................................................................................
    notes [inthread $c {
	note [read $c 10]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
................................................................................
    notes [inthread $c {
	note [catch {[read $c 2]} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} 1 {read delivered more than requested}}
test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track; note MUST_NOT_HAPPEN
    }
    set c [chan create {w} foo]
    notes [inthread $c {
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 BOOM!} \
    -constraints {testchannel thread}
test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code break BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*} \
    -constraints {testchannel thread}
test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code continue BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*} \
    -constraints {testchannel thread}
test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code 777 BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*} \
    -constraints {testchannel thread}
test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -level 55 -code 777 BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
    -constraints {testchannel thread}
test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return ""
    }
................................................................................
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{read rc* 4096} {} 1} \
    -constraints {testchannel thread}
test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	error EAGAIN
    }
................................................................................
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{read rc* 4096} {} 0} \
    -constraints {testchannel thread}

# --- === *** ###########################
# method write

test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
    set res {}
................................................................................

# --- === *** ###########################
# method configure

test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -translation lf]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{}}
test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]






|











|







 







|











|











|











|











|







 







|







 







|







 







|






|







 







|












|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|









|







1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
....
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
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
1105
1106
1107
1108
1109
1110
1111
1112
....
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
....
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
....
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
....
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
....
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
....
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
....
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
....
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
....
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
....
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
....
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
....
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
....
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
....
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
	return snarf
    }
    set c [chan create {r w} foo]
    note [read $c 10]
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {read rc* 4096} {watch rc* {}} snarfsnarf}
test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 {read delivered more than requested}}
test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track; note MUST_NOT_HAPPEN
    }
    set c [chan create {w} foo]
    note [catch {read $c 2} msg]; note $msg
................................................................................
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 BOOM!}
test iocmd-23.5 {chan read, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code break BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*}
test iocmd-23.6 {chan read, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code continue BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*}
test iocmd-23.7 {chan read, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*}
test iocmd-23.8 {chan read, level is squashed} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -level 55 -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return ""
    }
    set c [chan create {r w} foo]
................................................................................
    note [read $c 2]
    note [eof $c]
    set res
} -cleanup {
    close $c
    rename foo {}
    unset res
} -result {{read rc* 4096} {watch rc* {}} {} 1}
test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	error EAGAIN
    }
    set c [chan create {r w} foo]
................................................................................
    note [read $c 2]
    note [eof $c]
    set res
} -cleanup {
    close $c
    rename foo {}
    unset res
} -result {{read rc* 4096} {watch rc* {}} {} 0}
test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	set args [lassign $args sub id]
	if {$sub ne "read"} {return}
	close $id
................................................................................

# --- === *** ###########################
# method configure

test iocmd-26.1 {chan configure, set standard option} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track; return
    }
    set c [chan create {r w} foo]
    note [fconfigure $c -translation lf]
    close $c
    rename foo {}
    set res
} -result {{watch rc* {}} {}}
test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
................................................................................
    set stop [after 10000 {note TIMEOUT}]
    after  1000 {note [chan postevent $c r]}
    vwait ::res
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* read} {} TOCK {watch rc* read} {} {watch rc* {}}}
test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    note [fileevent $c writable {note TOCK}]
    set stop [after 10000 {note TIMEOUT}]
    after  1000 {note [chan postevent $c w]}
    vwait ::res
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* write} {} TOCK {watch rc* write} {} {watch rc* {}}}
test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
    proc foo {args} {oninit; onfinal; track; return}
    proc dummy args { return }
    set c [chan create {r w} foo]
    fileevent $c readable dummy
} -body {
    close $c
................................................................................
    notes [inthread $c {
	note [read $c 10]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} {watch rc* {}} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
................................................................................
    notes [inthread $c {
	note [catch {[read $c 2]} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} {watch rc* {}} 1 {read delivered more than requested}}
test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track; note MUST_NOT_HAPPEN
    }
    set c [chan create {w} foo]
    notes [inthread $c {
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 BOOM!} \
    -constraints {testchannel thread}
test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code break BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \
    -constraints {testchannel thread}
test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code continue BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \
    -constraints {testchannel thread}
test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code 777 BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \
    -constraints {testchannel thread}
test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -level 55 -code 777 BOOM!
    }
................................................................................
    notes [inthread $c {
	note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} {watch rc* {}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
    -constraints {testchannel thread}
test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return ""
    }
................................................................................
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{read rc* 4096} {watch rc* {}} {} 1} \
    -constraints {testchannel thread}
test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	error EAGAIN
    }
................................................................................
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{read rc* 4096} {watch rc* {}} {} 0} \
    -constraints {testchannel thread}

# --- === *** ###########################
# method write

test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
    set res {}
................................................................................

# --- === *** ###########################
# method configure

test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track; return
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -translation lf]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{watch rc* {}} {}}
test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]

Changes to unix/tclUnixNotfy.c.

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
....
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
static int	atForkInit = AT_FORK_INIT_VALUE;
static void	AtForkPrepare(void);
static void	AtForkParent(void);
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of Windows API when building threaded with Cygwin.
 */

#if defined(TCL_THREADS) && defined(__CYGWIN__)
typedef struct {
    void *hwnd;
................................................................................
		    }
		    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
		    tsdPtr->onList = 0;
		    tsdPtr->pollState = 0;
		}
#ifdef __CYGWIN__
		PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else
		pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
	    }
	}
	pthread_mutex_unlock(&notifierMutex);

	/*






|







 







|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
....
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
static int	atForkInit = AT_FORK_INIT_VALUE;
static void	AtForkPrepare(void);
static void	AtForkParent(void);
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
 
/*
 * Import of Windows API when building threaded with Cygwin.
 */

#if defined(TCL_THREADS) && defined(__CYGWIN__)
typedef struct {
    void *hwnd;
................................................................................
		    }
		    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
		    tsdPtr->onList = 0;
		    tsdPtr->pollState = 0;
		}
#ifdef __CYGWIN__
		PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else /* __CYGWIN__ */
		pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
	    }
	}
	pthread_mutex_unlock(&notifierMutex);

	/*