diff options
| -rw-r--r-- | generic/tclTest.c | 55 | ||||
| -rw-r--r-- | tests/chanio.test | 16 | ||||
| -rw-r--r-- | tests/io.test | 12 | ||||
| -rw-r--r-- | tests/parse.test | 29 | ||||
| -rw-r--r-- | tests/parseExpr.test | 5 | ||||
| -rw-r--r-- | tests/parseOld.test | 13 | ||||
| -rw-r--r-- | tests/stringObj.test | 17 | ||||
| -rw-r--r-- | tests/subst.test | 12 | ||||
| -rw-r--r-- | tests/utf.test | 94 | ||||
| -rw-r--r-- | tests/util.test | 5 |
10 files changed, 159 insertions, 99 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index a27c95a..0f4b6d4 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -201,8 +201,9 @@ static int EncodingFromUtfProc(ClientData clientData, int *dstCharsPtr); static void ExitProcEven(ClientData clientData); static void ExitProcOdd(ClientData clientData); -static int GetTimesCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static int GetTimesObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static void MainLoop(void); static int NoopCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); @@ -219,6 +220,9 @@ static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static int TestasyncCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); +static int TestbytestringObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestcmdinfoCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestcmdtokenCmd(ClientData dummy, @@ -556,9 +560,10 @@ Tcltest_Init( * Create additional commands and math functions for testing Tcl. */ - Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, @@ -4717,7 +4722,7 @@ TestgetvarfullnameCmd( /* *---------------------------------------------------------------------- * - * GetTimesCmd -- + * GetTimesObjCmd -- * * This procedure implements the "gettimes" command. It is used for * computing the time needed for various basic operations such as reading @@ -4733,11 +4738,11 @@ TestgetvarfullnameCmd( */ static int -GetTimesCmd( +GetTimesObjCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ - int argc, /* The number of arguments. */ - const char **argv) /* The argument strings. */ + int notused1, /* Number of arguments. */ + Tcl_Obj *const notused2[]) /* The argument objects. */ { Interp *iPtr = (Interp *) interp; int i, n; @@ -4951,6 +4956,42 @@ NoopObjCmd( /* *---------------------------------------------------------------------- * + * TestbytestringObjCmd -- + * + * This object-based procedure constructs a string which can + * possibly contain invalid UTF-8 bytes. + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestbytestringObjCmd( + ClientData unused, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + int n; + const char *p; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "bytearray"); + return TCL_ERROR; + } + p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestsetCmd -- * * Implements the "testset{err,noerr}" cmds that are used when testing diff --git a/tests/chanio.test b/tests/chanio.test index e53f059..2738fc6 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -13,10 +13,16 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[catch {package require tcltest 2}]} { - chan puts stderr "Skipping tests in [info script]. tcltest 2 required." - return +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* } + +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + +testConstraint testbytestring [llength [info commands testbytestring]] + namespace eval ::tcl::test::io { namespace import ::tcltest::* @@ -7426,11 +7432,11 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} { string equal $result [testmainthread] } {1} -test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} { +test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] chan puts $out { - chan puts [encoding convertfrom identity \xe2] + chan puts [testbytestring \xe2] exit 1 } proc readit {pipe} { diff --git a/tests/io.test b/tests/io.test index a7a666a..bf5adb0 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,14 +13,16 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[catch {package require tcltest 2}]} { - puts stderr "Skipping tests in [info script]. tcltest 2 required." - return +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +testConstraint testbytestring [llength [info commands testbytestring]] + namespace eval ::tcl::test::io { namespace import ::tcltest::* @@ -7860,12 +7862,12 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} { string equal $result [testmainthread] } {1} -test io-60.1 {writing illegal utf sequences} {openpipe fileevent} { +test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] puts $out { - puts [encoding convertfrom identity \xe2] + puts [testbytestring \xe2] exit 1 } proc readit {pipe} { diff --git a/tests/parse.test b/tests/parse.test index 01443c9..fe6026d 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -20,6 +20,7 @@ namespace eval ::tcl::test::parse { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testparser [llength [info commands testparser]] +testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] testConstraint testparsevarname [llength [info commands testparsevarname]] @@ -29,8 +30,8 @@ testConstraint testcmdtrace [llength [info commands testcmdtrace]] testConstraint testevent [llength [info commands testevent]] testConstraint memory [llength [info commands memory]] -test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser { - testparser [bytestring "foo\0 bar"] -1 +test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} { + testparser [testbytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { testparser "foo bar" -1 @@ -301,9 +302,9 @@ test parse-6.15 {ParseTokens procedure, backslash-newline} testparser { test parse-6.16 {ParseTokens procedure, backslash substitution} testparser { testparser {\n\a\x7f} 0 } {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}} -test parse-6.17 {ParseTokens procedure, null characters} testparser { - testparser [bytestring "foo\0zz"] 0 -} "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}" +test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} { + testparser [testbytestring "foo\0zz"] 0 +} "- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}" test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser { # Test for Bug 681841 list [catch {testparser {[a]} 2} msg] $msg @@ -700,8 +701,8 @@ test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup { rename getbytes {} } -result 0 -test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser { - testparser [bytestring "foo\0 bar"] -1 +test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} { + testparser [testbytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { testparser "foo bar" -1 @@ -737,8 +738,8 @@ test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser { list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"} -test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} testparser { - testparser [bytestring "foo\0 bar"] -1 +test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {testparser testbytestring} { + testparser [testbytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser { testparser "foo bar" -1 @@ -903,11 +904,11 @@ test parse-15.53 {CommandComplete procedure} " test parse-15.54 {CommandComplete procedure} " info complete \"foo bar;# \{\" " 1 -test parse-15.55 {CommandComplete procedure} { - info complete "set x [bytestring \0]; puts hi" +test parse-15.55 {CommandComplete procedure} testbytestring { + info complete "set x [testbytestring \0]; puts hi" } 1 -test parse-15.56 {CommandComplete procedure} { - info complete "set x [bytestring \0]; \{" +test parse-15.56 {CommandComplete procedure} testbytestring { + info complete "set x [testbytestring \0]; \{" } 0 test parse-15.57 {CommandComplete procedure} { info complete "# Comment should be complete command" @@ -917,7 +918,7 @@ test parse-15.58 {CommandComplete procedure, memory leaks} { } 1 test parse-15.59 {CommandComplete procedure} { # Test for Tcl Bug 684744 - info complete [encoding convertfrom identity "\x00;if 1 \{"] + info complete [testbytestring "\x00;if 1 \{"] } 0 test parse-15.60 {CommandComplete procedure} { # Test for Tcl Bug 1968882 diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 714c45b..5c7986a 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -20,6 +20,7 @@ catch [list package require -exact Tcltest [info patchlevel]] # of "<<" are integers. testConstraint testexprparser [llength [info commands testexprparser]] +testConstraint testbytestring [llength [info commands testbytestring]] # Big test for correct ordering of data in [expr] @@ -81,8 +82,8 @@ testConstraint ieeeFloatingPoint [testIEEE] ###################################################################### -test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} testexprparser { - testexprparser [bytestring "1+2\0 +3"] -1 +test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {testexprparser testbytestring} { + testexprparser [testbytestring "1+2\0 +3"] -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser { testexprparser "1 + 2" -1 diff --git a/tests/parseOld.test b/tests/parseOld.test index f3b1591..4c08b5d 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -20,6 +20,7 @@ namespace import ::tcltest::* catch [list package require -exact Tcltest [info patchlevel]] testConstraint testwordend [llength [info commands testwordend]] +testConstraint testbytestring [llength [info commands testbytestring]] # Save the argv value for restoration later set savedArgv $argv @@ -261,15 +262,15 @@ test parseOld-7.10 {backslash substitution} { test parseOld-7.11 {backslash substitution} { eval "list a \"b c\"\\\nd e" } {a {b c} d e} -test parseOld-7.12 {backslash substitution} { +test parseOld-7.12 {backslash substitution} testbytestring { list \ua2 -} [bytestring "\xc2\xa2"] -test parseOld-7.13 {backslash substitution} { +} [testbytestring "\xc2\xa2"] +test parseOld-7.13 {backslash substitution} testbytestring { list \u4e21 -} [bytestring "\xe4\xb8\xa1"] -test parseOld-7.14 {backslash substitution} { +} [testbytestring "\xe4\xb8\xa1"] +test parseOld-7.14 {backslash substitution} testbytestring { list \u4e2k -} [bytestring "\xd3\xa2k"] +} [testbytestring "\xd3\xa2k"] # Semi-colon. diff --git a/tests/stringObj.test b/tests/stringObj.test index 6f331d3..ec7b819 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -21,6 +21,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] +testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] test stringObj-1.1 {string type registration} testobj { @@ -338,7 +339,7 @@ test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstr # Because this test does not use \uXXXX notation below instead of # hardcoding the values, it may fail in multibyte locales. However, we # need to test that the parser produces untyped objects even when there - # are high-ASCII characters in the input (like "ï"). I don't know what + # are high-ASCII characters in the input (like "�"). I don't know what # else to do but inline those characters here. testdstring free testdstring append "abc\u00ef\u00efdef" -1 @@ -347,7 +348,7 @@ test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstr [testobj objtype $x] [testobj objtype $y] } [list none "bc\u00EF\u00EFde" string string] test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj { - # set x "abcïïdef" + # set x "abc��def" # Use \uXXXX notation below instead of hardcoding the values, otherwise # the test will fail in multibyte locales. set x "abc\u00EF\u00EFdef" @@ -356,7 +357,7 @@ test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj { [testobj objtype $x] [testobj objtype $y] } [list string "bc\u00EF\u00EFde" string string] test stringObj-10.4 {Tcl_GetRange with some mixed width chars} testobj { - # set a "ïa¿b®cï¿d®" + # set a "�a�b�c�d�" # Use \uXXXX notation below instead of hardcoding the values, otherwise # the test will fail in multibyte locales. set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" @@ -422,18 +423,18 @@ test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj { string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE" } 6 test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj { - # set a "ïa¿b®cï¿d®" + # set a "�a�b�c�d�" # Use \uXXXX notation below instead of hardcoding the values, otherwise # the test will fail in multibyte locales. set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" list [string length $a] [string length $a] } {10 10} -test stringObj-13.7 {Tcl_GetCharLength with identity nulls} testobj { +test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { # SF bug #684699 - string length [encoding convertfrom identity \x00] + string length [testbytestring \x00] } 1 -test stringObj-13.8 {Tcl_GetCharLength with identity nulls} testobj { - string length [encoding convertfrom identity \x01\x00\x02] +test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { + string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { diff --git a/tests/subst.test b/tests/subst.test index 498512d..747438e 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -15,6 +15,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + +testConstraint testbytestring [llength [info commands testbytestring]] test subst-1.1 {basics} -returnCodes error -body { subst @@ -32,16 +36,16 @@ test subst-2.2 {simple strings} { test subst-2.3 {simple strings} { subst abcdefg } abcdefg -test subst-2.4 {simple strings} { +test subst-2.4 {simple strings} testbytestring { # Tcl Bug 685106 - subst [bytestring bar\x00soom] -} [bytestring bar\x00soom] + subst [testbytestring bar\x00soom] +} [testbytestring bar\x00soom] test subst-3.1 {backslash substitutions} { subst {\x\$x\[foo bar]\\} } "x\$x\[foo bar]\\" test subst-3.2 {backslash substitutions with utf chars} { - # 'j' is just a char that doesn't mean anything, and \344 is 'ä' + # 'j' is just a char that doesn't mean anything, and \344 is '�' # that also doesn't mean anything, but is multi-byte in UTF-8. list [subst \j] [subst \\j] [subst \\344] [subst \\\344] } "j j \344 \344" diff --git a/tests/utf.test b/tests/utf.test index 2d62fa0..2fcac49 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -16,50 +16,52 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] +testConstraint testbytestring [llength [info commands testbytestring]] + catch {unset x} -test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} { +test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring { set x \x01 -} [bytestring "\x01"] -test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} { +} [testbytestring "\x01"] +test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { set x "\x00" -} [bytestring "\xc0\x80"] -test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} { +} [testbytestring "\xc0\x80"] +test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { set x "\xe0" -} [bytestring "\xc3\xa0"] -test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} { +} [testbytestring "\xc3\xa0"] +test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring { set x "\u4e4e" -} [bytestring "\xe4\xb9\x8e"] -test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} { +} [testbytestring "\xe4\xb9\x8e"] +test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { format %c 0x110000 -} [bytestring "\xef\xbf\xbd"] -test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} { +} [testbytestring "\xef\xbf\xbd"] +test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { format %c -1 -} [bytestring "\xef\xbf\xbd"] +} [testbytestring "\xef\xbf\xbd"] test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" } {3} -test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} { - string length [bytestring "\x82\x83\x84"] +test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring { + string length [testbytestring "\x82\x83\x84"] } {3} -test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} { - string length [bytestring "\xC2"] +test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} testbytestring { + string length [testbytestring "\xC2"] } {1} -test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} { - string length [bytestring "\xC2\xa2"] +test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} testbytestring { + string length [testbytestring "\xC2\xa2"] } {1} -test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} { - string length [bytestring "\xE2"] +test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} testbytestring { + string length [testbytestring "\xE2"] } {1} -test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} { - string length [bytestring "\xE2\xA2"] +test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring { + string length [testbytestring "\xE2\xA2"] } {2} -test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} { - string length [bytestring "\xE4\xb9\x8e"] +test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring { + string length [testbytestring "\xE4\xb9\x8e"] } {1} -test utf-2.8 {Tcl_UtfToUniChar: longer UTF sequences not supported} { - string length [bytestring "\xF4\xA2\xA2\xA2"] +test utf-2.8 {Tcl_UtfToUniChar: longer UTF sequences not supported} testbytestring { + string length [testbytestring "\xF4\xA2\xA2\xA2"] } {4} test utf-3.1 {Tcl_UtfCharComplete} { @@ -69,26 +71,26 @@ testConstraint testnumutfchars [llength [info commands testnumutfchars]] test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" } {0} -test utf-4.2 {Tcl_NumUtfChars: length 1} testnumutfchars { - testnumutfchars [bytestring "\xC2\xA2"] +test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring "\xC2\xA2"] } {1} -test utf-4.3 {Tcl_NumUtfChars: long string} testnumutfchars { - testnumutfchars [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] +test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] } {7} -test utf-4.4 {Tcl_NumUtfChars: #u0000} testnumutfchars { - testnumutfchars [bytestring "\xC0\x80"] +test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring "\xC0\x80"] } {1} test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars { testnumutfchars "" 1 } {0} -test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} testnumutfchars { - testnumutfchars [bytestring "\xC2\xA2"] 1 +test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring "\xC2\xA2"] 1 } {1} -test utf-4.7 {Tcl_NumUtfChars: long string, calc len} testnumutfchars { - testnumutfchars [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 1 +test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 1 } {7} -test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} testnumutfchars { - testnumutfchars [bytestring "\xC0\x80"] 1 +test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} { + testnumutfchars [testbytestring "\xC0\x80"] 1 } {1} test utf-5.1 {Tcl_UtfFindFirsts} { @@ -125,18 +127,18 @@ test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { set x \n } { } -test utf-10.2 {Tcl_UtfBackslash: \u subst} { +test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring { set x \ua2 -} [bytestring "\xc2\xa2"] -test utf-10.3 {Tcl_UtfBackslash: longer \u subst} { +} [testbytestring "\xc2\xa2"] +test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring { set x \u4e21 -} [bytestring "\xe4\xb8\xa1"] -test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} { +} [testbytestring "\xe4\xb8\xa1"] +test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring { set x \u4e2k -} "[bytestring \xd3\xa2]k" -test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} { +} "[testbytestring \xd3\xa2]k" +test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring { set x \u4e216 -} "[bytestring \xe4\xb8\xa1]6" +} "[testbytestring \xe4\xb8\xa1]6" proc bsCheck {char num} { global errNum test utf-10.$errNum {backslash substitution} { diff --git a/tests/util.test b/tests/util.test index 0e50483..7782f35 100644 --- a/tests/util.test +++ b/tests/util.test @@ -16,6 +16,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { catch [list package require -exact Tcltest [info patchlevel]] testConstraint controversialNaN 1 +testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] testConstraint testconcatobj [llength [info commands testconcatobj]] testConstraint testdoubledigits [llength [info commands testdoubledigits]] @@ -274,10 +275,10 @@ test util-5.17 {Tcl_StringMatch: UTF-8} { # get 1 UTF-8 character Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc" } 1 -test util-5.18 {Tcl_StringMatch: UTF-8} { +test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance: wrong answer would match on UTF trail byte of \u4e4f - Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc] + Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\u008fc] } 0 test util-5.19 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); |