* tests/stringComp.test: improved string test coverage

	* generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP
	and INST_STR_EQ/INST_STR_NEQ paths.  Speeds up eq/ne/[string eq]
	with obj-aware comparisons and eq/==/ne/!= with length equality
	check.

1 files changed, 153 insertions, 167 deletions

diff --git a/tests/stringComp.test b/tests/stringComp.test
index 2f187be..6ef94ee 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.17 2009/06/24 15:17:41 dgp Exp $
+# RCS: @(#) $Id: stringComp.test,v 1.18 2010/09/25 02:25:54 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -44,180 +44,166 @@ test stringComp-1.3 {error condition - undefined method during compile} {
     foo abc 0
 } a
 
-test stringComp-2.1 {string compare, too few args} {
-    proc foo {} {string compare a}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test stringComp-2.2 {string compare, bad args} {
-    proc foo {} {string compare a b c}
-    list [catch {foo} msg] $msg
-} {1 {bad option "a": must be -nocase or -length}}
-test stringComp-2.3 {string compare, bad args} {
-    list [catch {string compare -length -nocase str1 str2} msg] $msg
-} {1 {expected integer but got "-nocase"}}
-test stringComp-2.4 {string compare, too many args} {
-    list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
-} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test stringComp-2.5 {string compare with length unspecified} {
-    list [catch {string compare -length 10 10} msg] $msg
-} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test stringComp-2.6 {string compare} {
-    proc foo {} {string compare abcde abdef}
-    foo
-} -1
-test stringComp-2.7 {string compare, shortest method name} {
-    proc foo {} {string c abcde ABCDE}
-    foo
-} 1
-test stringComp-2.8 {string compare} {
-    proc foo {} {string compare abcde abcde}
-    foo
-} 0
-test stringComp-2.9 {string compare with length} {
-    proc foo {} {string compare -length 2 abcde abxyz}
-    foo
-} 0
-test stringComp-2.10 {string compare with special index} {
-    proc foo {} {string compare -length end-3 abcde abxyz}
-    list [catch {foo} msg] $msg
-} {1 {expected integer but got "end-3"}}
-test stringComp-2.11 {string compare, unicode} {
-    proc foo {} {string compare ab\u7266 ab\u7267}
-    foo
-} -1
-test stringComp-2.12 {string compare, high bit} {
-    # This test will fail if the underlying comparaison
-    # is using signed chars instead of unsigned chars.
-    # (like SunOS's default memcmp thus the compat/memcmp.c)
-    proc foo {} {string compare "\x80" "@"}
-    foo
-    # Nb this tests works also in utf8 space because \x80 is
-    # translated into a 2 or more bytelength but whose first byte has
-    # the high bit set.
-} 1
-test stringComp-2.13 {string compare -nocase} {
-    proc foo {} {string compare -nocase abcde abdef}
-    foo
-} -1
-test stringComp-2.14 {string compare -nocase} {
-    proc foo {} {string c -nocase abcde ABCDE}
-    foo
-} 0
-test stringComp-2.15 {string compare -nocase} {
-    proc foo {} {string compare -nocase abcde abcde}
-    foo
-} 0
-test stringComp-2.16 {string compare -nocase with length} {
-    proc foo {} {string compare -length 2 -nocase abcde Abxyz}
-    foo
-} 0
-test stringComp-2.17 {string compare -nocase with length} {
-    proc foo {} {string compare -nocase -length 3 abcde Abxyz}
-    foo
-} -1
-test stringComp-2.18 {string compare -nocase with length <= 0} {
-    proc foo {} {string compare -nocase -length -1 abcde AbCdEf}
-    foo
-} -1
-test stringComp-2.19 {string compare -nocase with excessive length} {
-    proc foo {} {string compare -nocase -length 50 AbCdEf abcde}
-    foo
-} 1
-test stringComp-2.20 {string compare -len unicode} {
-    # These are strings that are 6 BYTELENGTH long, but the length
-    # shouldn't make a different because there are actually 3 CHARS long
-    proc foo {} {string compare -len 5 \334\334\334 \334\334\374}
-    foo
-} -1
-test stringComp-2.21 {string compare -nocase with special index} {
-    proc foo {} {string compare -nocase -length end-3 Abcde abxyz}
-    list [catch {foo} msg] $msg
-} {1 {expected integer but got "end-3"}}
-test stringComp-2.22 {string compare, null strings} {
-    proc foo {} {string compare "" ""}
-    foo
-} 0
-test stringComp-2.23 {string compare, null strings} {
-    proc foo {} {string compare "" foo}
-    foo
-} -1
-test stringComp-2.24 {string compare, null strings} {
-    proc foo {} {string compare foo ""}
-    foo
-} 1
-test stringComp-2.25 {string compare -nocase, null strings} {
-    proc foo {} {string compare -nocase "" ""}
-    foo
-} 0
-test stringComp-2.26 {string compare -nocase, null strings} {
-    proc foo {} {string compare -nocase "" foo}
-    foo
-} -1
-test stringComp-2.27 {string compare -nocase, null strings} {
-    proc foo {} {string compare -nocase foo ""}
-    foo
-} 1
-test stringComp-2.28 {string compare with length, unequal strings} {
-    proc foo {} {string compare -length 2 abc abde}
-    foo
-} 0
-test stringComp-2.29 {string compare with length, unequal strings} {
-    proc foo {} {string compare -length 2 ab abde}
-    foo
-} 0
-test stringComp-2.30 {string compare with NUL character vs. other ASCII} {
-    # Be careful here, since UTF-8 rep comparison with memcmp() of
-    # these puts chars in the wrong order
-    proc foo {} {string compare \x00 \x01}
-    foo
-} -1
-test stringComp-2.31 {string compare, high bit} {
-    proc foo {} {string compare "a\x80" "a@"}
-    foo
-} 1
-test stringComp-2.32 {string compare, high bit} {
-    proc foo {} {string compare "a\x00" "a\x01"}
-    foo
-} -1
-test stringComp-2.33 {string compare, high bit} {
-    proc foo {} {string compare "\x00\x00" "\x00\x01"}
-    foo
-} -1
+## Test string compare|equal over equal constraints
+## Use result for string compare, and negate it for string equal
+## The body will be tested both in and outside a proc
+set i 0
+foreach {tname tbody tresult tcode} {
+    {too few args} {
+	string compare a
+    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
+    {bad args} {
+	string compare a b c
+    } {bad option "a": must be -nocase or -length} {error}
+    {bad args} {
+	string compare -length -nocase str1 str2
+    } {expected integer but got "-nocase"} {error}
+    {too many args} {
+	string compare -length 10 -nocase str1 str2 str3
+    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
+    {compare with length unspecified} {
+	string compare -length 10 10
+    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
+    {basic operation fail} {
+	string compare abcde abdef
+    } {-1} {}
+    {basic operation success} {
+	string compare abcde abcde
+    } {0} {}
+    {with length} {
+	string compare -length 2 abcde abxyz
+    } {0} {}
+    {with special index} {
+	string compare -length end-3 abcde abxyz
+    } {expected integer but got "end-3"} {error}
+    {unicode} {
+	string compare ab\u7266 ab\u7267
+    } {-1} {}
+    {unicode} {string compare \334 \u00dc} 0 {}
+    {unicode} {string compare \334 \u00fc} -1 {}
+    {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
+    {high bit} {
+	# This test will fail if the underlying comparaison
+	# is using signed chars instead of unsigned chars.
+	# (like SunOS's default memcmp thus the compat/memcmp.c)
+	string compare "\x80" "@"
+	# Nb this tests works also in utf8 space because \x80 is
+	# translated into a 2 or more bytelength but whose first byte has
+	# the high bit set.
+    } {1} {}
+    {-nocase 1} {string compare -nocase abcde abdef} {-1} {}
+    {-nocase 2} {string compare -nocase abcde Abdef} {-1} {}
+    {-nocase 3} {string compare -nocase abcde ABCDE} {0} {}
+    {-nocase 4} {string compare -nocase abcde abcde} {0} {}
+    {-nocase unicode} {
+	string compare -nocase \334 \u00dc
+    } 0 {}
+    {-nocase unicode} {
+	string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334
+    } 0 {}
+    {-nocase with length} {
+	string compare -length 2 -nocase abcde Abxyz
+    } {0} {}
+    {-nocase with length} {
+	string compare -nocase -length 3 abcde Abxyz
+    } {-1} {}
+    {-nocase with length <= 0} {
+	string compare -nocase -length -1 abcde AbCdEf
+    } {-1} {}
+    {-nocase with excessive length} {
+	string compare -nocase -length 50 AbCdEf abcde
+    } {1} {}
+    {-len unicode} {
+	# These are strings that are 6 BYTELENGTH long, but the length
+	# shouldn't make a different because there are actually 3 CHARS long
+	string compare -len 5 \334\334\334 \334\334\374
+    } -1 {}
+    {-nocase with special index} {
+	string compare -nocase -length end-3 Abcde abxyz
+    } {expected integer but got "end-3"} error
+    {null strings} {
+	string compare "" ""
+    } 0 {}
+    {null strings} {
+	string compare "" foo
+    } -1 {}
+    {null strings} {
+	string compare foo ""
+    } 1 {}
+    {-nocase null strings} {
+	string compare -nocase "" ""
+    } 0 {}
+    {-nocase null strings} {
+	string compare -nocase "" foo
+    } -1 {}
+    {-nocase null strings} {
+	string compare -nocase foo ""
+    } 1 {}
+    {with length, unequal strings} {
+	string compare -length 2 abc abde
+    } 0 {}
+    {with length, unequal strings} {
+	string compare -length 2 ab abde
+    } 0 {}
+    {with NUL character vs. other ASCII} {
+	# Be careful here, since UTF-8 rep comparison with memcmp() of
+	# these puts chars in the wrong order
+	string compare \x00 \x01
+    } -1 {}
+    {high bit} {
+	string compare "a\x80" "a@"
+    } 1 {}
+    {high bit} {
+	string compare "a\x00" "a\x01"
+    } -1 {}
+    {high bit} {
+	string compare "\x00\x00" "\x00\x01"
+    } -1 {}
+    {binary equal} {
+	string compare [binary format a100 0] [binary format a100 0]
+    } 0 {}
+    {binary neq} {
+	string compare [binary format a100a 0 1] [binary format a100a 0 0]
+    } 1 {}
+    {binary neq inequal length} {
+	string compare [binary format a20a 0 1] [binary format a100a 0 0]
+    } 1 {}
+} {
+    if {$tname eq ""} { continue }
+    if {$tcode eq ""} { set tcode ok }
+    test stringComp-2.[incr i] "string compare, $tname" \
+	-body [list eval $tbody] \
+	-returnCodes $tcode -result $tresult
+    test stringComp-2.[incr i] "string compare bc, $tname" \
+	-body "[list proc foo {} $tbody];foo" \
+	-returnCodes $tcode -result $tresult
+    if {"error" ni $tcode} {
+	set tresult [expr {!$tresult}]
+    } else {
+	set tresult [string map {compare equal} $tresult]
+    }
+    set tbody [string map {compare equal} $tbody]
+    test stringComp-2.[incr i] "string equal, $tname" \
+	-body [list eval $tbody] \
+	-returnCodes $tcode -result $tresult
+    test stringComp-2.[incr i] "string equal bc, $tname" \
+	-body "[list proc foo {} $tbody];foo" \
+	-returnCodes $tcode -result $tresult
+}
 
-# only need a few tests on equal, since it uses the same code as
-# string compare, but just modifies the return output
-test stringComp-3.1 {string equal} {
-    proc foo {} {string equal abcde abdef}
-    foo
-} 0
-test stringComp-3.2 {string equal} {
-    proc foo {} {string eq abcde ABCDE}
-    foo
-} 0
-test stringComp-3.3 {string equal} {
-    proc foo {} {string equal abcde abcde}
-    foo
-} 1
-test stringComp-3.4 {string equal -nocase} {
-    proc foo {} {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
+# need a few extra tests short abbr cmd
+test stringComp-3.1 {string compare, shortest method name} {
+    proc foo {} {string c abcde ABCDE}
     foo
 } 1
-test stringComp-3.5 {string equal -nocase} {
-    proc foo {} {string equal -nocase abcde abdef}
+test stringComp-3.2 {string equal, shortest method name} {
+    proc foo {} {string e abcde ABCDE}
     foo
 } 0
-test stringComp-3.6 {string equal -nocase} {
+test stringComp-3.3 {string equal -nocase} {
     proc foo {} {string eq -nocase abcde ABCDE}
     foo
 } 1
-test stringComp-3.7 {string equal -nocase} {
-    proc foo {} {string equal -nocase abcde abcde}
-    foo
-} 1
-test stringComp-3.8 {string equal with length, unequal strings} {
-    proc foo {} {string equal -length 2 abc abde}
-    foo
-} 1
 
 test stringComp-4.1 {string first, too few args} {
     proc foo {} {string first a}