Merge 8.7

5 files changed, 151 insertions, 9 deletions

diff --git a/tests/chanio.test b/tests/chanio.test
index 9d84b0d..6da6305 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -4982,7 +4982,7 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup {
 test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
     # This test crashes the interp if Bug #427196 is not fixed
     set chan [open [info script] r]
-    chan configure $chan -buffersize 10
+    chan configure $chan -buffersize 10 -encoding utf-8
     set var [chan read $chan 2]
     chan configure $chan -buffersize 32
     append var [chan read $chan]
diff --git a/tests/encoding.test b/tests/encoding.test
index a51b6c0..1af5a26 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -561,15 +561,27 @@ test encoding-16.18 {
 	return done
     } [namespace current]]
 } -result done
-test encoding-16.19 {UnicodeToUtfProc, bug [d19fe0a5b]} -body {
+test encoding-16.19 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom utf-16 "\x41\x41\x41"
 } -result \u4141\uFFFD
-test encoding-16.20 {UnicodeToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body {
+test encoding-16.20 {Utf16ToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body {
     encoding convertfrom utf-16 "\xD8\xD8"
 } -result \uD8D8
-test encoding-16.21 {UnicodeToUtfProc, bug [d19fe0a5b]} -body {
+test encoding-16.21 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom utf-32 "\x00\x00\x00\x00\x41\x41"
 } -result \x00\uFFFD
+test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
+    encoding convertfrom -profile strict utf-16le \x00\xD8
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
+test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
+    encoding convertfrom -profile strict utf-16le \x00\xDC
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
+test encoding-16.24 {Utf32ToUtfProc} -body {
+    encoding convertfrom utf-32 "\xFF\xFF\xFF\xFF"
+} -result \uFFFD
+test encoding-16.25 {Utf32ToUtfProc} -body {
+    encoding convertfrom utf-32 "\x01\x00\x00\x01"
+} -result \uFFFD
 
 test encoding-17.1 {UtfToUtf16Proc} -body {
     encoding convertto utf-16 "\U460DC"
@@ -601,6 +613,12 @@ test encoding-17.9 {Utf32ToUtfProc} -body {
 test encoding-17.10 {Utf32ToUtfProc} -body {
     encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF"
 } -result \uFFFD
+test encoding-17.11 {Utf32ToUtfProc} -body {
+    encoding convertfrom -profile strict utf-32le "\x00\xD8\x00\x00"
+} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}
+test encoding-17.12 {Utf32ToUtfProc} -body {
+    encoding convertfrom -profile strict utf-32le "\x00\xDC\x00\x00"
+} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}
 
 test encoding-18.1 {TableToUtfProc on invalid input} -constraints deprecated -body {
 	list [catch {encoding convertto jis0208 \\} res] $res
@@ -1040,6 +1058,46 @@ test encoding-28.0 {all encodings load} -body {
 
 runtests
 
+test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result
+} -result [list 0 [list nospace {} \xff]]
+
+test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result
+} -result [list 0 [list nospace {} {}]]
+
+test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result
+} -result [list 0 [list nospace {} \x00\x00]]
+
+test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result
+} -result [list 0 [list nospace {} \x00\x00\xff]]
+
+test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -constraints {
+    knownBug
+} -body {
+    # The knownBug constraint is because test depends on TCL_UTF_MAX and
+    # also UtfToUtf16 assumes space required in destination buffer is
+    # sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result
+} -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]]
+
 }
 
 test encoding-29.0 {get encoding nul terminator lengths} -constraints {
diff --git a/tests/io.test b/tests/io.test
index 5a2abbe..fc126de 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -5476,7 +5476,7 @@ test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
     # This test crashes the interp if Bug #427196 is not fixed
 
     set chan [open [info script] r]
-    fconfigure $chan -buffersize 10
+    fconfigure $chan -buffersize 10 -encoding utf-8
     set var [read $chan 2]
     fconfigure $chan -buffersize 32
     append var [read $chan]
@@ -5693,7 +5693,7 @@ test io-39.16a {Tcl_SetChannelOption: -encoding (invalid shortening to "-e"), er
     fconfigure $f -e foobar
 } -cleanup {
     close $f
-} -returnCodes 1 -result {bad option "-e": should be one of -blocking, -buffering, -buffersize, -encoding, -encodingprofile, -eofchar, or -translation}
+} -returnCodes 1 -match glob -result {bad option "-e": should be one of *}
 test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
     set f [open "|[list [interpreter] $path(cat)]" r+]
     fconfigure $f -encoding binary
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 79493e0..9639576 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -634,6 +634,58 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
         }
     }
 
+
+
+namespace eval reflector {
+    proc initialize {_ chan mode} {
+	return {initialize finalize watch read}
+    }
+
+
+    proc finalize {_ chan} {
+	namespace delete $_
+    }
+
+
+    proc read {_ chan count} {
+	namespace upvar $_ source source
+	set res [string range $source 0 $count-1]
+	set source [string range $source $count end]
+	return $res
+    }
+
+
+    proc watch {_ chan events} {
+	after 0 [list chan postevent $chan read]
+	return read
+    }
+
+    namespace ensemble create -parameters _
+    namespace export *
+}
+
+
+
+
+namespace eval inputfilter {
+    proc initialize {chan mode} {
+	return {initialize finalize read}
+    }
+
+    proc read {chan buffer} {
+	return $buffer
+    }
+
+    proc finalize chan {
+	namespace delete $chan
+    }
+
+    namespace ensemble create
+    namespace export *
+}
+
+
+
 # Channel read transform that is just the identity - pass all through
     proc idxform {cmd handle args} {
       switch -- $cmd {
@@ -2089,7 +2141,39 @@ test iortrans.tf-11.1 {origin thread of moved transform destroyed during access}
     thread::release $tidb
 } -result {Owner lost}
 
-# ### ### ### ######### ######### #########
+
+test iortrans-ea69b0258a9833cb {
+    Crash when using a channel transformation on TCP client socket
+
+    "line two" does not make it into result.  This issue should probably be
+    addressed, but it is outside the scope of this test.
+} -setup {
+    set res {}
+    set read 0
+} -body {
+    namespace eval reflector1 {
+	variable source "line one\nline two"
+	interp alias {} [namespace current]::dispatch {} [
+	    namespace parent]::reflector [namespace current]
+    }
+    set chan [chan create read [namespace which reflector1::dispatch]]
+    chan configure $chan -blocking 0
+    chan push $chan inputfilter
+    chan event $chan read [list ::apply [list chan {
+	variable res
+	variable read
+	set gets [gets $chan]
+	append res $gets
+	incr read
+    } [namespace current]] $chan]
+    vwait [namespace current]::read
+    chan pop $chan
+    vwait [namespace current]::read
+    return $res
+} -cleanup {
+    catch {unset read}
+    close $chan
+} -result {line one}
 
 cleanupTests
 return
diff --git a/tests/utfext.test b/tests/utfext.test
index 6cf3dd7..bc996c9 100644
--- a/tests/utfext.test
+++ b/tests/utfext.test
@@ -85,8 +85,8 @@ foreach {enc utfhex hex} $utfExtMap {
 
 # Test for insufficient space
 test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body {
-    testencoding Tcl_UtfToExternal unicode A {start end} {} 1
-} -result {nospace {} {}}
+    testencoding Tcl_UtfToExternal ucs-2 A {start end} {} 1
+} -result [list nospace {} \xFF]
 
 # Another bug - char limit not obeyed
 # % set cv 2