diff options
author | stanton <stanton> | 1999-04-16 00:46:29 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-04-16 00:46:29 (GMT) |
commit | 97464e6cba8eb0008cf2727c15718671992b913f (patch) | |
tree | ce9959f2747257d98d52ec8d18bf3b0de99b9535 /tests/util.test | |
parent | a8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff) | |
download | tcl-97464e6cba8eb0008cf2727c15718671992b913f.zip tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2 |
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'tests/util.test')
-rw-r--r-- | tests/util.test | 230 |
1 files changed, 202 insertions, 28 deletions
diff --git a/tests/util.test b/tests/util.test index a8c5241..3c8b7b0 100644 --- a/tests/util.test +++ b/tests/util.test @@ -1,21 +1,25 @@ # 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. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.3 1998/11/02 23:04:15 stanton Exp $ +# RCS: @(#) $Id: util.test,v 1.4 1999/04/16 00:47:36 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." + ::tcltest::cleanupTests return } -if {[string compare test [info procs test]] == 1} then {source defs} - test util-1.1 {TclFindElement procedure - binary element in middle of list} { lindex {0 foo\x00help 1} 1 } "foo\x00help" @@ -58,26 +62,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, still treats as a set + + string match {[a} a +} 1 +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 +252,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} {eformat} { +test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} { concat x[expr 3.0e98] } {x3e+98} @@ -123,10 +282,25 @@ 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 "" + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + |