diff options
Diffstat (limited to 'tests/util.test')
| -rw-r--r-- | tests/util.test | 208 |
1 files changed, 182 insertions, 26 deletions
diff --git a/tests/util.test b/tests/util.test index ee37047..c24ada7 100644 --- a/tests/util.test +++ b/tests/util.test @@ -1,12 +1,12 @@ # This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # -# Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright (c) 1995-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: @(#) util.test 1.8 97/08/12 15:50:02 +# SCCS: @(#) util.test 1.13 98/01/16 23:30:07 if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" @@ -58,26 +58,181 @@ test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} { concat a { } c } {a c} -test util-5.1 {Tcl_SetObjErrorCode - one arg} { - catch {testsetobjerrorcode 1} - list [set errorCode] -} {1} -test util-5.2 {Tcl_SetObjErrorCode - two args} { - catch {testsetobjerrorcode 1 2} - list [set errorCode] -} {{1 2}} -test util-5.3 {Tcl_SetObjErrorCode - three args} { - catch {testsetobjerrorcode 1 2 3} - list [set errorCode] -} {{1 2 3}} -test util-5.4 {Tcl_SetObjErrorCode - four args} { - catch {testsetobjerrorcode 1 2 3 4} - list [set errorCode] -} {{1 2 3 4}} -test util-5.5 {Tcl_SetObjErrorCode - five args} { - catch {testsetobjerrorcode 1 2 3 4 5} - list [set errorCode] -} {{1 2 3 4 5}} +test util-5.1 {Tcl_StringMatch} { + string match ab*c abc +} 1 +test util-5.2 {Tcl_StringMatch} { + string match ab**c abc +} 1 +test util-5.3 {Tcl_StringMatch} { + string match ab* abcdef +} 1 +test util-5.4 {Tcl_StringMatch} { + string match *c abc +} 1 +test util-5.5 {Tcl_StringMatch} { + string match *3*6*9 0123456789 +} 1 +test util-5.6 {Tcl_StringMatch} { + string match *3*6*9 01234567890 +} 0 +test util-5.7 {Tcl_StringMatch: UTF-8} { + string match *u \u4e4fu +} 1 +test util-5.8 {Tcl_StringMatch} { + string match a?c abc +} 1 +test util-5.9 {Tcl_StringMatch: UTF-8} { + # skip one character in string + + string match a?c a\u4e4fc +} 1 +test util-5.10 {Tcl_StringMatch} { + string match a??c abc +} 0 +test util-5.11 {Tcl_StringMatch} { + string match ?1??4???8? 0123456789 +} 1 +test util-5.12 {Tcl_StringMatch} { + string match {[abc]bc} abc +} 1 +test util-5.13 {Tcl_StringMatch: UTF-8} { + # string += Tcl_UtfToUniChar(string, &ch); + + string match "\[\u4e4fxy\]bc" "\u4e4fbc" +} 1 +test util-5.14 {Tcl_StringMatch} { + # if ((*pattern == ']') || (*pattern == '\0')) + # badly formed pattern + + string match {[]} {[]} +} 0 +test util-5.15 {Tcl_StringMatch} { + # if ((*pattern == ']') || (*pattern == '\0')) + # badly formed pattern + + string match {[} {[} +} 0 +test util-5.16 {Tcl_StringMatch} { + string match {a[abc]c} abc +} 1 +test util-5.17 {Tcl_StringMatch: UTF-8} { + # pattern += Tcl_UtfToUniChar(pattern, &endChar); + # get 1 UTF-8 character + + string match "a\[a\u4e4fc]c" "a\u4e4fc" +} 1 +test util-5.18 {Tcl_StringMatch: UTF-8} { + # pattern += Tcl_UtfToUniChar(pattern, &endChar); + # proper advance: wrong answer would match on UTF trail byte of \u4e4f + + string match {a[a\u4e4fc]c} [bytestring a\u008fc] +} 0 +test util-5.19 {Tcl_StringMatch: UTF-8} { + # pattern += Tcl_UtfToUniChar(pattern, &endChar); + # proper advance. + + string match {a[a\u4e4fc]c} "acc" +} 1 +test util-5.20 {Tcl_StringMatch} { + string match {a[xyz]c} abc +} 0 +test util-5.21 {Tcl_StringMatch} { + string match {12[2-7]45} 12345 +} 1 +test util-5.22 {Tcl_StringMatch: UTF-8 range} { + string match "\[\u4e00-\u4e4f]" "0" +} 0 +test util-5.23 {Tcl_StringMatch: UTF-8 range} { + string match "\[\u4e00-\u4e4f]" "\u4e33" +} 1 +test util-5.24 {Tcl_StringMatch: UTF-8 range} { + string match "\[\u4e00-\u4e4f]" "\uff08" +} 0 +test util-5.25 {Tcl_StringMatch} { + string match {12[ab2-4cd]45} 12345 +} 1 +test util-5.26 {Tcl_StringMatch} { + string match {12[ab2-4cd]45} 12b45 +} 1 +test util-5.27 {Tcl_StringMatch} { + string match {12[ab2-4cd]45} 12d45 +} 1 +test util-5.28 {Tcl_StringMatch} { + string match {12[ab2-4cd]45} 12145 +} 0 +test util-5.29 {Tcl_StringMatch} { + string match {12[ab2-4cd]45} 12545 +} 0 +test util-5.30 {Tcl_StringMatch: forwards range} { + string match {[k-w]} "z" +} 0 +test util-5.31 {Tcl_StringMatch: forwards range} { + string match {[k-w]} "w" +} 1 +test util-5.32 {Tcl_StringMatch: forwards range} { + string match {[k-w]} "r" +} 1 +test util-5.33 {Tcl_StringMatch: forwards range} { + string match {[k-w]} "k" +} 1 +test util-5.34 {Tcl_StringMatch: forwards range} { + string match {[k-w]} "a" +} 0 +test util-5.35 {Tcl_StringMatch: reverse range} { + string match {[w-k]} "z" +} 0 +test util-5.36 {Tcl_StringMatch: reverse range} { + string match {[w-k]} "w" +} 1 +test util-5.37 {Tcl_StringMatch: reverse range} { + string match {[w-k]} "r" +} 1 +test util-5.38 {Tcl_StringMatch: reverse range} { + string match {[w-k]} "k" +} 1 +test util-5.39 {Tcl_StringMatch: reverse range} { + string match {[w-k]} "a" +} 0 +test util-5.40 {Tcl_StringMatch: skip correct number of ']'} { + string match {[A-]x} Ax +} 0 +test util-5.41 {Tcl_StringMatch: skip correct number of ']'} { + string match {[A-]]x} Ax +} 1 +test util-5.42 {Tcl_StringMatch: skip correct number of ']'} { + string match {[A-]]x} \ue1x +} 0 +test util-5.43 {Tcl_StringMatch: skip correct number of ']'} { + string match \[A-]\ue1]x \ue1x +} 1 +test util-5.44 {Tcl_StringMatch: skip correct number of ']'} { + string match {[A-]h]x} hx +} 1 +test util-5.45 {Tcl_StringMatch} { + # if (*pattern == '\0') + # badly formed pattern + + string match {[a} a +} 0 +test util-5.46 {Tcl_StringMatch} { + string match {a\*b} a*b +} 1 +test util-5.47 {Tcl_StringMatch} { + string match {a\*b} ab +} 0 +test util-5.48 {Tcl_StringMatch} { + string match {a\*\?\[\]\\\x} "a*?\[\]\\x" +} 1 +test util-5.49 {Tcl_StringMatch} { + string match ** "" +} 1 +test util-5.50 {Tcl_StringMatch} { + string match *. "" +} 0 +test util-5.51 {Tcl_StringMatch} { + string match "" "" +} 1 test util-6.1 {Tcl_PrintDouble - using tcl_precision} { concat x[expr 1.4] @@ -93,10 +248,10 @@ test util-6.4 {Tcl_PrintDouble - using tcl_precision} { concat x[expr 1.123412341234] } {x1.1234} set tcl_precision 12 -test util-6.4 {Tcl_PrintDouble - make sure there's a decimal point} { +test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr 2.0] } {x2.0} -test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { +test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} { concat x[expr 3.0e98] } {x3e+98} @@ -123,10 +278,11 @@ test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} { interp delete child list $x $tcl_precision } {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12} -test util-7.3 {TclPrecTraceProc - write traces, bogus values} { +test util-7.4 {TclPrecTraceProc - write traces, bogus values} { set tcl_precision 12 list [catch {set tcl_precision abc} msg] $msg $tcl_precision } {1 {can't set "tcl_precision": improper value for precision} 12} set tcl_precision 12 -concat "" + +return |