diff options
author | hobbs <hobbs> | 2000-05-26 08:50:34 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2000-05-26 08:50:34 (GMT) |
commit | bce186e5e3868fcc8c95aa589ff668f6fb767758 (patch) | |
tree | cc0e8e165a9746508d977aa0c8c5d9bb71a4f55b | |
parent | de3734d2d5031072fc62227f3958364b3479ab7b (diff) | |
download | tcl-bce186e5e3868fcc8c95aa589ff668f6fb767758.zip tcl-bce186e5e3868fcc8c95aa589ff668f6fb767758.tar.gz tcl-bce186e5e3868fcc8c95aa589ff668f6fb767758.tar.bz2 |
* tests/string.test: added string map tests for the one-pair case,
corrected tests to reflect improved error messages in first/last.
Added tests against mem overrun in string index bytearray case.
-rw-r--r-- | tests/binary.test | 15 | ||||
-rw-r--r-- | tests/string.test | 38 |
2 files changed, 23 insertions, 30 deletions
diff --git a/tests/binary.test b/tests/binary.test index 07790a2..6e8b64a 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: binary.test,v 1.7 2000/04/10 17:18:57 ericm Exp $ +# RCS: @(#) $Id: binary.test,v 1.8 2000/05/26 08:50:34 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -42,7 +42,6 @@ test binary-1.4 {Tcl_BinaryObjCmd: format} { } {} - test binary-2.1 {Tcl_BinaryObjCmd: format} { list [catch {binary format a } msg] $msg } {1 {not enough arguments for all format specifiers}} @@ -1464,15 +1463,3 @@ test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/string.test b/tests/string.test index 0a7e1c1..363868e 100644 --- a/tests/string.test +++ b/tests/string.test @@ -11,7 +11,7 @@ # 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.24 2000/05/08 22:04:16 hobbs Exp $ +# RCS: @(#) $Id: string.test,v 1.25 2000/05/26 08:50:35 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -155,13 +155,13 @@ test string-3.8 {string equal with length, unequal strings} { test string-4.1 {string first, too few args} { list [catch {string first a} msg] $msg -} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}} +} {1 {wrong # args: should be "string first subString string ?startIndex?"}} test string-4.2 {string first, bad args} { list [catch {string first a b c} msg] $msg } {1 {bad index "c": must be integer or end?-integer?}} test string-4.3 {string first, too many args} { list [catch {string first a b 5 d} msg] $msg -} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}} +} {1 {wrong # args: should be "string first subString string ?startIndex?"}} test string-4.4 {string first} { string first bq abcdefgbcefgbqrs } 12 @@ -192,9 +192,6 @@ test string-4.12 {string first, start index} { test string-4.13 {string first, start index} { string first \u7266 abc\u7266x end-2 } 3 -test string-4.14 {string first, start index} { - string first a abcabc end-4 -} 3 test string-5.1 {string index} { list [catch {string index} msg] $msg @@ -255,6 +252,12 @@ test string-5.17 {string index, bad integer} { test string-5.18 {string index, bad integer} { list [catch {string index "abc" end-00289} msg] $msg } {1 {expected integer but got "-00289" (looks like invalid octal number)}} +test string-5.19 {string index, bytearray object out of bounds} { + string index [binary format I* {0x50515253 0x52}] -1 +} {} +test string-5.20 {string index, bytearray object out of bounds} { + string index [binary format I* {0x50515253 0x52}] 20 +} {} proc largest_int {} { @@ -554,13 +557,13 @@ catch {rename largest_int {}} test string-7.1 {string last, too few args} { list [catch {string last a} msg] $msg -} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}} +} {1 {wrong # args: should be "string last subString string ?startIndex?"}} test string-7.2 {string last, bad args} { list [catch {string last a b c} msg] $msg } {1 {bad index "c": must be integer or end?-integer?}} test string-7.3 {string last, too many args} { list [catch {string last a b c d} msg] $msg -} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}} +} {1 {wrong # args: should be "string last subString string ?startIndex?"}} test string-7.4 {string last} { string la xxx xxxx123xx345x678 } 1 @@ -680,6 +683,15 @@ test string-10.13 {string map, -nocase unicode} { test string-10.14 {string map, -nocase null arguments} { string map -nocase {{} abc} foo } foo +test string-10.15 {string map, one pair case} { + string map -nocase {abc 32} aAbCaBaAbAbcAb +} {a32aBaAb32Ab} +test string-10.16 {string map, one pair case} { + string map -nocase {ab 4321} aAbCaBaAbAbcAb +} {a4321C4321a43214321c4321} +test string-10.17 {string map, one pair case} { + string map {Ab 4321} aAbCaBaAbAbcAb +} {a4321CaBa43214321c4321} test string-11.1 {string match, too few args} { list [catch {string match a} msg] $msg @@ -890,8 +902,8 @@ test string-12.19 {string range, bytearray object} { set b [binary format I* {0x50515253 0x52}] set r1 [string range $b 1 end-1] set r2 [string range $b 1 6] - string compare $r1 $r2 -} 0 + string equal $r1 $r2 +} 1 test string-12.20 {string range, out of bounds indices} { string range \u00ff 0 1 } \u00ff @@ -1196,9 +1208,3 @@ test string-22.13 {string wordstart, unicode} { # cleanup ::tcltest::cleanupTests return - - - - - - |