diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/get.test | 13 | ||||
| -rw-r--r-- | tests/http.test | 2 | ||||
| -rw-r--r-- | tests/interp.test | 20 | ||||
| -rw-r--r-- | tests/string.test | 65 | ||||
| -rw-r--r-- | tests/stringObj.test | 10 |
5 files changed, 57 insertions, 53 deletions
diff --git a/tests/get.test b/tests/get.test index 936bdda..eb26484 100644 --- a/tests/get.test +++ b/tests/get.test @@ -20,7 +20,6 @@ catch [list package require -exact tcl::test [info patchlevel]] testConstraint testgetint [llength [info commands testgetint]] testConstraint testdoubleobj [llength [info commands testdoubleobj]] -testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] test get-1.1 {Tcl_GetInt procedure} testgetint { @@ -41,7 +40,7 @@ test get-1.5 {Tcl_GetInt procedure} testgetint { test get-1.6 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 {16 x}} msg] $msg } {1 {expected integer but got "16 x"}} -test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} { +test get-1.7 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} { @@ -50,19 +49,19 @@ test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} { test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} { testgetint +18446744073709551614 } {-2} -test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} { +test get-1.10 {Tcl_GetInt procedure} testgetint { list [catch {testgetint -18446744073709551614} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} -test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} { +test get-1.11 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 44 4294967296} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} -test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} { +test get-1.12 {Tcl_GetInt procedure} testgetint { list [catch {testgetint 4294967294} msg] $msg } {0 -2} -test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} { +test get-1.13 {Tcl_GetInt procedure} testgetint { list [catch {testgetint +4294967294} msg] $msg } {0 -2} -test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} { +test get-1.14 {Tcl_GetInt procedure} testgetint { list [catch {testgetint -4294967294} msg] $msg } {1 {integer value too large to represent}} diff --git a/tests/http.test b/tests/http.test index aeb1029..221985f 100644 --- a/tests/http.test +++ b/tests/http.test @@ -686,7 +686,7 @@ test http-7.4 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -body { # this would be reverting to http <=2.4 behavior w/o errors - # with Tcl 8.x (unknown chars become '?'), generating a + # with Tcl 8.x (unknown chars become '?'), generating a # proper exception with Tcl 9.0 http::config -urlencoding "iso8859-1" http::mapReply "∈" diff --git a/tests/interp.test b/tests/interp.test index 385d3e2..532f1e5 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -2414,21 +2414,21 @@ test interp-29.1.4 {interp recursionlimit argument checking} { interp delete moo list $result $msg } {1 {expected integer but got "bar"}} -test interp-29.1.5 {interp recursionlimit argument checking} { +test interp-29.1.5 {interp recursionlimit argument checking} -body { interp create moo set result [catch {interp recursionlimit moo 0} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} -test interp-29.1.6 {interp recursionlimit argument checking} { +} -match glob -result {1 {recursion limit must be > 0 and < *}} +test interp-29.1.6 {interp recursionlimit argument checking} -body { interp create moo set result [catch {interp recursionlimit moo -1} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} +} -match glob -result {1 {recursion limit must be > 0 and < *}} test interp-29.1.7 {interp recursionlimit argument checking} { interp create moo - set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg] + set result [catch {interp recursionlimit moo [expr {wide(1)<<64}]} msg] interp delete moo list $result [string range $msg 0 35] } {1 {integer value too large to represent}} @@ -2444,21 +2444,21 @@ test interp-29.1.9 {child recursionlimit argument checking} { interp delete moo list $result $msg } {1 {expected integer but got "foo"}} -test interp-29.1.10 {child recursionlimit argument checking} { +test interp-29.1.10 {child recursionlimit argument checking} -body { interp create moo set result [catch {moo recursionlimit 0} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} -test interp-29.1.11 {child recursionlimit argument checking} { +} -match glob -result {1 {recursion limit must be > 0 and < *}} +test interp-29.1.11 {child recursionlimit argument checking} -body { interp create moo set result [catch {moo recursionlimit -1} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} +} -match glob -result {1 {recursion limit must be > 0 and < *}} test interp-29.1.12 {child recursionlimit argument checking} { interp create moo - set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg] + set result [catch {moo recursionlimit [expr {wide(1)<<64}]} msg] interp delete moo list $result [string range $msg 0 35] } {1 {integer value too large to represent}} diff --git a/tests/string.test b/tests/string.test index b6b6843..8769556 100644 --- a/tests/string.test +++ b/tests/string.test @@ -32,7 +32,7 @@ proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s} testConstraint testobj [expr {[info commands testobj] ne {}}] testConstraint testindexobj [expr {[info commands testindexobj] ne {}}] testConstraint testevalex [expr {[info commands testevalex] ne {}}] -testConstraint fullutf [expr {[string length \U010000] == 1}] +testConstraint utf32 [expr {[string length \U010000] == 1}] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint utf32 [expr {[testConstraint fullutf] && [string length [format %c 0x10000]] == 1}] @@ -368,7 +368,6 @@ test string-3.42.$noComp {string equal, binary neq inequal length} { run {string equal [binary format a20a 0 1] [binary format a100a 0 0]} } 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?"}} @@ -427,22 +426,22 @@ test string-4.16.$noComp {string first, normal string vs pure unicode string} -b } -result {{string 1} {string 0} 2} test string-4.17.$noComp {string first, corner case} -body { run {string first a aaa 4294967295} -} -result {-1} +} -result -1 test string-4.18.$noComp {string first, corner case} -body { run {string first a aaa -1} -} -result {0} +} -result 0 test string-4.19.$noComp {string first, corner case} -body { run {string first a aaa end-5} -} -result {0} +} -result 0 test string-4.20.$noComp {string last, corner case} -body { run {string last a aaa 4294967295} -} -result {2} +} -result 2 test string-4.21.$noComp {string last, corner case} -body { run {string last a aaa -1} -} -result {-1} +} -result -1 test string-4.22.$noComp {string last, corner case} { run {string last a aaa end-5} -} {-1} +} -1 test string-5.1.$noComp {string index} { list [catch {run {string index}} msg] $msg @@ -503,13 +502,13 @@ test string-5.17.$noComp {string index, bad integer} -body { test string-5.18.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" end-0o0289}} msg] $msg } -match glob -result {1 {*}} -test string-5.19.$noComp {string index, bytearray object out of bounds} -body { +test string-5.19.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] -1} -} -result {} +} {} test string-5.20.$noComp {string index, bytearray object out of bounds} -body { run {string index [binary format I* {0x50515253 0x52}] 20} } -result {} -test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints fullutf -body { +test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf32 -body { run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]} } -result [list \U100000 b {}] test string-5.22.$noComp {string index} -constraints testbytestring -body { @@ -988,6 +987,12 @@ test string-6.137.$noComp {string is unicode, noncharacter} { test string-6.138.$noComp {string is unicode, noncharacter} { run {string is unicode \uFDEF} } 0 +test string-6.139.$noComp {string is integer, bug [76ad7aeba3]} { + run {string is integer 18446744073709551615} +} 1 +test string-6.140.$noComp {string is integer, bug [76ad7aeba3]} { + run {string is integer -18446744073709551615} +} 1 test string-7.1.$noComp {string last, not enough args} { @@ -1074,13 +1079,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*} @@ -1095,7 +1100,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 ü ue UE Ü] "aüueUE\x00EU"} } aueueÜ\x00EU @@ -1107,13 +1112,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 @@ -1507,7 +1512,7 @@ test string-12.22.$noComp {string range, shimmering binary/index} { binary scan $s a* x run {string range $s $s end} } 000000001 -test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} fullutf { +test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf32 { run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]} } [list \U100000 b {}] test string-12.24.$noComp {bignum index arithmetic} -setup { @@ -1585,22 +1590,22 @@ test string-14.5.$noComp {string replace} { } {abp} test string-14.6.$noComp {string replace} -body { run {string replace abcdefghijklmnop 7 1000} -} -result {abcdefg} +} -result abcdefg test string-14.7.$noComp {string replace} { run {string replace abcdefghijklmnop 10 end} -} {abcdefghij} +} abcdefghij test string-14.8.$noComp {string replace} { run {string replace abcdefghijklmnop 10 9} -} {abcdefghijklmnop} +} abcdefghijklmnop test string-14.9.$noComp {string replace} { run {string replace abcdefghijklmnop -3 2} -} {defghijklmnop} +} defghijklmnop test string-14.10.$noComp {string replace} { run {string replace abcdefghijklmnop -3 -2} -} {abcdefghijklmnop} +} abcdefghijklmnop test string-14.11.$noComp {string replace} -body { run {string replace abcdefghijklmnop 1000 1010} -} -result {abcdefghijklmnop} +} -result abcdefghijklmnop test string-14.12.$noComp {string replace} { run {string replace abcdefghijklmnop -100 end} } {} @@ -1777,7 +1782,7 @@ test string-17.7.$noComp {string totitle, unicode} { test string-17.8.$noComp {string totitle, compiled} { lindex [run {string totitle [list aa bb [list cc]]}] 0 } Aa -test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} fullutf { +test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} utf32 { run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \ [string totitle a\U118c0c 3 3]} } [list a\U118a0c a\U118c0C a\U118c0c] @@ -1847,7 +1852,7 @@ test string-20.5.$noComp {string trimright} { test string-20.6.$noComp {string trimright, unicode default} { run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 -test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} {testbytestring} { +test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} testbytestring { set result {} set a [testbytestring \xC0\x80\xA0] set b foo$a @@ -1860,7 +1865,7 @@ test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS lappend result [string map $m [run {string trim $b fox}]] lappend result [string map $m [run {string trim $b fo\x00}]] } [list {*}[lrepeat 3 fooUV] {*}[lrepeat 2 UV V]] -test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} {testbytestring} { +test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} testbytestring { set result {} set a [testbytestring \xE8\xA0] set b foo$a @@ -1921,7 +1926,7 @@ test string-21.14.$noComp {string wordend, unicode} -body { test string-21.15.$noComp {string wordend, unicode} -body { run {string wordend "\U1D7CA\U1D7CA abc" 0} } -result 2 -test string-21.16.$noComp {string wordend, unicode} -constraints fullutf -body { +test string-21.16.$noComp {string wordend, unicode} -constraints utf32 -body { run {string wordend "\U1D7CA\U1D7CA abc" 10} } -result 6 test string-21.17.$noComp {string trim, unicode} { @@ -1999,7 +2004,7 @@ test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbyt test string-22.15.$noComp {string wordstart, unicode} -body { run {string wordstart "\U1D7CA\U1D7CA abc" 0} } -result 0 -test string-22.16.$noComp {string wordstart, unicode} -constraints fullutf -body { +test string-22.16.$noComp {string wordstart, unicode} -constraints utf32 -body { run {string wordstart "\U1D7CA\U1D7CA abc" 10} } -result 3 diff --git a/tests/stringObj.test b/tests/stringObj.test index 18c89bb..e5820fc 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -23,7 +23,7 @@ catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] -testConstraint fullutf [expr {[string length \U010000] == 1}] +testConstraint utf32 [expr {[string length \U010000] == 1}] test stringObj-1.1 {string type registration} testobj { set t [testobj types] @@ -454,19 +454,19 @@ test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo -test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj fullutf} { +test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo -test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj fullutf} { +test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo -test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj fullutf} { +test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo -test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj fullutf} { +test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo |