diff options
| -rw-r--r-- | jim.c | 4 | ||||
| -rw-r--r-- | tests/util.test | 481 |
2 files changed, 485 insertions, 0 deletions
@@ -5758,6 +5758,10 @@ static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc) realLength += len + 2; break; case JIM_ELESTR_QUOTE: + if (i == 0 && strRep[0] == '#') { + *p++ = '\\'; + realLength++; + } qlen = BackslashQuoteString(strRep, p); p += qlen; realLength += qlen; diff --git a/tests/util.test b/tests/util.test new file mode 100644 index 0000000..af7c468 --- /dev/null +++ b/tests/util.test @@ -0,0 +1,481 @@ +# 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-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. + +source [file dirname [info script]]/testing.tcl + +needs cmd binary +testConstraint controversialNaN 1 +testConstraint testdstring [llength [info commands testdstring]] +testConstraint testconcatobj [llength [info commands testconcatobj]] + +# Big test for correct ordering of data in [expr] + +proc convertDouble { x } { + variable ieeeValues + if { $ieeeValues(littleEndian) } { + binary scan [binary format w $x] d result + } else { + binary scan [binary format W $x] d result + } + return $result +} + +test util-1.1 {TclFindElement procedure - binary element in middle of list} { + lindex {0 foo\x00help 1} 1 +} "foo\x00help" +test util-1.2 {TclFindElement procedure - binary element at end of list} { + lindex {0 foo\x00help} 1 +} "foo\x00help" + +test util-2.1 {TclCopyAndCollapse procedure - normal string} { + lindex {0 foo} 1 +} {foo} +test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} { + lindex {0 foo\n\x00help 1} 1 +} "foo\n\x00help" + +test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} { + # This test checks for a very tricky feature. Any list element + # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must + # have the property that it can be enclosing in curly braces to make + # an embedded sub-list. If this property doesn't hold, then + # Tcl_DStringStartSublist doesn't work. + set x {} + lappend x "# \\\{ \\" + concat $x [llength "{$x}"] +} {\#\ \\\{\ \\ 1} +test util-3.2 {Tcl_ConverCountedElement procedure - quote leading '#'} { + list # # a +} {{#} # a} +test util-3.3 {Tcl_ConverCountedElement procedure - quote leading '#'} { + list #\{ # a +} {\#\{ # a} +test util-3.4 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc # {} {return #} + set result [eval [list #]] + rename # {} + set result +} {#} +test util-3.4.1 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc # {} {return #} + set cmd [list #] + append cmd "" ;# force string rep generation + set result [eval $cmd] + rename # {} + set result +} {#} +test util-3.5 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc #\{ {} {return #} + set result [eval [list #\{]] + rename #\{ {} + set result +} {#} +test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc #\{ {} {return #} + set cmd [list #\{] + append cmd "" ;# force string rep generation + set result [eval $cmd] + rename #\{ {} + set result +} {#} +test util-3.6 {Tcl_ConvertElement, Bug 3371644} tcl { + interp create #\\ + interp alias {} x #\\ concat + interp target {} x ;# Crash if bug not fixed + interp delete #\\ +} {} + +test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} { + concat a {b\ } c +} {a b\ c} +test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} { + concat a {b\ } c +} {a b\ c} +test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} { + concat a {b\\ } c +} {a b\\ c} +test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} { + concat a {b } c +} {a b c} +test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} { + concat a { } c +} {a c} +test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} { + # Check for Bug #227512. If this violates C isspace, then it returns \xc3. + concat \xe0 +} \xe0 +test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj { + # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the + # symptoms was Bug #2055782. + testconcatobj +} {} + +proc Wrapper_Tcl_StringMatch {pattern string} { + # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch + switch -glob -- $string $pattern {return 1} default {return 0} +} +test util-5.1 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch ab*c abc +} 1 +test util-5.2 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch ab**c abc +} 1 +test util-5.3 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch ab* abcdef +} 1 +test util-5.4 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch *c abc +} 1 +test util-5.5 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch *3*6*9 0123456789 +} 1 +test util-5.6 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch *3*6*9 01234567890 +} 0 +test util-5.7 {Tcl_StringMatch: UTF-8} { + Wrapper_Tcl_StringMatch *u \u4e4fu +} 1 +test util-5.8 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch a?c abc +} 1 +test util-5.9 {Tcl_StringMatch: UTF-8} { + # skip one character in string + Wrapper_Tcl_StringMatch a?c a\u4e4fc +} 1 +test util-5.10 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch a??c abc +} 0 +test util-5.11 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch ?1??4???8? 0123456789 +} 1 +test util-5.12 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {[abc]bc} abc +} 1 +test util-5.13 {Tcl_StringMatch: UTF-8} { + # string += Tcl_UtfToUniChar(string, &ch); + Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc" +} 1 +test util-5.14 {Tcl_StringMatch} { + # if ((*pattern == ']') || (*pattern == '\0')) + # badly formed pattern + Wrapper_Tcl_StringMatch {[]} {[]} +} 0 +test util-5.15 {Tcl_StringMatch} { + # if ((*pattern == ']') || (*pattern == '\0')) + # badly formed pattern + Wrapper_Tcl_StringMatch {[} {[} +} 0 +test util-5.16 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {a[abc]c} abc +} 1 +test util-5.17 {Tcl_StringMatch: UTF-8} { + # pattern += Tcl_UtfToUniChar(pattern, &endChar); + # get 1 UTF-8 character + Wrapper_Tcl_StringMatch "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 + Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc] +} 0 +test util-5.19 {Tcl_StringMatch: UTF-8} { + # pattern += Tcl_UtfToUniChar(pattern, &endChar); + # proper advance. + Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc" +} 1 +test util-5.20 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {a[xyz]c} abc +} 0 +test util-5.21 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {12[2-7]45} 12345 +} 1 +test util-5.22 {Tcl_StringMatch: UTF-8 range} { + Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0" +} 0 +test util-5.23 {Tcl_StringMatch: UTF-8 range} { + Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33" +} 1 +test util-5.24 {Tcl_StringMatch: UTF-8 range} { + Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08" +} 0 +test util-5.25 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345 +} 1 +test util-5.26 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45 +} 1 +test util-5.27 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12d45 +} 1 +test util-5.28 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12145 +} 0 +test util-5.29 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12545 +} 0 +test util-5.30 {Tcl_StringMatch: forwards range} { + Wrapper_Tcl_StringMatch {[k-w]} "z" +} 0 +test util-5.31 {Tcl_StringMatch: forwards range} { + Wrapper_Tcl_StringMatch {[k-w]} "w" +} 1 +test util-5.32 {Tcl_StringMatch: forwards range} { + Wrapper_Tcl_StringMatch {[k-w]} "r" +} 1 +test util-5.33 {Tcl_StringMatch: forwards range} { + Wrapper_Tcl_StringMatch {[k-w]} "k" +} 1 +test util-5.34 {Tcl_StringMatch: forwards range} { + Wrapper_Tcl_StringMatch {[k-w]} "a" +} 0 +test util-5.35 {Tcl_StringMatch: reverse range} { + Wrapper_Tcl_StringMatch {[w-k]} "z" +} 0 +test util-5.36 {Tcl_StringMatch: reverse range} { + Wrapper_Tcl_StringMatch {[w-k]} "w" +} 1 +test util-5.37 {Tcl_StringMatch: reverse range} { + Wrapper_Tcl_StringMatch {[w-k]} "r" +} 1 +test util-5.38 {Tcl_StringMatch: reverse range} { + Wrapper_Tcl_StringMatch {[w-k]} "k" +} 1 +test util-5.39 {Tcl_StringMatch: reverse range} { + Wrapper_Tcl_StringMatch {[w-k]} "a" +} 0 +test util-5.40 {Tcl_StringMatch: skip correct number of ']'} { + Wrapper_Tcl_StringMatch {[A-]x} Ax +} 0 +test util-5.41 {Tcl_StringMatch: skip correct number of ']'} { + Wrapper_Tcl_StringMatch {[A-]]x} Ax +} 1 +test util-5.42 {Tcl_StringMatch: skip correct number of ']'} { + Wrapper_Tcl_StringMatch {[A-]]x} \ue1x +} 0 +test util-5.43 {Tcl_StringMatch: skip correct number of ']'} { + Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x +} 1 +test util-5.44 {Tcl_StringMatch: skip correct number of ']'} { + Wrapper_Tcl_StringMatch {[A-]h]x} hx +} 1 +test util-5.45 {Tcl_StringMatch} { + # if (*pattern == '\0') + # badly formed pattern, still treats as a set + Wrapper_Tcl_StringMatch {[a} a +} 1 +test util-5.46 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {a\*b} a*b +} 1 +test util-5.47 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {a\*b} ab +} 0 +test util-5.48 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch {a\*\?\[\]\\\x} "a*?\[\]\\x" +} 1 +test util-5.49 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch ** "" +} 1 +test util-5.50 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch *. "" +} 0 +test util-5.51 {Tcl_StringMatch} { + Wrapper_Tcl_StringMatch "" "" +} 1 + +test util-9.0.0 {TclGetIntForIndex} { + string index abcd 0 +} a +test util-9.0.1 {TclGetIntForIndex} { + string index abcd 0x0 +} a +test util-9.0.2 {TclGetIntForIndex} { + string index abcd -0x0 +} a +test util-9.0.3 {TclGetIntForIndex} { + string index abcd { 0 } +} a +test util-9.0.4 {TclGetIntForIndex} { + string index abcd { 0x0 } +} a +test util-9.0.5 {TclGetIntForIndex} { + string index abcd { -0x0 } +} a +test util-9.0.6 {TclGetIntForIndex} { + string index abcd 01 +} b +test util-9.0.7 {TclGetIntForIndex} { + string index abcd { 01 } +} b +test util-9.1.0 {TclGetIntForIndex} { + string index abcd 3 +} d +test util-9.1.1 {TclGetIntForIndex} { + string index abcd { 3 } +} d +test util-9.1.2 {TclGetIntForIndex} { + string index abcdefghijk 0xa +} k +test util-9.1.3 {TclGetIntForIndex} { + string index abcdefghijk { 0xa } +} k +test util-9.2.0 {TclGetIntForIndex} { + string index abcd end +} d +test util-9.2.1 {TclGetIntForIndex} -body { + string index abcd { end} +} -returnCodes error -match glob -result * +test util-9.2.2 {TclGetIntForIndex} -constraints tcl -body { + string index abcd {end } +} -returnCodes error -match glob -result * +test util-9.3 {TclGetIntForIndex} tcl { + # Deprecated + string index abcd en +} d +test util-9.4 {TclGetIntForIndex} tcl { + # Deprecated + string index abcd e +} d +test util-9.5.0 {TclGetIntForIndex} { + string index abcd end-1 +} c +test util-9.5.1 {TclGetIntForIndex} tcl { + string index abcd {end-1 } +} c +test util-9.5.2 {TclGetIntForIndex} -body { + string index abcd { end-1} +} -returnCodes error -match glob -result * +test util-9.6 {TclGetIntForIndex} { + string index abcd end+-1 +} c +test util-9.7 {TclGetIntForIndex} { + string index abcd end+1 +} {} +test util-9.8 {TclGetIntForIndex} { + string index abcd end--1 +} {} +test util-9.9.0 {TclGetIntForIndex} { + string index abcd 0+0 +} a +test util-9.9.1 {TclGetIntForIndex} tcl { + string index abcd { 0+0 } +} a +test util-9.10 {TclGetIntForIndex} { + string index abcd 0-0 +} a +test util-9.11 {TclGetIntForIndex} { + string index abcd 1+0 +} b +test util-9.12 {TclGetIntForIndex} { + string index abcd 1-0 +} b +test util-9.13 {TclGetIntForIndex} { + string index abcd 1+1 +} c +test util-9.14 {TclGetIntForIndex} { + string index abcd 1-1 +} a +test util-9.15 {TclGetIntForIndex} { + string index abcd -1+2 +} b +test util-9.16 {TclGetIntForIndex} { + string index abcd -1--2 +} b +test util-9.17 {TclGetIntForIndex} tcl { + string index abcd { -1+2 } +} b +test util-9.18 {TclGetIntForIndex} tcl { + string index abcd { -1--2 } +} b +test util-9.19 {TclGetIntForIndex} -body { + string index a {} +} -returnCodes error -match glob -result * +test util-9.20 {TclGetIntForIndex} -body { + string index a { } +} -returnCodes error -match glob -result * +test util-9.21 {TclGetIntForIndex} -body { + string index a " \r\t\n" +} -returnCodes error -match glob -result * +test util-9.22 {TclGetIntForIndex} -body { + string index a + +} -returnCodes error -match glob -result * +test util-9.23 {TclGetIntForIndex} -body { + string index a - +} -returnCodes error -match glob -result * +test util-9.24 {TclGetIntForIndex} -body { + string index a x +} -returnCodes error -match glob -result * +test util-9.25 {TclGetIntForIndex} -body { + string index a +x +} -returnCodes error -match glob -result * +test util-9.26 {TclGetIntForIndex} -body { + string index a -x +} -returnCodes error -match glob -result * +test util-9.27 {TclGetIntForIndex} -body { + string index a 0y +} -returnCodes error -match glob -result * +test util-9.28 {TclGetIntForIndex} -body { + string index a 1* +} -returnCodes error -match glob -result * +test util-9.29 {TclGetIntForIndex} -body { + string index a 0+ +} -returnCodes error -match glob -result * +test util-9.30 {TclGetIntForIndex} -body { + string index a {0+ } +} -returnCodes error -match glob -result * +test util-9.31 {TclGetIntForIndex} -body { + string index a 0x +} -returnCodes error -match glob -result * +test util-9.32 {TclGetIntForIndex} -constraints tcl -body { + string index a 0x1FFFFFFFF+0 +} -returnCodes error -match glob -result * +test util-9.33 {TclGetIntForIndex} -constraints tcl -body { + string index a 100000000000+0 +} -returnCodes error -match glob -result * +test util-9.34 {TclGetIntForIndex} -body { + string index a 1.0 +} -returnCodes error -match glob -result * +test util-9.35 {TclGetIntForIndex} -body { + string index a 1e23 +} -returnCodes error -match glob -result * +test util-9.36 {TclGetIntForIndex} -body { + string index a 1.5e2 +} -returnCodes error -match glob -result * +test util-9.37 {TclGetIntForIndex} -body { + string index a 0+x +} -returnCodes error -match glob -result * +test util-9.38 {TclGetIntForIndex} -body { + string index a 0+0x +} -returnCodes error -match glob -result * +test util-9.39 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.40 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.41 {TclGetIntForIndex} -body { + string index a 0+1.0 +} -returnCodes error -match glob -result * +test util-9.42 {TclGetIntForIndex} -body { + string index a 0+1e2 +} -returnCodes error -match glob -result * +test util-9.43 {TclGetIntForIndex} -body { + string index a 0+1.5e1 +} -returnCodes error -match glob -result * +test util-9.44 {TclGetIntForIndex} -constraints tcl -body { + string index a 0+1000000000000 +} -returnCodes error -match glob -result * + + +# cleanup +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: |