diff options
Diffstat (limited to 'tests/string.test')
| -rw-r--r-- | tests/string.test | 143 |
1 files changed, 123 insertions, 20 deletions
diff --git a/tests/string.test b/tests/string.test index 3fc1153..cf658a2 100644 --- a/tests/string.test +++ b/tests/string.test @@ -11,14 +11,15 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: string.test,v 1.77 2009/06/24 15:17:41 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] @@ -314,10 +315,10 @@ test string-6.4 {string is, too many args} { } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.5 {string is, class check} { list [catch {string is bogus str} msg] $msg -} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} +} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.6 {string is, ambiguous class} { list [catch {string is al str} msg] $msg -} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} +} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.7 {string is alpha, all ok} { string is alpha -strict -failindex var abc } 1 @@ -407,13 +408,15 @@ test string-6.35 {string is double, false} { test string-6.36 {string is double, false} { list [string is double -fail var "\n"] $var } {0 0} -test string-6.37 {string is double, false on int overflow} { +test string-6.37 {string is double, false on int overflow} -setup { + set var priorValue +} -body { # Make it the largest int recognizable, with one more digit for overflow # Since bignums arrived in Tcl 8.5, the sense of this test changed. # Now integer values that exceed native limits become bignums, and # bignums can convert to doubles without error. list [string is double -fail var [largest_int]0] $var -} {1 0} +} -result {1 priorValue} # string-6.38 removed, underflow on input is no longer an error. test string-6.39 {string is double, false} { # This test is non-portable because IRIX thinks @@ -594,7 +597,7 @@ test string-6.90 {string is integer, bad integers} { foreach num $numbers { lappend result [string is int -strict $num] } - set result + return $result } {1 1 0 0 0 1 0 0} test string-6.91 {string is double, bad doubles} { set result "" @@ -602,20 +605,20 @@ test string-6.91 {string is double, bad doubles} { foreach num $numbers { lappend result [string is double -strict $num] } - set result + return $result } {1 1 0 0 0 1 0 0} -test string-6.92 {string is double, 32-bit overflow} { +test string-6.92 {string is integer, 32-bit overflow} { # Bug 718878 set x 0x100000000 list [string is integer -failindex var $x] $var } {0 -1} -test string-6.93 {string is double, 32-bit overflow} { +test string-6.93 {string is integer, 32-bit overflow} { # Bug 718878 set x 0x100000000 append x "" list [string is integer -failindex var $x] $var } {0 -1} -test string-6.94 {string is double, 32-bit overflow} { +test string-6.94 {string is integer, 32-bit overflow} { # Bug 718878 set x 0x100000000 list [string is integer -failindex var [expr {$x}]] $var @@ -666,7 +669,7 @@ test string-6.107 {string is integer, bad integers} { foreach num $numbers { lappend result [string is wideinteger -strict $num] } - set result + return $result } {1 1 0 0 0 1 0 0} test string-6.108 {string is double, Bug 1382287} { set x 2turtledoves @@ -676,6 +679,78 @@ test string-6.108 {string is double, Bug 1382287} { test string-6.109 {string is double, Bug 1360532} { string is double 1\u00a0 } 0 +test string-6.110 {string is entier, true} { + string is entier +1234567890 +} 1 +test string-6.111 {string is entier, true on type} { + string is entier [expr wide(50.0)] +} 1 +test string-6.112 {string is entier, true} { + string is entier [list -10] +} 1 +test string-6.113 {string is entier, true as hex} { + string is entier 0xabcdef +} 1 +test string-6.114 {string is entier, true as octal} { + string is entier 0123456 +} 1 +test string-6.115 {string is entier, true with whitespace} { + string is entier " \n1234\v" +} 1 +test string-6.116 {string is entier, false} { + list [string is entier -fail var 123abc] $var +} {0 3} +test string-6.117 {string is entier, false} { + list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var +} {0 84} +test string-6.118 {string is entier, false} { + list [string is entier -fail var [expr double(1)]] $var +} {0 1} +test string-6.119 {string is entier, false} { + list [string is entier -fail var " "] $var +} {0 0} +test string-6.120 {string is entier, false on bad octal} { + list [string is entier -fail var 0o36963] $var +} {0 4} +test string-6.121.1 {string is entier, false on bad octal} { + list [string is entier -fail var 0o36963] $var +} {0 4} +test string-6.122 {string is entier, false on bad hex} { + list [string is entier -fail var 0X345XYZ] $var +} {0 5} +test string-6.123 {string is entier, bad integers} { + # SF bug #634856 + set result "" + set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] + foreach num $numbers { + lappend result [string is entier -strict $num] + } + return $result +} {1 1 0 0 0 1 0 0} +test string-6.124 {string is entier, true} { + string is entier +1234567890123456789012345678901234567890 +} 1 +test string-6.125 {string is entier, true} { + string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000] +} 1 +test string-6.126 {string is entier, true as hex} { + string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef +} 1 +test string-6.127 {string is entier, true as octal} { + string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456 +} 1 +test string-6.128 {string is entier, true with whitespace} { + string is entier " \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v" +} 1 +test string-6.129 {string is entier, false on bad octal} { + list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var +} {0 87} +test string-6.130.1 {string is entier, false on bad octal} { + list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var +} {0 87} +test string-6.131 {string is entier, false on bad hex} { + list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var +} {0 88} catch {rename largest_int {}} @@ -1323,6 +1398,9 @@ test string-15.9 {string tolower} { test string-15.10 {string tolower, unicode} { string tolower ABCabc\xc7\xe7 } "abcabc\xe7\xe7" +test string-15.11 {string tolower, compiled} { + lindex [string tolower [list A B [list C]]] 1 +} b test string-16.1 {string toupper} { list [catch {string toupper} msg] $msg @@ -1354,6 +1432,9 @@ test string-16.9 {string toupper} { test string-16.10 {string toupper, unicode} { string toupper ABCabc\xc7\xe7 } "ABCABC\xc7\xc7" +test string-16.11 {string toupper, compiled} { + lindex [string toupper [list a b [list c]]] 1 +} B test string-17.1 {string totitle} { list [catch {string totitle} msg] $msg @@ -1376,6 +1457,9 @@ test string-17.6 {string totitle, unicode} { test string-17.7 {string totitle, unicode} { string totitle \u01f3BCabc\xc7\xe7 } "\u01f2bcabc\xe7\xe7" +test string-17.8 {string totitle, compiled} { + lindex [string totitle [list aa bb [list cc]]] 0 +} Aa test string-18.1 {string trim} { list [catch {string trim} msg] $msg @@ -1411,8 +1495,8 @@ test string-18.11 {string trim, unicode} { string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8 } " AB\xe7C " test string-18.12 {string trim, unicode default} { - string trim ABC\u1361\u1680\u3000 -} ABC + string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000 +} ABC\u1361 test string-19.1 {string trimleft} { list [catch {string trimleft} msg] $msg @@ -1421,8 +1505,8 @@ test string-19.2 {string trimleft} { string trimleft " XYZ " } {XYZ } test string-19.3 {string trimleft, unicode default} { - string trimleft \u1361\u1680\u3000ABC -} ABC + string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC +} \u1361ABC test string-20.1 {string trimright errors} { list [catch {string trimright} msg] $msg @@ -1440,8 +1524,8 @@ test string-20.5 {string trimright} { string trimright "" } {} test string-20.6 {string trimright, unicode default} { - string trimright ABC\u1361\u1680\u3000 -} ABC + string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000 +} ABC\u1361 test string-21.1 {string wordend} { list [catch {string wordend a} msg] $msg @@ -1620,6 +1704,22 @@ test string-24.11 {string reverse command - corner case} { set y \udead string reverse $x$y } \udead\ubeef +test string-24.12 {string reverse command - corner case} { + set x \ubeef + set y \udead + string is ascii [string reverse $x$y] +} 0 +test string-24.13 {string reverse command - pure Unicode string} { + string reverse [string range \ubeef\udead\ubeef\udead\ubeef\udead 1 5] +} \udead\ubeef\udead\ubeef\udead +test string-24.14 {string reverse command - pure bytearray} { + binary scan [string reverse [binary format H* 010203]] H* x + set x +} 030201 +test string-24.15 {string reverse command - pure bytearray} { + binary scan [tcl::string::reverse [binary format H* 010203]] H* x + set x +} 030201 test string-25.1 {string is list} { string is list {a b c} @@ -1676,6 +1776,9 @@ test string-26.1 {tcl::prefix, too few args} -body { test string-26.2 {tcl::prefix, bad args} -body { tcl::prefix match a b c } -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message} +test string-26.2.1 {tcl::prefix, empty table} -body { + tcl::prefix match {} foo +} -returnCodes 1 -result {bad option "foo": no valid options} test string-26.3 {tcl::prefix, bad args} -body { tcl::prefix match -error "{}x" -exact str1 str2 } -returnCodes 1 -result {list element in braces followed by "x" instead of space} @@ -1684,10 +1787,10 @@ test string-26.3.1 {tcl::prefix, bad args} -body { } -returnCodes 1 -result {error options must have an even number of elements} test string-26.3.2 {tcl::prefix, bad args} -body { tcl::prefix match -error str1 str2 -} -returnCodes 1 -result {missing error options} +} -returnCodes 1 -result {missing value for -error} test string-26.4 {tcl::prefix, bad args} -body { tcl::prefix match -message str1 str2 -} -returnCodes 1 -result {missing message} +} -returnCodes 1 -result {missing value for -message} test string-26.5 {tcl::prefix} { tcl::prefix match {apa bepa cepa depa} cepa } cepa |