Tcl Source Code

Check-in [032cde93a3]
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 iogt fixes.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-5adc350683-86
Files: files | file ages | folders
SHA1: 032cde93a36a7a41c9749c511c5f58dd2d5608f6
User & Date: dgp 2014-11-06 16:20:44
Context
2014-11-06
16:34
[5adc350683] Stop Tcl forcing EOF condition on channels to be permanent. It may be fleeting, and all... check-in: 16bdf667aa user: dgp tags: trunk
16:20
merge iogt fixes. Closed-Leaf check-in: 032cde93a3 user: dgp tags: bug-5adc350683-86
16:12
Also test transfroms that delay. Closed-Leaf check-in: 431afa5371 user: dgp tags: bug-5adc350683
14:52
Another test checking that handling when transform returns nothing is right. check-in: d7e45b9c0f user: dgp tags: bug-5adc350683-86
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclIOGT.c.

183
184
185
186
187
188
189

190
191
192
193
194
195
196
...
288
289
290
291
292
293
294

295
296
297
298
299
300
301
...
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
...
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
...
719
720
721
722
723
724
725

726
727
728
729
730
731
732
...
746
747
748
749
750
751
752
753
754




755
756
757
758
759
760
761
...
858
859
860
861
862
863
864

865
866
867
868
869
870
871
...
931
932
933
934
935
936
937

938
939
940
941
942
943
944
     * General section. Data to integrate the transformation into the channel
     * system.
     */

    Tcl_Channel self;		/* Our own Channel handle. */
    int readIsFlushed;		/* Flag to note whether in.flushProc was
				 * called or not. */

    int flags;			/* Currently CHANNEL_ASYNC or zero. */
    int watchMask;		/* Current watch/event/interest mask. */
    int mode;			/* Mode of parent channel, OR'ed combination
				 * of TCL_READABLE, TCL_WRITABLE. */
    Tcl_TimerToken timer;	/* Timer for automatic flushing of information
				 * sitting in an internal buffer. Required for
				 * full fileevent support. */
................................................................................

    dataPtr = ckalloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;

    dataPtr->flags = 0;
    if (ds.string[0] == '0') {
	dataPtr->flags |= CHANNEL_ASYNC;
    }
    Tcl_DStringFree(&ds);

    dataPtr->watchMask = 0;
................................................................................

    /*
     * Should assert(dataPtr->mode & TCL_READABLE);
     */

    if (toRead == 0 || dataPtr->self == NULL) {
	/*
	 * Catch a no-op.
	 */
	return 0;
    }

    gotBytes = 0;
    downChan = Tcl_GetStackedChannel(dataPtr->self);

................................................................................
	    if (dataPtr->maxRead < toRead) {
		toRead = dataPtr->maxRead;
	    }
	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
	if (toRead <= 0) {
	    break;
	}

	if (dataPtr->readIsFlushed) {
	    /*
	     * Already saw EOF from downChan; don't ask again.
	     * NOTE: Could move this up to avoid the last maxRead
	     * execution.  Believe this would still be correct behavior,
	     * but the test suite tests the whole command callback 
	     * sequence, so leave it unchanged for now.
	     */
................................................................................
	} else if (read == 0) {

	    /*
	     * Zero returned from Tcl_ReadRaw() always indicates EOF
	     * on the down channel.
	     */


	    dataPtr->readIsFlushed = 1;
	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
		    TRANSMIT_IBUF, P_PRESERVE);

	    if (ResultEmpty(&dataPtr->result)) {
		/*
		 * We had nothing to flush.
................................................................................
	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    gotBytes = -1;
	    break;
	}
    } /* while toRead > 0 */
    ReleaseData(dataPtr);





    return gotBytes;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransformOutputProc --
................................................................................
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;

    }
    ReleaseData(dataPtr);

    return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
	    errorCodePtr);
}
 
................................................................................
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;

    }
    ReleaseData(dataPtr);

    /*
     * If we have a wide seek capability, we should stick with that.
     */







>







 







>







 







|







 







<
|







 







>







 







<

>
>
>
>







 







>







 







>







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
...
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
...
674
675
676
677
678
679
680

681
682
683
684
685
686
687
688
...
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
...
748
749
750
751
752
753
754

