From 29c7bc7ff7a9c37a5ad8d3cd3f297cb256b9eec4 Mon Sep 17 00:00:00 2001 From: stanton Date: Wed, 2 Dec 1998 03:13:29 +0000 Subject: Cleaned up some tests Fixed an I/O bug where UpdateInterest was not always called on input --- ChangeLog | 3 +++ generic/tclIO.c | 16 +++++++++++++--- tests/encoding.test | 15 ++++++++++++++- tests/io.test | 45 +++++++++++++++++++++++---------------------- tests/ioUtil.test | 4 ++-- 5 files changed, 55 insertions(+), 28 deletions(-) diff --git a/ChangeLog b/ChangeLog index f455629..1ee06f8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 1998-12-01 + * generic/tclIO.c (Tcl_ReadChars): Added a call to UpdateInterest + so we don't block when there is data sitting in the buffers. + * generic/tclTest.c (TestevalobjvObjCmd): Updated for EvalObjv change. diff --git a/generic/tclIO.c b/generic/tclIO.c index 42fcf44..a297b22 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.1.2.3 1998/11/11 04:08:16 stanton Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.1.2.4 1998/12/02 03:13:30 stanton Exp $ */ #include "tclInt.h" @@ -3510,7 +3510,8 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag) chanPtr = (Channel *) chan; if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) { - return -1; + copied = -1; + goto done; } encoding = chanPtr->encoding; @@ -3572,7 +3573,8 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag) if (result == EAGAIN) { break; } - return -1; + copied = -1; + goto done; } } else { copied += copiedNow; @@ -3585,6 +3587,14 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag) } else { Tcl_SetObjLength(objPtr, offset); } + + done: + /* + * Update the notifier state so we don't block while there is still + * data in the buffers. + */ + + UpdateInterest(chanPtr); return copied; } /* diff --git a/tests/encoding.test b/tests/encoding.test index e0f2521..70ef976 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -80,7 +80,7 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} { set x } {jis0208} -test encoding-4.1 {Tcl_GetEncodingNames} { +test encoding-4.1 {Tcl_GetEncodingNames} {pcOnly} { file mkdir tmp/encoding close [open tmp/encoding/junk.enc w] close [open tmp/encoding/junk2.enc w] @@ -93,6 +93,19 @@ test encoding-4.1 {Tcl_GetEncodingNames} { file delete -force tmp set x } {junk utf-8 cp1252 junk2 identity unicode iso8859-1} +test encoding-4.1 {Tcl_GetEncodingNames} {unixOnly} { + file mkdir tmp/encoding + close [open tmp/encoding/junk.enc w] + close [open tmp/encoding/junk2.enc w] + cd tmp + set path [testencoding path] + testencoding path . + set x [encoding names] + testencoding path $path + cd .. + file delete -force tmp + set x +} {junk utf-8 junk2 identity unicode iso8859-1} test encoding-5.1 {Tcl_SetSystemEncoding} { diff --git a/tests/io.test b/tests/io.test index cd0c06d..1899e45 100644 --- a/tests/io.test +++ b/tests/io.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.1.2.3 1998/11/11 04:08:30 stanton Exp $ +# RCS: @(#) $Id: io.test,v 1.1.2.4 1998/12/02 03:13:31 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -60,7 +60,7 @@ close $f # These tests are disabled until we decide what to do with "unsupported0". # -#test io-1.7 {unsupported0 command} { +#test io-1.1 {unsupported0 command} { # removeFile test1 # set f1 [open iocmd.test] # set f2 [open test1 w] @@ -75,7 +75,7 @@ close $f # } # set x #} ok -#test io-1.8 {unsupported0 command} { +#test io-1.2 {unsupported0 command} { # removeFile test1 # set f1 [open [info script]] # set f2 [open test1 w] @@ -84,7 +84,7 @@ close $f # close $f2 # file size test1 #} 40 -#test io-1.9 {unsupported0 command} { +#test io-1.3 {unsupported0 command} { # removeFile test1 # set f1 [open [info script]] # set f2 [open test1 w] @@ -99,7 +99,7 @@ close $f # } # set x #} ok -#test io-1.10 {unsupported0 command} {unixOrPc} { +#test io-1.4 {unsupported0 command} {unixOrPc} { # removeFile pipe # removeFile test1 # set f1 [open pipe w] @@ -133,17 +133,17 @@ proc contents {file} { return $a } -test io-1.1 {Tcl_WriteChars: CheckChannelErrors} { +test io-1.5 {Tcl_WriteChars: CheckChannelErrors} { # no test, need to cause an async error. } {} -test io-1.2 {Tcl_WriteChars: WriteBytes} { +test io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open test1 w] fconfigure $f -encoding binary puts -nonewline $f "a\u4e4d\0" close $f contents test1 } "a\x4d\x00" -test io-1.3 {Tcl_WriteChars: WriteChars} { +test io-1.7 {Tcl_WriteChars: WriteChars} { set f [open test1 w] fconfigure $f -encoding shiftjis puts -nonewline $f "a\u4e4d\0" @@ -1831,12 +1831,12 @@ test io-19.4 {Tcl_CreateChannel, insertion into channel table} { test io-20.1 {Tcl_CreateChannel: initial settings} { set a [open test2 w] - set old [testencoding system] - testencoding system ascii + set old [encoding system] + encoding system ascii set f [open test1 w] set x [fconfigure $f -encoding] close $f - testencoding system $old + encoding system $old close $a set x } {ascii} @@ -4924,7 +4924,7 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { close $f set x } 40000 -test io-39.13 {Tcl_SetChannelOption: -encoding, binary & utf-8} { +test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { removeFile test1 set f [open test1 w] fconfigure $f -encoding {} @@ -4936,7 +4936,7 @@ test io-39.13 {Tcl_SetChannelOption: -encoding, binary & utf-8} { close $f set x } \u7266 -test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { +test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} { removeFile test1 set f [open test1 w] fconfigure $f -encoding binary @@ -4948,14 +4948,14 @@ test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { close $f set x } \u7266 -test io-39.14 {Tcl_SetChannelOption: -encoding, errors} { +test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { removeFile test1 set f [open test1 w] set result [list [catch {fconfigure $f -encoding foobar} msg] $msg] close $f set result } {1 {unknown encoding "foobar"}} -test io-39.14 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} { +test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} { set f [open "|[list $tcltest cat]" r+] fconfigure $f -encoding binary puts -nonewline $f "\xe7" @@ -4978,7 +4978,7 @@ test io-39.14 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} set x } "{} timeout {} timeout \xe7 timeout" -test io-39.14 {Tcl_SetChannelOption, setting read mode independently} \ +test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server accept 0] @@ -4991,7 +4991,7 @@ test io-39.14 {Tcl_SetChannelOption, setting read mode independently} \ close $s2 set modes } {auto lf} -test io-39.15 {Tcl_SetChannelOption, setting read mode independently} \ +test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server accept 0] @@ -5004,7 +5004,7 @@ test io-39.15 {Tcl_SetChannelOption, setting read mode independently} \ close $s2 set modes } {auto crlf} -test io-39.16 {Tcl_SetChannelOption, setting read mode independently} \ +test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server accept 0] @@ -5017,7 +5017,7 @@ test io-39.16 {Tcl_SetChannelOption, setting read mode independently} \ close $s2 set modes } {auto cr} -test io-39.17 {Tcl_SetChannelOption, setting read mode independently} \ +test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} set s1 [socket -server accept 0] @@ -6680,7 +6680,7 @@ test io-56.1 {ChannelTimerProc} { lappend result $y } {2 done} -test io-34.1 {buffered data and file events, gets} { +test io-57.1 {buffered data and file events, gets} { proc accept {sock args} { set ::s2 $sock } @@ -6701,7 +6701,7 @@ test io-34.1 {buffered data and file events, gets} { close $server set result } {12 readable 34567890 timer} -test io-34.2 {buffered data and file events, read} { +test io-57.2 {buffered data and file events, read} { proc accept {sock args} { set ::s2 $sock } @@ -6723,7 +6723,7 @@ test io-34.2 {buffered data and file events, read} { set result } {1 readable 234567890 timer} -test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} { +test io-58.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} { set out [open script w] puts $out { puts "normal message from pipe" @@ -6766,3 +6766,4 @@ file delete cat restoreState return + diff --git a/tests/ioUtil.test b/tests/ioUtil.test index 4e86353..349733a 100644 --- a/tests/ioUtil.test +++ b/tests/ioUtil.test @@ -1,4 +1,4 @@ -# This file (iOUtil.test) tests the hookable TclStat(), TclAccess(), +# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(), # and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioUtil.test,v 1.1.2.1 1998/09/24 23:59:26 stanton Exp $ +# RCS: @(#) $Id: ioUtil.test,v 1.1.2.2 1998/12/02 03:13:33 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} -- cgit v0.12