Tcl Source Code

The following script causes Tcl to hang:

#! /bin/env tclsh

package require Thread

lassign [chan pipe] pr pw

# Comment this out and the interpreter no-longer hangs.
chan configure $pw -blocking 0

set tid [thread::create]
thread::transfer $tid $pw
thread::send $tid [list variable pw $pw]
thread::send $tid [list lappend notify_condition $pw]
thread::send -async $tid {
    #after 5000
    apply {{} {
        variable notify_condition
        variable pw
        for {set i 0} {$i < 10000} {incr i} {
            puts $pw [string repeat [info cmdcount] 15]
        }
        foreach chan $notify_condition {
            chan configure $chan -blocking 1
            close $chan
        }
    }}
    thread::release
}

after 5000
set data [read $pr]
close $pr
puts {condition occured}

Add a call to [flush] after enabling blocking, and the script no longer hangs:

#! /bin/env tclsh

package require Thread

lassign [chan pipe] pr pw

# Comment this out and the interpreter no-longer hangs.
chan configure $pw -blocking 0

set tid [thread::create]
thread::transfer $tid $pw
thread::send $tid [list variable pw $pw]
thread::send $tid [list lappend notify_condition $pw]
thread::send -async $tid {
    #after 5000
    apply {{} {
        variable notify_condition
        variable pw
        for {set i 0} {$i < 10000} {incr i} {
            puts $pw [string repeat [info cmdcount] 15]
        }
        foreach chan $notify_condition {
            chan configure $chan -blocking 1
            flush $chan
            close $chan
        }
    }}
    thread::release
}

after 5000
set data [read $pr]
close $pr
puts {condition occured}

Fix [453c47d3d9] works for me, thanks !

Right you are!

Will fix soon.

Thank you for the patch and the test. I have tried this checkin [98d7d3d724], Win 8.1, MS-VC6.

For me, the test fails as follows:

---- io-53.4.1 start


==== io-53.4.1 Bug 894da183c8 FAILED
==== Contents of test case:

    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

---- Result was:
270338
---- Result should have been (exact matching):
266241
==== io-53.4.1 FAILED

I suppose, this is due to different line ending styles: \n\r on windows and by \n on unix....

Tidied patches merged to active release branches.

See branch bug-894da183c8 for test and fix demonstrating
where the regression regressed.

Regression introduced in

http://core.tcl.tk/tcl/info/37bcb4b42d963315

Some experimentation showed that in case of the first example (no [flush $chan]), the contents of In tclIO.c/FlushChannl, the contents of statePtr->curOutPtr were not getting flushed, causing FlushChannel not to call CloseChannel. This fix solves the problem and passes the Tcl test suite:

--- tclIO.c
+++ tclIO.c
@@ -2653,12 +2653,14 @@
      * 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))) {
+           (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
+           || GotFlag(statePtr ,CHANNEL_CLOSED))) {
        if (statePtr->outQueueHead == NULL) {
            statePtr->outQueueHead = bufPtr;
        } else {
            statePtr->outQueueTail->nextPtr = bufPtr;
        }