diff options
| -rw-r--r-- | generic/tclIO.c | 16 | ||||
| -rw-r--r-- | tests/io.test | 38 |
2 files changed, 43 insertions, 11 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index e786946..0122ec9 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4212,10 +4212,6 @@ Tcl_GetsObj( } goto gotEOL; } - if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING) - == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) { - goto restore; - } dst = dstEnd; } @@ -4680,6 +4676,12 @@ FilterInputBytes( */ read: + if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) + == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + gsPtr->charsWrote = 0; + gsPtr->rawRead = 0; + return -1; + } if (GetInput(chanPtr) != 0) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; @@ -4770,12 +4772,6 @@ FilterInputBytes( * some more, but avoid blocking on a non-blocking channel. */ - if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) - == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { - gsPtr->charsWrote = 0; - gsPtr->rawRead = 0; - return -1; - } goto read; } } else { diff --git a/tests/io.test b/tests/io.test index 0d9468d..f6690ad 100644 --- a/tests/io.test +++ b/tests/io.test @@ -4333,7 +4333,7 @@ test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { close $c rename driver {} } -result {{} {} {} .......} -test io-33.12 {TclGetsObjBinary, [10dc6daa37]} -setup { +test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { variable buffer variable index @@ -4367,6 +4367,42 @@ test io-33.12 {TclGetsObjBinary, [10dc6daa37]} -setup { close $c rename driver {} } -result {{} {} {} .......} +test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [string repeat \ + [string repeat . 64]\n[string repeat . 25] 2] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 65} {set n 65} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } + } +} -body { + set c [chan create read [namespace which driver]] + chan configure $c -blocking 0 + list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c] +} -cleanup { + close $c + rename driver {} +} -result [list [string repeat . 64] {} [string repeat . 89] \ + [string repeat . 25] {}] # Test Tcl_Seek and Tcl_Tell. |