diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-07-03 14:10:34 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-07-03 14:10:34 (GMT) |
| commit | 3d98702f4592b02dee7b963d566407db562fb962 (patch) | |
| tree | fec572bb24a2b892251b2ca30e72df0e8135c0b1 | |
| parent | 78c9978aa144e618d1a5e20309accc5ba83e6ac5 (diff) | |
| parent | 6416a20fd8e2a665f23a1df31e0881b7a91185d4 (diff) | |
| download | tcl-3d98702f4592b02dee7b963d566407db562fb962.zip tcl-3d98702f4592b02dee7b963d566407db562fb962.tar.gz tcl-3d98702f4592b02dee7b963d566407db562fb962.tar.bz2 | |
Merge 8.7
| -rw-r--r-- | library/tcltest/tcltest.tcl | 10 | ||||
| -rw-r--r-- | tests/chanio.test | 3 | ||||
| -rw-r--r-- | tests/io.test | 3 | ||||
| -rw-r--r-- | tests/tcltests.tcl | 1 |
4 files changed, 11 insertions, 6 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index ff3f250..c7aee29 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -29,6 +29,7 @@ namespace eval tcltest { # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] + variable fullutf [package vsatisfies $version 8.7-] ##### Export the public tcltest procs; several categories # @@ -1150,16 +1151,17 @@ proc tcltest::SafeFetch {n1 n2 op} { # None. proc tcltest::Asciify {s} { + variable fullutf set print "" foreach c [split $s ""] { if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} { append print $c - } elseif {$c <= "\xFF"} { + } elseif {$c < "\u0100"} { append print \\x[format %02X [scan $c %c]] - } elseif {$c <= "\xFFFF"} { - append print \\u[format %04X [scan $c %c]] - } else { + } elseif {$fullutf && ($c >= "\U10000")} { append print \\U[format %08X [scan $c %c]] + } else { + append print \\u[format %04X [scan $c %c]] } } return $print diff --git a/tests/chanio.test b/tests/chanio.test index 5a793d6..8a27acb 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -1090,9 +1090,10 @@ test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -bod } -cleanup { chan close $f } -result {10 1234567890 0} +# This testcase fails in "debug" builds. See: [5be203d6ca] test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { set x "" -} -constraints {testchannel} -body { +} -constraints {testchannel ndebug} -body { set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" diff --git a/tests/io.test b/tests/io.test index 0fed043..265eb5e 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1189,7 +1189,8 @@ test io-7.2 {FilterInputBytes: split up character in middle of buffer} { close $f set x } [list 10 "1234567890" 0] -test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { +# This testcase fails in "debug" builds. See: [5be203d6ca] +test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel ndebug} { set f [open $path(test1) w] fconfigure $f -encoding binary puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index 61366a4..0cabaaa 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -8,6 +8,7 @@ namespace import ::tcltest::* testConstraint exec [llength [info commands exec]] testConstraint deprecated [expr {![tcl::build-info no-deprecate]}] testConstraint debug [tcl::build-info debug] +testConstraint ndebug [expr {![tcl::build-info debug]}] testConstraint purify [tcl::build-info purify] testConstraint debugpurify [ expr { |