Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/util.test@bde4ae8d615e

     1 # This file is a Tcl script to test the code in the file tclUtil.c.

     2 # This file is organized in the standard fashion for Tcl tests.

3 #

     4 # Copyright (c) 1995-1998 Sun Microsystems, Inc.

     5 # Copyright (c) 1998-1999 by Scriptics Corporation.

6 #

     7 # See the file "license.terms" for information on usage and redistribution

     8 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

9 #

    10 # RCS: @(#) $Id: util.test,v 1.10.4.4 2005/10/28 03:26:33 mdejong Exp $

    12 if {[lsearch [namespace children] ::tcltest] == -1} {

    13     package require tcltest

    14     namespace import -force ::tcltest::*

    15 }

    17 test util-1.1 {TclFindElement procedure - binary element in middle of list} {

    18     lindex {0 foo\x00help 1} 1

    19 } "foo\x00help"

    20 test util-1.2 {TclFindElement procedure - binary element at end of list} {

    21     lindex {0 foo\x00help} 1

    22 } "foo\x00help"

    24 test util-2.1 {TclCopyAndCollapse procedure - normal string} {

    25     lindex {0 foo} 1

    26 } {foo}

    27 test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} {

    28     lindex {0 foo\n\x00help 1} 1

    29 } "foo\n\x00help"

    31 test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} {

    32     # This test checks for a very tricky feature.  Any list element

    33     # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must

    34     # have the property that it can be enclosing in curly braces to make

    35     # an embedded sub-list.  If this property doesn't hold, then

    36     # Tcl_DStringStartSublist doesn't work.

    38     set x {}

    39     lappend x " \\\{ \\"

    40     concat $x [llength "{$x}"]

    41 } {\ \\\{\ \\ 1}

    43 test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {

    44     concat a {b\ } c

    45 } {a b\  c}

    46 test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} {

    47     concat a {b\   } c

    48 } {a b\  c}

    49 test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} {

    50     concat a {b\\   } c

    51 } {a b\\  c}

    52 test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {

    53     concat a {b } c

    54 } {a b c}

    55 test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {

    56     concat a { } c

    57 } {a c}

    58 test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {

    59     # Check for Bug #227512.  If this violates C isspace, then it returns \xc3.

    60     concat \xe0

    61 } \xe0

    63 proc Wrapper_Tcl_StringMatch {pattern string} {

    64     # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch

    65     switch -glob -- $string $pattern {return 1} default {return 0}

    66 }

    67 test util-5.1 {Tcl_StringMatch} {

    68     Wrapper_Tcl_StringMatch ab*c abc

    69 } 1

    70 test util-5.2 {Tcl_StringMatch} {

    71     Wrapper_Tcl_StringMatch ab**c abc

    72 } 1

    73 test util-5.3 {Tcl_StringMatch} {

    74     Wrapper_Tcl_StringMatch ab* abcdef

    75 } 1

    76 test util-5.4 {Tcl_StringMatch} {

    77     Wrapper_Tcl_StringMatch *c abc

    78 } 1

    79 test util-5.5 {Tcl_StringMatch} {

    80     Wrapper_Tcl_StringMatch *3*6*9 0123456789

    81 } 1

    82 test util-5.6 {Tcl_StringMatch} {

    83     Wrapper_Tcl_StringMatch *3*6*9 01234567890

    84 } 0

    85 test util-5.7 {Tcl_StringMatch: UTF-8} {

    86     Wrapper_Tcl_StringMatch *u \u4e4fu

    87 } 1

    88 test util-5.8 {Tcl_StringMatch} {

    89     Wrapper_Tcl_StringMatch a?c abc

    90 } 1

    91 test util-5.9 {Tcl_StringMatch: UTF-8} {

    92     # skip one character in string

    94     Wrapper_Tcl_StringMatch a?c a\u4e4fc

    95 } 1

    96 test util-5.10 {Tcl_StringMatch} {

    97     Wrapper_Tcl_StringMatch a??c abc

    98 } 0

    99 test util-5.11 {Tcl_StringMatch} {

   100     Wrapper_Tcl_StringMatch ?1??4???8? 0123456789

   101 } 1

   102 test util-5.12 {Tcl_StringMatch} {

   103     Wrapper_Tcl_StringMatch {[abc]bc} abc

   104 } 1

   105 test util-5.13 {Tcl_StringMatch: UTF-8} {

   106     # string += Tcl_UtfToUniChar(string, &ch);

   108     Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"

   109 } 1

   110 test util-5.14 {Tcl_StringMatch} {

   111     # if ((*pattern == ']') || (*pattern == '\0'))

   112     # badly formed pattern

   114     Wrapper_Tcl_StringMatch {[]} {[]}

   115 } 0

   116 test util-5.15 {Tcl_StringMatch} {

   117     # if ((*pattern == ']') || (*pattern == '\0'))

   118     # badly formed pattern

   120     Wrapper_Tcl_StringMatch {[} {[}

   121 } 0

   122 test util-5.16 {Tcl_StringMatch} {

   123     Wrapper_Tcl_StringMatch {a[abc]c} abc

   124 } 1

   125 test util-5.17 {Tcl_StringMatch: UTF-8} {

   126     # pattern += Tcl_UtfToUniChar(pattern, &endChar);

   127     # get 1 UTF-8 character

   129     Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"

   130 } 1

   131 test util-5.18 {Tcl_StringMatch: UTF-8} {

   132     # pattern += Tcl_UtfToUniChar(pattern, &endChar);

   133     # proper advance: wrong answer would match on UTF trail byte of \u4e4f

   135     Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]

   136 } 0

   137 test util-5.19 {Tcl_StringMatch: UTF-8} {

   138     # pattern += Tcl_UtfToUniChar(pattern, &endChar);

   139     # proper advance.

   141     Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"

   142 } 1

   143 test util-5.20 {Tcl_StringMatch} {

   144     Wrapper_Tcl_StringMatch {a[xyz]c} abc

   145 } 0

   146 test util-5.21 {Tcl_StringMatch} {

   147     Wrapper_Tcl_StringMatch {12[2-7]45} 12345

   148 } 1

   149 test util-5.22 {Tcl_StringMatch: UTF-8 range} {

   150     Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0"

   151 } 0

   152 test util-5.23 {Tcl_StringMatch: UTF-8 range} {

   153     Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33"

   154 } 1

   155 test util-5.24 {Tcl_StringMatch: UTF-8 range} {

   156     Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08"

   157 } 0

   158 test util-5.25 {Tcl_StringMatch} {

   159     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345

   160 } 1

   161 test util-5.26 {Tcl_StringMatch} {

   162     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45

   163 } 1

   164 test util-5.27 {Tcl_StringMatch} {

   165     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12d45

   166 } 1

   167 test util-5.28 {Tcl_StringMatch} {

   168     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12145

   169 } 0

   170 test util-5.29 {Tcl_StringMatch} {

   171     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12545

   172 } 0

   173 test util-5.30 {Tcl_StringMatch: forwards range} {

   174     Wrapper_Tcl_StringMatch {[k-w]} "z"

   175 } 0

   176 test util-5.31 {Tcl_StringMatch: forwards range} {

   177     Wrapper_Tcl_StringMatch {[k-w]} "w"

   178 } 1

   179 test util-5.32 {Tcl_StringMatch: forwards range} {

   180     Wrapper_Tcl_StringMatch {[k-w]} "r"

   181 } 1

   182 test util-5.33 {Tcl_StringMatch: forwards range} {

   183     Wrapper_Tcl_StringMatch {[k-w]} "k"

   184 } 1

   185 test util-5.34 {Tcl_StringMatch: forwards range} {

   186     Wrapper_Tcl_StringMatch {[k-w]} "a"

   187 } 0

   188 test util-5.35 {Tcl_StringMatch: reverse range} {

   189     Wrapper_Tcl_StringMatch {[w-k]} "z"

   190 } 0

   191 test util-5.36 {Tcl_StringMatch: reverse range} {

   192     Wrapper_Tcl_StringMatch {[w-k]} "w"

   193 } 1

   194 test util-5.37 {Tcl_StringMatch: reverse range} {

   195     Wrapper_Tcl_StringMatch {[w-k]} "r"

   196 } 1

   197 test util-5.38 {Tcl_StringMatch: reverse range} {

   198     Wrapper_Tcl_StringMatch {[w-k]} "k"

   199 } 1

   200 test util-5.39 {Tcl_StringMatch: reverse range} {

   201     Wrapper_Tcl_StringMatch {[w-k]} "a"

   202 } 0

   203 test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {

   204     Wrapper_Tcl_StringMatch {[A-]x} Ax

   205 } 0

   206 test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {

   207     Wrapper_Tcl_StringMatch {[A-]]x} Ax

   208 } 1

   209 test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {

   210     Wrapper_Tcl_StringMatch {[A-]]x} \ue1x

   211 } 0

   212 test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {

   213     Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x

   214 } 1

   215 test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {

   216     Wrapper_Tcl_StringMatch {[A-]h]x} hx

   217 } 1

   218 test util-5.45 {Tcl_StringMatch} {

   219     # if (*pattern == '\0')

   220     # badly formed pattern, still treats as a set

   222     Wrapper_Tcl_StringMatch {[a} a

   223 } 1

   224 test util-5.46 {Tcl_StringMatch} {

   225     Wrapper_Tcl_StringMatch {a\*b} a*b

   226 } 1

   227 test util-5.47 {Tcl_StringMatch} {

   228     Wrapper_Tcl_StringMatch {a\*b} ab

   229 } 0

   230 test util-5.48 {Tcl_StringMatch} {

   231     Wrapper_Tcl_StringMatch {a\*\?\[\]\\\x} "a*?\[\]\\x"

   232 } 1

   233 test util-5.49 {Tcl_StringMatch} {

   234     Wrapper_Tcl_StringMatch ** ""

   235 } 1

   236 test util-5.50 {Tcl_StringMatch} {

   237     Wrapper_Tcl_StringMatch *. ""

   238 } 0

   239 test util-5.51 {Tcl_StringMatch} {

   240     Wrapper_Tcl_StringMatch "" ""

   241 } 1

   243 test util-6.1 {Tcl_PrintDouble - using tcl_precision} {

   244     concat x[expr 1.4]

   245 } {x1.4}

   246 test util-6.2 {Tcl_PrintDouble - using tcl_precision} {

   247     concat x[expr 1.39999999999]

   248 } {x1.39999999999}

   249 test util-6.3 {Tcl_PrintDouble - using tcl_precision} {

   250     concat x[expr 1.399999999999]

   251 } {x1.4}

   252 test util-6.4 {Tcl_PrintDouble - using tcl_precision} {

   253     set tcl_precision 5

   254     concat x[expr 1.123412341234]

   255 } {x1.1234}

   256 set tcl_precision 12

   257 test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {

   258     concat x[expr 2.0]

   259 } {x2.0}

   260 test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} {

   261     concat x[expr 3.0e98]

   262 } {x3e+98}

   264 test util-7.1 {TclPrecTraceProc - unset callbacks} {

   265     set tcl_precision 7

   266     set x $tcl_precision

   267     unset tcl_precision

   268     list $x $tcl_precision

   269 } {7 7}

   270 test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} {

   271     set tcl_precision 12

   272     interp create child

   273     set x [child eval set tcl_precision]

   274     child eval {set tcl_precision 6}

   275     interp delete child

   276     list $x $tcl_precision

   277 } {12 6}

   278 test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} {

   279     set tcl_precision 12

   280     interp create -safe child

   281     set x [child eval {

   282 	list [catch {set tcl_precision 8} msg] $msg

   283     }]

   284     interp delete child

   285     list $x $tcl_precision

   286 } {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}

   287 test util-7.4 {TclPrecTraceProc - write traces, bogus values} {

   288     set tcl_precision 12

   289     list [catch {set tcl_precision abc} msg] $msg $tcl_precision

   290 } {1 {can't set "tcl_precision": improper value for precision} 12}

   292 set tcl_precision 12

   294 # This test always succeeded in the C locale anyway...

   295 test util-8.1 {TclNeedSpace - correct UTF8 handling} {

   296     # Bug 411825

   297     # Note that this test relies on the fact that

   298     # [interp target] calls on Tcl_AppendElement()

   299     # which calls on TclNeedSpace().  If [interp target]

   300     # is ever updated, this test will no longer test

   301     # TclNeedSpace.

   302     interp create \u5420

   303     interp create [list \u5420 foo]

   304     interp alias {} fooset [list \u5420 foo] set

   305     set result [interp target {} fooset]

   306     interp delete \u5420

   307     set result

   308 } "\u5420 foo"

   310 tcltest::testConstraint testdstring [expr {[info commands testdstring] != {}}]

   312 test util-8.2 {TclNeedSpace - correct UTF8 handling} testdstring {

   313     # Bug 411825

   314     # This tests the same bug as the previous test, but

   315     # should be more future-proof, as the DString

   316     # operations will likely continue to call TclNeedSpace

   317     testdstring free

   318     testdstring append \u5420 -1

   319     testdstring element foo

   320     llength [testdstring get]

   321 } 2

   322 test util-8.3 {TclNeedSpace - correct UTF8 handling} testdstring {

   323     # Bug 411825 - new variant reported by Dossy Shiobara

   324     testdstring free

   325     testdstring append \u00A0 -1

   326     testdstring element foo

   327     llength [testdstring get]

   328 } 2

   329 test util-8.4 {TclNeedSpace - correct UTF8 handling} testdstring {

   330     # Another bug uncovered while fixing 411825

   331     testdstring free

   332     testdstring append {\ } -1

   333     testdstring append \{ -1

   334     testdstring element foo

   335     llength [testdstring get]

   336 } 2

   337 test util-8.5 {TclNeedSpace - correct UTF8 handling} testdstring {

   338     # Note that in this test TclNeedSpace actually gets it wrong,

   339     # claiming we need a space when we really do not.  Extra space

   340     # between list elements is harmless though, and better to have

   341     # extra space in really weird string reps of lists, than to

   342     # invest the effort required to make TclNeedSpace foolproof.

   343     testdstring free

   344     testdstring append {\\ } -1

   345     testdstring element foo

   346     list [llength [testdstring get]] [string length [testdstring get]]

   347 } {2 7}

   348 test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring {

   349     # Another example of TclNeedSpace harmlessly getting it wrong.

   350     testdstring free

   351     testdstring append {\\ } -1

   352     testdstring append \{ -1

   353     testdstring element foo

   354     testdstring append \} -1

   355     list [llength [testdstring get]] [string length [testdstring get]]

   356 } {2 9}

   358 # cleanup

   359 ::tcltest::cleanupTests

   360 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--