diff options
Diffstat (limited to 'tests/stringComp.test')
| -rw-r--r-- | tests/stringComp.test | 342 |
1 files changed, 172 insertions, 170 deletions
diff --git a/tests/stringComp.test b/tests/stringComp.test index 210f431..2ce2010 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -20,13 +20,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { 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] != {}}] - + test stringComp-1.1 {error conditions} { proc foo {} {string gorp a b} list [catch {foo} msg] $msg @@ -34,7 +31,7 @@ test stringComp-1.1 {error conditions} { test stringComp-1.2 {error conditions} { proc foo {} {string} list [catch {foo} msg] $msg -} {1 {wrong # args: should be "string subcommand ?arg ...?"}} +} {1 {wrong # args: should be "string subcommand ?argument ...?"}} test stringComp-1.3 {error condition - undefined method during compile} { # We don't want this to complain about 'never' because it may never # be called, or string may get redefined. This must compile OK. @@ -45,166 +42,180 @@ test stringComp-1.3 {error condition - undefined method during compile} { foo abc 0 } a -## Test string compare|equal over equal constraints -## Use result for string compare, and negate it for string equal -## The body will be tested both in and outside a proc -set i 0 -foreach {tname tbody tresult tcode} { - {too few args} { - string compare a - } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error} - {bad args} { - string compare a b c - } {bad option "a": must be -nocase or -length} {error} - {bad args} { - string compare -length -nocase str1 str2 - } {expected integer but got "-nocase"} {error} - {too many args} { - string compare -length 10 -nocase str1 str2 str3 - } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error} - {compare with length unspecified} { - string compare -length 10 10 - } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error} - {basic operation fail} { - string compare abcde abdef - } {-1} {} - {basic operation success} { - string compare abcde abcde - } {0} {} - {with length} { - string compare -length 2 abcde abxyz - } {0} {} - {with special index} { - string compare -length end-3 abcde abxyz - } {expected integer but got "end-3"} {error} - {unicode} { - string compare ab\u7266 ab\u7267 - } {-1} {} - {unicode} {string compare \334 \u00dc} 0 {} - {unicode} {string compare \334 \u00fc} -1 {} - {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {} - {high bit} { - # This test will fail if the underlying comparaison - # is using signed chars instead of unsigned chars. - # (like SunOS's default memcmp thus the compat/memcmp.c) - string compare "\x80" "@" - # Nb this tests works also in utf8 space because \x80 is - # translated into a 2 or more bytelength but whose first byte has - # the high bit set. - } {1} {} - {-nocase 1} {string compare -nocase abcde abdef} {-1} {} - {-nocase 2} {string compare -nocase abcde Abdef} {-1} {} - {-nocase 3} {string compare -nocase abcde ABCDE} {0} {} - {-nocase 4} {string compare -nocase abcde abcde} {0} {} - {-nocase unicode} { - string compare -nocase \334 \u00dc - } 0 {} - {-nocase unicode} { - string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334 - } 0 {} - {-nocase with length} { - string compare -length 2 -nocase abcde Abxyz - } {0} {} - {-nocase with length} { - string compare -nocase -length 3 abcde Abxyz - } {-1} {} - {-nocase with length <= 0} { - string compare -nocase -length -1 abcde AbCdEf - } {-1} {} - {-nocase with excessive length} { - string compare -nocase -length 50 AbCdEf abcde - } {1} {} - {-len unicode} { - # These are strings that are 6 BYTELENGTH long, but the length - # shouldn't make a different because there are actually 3 CHARS long - string compare -len 5 \334\334\334 \334\334\374 - } -1 {} - {-nocase with special index} { - string compare -nocase -length end-3 Abcde abxyz - } {expected integer but got "end-3"} error - {null strings} { - string compare "" "" - } 0 {} - {null strings} { - string compare "" foo - } -1 {} - {null strings} { - string compare foo "" - } 1 {} - {-nocase null strings} { - string compare -nocase "" "" - } 0 {} - {-nocase null strings} { - string compare -nocase "" foo - } -1 {} - {-nocase null strings} { - string compare -nocase foo "" - } 1 {} - {with length, unequal strings} { - string compare -length 2 abc abde - } 0 {} - {with length, unequal strings} { - string compare -length 2 ab abde - } 0 {} - {with NUL character vs. other ASCII} { - # Be careful here, since UTF-8 rep comparison with memcmp() of - # these puts chars in the wrong order - string compare \x00 \x01 - } -1 {} - {high bit} { - string compare "a\x80" "a@" - } 1 {} - {high bit} { - string compare "a\x00" "a\x01" - } -1 {} - {high bit} { - string compare "\x00\x00" "\x00\x01" - } -1 {} - {binary equal} { - string compare [binary format a100 0] [binary format a100 0] - } 0 {} - {binary neq} { - string compare [binary format a100a 0 1] [binary format a100a 0 0] - } 1 {} - {binary neq inequal length} { - string compare [binary format a20a 0 1] [binary format a100a 0 0] - } 1 {} -} { - if {$tname eq ""} { continue } - if {$tcode eq ""} { set tcode ok } - test stringComp-2.[incr i] "string compare, $tname" \ - -body [list eval $tbody] \ - -returnCodes $tcode -result $tresult - test stringComp-2.[incr i] "string compare bc, $tname" \ - -body "[list proc foo {} $tbody];foo" \ - -returnCodes $tcode -result $tresult - if {"error" ni $tcode} { - set tresult [expr {!$tresult}] - } else { - set tresult [string map {compare equal} $tresult] - } - set tbody [string map {compare equal} $tbody] - test stringComp-2.[incr i] "string equal, $tname" \ - -body [list eval $tbody] \ - -returnCodes $tcode -result $tresult - test stringComp-2.[incr i] "string equal bc, $tname" \ - -body "[list proc foo {} $tbody];foo" \ - -returnCodes $tcode -result $tresult -} - -# need a few extra tests short abbr cmd -test stringComp-3.1 {string compare, shortest method name} { +test stringComp-2.1 {string compare, too few args} { + proc foo {} {string compare a} + list [catch {foo} msg] $msg +} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} +test stringComp-2.2 {string compare, bad args} { + proc foo {} {string compare a b c} + list [catch {foo} msg] $msg +} {1 {bad option "a": must be -nocase or -length}} +test stringComp-2.3 {string compare, bad args} { + list [catch {string compare -length -nocase str1 str2} msg] $msg +} {1 {expected integer but got "-nocase"}} +test stringComp-2.4 {string compare, too many args} { + list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg +} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} +test stringComp-2.5 {string compare with length unspecified} { + list [catch {string compare -length 10 10} msg] $msg +} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} +test stringComp-2.6 {string compare} { + proc foo {} {string compare abcde abdef} + foo +} -1 +test stringComp-2.7 {string compare, shortest method name} { proc foo {} {string c abcde ABCDE} foo } 1 -test stringComp-3.2 {string equal, shortest method name} { - proc foo {} {string e abcde ABCDE} +test stringComp-2.8 {string compare} { + proc foo {} {string compare abcde abcde} + foo +} 0 +test stringComp-2.9 {string compare with length} { + proc foo {} {string compare -length 2 abcde abxyz} + foo +} 0 +test stringComp-2.10 {string compare with special index} { + proc foo {} {string compare -length end-3 abcde abxyz} + list [catch {foo} msg] $msg +} {1 {expected integer but got "end-3"}} +test stringComp-2.11 {string compare, unicode} { + proc foo {} {string compare ab\u7266 ab\u7267} + foo +} -1 +test stringComp-2.12 {string compare, high bit} { + # This test will fail if the underlying comparaison + # is using signed chars instead of unsigned chars. + # (like SunOS's default memcmp thus the compat/memcmp.c) + proc foo {} {string compare "\x80" "@"} + foo + # Nb this tests works also in utf8 space because \x80 is + # translated into a 2 or more bytelength but whose first byte has + # the high bit set. +} 1 +test stringComp-2.13 {string compare -nocase} { + proc foo {} {string compare -nocase abcde abdef} + foo +} -1 +test stringComp-2.14 {string compare -nocase} { + proc foo {} {string c -nocase abcde ABCDE} + foo +} 0 +test stringComp-2.15 {string compare -nocase} { + proc foo {} {string compare -nocase abcde abcde} + foo +} 0 +test stringComp-2.16 {string compare -nocase with length} { + proc foo {} {string compare -length 2 -nocase abcde Abxyz} + foo +} 0 +test stringComp-2.17 {string compare -nocase with length} { + proc foo {} {string compare -nocase -length 3 abcde Abxyz} + foo +} -1 +test stringComp-2.18 {string compare -nocase with length <= 0} { + proc foo {} {string compare -nocase -length -1 abcde AbCdEf} + foo +} -1 +test stringComp-2.19 {string compare -nocase with excessive length} { + proc foo {} {string compare -nocase -length 50 AbCdEf abcde} + foo +} 1 +test stringComp-2.20 {string compare -len unicode} { + # These are strings that are 6 BYTELENGTH long, but the length + # shouldn't make a different because there are actually 3 CHARS long + proc foo {} {string compare -len 5 \334\334\334 \334\334\374} + foo +} -1 +test stringComp-2.21 {string compare -nocase with special index} { + proc foo {} {string compare -nocase -length end-3 Abcde abxyz} + list [catch {foo} msg] $msg +} {1 {expected integer but got "end-3"}} +test stringComp-2.22 {string compare, null strings} { + proc foo {} {string compare "" ""} + foo +} 0 +test stringComp-2.23 {string compare, null strings} { + proc foo {} {string compare "" foo} + foo +} -1 +test stringComp-2.24 {string compare, null strings} { + proc foo {} {string compare foo ""} + foo +} 1 +test stringComp-2.25 {string compare -nocase, null strings} { + proc foo {} {string compare -nocase "" ""} + foo +} 0 +test stringComp-2.26 {string compare -nocase, null strings} { + proc foo {} {string compare -nocase "" foo} + foo +} -1 +test stringComp-2.27 {string compare -nocase, null strings} { + proc foo {} {string compare -nocase foo ""} + foo +} 1 +test stringComp-2.28 {string compare with length, unequal strings} { + proc foo {} {string compare -length 2 abc abde} + foo +} 0 +test stringComp-2.29 {string compare with length, unequal strings} { + proc foo {} {string compare -length 2 ab abde} + foo +} 0 +test stringComp-2.30 {string compare with NUL character vs. other ASCII} { + # Be careful here, since UTF-8 rep comparison with memcmp() of + # these puts chars in the wrong order + proc foo {} {string compare \x00 \x01} + foo +} -1 +test stringComp-2.31 {string compare, high bit} { + proc foo {} {string compare "a\x80" "a@"} + foo +} 1 +test stringComp-2.32 {string compare, high bit} { + proc foo {} {string compare "a\x00" "a\x01"} + foo +} -1 +test stringComp-2.33 {string compare, high bit} { + proc foo {} {string compare "\x00\x00" "\x00\x01"} + foo +} -1 + +# only need a few tests on equal, since it uses the same code as +# string compare, but just modifies the return output +test stringComp-3.1 {string equal} { + proc foo {} {string equal abcde abdef} + foo +} 0 +test stringComp-3.2 {string equal} { + proc foo {} {string eq abcde ABCDE} + foo +} 0 +test stringComp-3.3 {string equal} { + proc foo {} {string equal abcde abcde} + foo +} 1 +test stringComp-3.4 {string equal -nocase} { + proc foo {} {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334} + foo +} 1 +test stringComp-3.5 {string equal -nocase} { + proc foo {} {string equal -nocase abcde abdef} foo } 0 -test stringComp-3.3 {string equal -nocase} { +test stringComp-3.6 {string equal -nocase} { proc foo {} {string eq -nocase abcde ABCDE} foo } 1 +test stringComp-3.7 {string equal -nocase} { + proc foo {} {string equal -nocase abcde abcde} + foo +} 1 +test stringComp-3.8 {string equal with length, unequal strings} { + proc foo {} {string equal -length 2 abc abde} + foo +} 1 test stringComp-4.1 {string first, too few args} { proc foo {} {string first a} @@ -339,11 +350,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} -body { proc foo {} {string index "abc" 0o8} list [catch {foo} msg] $msg -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test stringComp-5.18 {string index, bad integer} -body { proc foo {} {string index "abc" end-0o0289} list [catch {foo} msg] $msg -} -match glob -result {1 {*}} +} -match glob -result {1 {*invalid octal number*}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo @@ -677,11 +688,7 @@ test stringComp-11.54 {string match, failure} { } {0 1 1 1 0 0} ## string range -test stringComp-12.1 {Bug 3588366: end-offsets before start} { - apply {s { - string range $s 0 end-5 - }} 12345 -} {} +## not yet bc ## string repeat ## not yet bc @@ -703,12 +710,7 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} { ## string word* ## not yet bc - + # cleanup -catch {rename foo {}} ::tcltest::cleanupTests return - -# Local Variables: -# mode: tcl -# End: |