diff options
author | dgp <dgp@users.sourceforge.net> | 2014-10-02 14:46:54 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2014-10-02 14:46:54 (GMT) |
commit | e500dec9fd8fb77231632352b45d2b0b715cdc22 (patch) | |
tree | 20a24e30d261d0bdfb0cea41eb93b3bf9d58a336 | |
parent | f987a699e563dd24c0a755d48e0169ac059a5536 (diff) | |
parent | a21e1b769836e5b589d00985420d87e74c8010e3 (diff) | |
download | tcl-e500dec9fd8fb77231632352b45d2b0b715cdc22.zip tcl-e500dec9fd8fb77231632352b45d2b0b715cdc22.tar.gz tcl-e500dec9fd8fb77231632352b45d2b0b715cdc22.tar.bz2 |
[bc5b790099] Improper calculation of new dstLimit value. New test io-12.7.
-rw-r--r-- | generic/tclIO.c | 5 | ||||
-rw-r--r-- | tests/io.test | 33 |
2 files changed, 35 insertions, 3 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index dcde8d1..aea633c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -6046,12 +6046,11 @@ ReadChars( /* * We read more chars than allowed. Reset limits to * prevent that and try again. Don't forget the extra - * padding of TCL_UTF_MAX - 1 bytes demanded by the + * padding of TCL_UTF_MAX bytes demanded by the * Tcl_ExternalToUtf() call! */ - dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - + TCL_UTF_MAX - 1 - dst; + dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst; statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; diff --git a/tests/io.test b/tests/io.test index 639691a..a030200 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1484,6 +1484,39 @@ test io-12.6 {ReadChars: too many chars read} { } close $c } {} +test io-12.7 {ReadChars: too many chars read [bc5b790099]} { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 10]....\uBEEF] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } + } + set c [chan create read [namespace which driver]] + chan configure $c -encoding utf-8 + while {![eof $c]} { + read $c 7 + } + close $c +} {} test io-13.1 {TranslateInputEOL: cr mode} {} { set f [open $path(test1) w] |