diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-03-12 11:28:00 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-03-12 11:28:00 (GMT) |
commit | ed8932a4eb542d1b5ce5714f89769865faacdefc (patch) | |
tree | 60b25491be6c6e9238acdd064605aca62dcf0b8a /library | |
parent | 21388fa31e1099692f83009f664791387f2c387d (diff) | |
parent | b7f151f1268d4b49953da193f135d52e6e52f841 (diff) | |
download | tcl-ed8932a4eb542d1b5ce5714f89769865faacdefc.zip tcl-ed8932a4eb542d1b5ce5714f89769865faacdefc.tar.gz tcl-ed8932a4eb542d1b5ce5714f89769865faacdefc.tar.bz2 |
Merge 8.7
Diffstat (limited to 'library')
-rw-r--r-- | library/manifest.txt | 2 | ||||
-rw-r--r-- | library/tcltest/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | library/tcltest/tcltest.tcl | 39 |
3 files changed, 38 insertions, 5 deletions
diff --git a/library/manifest.txt b/library/manifest.txt index cc1e223..5a999f4 100644 --- a/library/manifest.txt +++ b/library/manifest.txt @@ -12,7 +12,7 @@ apply {{dir} { 0 tcl::idna 1.0.1 {cookiejar idna.tcl} 0 platform 1.0.19 {platform platform.tcl} 0 platform::shell 1.1.4 {platform shell.tcl} - 1 tcltest 2.5.5 {tcltest tcltest.tcl} + 1 tcltest 2.5.6 {tcltest tcltest.tcl} } { if {$isafe && !$safe} continue package ifneeded $package $version [list source [file join $dir {*}$file]] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 18b05e5..9903e32 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded tcltest 2.5.5 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.5.6 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 7344f9f..19b7d64 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.5.5 + variable Version 2.5.6 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1134,6 +1134,39 @@ proc tcltest::SafeFetch {n1 n2 op} { } } + +# tcltest::Asciify -- +# +# Transforms the passed string to contain only printable ascii characters. +# Useful for printing to terminals. Non-printables are mapped to +# \x, \u or \U sequences. +# +# Arguments: +# s - string to transform +# +# Results: +# The transformed strings +# +# Side effects: +# None. + +proc tcltest::Asciify {s} { + set print "" + foreach c [split $s ""] { + set i [scan $c %c] + if {[string is print $c] && ($i <= 127) && ($i > 0)} { + append print $c + } elseif {$i <= 0xFF} { + append print \\x[format %02X $i] + } elseif {$i <= 0xFFFF} { + append print \\u[format %04X $i] + } else { + append print \\U[format %08X $i] + } + } + return $print +} + # tcltest::ConstraintInitializer -- # # Get or set a script that when evaluated in the tcltest namespace @@ -2221,9 +2254,9 @@ proc tcltest::test {name description args} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result: $scriptMatch" } else { - puts [outputChannel] "---- Result was:\n$actualAnswer" + puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]" puts [outputChannel] "---- Result should have been\ - ($match matching):\n$result" + ($match matching):\n[Asciify $result]" } } if {$errorCodeFailure} { |