diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/string.test | 37 | ||||
| -rw-r--r-- | tests/stringComp.test | 48 |
2 files changed, 82 insertions, 3 deletions
diff --git a/tests/string.test b/tests/string.test index bffb623..ae84010 100644 --- a/tests/string.test +++ b/tests/string.test @@ -12,7 +12,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.35 2002/11/19 02:34:50 hobbs Exp $ +# RCS: @(#) $Id: string.test,v 1.36 2003/02/18 02:25:45 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -895,7 +895,40 @@ test string-11.51 {string match; *, -nocase and UTF-8} { string match -nocase [binary format I 717316707] \ [binary format I 2028036707] } 1 - +test string-11.52 {string match, null char in string} { + set out "" + set ptn "*abc*" + foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] { + lappend out [string match $ptn $elem] + } + set out +} {1 1 1 1} +test string-11.53 {string match, null char in pattern} { + set out "" + foreach {ptn elem} [list \ + "*\u0000abc\u0000" "\u0000abc\u0000" \ + "*\u0000abc\u0000" "\u0000abc\u0000ef" \ + "*\u0000abc\u0000*" "\u0000abc\u0000ef" \ + "*\u0000abc\u0000" "@\u0000abc\u0000ef" \ + "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \ + ] { + lappend out [string match $ptn $elem] + } + set out +} {1 0 1 0 1} +test string-11.54 {string match, failure} { + set longString "" + for {set i 0} {$i < 10} {incr i} { + append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123" + } + string first $longString 123 + list [string match *cba* $longString] \ + [string match *a*l*\u0000* $longString] \ + [string match *a*l*\u0000*123 $longString] \ + [string match *a*l*\u0000*123* $longString] \ + [string match *a*l*\u0000*cba* $longString] \ + [string match *===* $longString] +} {0 1 1 1 0 0} test string-12.1 {string range} { list [catch {string range} msg] $msg diff --git a/tests/stringComp.test b/tests/stringComp.test index 20779e4..14b0107 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringComp.test,v 1.5 2002/05/29 09:09:00 hobbs Exp $ +# RCS: @(#) $Id: stringComp.test,v 1.6 2003/02/18 02:25:45 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -643,6 +643,52 @@ test string-11.50 {string match, *special case} { proc foo {} {string match "\\" "\\"} foo } 0 +test string-11.51 {string match; *, -nocase and UTF-8} { + proc foo {} {string match -nocase [binary format I 717316707] \ + [binary format I 2028036707]} + foo +} 1 +test string-11.52 {string match, null char in string} { + proc foo {} { + set ptn "*abc*" + foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] { + lappend out [string match $ptn $elem] + } + set out + } + foo +} {1 1 1 1} +test string-11.53 {string match, null char in pattern} { + proc foo {} { + set out "" + foreach {ptn elem} [list \ + "*\u0000abc\u0000" "\u0000abc\u0000" \ + "*\u0000abc\u0000" "\u0000abc\u0000ef" \ + "*\u0000abc\u0000*" "\u0000abc\u0000ef" \ + "*\u0000abc\u0000" "@\u0000abc\u0000ef" \ + "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \ + ] { + lappend out [string match $ptn $elem] + } + set out + } + foo +} {1 0 1 0 1} +test string-11.54 {string match, failure} { + proc foo {} { + set longString "" + for {set i 0} {$i < 10} {incr i} { + append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123" + } + list [string match *cba* $longString] \ + [string match *a*l*\u0000* $longString] \ + [string match *a*l*\u0000*123 $longString] \ + [string match *a*l*\u0000*123* $longString] \ + [string match *a*l*\u0000*cba* $longString] \ + [string match *===* $longString] + } + foo +} {0 1 1 1 0 0} ## string range ## not yet bc |