755
756
757
758
759
760
761
762
763
764
765
766
...
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
...
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
     * General section. Data to integrate the transformation into the channel
     * system.
     */

    Tcl_Channel self;		/* Our own Channel handle. */
    int readIsFlushed;		/* Flag to note whether in.flushProc was
				 * called or not. */
    int eofPending;		/* Flag: EOF seen down, not raised up */
    int flags;			/* Currently CHANNEL_ASYNC or zero. */
    int watchMask;		/* Current watch/event/interest mask. */
    int mode;			/* Mode of parent channel, OR'ed combination
				 * of TCL_READABLE, TCL_WRITABLE. */
    Tcl_TimerToken timer;	/* Timer for automatic flushing of information
				 * sitting in an internal buffer. Required for
				 * full fileevent support. */
................................................................................

    dataPtr = ckalloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;
    if (ds.string[0] == '0') {
	dataPtr->flags |= CHANNEL_ASYNC;
    }
    Tcl_DStringFree(&ds);

    dataPtr->watchMask = 0;
................................................................................

    /*
     * Should assert(dataPtr->mode & TCL_READABLE);
     */

    if (toRead == 0 || dataPtr->self == NULL) {
	/*
	 * Catch a no-op. TODO: Is this a panic()?
	 */
	return 0;
    }

    gotBytes = 0;
    downChan = Tcl_GetStackedChannel(dataPtr->self);

................................................................................
	    if (dataPtr->maxRead < toRead) {
		toRead = dataPtr->maxRead;
	    }
	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
	if (toRead <= 0) {
	    break;
	}

	if (dataPtr->eofPending) {
	    /*
	     * Already saw EOF from downChan; don't ask again.
	     * NOTE: Could move this up to avoid the last maxRead
	     * execution.  Believe this would still be correct behavior,
	     * but the test suite tests the whole command callback 
	     * sequence, so leave it unchanged for now.
	     */
................................................................................
	} else if (read == 0) {

	    /*
	     * Zero returned from Tcl_ReadRaw() always indicates EOF
	     * on the down channel.
	     */

	    dataPtr->eofPending = 1;
	    dataPtr->readIsFlushed = 1;
	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
		    TRANSMIT_IBUF, P_PRESERVE);

	    if (ResultEmpty(&dataPtr->result)) {
		/*
		 * We had nothing to flush.
................................................................................
	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    gotBytes = -1;
	    break;
	}
    } /* while toRead > 0 */


    if (gotBytes == 0) {
	dataPtr->eofPending = 0;
    }
    ReleaseData(dataPtr);
    return gotBytes;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TransformOutputProc --
................................................................................
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
	dataPtr->eofPending = 0;
    }
    ReleaseData(dataPtr);

    return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
	    errorCodePtr);
}
 
................................................................................
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
	dataPtr->eofPending = 0;
    }
    ReleaseData(dataPtr);

    /*
     * If we have a wide seek capability, we should stick with that.
     */

Changes to tests/iogt.test.

867
868
869
870
871
872
873










































































874
875
876
877
878
879
880
881
    set res [read $f 3]
    testchannel unstack $f
    append res [read $f 3]
} -cleanup {
    close $f
} -result {xxxghi}
 










































































# cleanup
foreach file [list dummy dummyout __echo_srv__.tcl] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::iogt
return






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








867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
    set res [read $f 3]
    testchannel unstack $f
    append res [read $f 3]
} -cleanup {
    close $f
} -result {xxxghi}
 

# Driver for a base channel that emits several short "files"
# with each terminated by a fleeting EOF
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .....
                return {initialize finalize watch read}
            }
            finalize {
                if {![info exists index($chan)]} {return}
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                if {![info exists index($chan)]} {
                    driver initialize $chan
                }
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                if {[string length $result] == 0} {
                    driver finalize $chan
                }
                return $result
            }
        }
    }

test iogt-7.0 {Handle fleeting EOF} -constraints {testchannel} -body {
    set chan [chan create read [namespace which driver]]
    identity -attach $chan
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

proc delay {op data} {
    variable store
    switch -- $op {
	create/write -	create/read  -
	delete/write -	delete/read  -
	flush/write -	write -
	clear_read   {;#ignore}
	flush/read  -
	read        {
	    if {![info exists store]} {set store {}}
	    set reply $store
	    set store $data
	    return $reply
	}
	query/maxRead {return -1}
    }
}

test iogt-7.1 {Handle fleeting EOF} -constraints {testchannel} -body {
    set chan [chan create read [namespace which driver]]
    testchannel transform $chan -command [namespace code delay]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

rename delay {}
rename driver {}

# cleanup
foreach file [list dummy dummyout __echo_srv__.tcl] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::iogt
return