Tcl Source Code

Check-in [a13963e6e4]
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] Test and fix for regression in flushing blocked channels.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: a13963e6e4bdfb406bb15ec31e0e29ac6ecdef58
User & Date: dgp 2015-04-29 18:00:15
Context
2015-04-29
20:34
Use joinable threads to avoid thread finalization crashes. check-in: 20cec4e959 user: dgp tags: core-8-5-branch
18:16
[894da183c8] Test and fix for regression in flushing blocked channels. check-in: 98d7d3d724 user: dgp tags: trunk
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
07:54
Update to tzdata2015d from ietf.org check-in: 635281ed4f user: venkat tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclIO.c.

2552
2553
2554
2555
2556
2557
2558


2559
2560
2561
2562
2563
2564
2565
2566

2567
2568
2569
2570
2571
2572
2573
     * First check that there are bytes in it.  If so then...
     * If the output queue is empty, then yes, trusting the caller called
     * us only when written bytes ought to be flushed.
     * If the current output buffer is full, then yes, so we can meet
     * the post-condition that on a successful return to caller we've
     * left space in the current output buffer for more writing (the flush
     * call was to make new room).


     * Otherwise, no.  Keep the current output buffer where it is so more
     * can be written to it, possibly filling it, to promote more efficient
     * buffer usage.
     */

    bufPtr = statePtr->curOutPtr;
    if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) {

	if (statePtr->outQueueHead == NULL) {
	    statePtr->outQueueHead = bufPtr;
	} else {
	    statePtr->outQueueTail->nextPtr = bufPtr;
	}
	statePtr->outQueueTail = bufPtr;
	statePtr->curOutPtr = NULL;






>
>







|
>







2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
     * First check that there are bytes in it.  If so then...
     * If the output queue is empty, then yes, trusting the caller called
     * us only when written bytes ought to be flushed.
     * If the current output buffer is full, then yes, so we can meet
     * the post-condition that on a successful return to caller we've
     * left space in the current output buffer for more writing (the flush
     * call was to make new room).
     * If the channel is blocking, then yes, so we guarantee that 
     * blocking flushes actually flush all pending data.
     * Otherwise, no.  Keep the current output buffer where it is so more
     * can be written to it, possibly filling it, to promote more efficient
     * buffer usage.
     */

    bufPtr = statePtr->curOutPtr;
    if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
		    || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
	if (statePtr->outQueueHead == NULL) {
	    statePtr->outQueueHead = bufPtr;
	} else {
	    statePtr->outQueueTail->nextPtr = bufPtr;
	}
	statePtr->outQueueTail = bufPtr;
	statePtr->curOutPtr = NULL;

Changes to tests/io.test.

7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379































7380
7381
7382
7383
7384
7385
7386
    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]} {






|








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







7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
    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]} {