summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2016-04-04 10:06:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2016-04-04 10:06:40 (GMT)
commit1fa8d8f8ed23d263b17cb2315eaf7de803690ee4 (patch)
treecb68882ce559d423af7a6ef11394623993dad295
parentaa0288d6918b42ae6b13f1cd94180e28c4ce3750 (diff)
parent082197d5c8f618d1cf78dffd199915806079b7de (diff)
downloadtcl-1fa8d8f8ed23d263b17cb2315eaf7de803690ee4.zip
tcl-1fa8d8f8ed23d263b17cb2315eaf7de803690ee4.tar.gz
tcl-1fa8d8f8ed23d263b17cb2315eaf7de803690ee4.tar.bz2
Corrections to compression stream flushing to make Tk generate PNGs correctly. Tk bug [9eb55debc5].
-rw-r--r--generic/tclZlib.c9
-rw-r--r--tests/zlib.test18
2 files changed, 23 insertions, 4 deletions
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 50d9a30..691d57a 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1194,11 +1194,12 @@ Tcl_ZlibStreamPut(
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
- while (e == Z_BUF_ERROR) {
+ while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
/*
- * Output buffer too small to hold the data being generated; so
- * put a new buffer into place after saving the old generated
- * data to the outData list.
+ * Output buffer too small to hold the data being generated or we
+ * are doing the end-of-stream flush (which can spit out masses of
+ * data). This means we need to put a new buffer into place after
+ * saving the old generated data to the outData list.
*/
obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
diff --git a/tests/zlib.test b/tests/zlib.test
index 7a486ba..968469d 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -875,6 +875,24 @@ test zlib-11.3 {Bug 3595576 variant} -setup {
} -cleanup {
removeFile $file
} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}
+
+test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup {
+ set stream [zlib stream compress]
+} -body {
+ for {set opts {};set y 0} {$y < 60} {incr y} {
+ for {set line {};set x 0} {$x < 100} {incr x} {
+ append line [binary format ccc $x $y 128]
+ }
+ if {$y == 59} {
+ set opts -finalize
+ }
+ $stream put {*}$opts $line
+ }
+ set data [$stream get]
+ list [string length $data] [string length [zlib decompress $data]]
+} -cleanup {
+ $stream close
+} -result {12026 18000}
::tcltest::cleanupTests
return