* 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.

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