Ticket UUID: | 894da183c8475264b8070b5b4dbbd6dd72f8dd69 | |||
Title: | In a thread, switch a non-blocking channel to blocking and close == hang | |||
Type: | Bug | Version: | 8.6.4 | |
Submitter: | pooryorick | Created on: | 2015-04-24 18:37:17 | |
Subsystem: | 25. Channel System | Assigned To: | dgp | |
Priority: | 5 Medium | Severity: | Critical | |
Status: | Closed | Last Modified: | 2015-04-30 16:13:39 | |
Resolution: | Fixed | Closed By: | oehhar | |
Closed on: | 2015-04-30 16:13:39 | |||
Description: |
(text/x-fossil-wiki)
The following script causes Tcl to hang: <code><verbatim> #! /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} </verbatim></code> Add a call to <code>[flush]</code> after enabling blocking, and the script no longer hangs: <code><verbatim> #! /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} </verbatim></code> | |||
User Comments: |
oehhar added on 2015-04-30 16:13:39:
(text/x-fossil-wiki)
Fix [453c47d3d9] works for me, thanks ! dgp added on 2015-04-30 13:57:07: Right you are! Will fix soon. oehhar added on 2015-04-30 13:02:01: (text/x-fossil-wiki) 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: <verbatim> ---- 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 </verbatim> I suppose, this is due to different line ending styles: \n\r on windows and by \n on unix.... dgp added on 2015-04-29 18:17:17: Tidied patches merged to active release branches. dgp added on 2015-04-29 16:35:20: See branch bug-894da183c8 for test and fix demonstrating where the regression regressed. dgp added on 2015-04-28 15:56:46: Regression introduced in http://core.tcl.tk/tcl/info/37bcb4b42d963315 pooryorick added on 2015-04-26 01:18:33: (text/x-fossil-wiki) 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: <code><verbatim> --- 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; } </verbatim></code> |