diff --git a/doc/tcltest.n b/doc/tcltest.n index 1a5151af054..2c204c9326c 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -431,7 +431,7 @@ denormalized or improperly formed strings to pass to C procedures that are supposed to accept strings with embedded NULL types and confirm that a string result has a certain pattern of bytes. This is exactly equivalent to the Tcl command \fBencoding convertfrom\fR -\fBidentity\fR. +\fBidentity\fR. This function is deprecated. .SH TESTS .PP The \fBtest\fR command is the heart of the \fBtcltest\fR package. diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 9f51e64a9f1..7f7968e2e10 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.8 [list source -encoding utf-8 [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.5.9 [list source -encoding utf-8 [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 168f5219a14..e7e8c36dcd7 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -21,7 +21,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.8 + variable Version 2.5.9 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package require] and [info patchlevel] @@ -43,7 +43,7 @@ namespace eval tcltest { outputChannel testConstraint # Export commands that are duplication (candidates for deprecation) - if {!$fullutf} { + if {![package vsatisfies [package provide Tcl] 9.0-]} { namespace export bytestring ;# dups [encoding convertfrom identity] } namespace export debug ;# [configure -debug] @@ -3342,7 +3342,7 @@ proc tcltest::viewFile {name {directory ""}} { # Side effects: # None -if {!$::tcltest::fullutf} { +if {![package vsatisfies [package provide Tcl] 9.0-]} { proc tcltest::bytestring {string} { return [encoding convertfrom identity $string] } diff --git a/tests/string.test b/tests/string.test index 6b66ebb3cbc..7a44f98d0ce 100644 --- a/tests/string.test +++ b/tests/string.test @@ -87,7 +87,7 @@ test string-2.11.$noComp {string compare, unicode} { run {string compare ab\u7266 ab\u7267} } -1 test string-2.12.$noComp {string compare, high bit} { - # This test will fail if the underlying comparison + # This test fails if the underlying comparison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) run {string compare "\x80" "@"} @@ -142,10 +142,10 @@ test string-2.26.$noComp {string compare -nocase, null strings} { test string-2.27.$noComp {string compare -nocase, null strings} { run {string compare -nocase foo ""} } 1 -test string-2.28.$noComp {string compare with length, unequal strings} { +test string-2.28.$noComp {string compare with length, unequal strings, partial first string} { run {string compare -length 2 abc abde} } 0 -test string-2.29.$noComp {string compare with length, unequal strings} { +test string-2.29.$noComp {string compare with length, unequal strings 2, full first string} { run {string compare -length 2 ab abde} } 0 test string-2.30.$noComp {string compare with NUL character vs. other ASCII} { @@ -209,7 +209,7 @@ test string-3.1.$noComp {string equal} { run {string equal abcde abdef} } 0 test string-3.2.$noComp {string equal} { - run {string eq abcde ABCDE} + run {string e abcde ABCDE} } 0 test string-3.3.$noComp {string equal} { run {string equal abcde abcde} @@ -377,6 +377,7 @@ test string-3.45f.$noComp {string equal -nocase empty string against byte array} run {string equal -nocase [binary decode hex 00] ""} } 0 + test string-4.1.$noComp {string first, not enough args} { list [catch {run {string first a}} msg] $msg } {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} @@ -1079,13 +1080,13 @@ test string-10.3.$noComp {string map, too many args} { } {1 {wrong # args: should be "string map ?-nocase? charMap string"}} test string-10.4.$noComp {string map} { run {string map {a b} abba} -} {bbbb} +} bbbb test string-10.5.$noComp {string map} { run {string map {a b} a} -} {b} +} b test string-10.6.$noComp {string map -nocase} { run {string map -nocase {a b} Abba} -} {bbbb} +} bbbb test string-10.7.$noComp {string map} { run {string map {abc 321 ab * a A} aabcabaababcab} } {A321*A*321*} @@ -1100,7 +1101,7 @@ test string-10.10.$noComp {string map} { } {1 {char map list unbalanced}} test string-10.11.$noComp {string map, nulls} { run {string map {\x00 NULL blah \x00nix} {qwerty}} -} {qwerty} +} qwerty test string-10.12.$noComp {string map, unicode} { run {string map [list \374 ue UE \334] "a\374ueUE\x00EU"} } aueue\334\x00EU @@ -1112,13 +1113,13 @@ test string-10.14.$noComp {string map, -nocase null arguments} { } foo test string-10.15.$noComp {string map, one pair case} { run {string map -nocase {abc 32} aAbCaBaAbAbcAb} -} {a32aBaAb32Ab} +} a32aBaAb32Ab test string-10.16.$noComp {string map, one pair case} { run {string map -nocase {ab 4321} aAbCaBaAbAbcAb} -} {a4321C4321a43214321c4321} +} a4321C4321a43214321c4321 test string-10.17.$noComp {string map, one pair case} { run {string map {Ab 4321} aAbCaBaAbAbcAb} -} {a4321CaBa43214321c4321} +} a4321CaBa43214321c4321 test string-10.18.$noComp {string map, empty argument} { run {string map -nocase {{} abc} foo} } foo @@ -1791,11 +1792,11 @@ test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is lappend result [string map $m $b] lappend result [string map $m [run {string trimright $b x}]] lappend result [string map $m [run {string trimright $b \xE8}]] - lappend result [string map $m [run {string trimright $b [bytestring \xE8]}]] + lappend result [string map $m [run {string trimright $b [testbytestring \xE8]}]] lappend result [string map $m [run {string trimright $b \xA0}]] - lappend result [string map $m [run {string trimright $b [bytestring \xA0]}]] + lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]] lappend result [string map $m [run {string trimright $b \xE8\xA0}]] - lappend result [string map $m [run {string trimright $b [bytestring \xE8\xA0]}]] + lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]] lappend result [string map $m [run {string trimright $b \x00}]] } [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV] @@ -1922,47 +1923,47 @@ test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj { test string-23.1.$noComp {string is command with empty string} { set s "" list \ - [run {string is alnum $s}] \ - [run {string is alpha $s}] \ - [run {string is ascii $s}] \ - [run {string is control $s}] \ - [run {string is boolean $s}] \ - [run {string is digit $s}] \ - [run {string is double $s}] \ - [run {string is false $s}] \ - [run {string is graph $s}] \ - [run {string is integer $s}] \ - [run {string is lower $s}] \ - [run {string is print $s}] \ - [run {string is punct $s}] \ - [run {string is space $s}] \ - [run {string is true $s}] \ - [run {string is upper $s}] \ - [run {string is wordchar $s}] \ - [run {string is xdigit $s}] \ + [run {string is alnum $s}] \ + [run {string is alpha $s}] \ + [run {string is ascii $s}] \ + [run {string is control $s}] \ + [run {string is boolean $s}] \ + [run {string is digit $s}] \ + [run {string is double $s}] \ + [run {string is false $s}] \ + [run {string is graph $s}] \ + [run {string is integer $s}] \ + [run {string is lower $s}] \ + [run {string is print $s}] \ + [run {string is punct $s}] \ + [run {string is space $s}] \ + [run {string is true $s}] \ + [run {string is upper $s}] \ + [run {string is wordchar $s}] \ + [run {string is xdigit $s}] \ } {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1} test string-23.2.$noComp {string is command with empty string} { set s "" list \ - [run {string is alnum -strict $s}] \ - [run {string is alpha -strict $s}] \ - [run {string is ascii -strict $s}] \ - [run {string is control -strict $s}] \ - [run {string is boolean -strict $s}] \ - [run {string is digit -strict $s}] \ - [run {string is double -strict $s}] \ - [run {string is false -strict $s}] \ - [run {string is graph -strict $s}] \ - [run {string is integer -strict $s}] \ - [run {string is lower -strict $s}] \ - [run {string is print -strict $s}] \ - [run {string is punct -strict $s}] \ - [run {string is space -strict $s}] \ - [run {string is true -strict $s}] \ - [run {string is upper -strict $s}] \ - [run {string is wordchar -strict $s}] \ - [run {string is xdigit -strict $s}] \ + [run {string is alnum -strict $s}] \ + [run {string is alpha -strict $s}] \ + [run {string is ascii -strict $s}] \ + [run {string is control -strict $s}] \ + [run {string is boolean -strict $s}] \ + [run {string is digit -strict $s}] \ + [run {string is double -strict $s}] \ + [run {string is false -strict $s}] \ + [run {string is graph -strict $s}] \ + [run {string is integer -strict $s}] \ + [run {string is lower -strict $s}] \ + [run {string is print -strict $s}] \ + [run {string is punct -strict $s}] \ + [run {string is space -strict $s}] \ + [run {string is true -strict $s}] \ + [run {string is upper -strict $s}] \ + [run {string is wordchar -strict $s}] \ + [run {string is xdigit -strict $s}] \ } {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} @@ -2133,12 +2134,12 @@ test string-26.10.$noComp {tcl::prefix} -body { } -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa} test string-26.10.1.$noComp {tcl::prefix} -setup { proc _testprefix {args} { - array set opts {-a x -b y -c y} - foreach {opt val} $args { - set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt] - set opts($opt) $val - } - array get opts + array set opts {-a x -b y -c y} + foreach {opt val} $args { + set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt] + set opts($opt) $val + } + array get opts } } -body { set a [catch {_testprefix -x u} result options] @@ -2154,15 +2155,15 @@ test string-26.10.1.$noComp {tcl::prefix} -setup { proc MemStress {args} { set res {} foreach body $args { - set end 0 - for {set i 0} {$i < 5} {incr i} { - proc MemStress_Body {} $body - uplevel 1 MemStress_Body - rename MemStress_Body {} - set tmp $end - set end [lindex [lindex [split [memory info] "\n"] 3] 3] - } - lappend res [expr {$end - $tmp}] + set end 0 + for {set i 0} {$i < 5} {incr i} { + proc MemStress_Body {} $body + uplevel 1 MemStress_Body + rename MemStress_Body {} + set tmp $end + set end [lindex [lindex [split [memory info] "\n"] 3] 3] + } + lappend res [expr {$end - $tmp}] } return $res } @@ -2170,21 +2171,21 @@ proc MemStress {args} { test string-26.11.$noComp {tcl::prefix: testing for leaks} -body { # This test is made to stress object reference management MemStress { - set table {hejj miff gurk} - set item [lindex $table 1] - # If not careful, this can cause a circular reference - # that will cause a leak. - tcl::prefix match $table $item + set table {hejj miff gurk} + set item [lindex $table 1] + # If not careful, this can cause a circular reference + # that will cause a leak. + tcl::prefix match $table $item } { - # A similar case with nested lists - set table2 {hejj {miff maff} gurk} - set item [lindex [lindex $table2 1] 0] - tcl::prefix match $table2 $item + # A similar case with nested lists + set table2 {hejj {miff maff} gurk} + set item [lindex [lindex $table2 1] 0] + tcl::prefix match $table2 $item } { - # A similar case with dict - set table3 {hejj {miff maff} gurk2} - set item [lindex [dict keys [lindex $table3 1]] 0] - tcl::prefix match $table3 $item + # A similar case with dict + set table3 {hejj {miff maff} gurk2} + set item [lindex [dict keys [lindex $table3 1]] 0] + tcl::prefix match $table3 $item } } -constraints memory -result {0 0 0} @@ -2193,29 +2194,29 @@ test string-26.12.$noComp {tcl::prefix: testing for leaks} -body { # in real code. The shared literal "miff" causes a connection # between the item and the table. MemStress { - proc stress1 {item} { - set table [list hejj miff gurk] - tcl::prefix match $table $item - } - proc stress2 {} { - stress1 miff - } - stress2 - rename stress1 {} - rename stress2 {} + proc stress1 {item} { + set table [list hejj miff gurk] + tcl::prefix match $table $item + } + proc stress2 {} { + stress1 miff + } + stress2 + rename stress1 {} + rename stress2 {} } } -constraints memory -result 0 test string-26.13.$noComp {tcl::prefix: testing for leaks} -body { # This test is made to stress object reference management MemStress { - set table [list hejj miff] - set item $table - set error $table - # Use the same objects in all places - catch { - tcl::prefix match -error $error $table $item - } + set table [list hejj miff] + set item $table + set error $table + # Use the same objects in all places + catch { + tcl::prefix match -error $error $table $item + } } } -constraints memory -result {0} diff --git a/unix/Makefile.in b/unix/Makefile.in index 7d5fa2eafbf..bc743b38928 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -872,9 +872,9 @@ install-libraries: libraries @echo "Installing package msgcat 1.6.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)/8.5/msgcat-1.6.1.tm" - @echo "Installing package tcltest 2.5.8 as a Tcl Module" + @echo "Installing package tcltest 2.5.9 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.8.tm" + "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.9.tm" @echo "Installing package platform 1.0.19 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm" diff --git a/win/Makefile.in b/win/Makefile.in index 2210f0164f0..8dd107670f6 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -756,8 +756,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.5/msgcat-1.6.1.tm"; - @echo "Installing package tcltest 2.5.8 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.8.tm"; + @echo "Installing package tcltest 2.5.9 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.9.tm"; @echo "Installing package platform 1.0.19 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module";