Tcl Source Code

Check-in [8eb3c44932]
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:[894da183c8] Fix and test for bug at the point it was introduced.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-894da183c8
Files: files | file ages | folders
SHA1: 8eb3c4493232a2d2195475c96970066293b381df
User & Date: dgp 2015-04-29 16:34:33
Context
2015-04-29
18:00
[894da183c8] Test and fix for regression in flushing blocked channels. check-in: a13963e6e4 user: dgp tags: core-8-5-branch
16:34
[894da183c8] Fix and test for bug at the point it was introduced. Closed-Leaf check-in: 8eb3c44932 user: dgp tags: bug-894da183c8
2014-05-27
13:28
Move code that can only matter in the first loop iteration out of the loop. check-in: 38257b5296 user: dgp tags: dgp-flush-channel
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclIO.c.

2512
2513
2514
2515
2516
2517
2518

2519
2520
2521
2522
2523
2524
2525
....
2697
2698
2699
2700
2701
2702
2703


2704
2705
2706
2707
2708
2709
2710
	/*
	 * If the queue is empty and there is a ready current buffer, OR if
	 * the current buffer is full, then move the current buffer to the
	 * queue.
	 */


	if (((statePtr->curOutPtr != NULL) &&
		IsBufferFull(statePtr->curOutPtr))
		|| (GotFlag(statePtr, BUFFER_READY) &&
			(statePtr->outQueueHead == NULL))) {
	    ResetFlag(statePtr, BUFFER_READY);
	    statePtr->curOutPtr->nextPtr = NULL;
	    if (statePtr->outQueueHead == NULL) {
................................................................................
	if (wroteSome) {
	    return errorCode;
	} else if (statePtr->outQueueHead == NULL) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
		    statePtr->interestMask);
	}


    }

    /*
     * If the channel is flagged as closed, delete it when the refCount drops
     * to zero, the output queue is empty and there is no output in the
     * current output buffer.
     */






>







 







>
>







2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
....
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
	/*
	 * If the queue is empty and there is a ready current buffer, OR if
	 * the current buffer is full, then move the current buffer to the
	 * queue.
	 */

start:
	if (((statePtr->curOutPtr != NULL) &&
		IsBufferFull(statePtr->curOutPtr))
		|| (GotFlag(statePtr, BUFFER_READY) &&
			(statePtr->outQueueHead == NULL))) {
	    ResetFlag(statePtr, BUFFER_READY);
	    statePtr->curOutPtr->nextPtr = NULL;
	    if (statePtr->outQueueHead == NULL) {
................................................................................
	if (wroteSome) {
	    return errorCode;
	} else if (statePtr->outQueueHead == NULL) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
		    statePtr->interestMask);
	}
    } else if (statePtr->curOutPtr && BytesLeft(statePtr->curOutPtr)) {
	goto start;
    }

    /*
     * If the channel is flagged as closed, delete it when the refCount drops
     * to zero, the output queue is empty and there is no output in the
     * current output buffer.
     */

Changes to tests/io.test.

7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153































7154
7155
7156
7157
7158
7159
7160
    fconfigure $f1 -blocking 0
    puts $f1 $big
    flush $f1
    after 500
    set result ""
    fileevent $f1 read [namespace code {
	append result [read $f1 1024]
	if {[string length $result] >= [string length $big]} {
	    set x done
	}
    }]
    vwait [namespace which -variable x]
    close $f1
    set big {}
    set x
} done































set result {}
proc FcopyTestAccept {sock args} {
    after 1000 "close $sock"
}
proc FcopyTestDone {bytes {error {}}} {
    variable fcopyTestDone
    if {[string length $error]} {






|








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







7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178
7179
7180
7181
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
    fconfigure $f1 -blocking 0
    puts $f1 $big
    flush $f1
    after 500
    set result ""
    fileevent $f1 read [namespace code {
	append result [read $f1 1024]
	if {[string length $result] >= [string length $big]+1} {
	    set x done
	}
    }]
    vwait [namespace which -variable x]
    close $f1
    set big {}
    set x
} done
test io-53.4.1 {Bug 894da183c8} {stdio fcopy} {
    set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
    variable x
    for {set x 0} {$x < 12} {incr x} {
	append big $big
    }
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 [list file delete $path(test1)]
    puts $f1 {
	puts ready
	set f [open io-53.4.1 w]
	fcopy stdin $f -command { set x }
	vwait x
	close $f
    }
    puts $f1 "close \[[list open $path(test1) w]]"
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    set result [gets $f1]
    fconfigure $f1 -blocking 0 -buffersize 125000
    puts $f1 $big
    fconfigure $f1 -blocking 1
    close $f1
    set big {}
    while {[catch {glob $path(test1)}]} {after 50}
    file delete $path(test1)
    set check [file size io-53.4.1]
    file delete io-53.4.1
    set check
} 266241
set result {}
proc FcopyTestAccept {sock args} {
    after 1000 "close $sock"
}
proc FcopyTestDone {bytes {error {}}} {
    variable fcopyTestDone
    if {[string length $error]} {