diff options
author | hobbs <hobbs@noemail.net> | 2003-02-18 02:25:40 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 2003-02-18 02:25:40 (GMT) |
commit | 019870bda1013613bd37b08acc3deb37fdea6756 (patch) | |
tree | 4897dca0fb72c73e8c8bee4e5d6b292195b07662 /tests/string.test | |
parent | ce4a32e90df2cc8122e34e0fa53a3f8a549703c5 (diff) | |
download | tcl-019870bda1013613bd37b08acc3deb37fdea6756.zip tcl-019870bda1013613bd37b08acc3deb37fdea6756.tar.gz tcl-019870bda1013613bd37b08acc3deb37fdea6756.tar.bz2 |
* generic/tclExecute.c (TclExecuteByteCode INST_STR_MATCH):
* generic/tclCmdMZ.c (Tcl_StringObjCmd STR_MATCH):
* generic/tclUtf.c (TclUniCharMatch):
* generic/tclInt.decls: add private TclUniCharMatch function that
* generic/tclIntDecls.h: does string match on counted unicode
* generic/tclStubInit.c: strings. Tcl_UniCharCaseMatch has the
* tests/string.test: failing that it can't handle strings or
* tests/stringComp.test: patterns with embedded NULLs. Added
tests that actually try strings/pats with NULLs. TclUniCharMatch
should be TIPed and made public in the next minor version rev.
FossilOrigin-Name: 28dcdcf39e0981d8917cd869b26dbdb4c0aa8ff6
Diffstat (limited to 'tests/string.test')
-rw-r--r-- | tests/string.test | 37 |
1 files changed, 35 insertions, 2 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 |