From bce186e5e3868fcc8c95aa589ff668f6fb767758 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Fri, 26 May 2000 08:50:34 +0000
Subject: 	* 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.

---
 tests/binary.test | 15 +--------------
 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
-
-
-
-
-
-
-- 
cgit v0.12