diff options
author | apnadkarni <apnmbx-wits@yahoo.com> | 2023-03-14 17:23:47 (GMT) |
---|---|---|
committer | apnadkarni <apnmbx-wits@yahoo.com> | 2023-03-14 17:23:47 (GMT) |
commit | c5d053512164c62b70e4604f3836630eb8a8633d (patch) | |
tree | 4147dc2d2eb522e0b1252ccafde35e6fd1335ce8 /tests | |
parent | 844792f3bb8eea9124be41d436c7462f1daa19b9 (diff) | |
parent | 76526242c0142e4ec4354ee1119f9dc50ae705f8 (diff) | |
download | tcl-c5d053512164c62b70e4604f3836630eb8a8633d.zip tcl-c5d053512164c62b70e4604f3836630eb8a8633d.tar.gz tcl-c5d053512164c62b70e4604f3836630eb8a8633d.tar.bz2 |
Merge 9.0. Also fix replace profile handling of orphan surrogates
Diffstat (limited to 'tests')
-rw-r--r-- | tests/encoding.test | 64 | ||||
-rw-r--r-- | tests/encodingVectors.tcl | 4 | ||||
-rw-r--r-- | tests/ioTrans.test | 86 | ||||
-rw-r--r-- | tests/utfext.test | 2 |
4 files changed, 149 insertions, 7 deletions
diff --git a/tests/encoding.test b/tests/encoding.test index 8ed7c1d..db5680d 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -564,15 +564,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" @@ -604,6 +616,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} -body { list [catch {encoding convertto jis0208 \\} res] $res @@ -1049,6 +1067,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/encodingVectors.tcl b/tests/encodingVectors.tcl index b3f3efa..1b569a1 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -553,10 +553,10 @@ lappend encInvalidBytes {*}{ utf-16le 41 replace \uFFFD -1 {solo tail} {Truncated} utf-16le 41 strict {} 0 {solo tail} {Truncated} utf-16le 00D8 tcl8 \uD800 -1 {} {Missing low surrogate} - utf-16le 00D8 replace \uFFFD -1 {knownBug} {Missing low surrogate} + utf-16le 00D8 replace \uFFFD -1 {} {Missing low surrogate} utf-16le 00D8 strict {} 0 {knownBug} {Missing low surrogate} utf-16le 00DC tcl8 \uDC00 -1 {} {Missing high surrogate} - utf-16le 00DC replace \uFFFD -1 {knownBug} {Missing high surrogate} + utf-16le 00DC replace \uFFFD -1 {} {Missing high surrogate} utf-16le 00DC strict {} 0 {knownBug} {Missing high surrogate} utf-16be 41 tcl8 \uFFFD -1 {solo tail} {Truncated} 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 61e36b8..4ceb72f 100644 --- a/tests/utfext.test +++ b/tests/utfext.test @@ -86,7 +86,7 @@ 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 {} {}} +} -result [list nospace {} \xFF] ::tcltest::cleanupTests return |