tests/util.test

   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 source [file dirname [info script]]/testing.tcl
  11
  12 needs cmd binary
  13 testConstraint controversialNaN 1
  14 testConstraint testdstring [llength [info commands testdstring]]
  15 testConstraint testconcatobj [llength [info commands testconcatobj]]
  16
  17 # Big test for correct ordering of data in [expr]
  18
  19 proc convertDouble { x } {
  20     variable ieeeValues
  21     if { $ieeeValues(littleEndian) } {
  22         binary scan [binary format w $x] d result
  23     } else {
  24         binary scan [binary format W $x] d result
  25     }
  26     return $result
  27 }
  28
  29 test util-1.1 {TclFindElement procedure - binary element in middle of list} {
  30     lindex {0 foo\x00help 1} 1
  31 } "foo\x00help"
  32 test util-1.2 {TclFindElement procedure - binary element at end of list} {
  33     lindex {0 foo\x00help} 1
  34 } "foo\x00help"
  35
  36 test util-2.1 {TclCopyAndCollapse procedure - normal string} {
  37     lindex {0 foo} 1
  38 } {foo}
  39 test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} {
  40     lindex {0 foo\n\x00help 1} 1
  41 } "foo\n\x00help"
  42
  43 test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} {
  44     # This test checks for a very tricky feature.  Any list element
  45     # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must
  46     # have the property that it can be enclosing in curly braces to make
  47     # an embedded sub-list.  If this property doesn't hold, then
  48     # Tcl_DStringStartSublist doesn't work.
  49     set x {}
  50     lappend x "# \\\{ \\"
  51     concat $x [llength "{$x}"]
  52 } {\#\ \\\{\ \\ 1}
  53 test util-3.2 {Tcl_ConverCountedElement procedure - quote leading '#'} {
  54     list # # a
  55 } {{#} # a}
  56 test util-3.3 {Tcl_ConverCountedElement procedure - quote leading '#'} {
  57     list #\{ # a
  58 } {\#\{ # a}
  59 test util-3.4 {Tcl_ConverCountedElement procedure - quote leading '#'} {
  60     proc # {} {return #}
  61     set result [eval [list #]]
  62     rename # {}
  63     set result
  64 } {#}
  65 test util-3.4.1 {Tcl_ConverCountedElement procedure - quote leading '#'} {
  66     proc # {} {return #}
  67     set cmd [list #]
  68     append cmd ""       ;# force string rep generation
  69     set result [eval $cmd]
  70     rename # {}
  71     set result
  72 } {#}
  73 test util-3.5 {Tcl_ConverCountedElement procedure - quote leading '#'} {
  74     proc #\{ {} {return #}
  75     set result [eval [list #\{]]
  76     rename #\{ {}
  77     set result
  78 } {#}
  79 test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} {
  80     proc #\{ {} {return #}
  81     set cmd [list #\{]
  82     append cmd ""       ;# force string rep generation
  83     set result [eval $cmd]
  84     rename #\{ {}
  85     set result
  86 } {#}
  87 test util-3.6 {Tcl_ConvertElement, Bug 3371644} tcl {
  88     interp create #\\
  89     interp alias {} x #\\ concat
  90     interp target {} x ;# Crash if bug not fixed
  91     interp delete #\\
  92 } {}
  93
  94 test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
  95     concat a {b\ } c
  96 } {a b\  c}
  97 test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} {
  98     concat a {b\   } c
  99 } {a b\  c}
 100 test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} {
 101     concat a {b\\   } c
 102 } {a b\\  c}
 103 test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
 104     concat a {b } c
 105 } {a b c}
 106 test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
 107     concat a { } c
 108 } {a c}
 109 test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
 110     # Check for Bug #227512.  If this violates C isspace, then it returns \xc3.
 111     concat \xe0
 112 } \xe0
 113 test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
 114     # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
 115     # symptoms was Bug #2055782.
 116     testconcatobj
 117 } {}
 118
 119 proc Wrapper_Tcl_StringMatch {pattern string} {
 120     # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
 121     switch -glob -- $string $pattern {return 1} default {return 0}
 122 }
 123 test util-5.1 {Tcl_StringMatch} {
 124     Wrapper_Tcl_StringMatch ab*c abc
 125 } 1
 126 test util-5.2 {Tcl_StringMatch} {
 127     Wrapper_Tcl_StringMatch ab**c abc
 128 } 1
 129 test util-5.3 {Tcl_StringMatch} {
 130     Wrapper_Tcl_StringMatch ab* abcdef
 131 } 1
 132 test util-5.4 {Tcl_StringMatch} {
 133     Wrapper_Tcl_StringMatch *c abc
 134 } 1
 135 test util-5.5 {Tcl_StringMatch} {
 136     Wrapper_Tcl_StringMatch *3*6*9 0123456789
 137 } 1
 138 test util-5.6 {Tcl_StringMatch} {
 139     Wrapper_Tcl_StringMatch *3*6*9 01234567890
 140 } 0
 141 test util-5.7 {Tcl_StringMatch: UTF-8} {
 142     Wrapper_Tcl_StringMatch *u \u4e4fu
 143 } 1
 144 test util-5.8 {Tcl_StringMatch} {
 145     Wrapper_Tcl_StringMatch a?c abc
 146 } 1
 147 test util-5.9 {Tcl_StringMatch: UTF-8} utf8 {
 148     # skip one character in string
 149     Wrapper_Tcl_StringMatch a?c a\u4e4fc
 150 } 1
 151 test util-5.10 {Tcl_StringMatch} {
 152     Wrapper_Tcl_StringMatch a??c abc
 153 } 0
 154 test util-5.11 {Tcl_StringMatch} {
 155     Wrapper_Tcl_StringMatch ?1??4???8? 0123456789
 156 } 1
 157 test util-5.12 {Tcl_StringMatch} {
 158     Wrapper_Tcl_StringMatch {[abc]bc} abc
 159 } 1
 160 test util-5.13 {Tcl_StringMatch: UTF-8} utf8 {
 161     # string += Tcl_UtfToUniChar(string, &ch);
 162     Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"
 163 } 1
 164 test util-5.14 {Tcl_StringMatch} {
 165     # if ((*pattern == ']') || (*pattern == '\0'))
 166     # badly formed pattern
 167     Wrapper_Tcl_StringMatch {[]} {[]}
 168 } 0
 169 test util-5.15 {Tcl_StringMatch} {
 170     # if ((*pattern == ']') || (*pattern == '\0'))
 171     # badly formed pattern
 172     Wrapper_Tcl_StringMatch {[} {[}
 173 } 0
 174 test util-5.16 {Tcl_StringMatch} {
 175     Wrapper_Tcl_StringMatch {a[abc]c} abc
 176 } 1
 177 test util-5.17 {Tcl_StringMatch: UTF-8} utf8 {
 178     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
 179     # get 1 UTF-8 character
 180     Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
 181 } 1
 182 test util-5.18 {Tcl_StringMatch: UTF-8} {
 183     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
 184     # proper advance: wrong answer would match on UTF trail byte of \u4e4f
 185     Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]
 186 } 0
 187 test util-5.19 {Tcl_StringMatch: UTF-8} {
 188     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
 189     # proper advance.
 190     Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
 191 } 1
 192 test util-5.20 {Tcl_StringMatch} {
 193     Wrapper_Tcl_StringMatch {a[xyz]c} abc
 194 } 0
 195 test util-5.21 {Tcl_StringMatch} {
 196     Wrapper_Tcl_StringMatch {12[2-7]45} 12345
 197 } 1
 198 test util-5.22 {Tcl_StringMatch: UTF-8 range} {
 199     Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0"
 200 } 0
 201 test util-5.23 {Tcl_StringMatch: UTF-8 range} utf8 {
 202     Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33"
 203 } 1
 204 test util-5.24 {Tcl_StringMatch: UTF-8 range} utf8 {
 205     Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08"
 206 } 0
 207 test util-5.25 {Tcl_StringMatch} {
 208     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345
 209 } 1
 210 test util-5.26 {Tcl_StringMatch} {
 211     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45
 212 } 1
 213 test util-5.27 {Tcl_StringMatch} {
 214     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12d45
 215 } 1
 216 test util-5.28 {Tcl_StringMatch} {
 217     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12145
 218 } 0
 219 test util-5.29 {Tcl_StringMatch} {
 220     Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12545
 221 } 0
 222 test util-5.30 {Tcl_StringMatch: forwards range} {
 223     Wrapper_Tcl_StringMatch {[k-w]} "z"
 224 } 0
 225 test util-5.31 {Tcl_StringMatch: forwards range} {
 226     Wrapper_Tcl_StringMatch {[k-w]} "w"
 227 } 1
 228 test util-5.32 {Tcl_StringMatch: forwards range} {
 229     Wrapper_Tcl_StringMatch {[k-w]} "r"
 230 } 1
 231 test util-5.33 {Tcl_StringMatch: forwards range} {
 232     Wrapper_Tcl_StringMatch {[k-w]} "k"
 233 } 1
 234 test util-5.34 {Tcl_StringMatch: forwards range} {
 235     Wrapper_Tcl_StringMatch {[k-w]} "a"
 236 } 0
 237 test util-5.35 {Tcl_StringMatch: reverse range} {
 238     Wrapper_Tcl_StringMatch {[w-k]} "z"
 239 } 0
 240 test util-5.36 {Tcl_StringMatch: reverse range} {
 241     Wrapper_Tcl_StringMatch {[w-k]} "w"
 242 } 1
 243 test util-5.37 {Tcl_StringMatch: reverse range} {
 244     Wrapper_Tcl_StringMatch {[w-k]} "r"
 245 } 1
 246 test util-5.38 {Tcl_StringMatch: reverse range} {
 247     Wrapper_Tcl_StringMatch {[w-k]} "k"
 248 } 1
 249 test util-5.39 {Tcl_StringMatch: reverse range} {
 250     Wrapper_Tcl_StringMatch {[w-k]} "a"
 251 } 0
 252 test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {
 253     Wrapper_Tcl_StringMatch {[A-]x} Ax
 254 } 0
 255 test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {
 256     Wrapper_Tcl_StringMatch {[A-]]x} Ax
 257 } 1
 258 test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {
 259     Wrapper_Tcl_StringMatch {[A-]]x} \ue1x
 260 } 0
 261 test util-5.43 {Tcl_StringMatch: skip correct number of ']'} utf8 {
 262     Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x
 263 } 1
 264 test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
 265     Wrapper_Tcl_StringMatch {[A-]h]x} hx
 266 } 1
 267 test util-5.45 {Tcl_StringMatch} {
 268     # if (*pattern == '\0')
 269     # badly formed pattern, still treats as a set
 270     Wrapper_Tcl_StringMatch {[a} a
 271 } 1
 272 test util-5.46 {Tcl_StringMatch} {
 273     Wrapper_Tcl_StringMatch {a\*b} a*b
 274 } 1
 275 test util-5.47 {Tcl_StringMatch} {
 276     Wrapper_Tcl_StringMatch {a\*b} ab
 277 } 0
 278 test util-5.48 {Tcl_StringMatch} {
 279     Wrapper_Tcl_StringMatch {a\*\?\[\]\\\x} "a*?\[\]\\x"
 280 } 1
 281 test util-5.49 {Tcl_StringMatch} {
 282     Wrapper_Tcl_StringMatch ** ""
 283 } 1
 284 test util-5.50 {Tcl_StringMatch} {
 285     Wrapper_Tcl_StringMatch *. ""
 286 } 0
 287 test util-5.51 {Tcl_StringMatch} {
 288     Wrapper_Tcl_StringMatch "" ""
 289 } 1
 290
 291 test util-9.0.0 {TclGetIntForIndex} {
 292     string index abcd 0
 293 } a
 294 test util-9.0.1 {TclGetIntForIndex} {
 295     string index abcd 0x0
 296 } a
 297 test util-9.0.2 {TclGetIntForIndex} {
 298     string index abcd -0x0
 299 } a
 300 test util-9.0.3 {TclGetIntForIndex} {
 301     string index abcd { 0 }
 302 } a
 303 test util-9.0.4 {TclGetIntForIndex} {
 304     string index abcd { 0x0 }
 305 } a
 306 test util-9.0.5 {TclGetIntForIndex} {
 307     string index abcd { -0x0 }
 308 } a
 309 test util-9.0.6 {TclGetIntForIndex} {
 310     string index abcd 01
 311 } b
 312 test util-9.0.7 {TclGetIntForIndex} {
 313     string index abcd { 01 }
 314 } b
 315 test util-9.1.0 {TclGetIntForIndex} {
 316     string index abcd 3
 317 } d
 318 test util-9.1.1 {TclGetIntForIndex} {
 319     string index abcd { 3 }
 320 } d
 321 test util-9.1.2 {TclGetIntForIndex} {
 322     string index abcdefghijk 0xa
 323 } k
 324 test util-9.1.3 {TclGetIntForIndex} {
 325     string index abcdefghijk { 0xa }
 326 } k
 327 test util-9.2.0 {TclGetIntForIndex} {
 328     string index abcd end
 329 } d
 330 test util-9.2.1 {TclGetIntForIndex} -body {
 331     string index abcd { end}
 332 } -returnCodes error -match glob -result *
 333 test util-9.2.2 {TclGetIntForIndex} -constraints tcl -body {
 334     string index abcd {end }
 335 } -returnCodes error -match glob -result *
 336 test util-9.3 {TclGetIntForIndex} tcl {
 337     # Deprecated
 338     string index abcd en
 339 } d
 340 test util-9.4 {TclGetIntForIndex} tcl {
 341     # Deprecated
 342     string index abcd e
 343 } d
 344 test util-9.5.0 {TclGetIntForIndex} {
 345     string index abcd end-1
 346 } c
 347 test util-9.5.1 {TclGetIntForIndex} tcl {
 348     string index abcd {end-1 }
 349 } c
 350 test util-9.5.2 {TclGetIntForIndex} -body {
 351     string index abcd { end-1}
 352 } -returnCodes error -match glob -result *
 353 test util-9.6 {TclGetIntForIndex} {
 354     string index abcd end+-1
 355 } c
 356 test util-9.7 {TclGetIntForIndex} {
 357     string index abcd end+1
 358 } {}
 359 test util-9.8 {TclGetIntForIndex} {
 360     string index abcd end--1
 361 } {}
 362 test util-9.9.0 {TclGetIntForIndex} {
 363     string index abcd 0+0
 364 } a
 365 test util-9.9.1 {TclGetIntForIndex} tcl {
 366     string index abcd { 0+0 }
 367 } a
 368 test util-9.10 {TclGetIntForIndex} {
 369     string index abcd 0-0
 370 } a
 371 test util-9.11 {TclGetIntForIndex} {
 372     string index abcd 1+0
 373 } b
 374 test util-9.12 {TclGetIntForIndex} {
 375     string index abcd 1-0
 376 } b
 377 test util-9.13 {TclGetIntForIndex} {
 378     string index abcd 1+1
 379 } c
 380 test util-9.14 {TclGetIntForIndex} {
 381     string index abcd 1-1
 382 } a
 383 test util-9.15 {TclGetIntForIndex} {
 384     string index abcd -1+2
 385 } b
 386 test util-9.16 {TclGetIntForIndex} {
 387     string index abcd -1--2
 388 } b
 389 test util-9.17 {TclGetIntForIndex} tcl {
 390     string index abcd { -1+2 }
 391 } b
 392 test util-9.18 {TclGetIntForIndex} tcl {
 393     string index abcd { -1--2 }
 394 } b
 395 test util-9.19 {TclGetIntForIndex} -body {
 396     string index a {}
 397 } -returnCodes error -match glob -result *
 398 test util-9.20 {TclGetIntForIndex} -body {
 399     string index a { }
 400 } -returnCodes error -match glob -result *
 401 test util-9.21 {TclGetIntForIndex} -body {
 402     string index a " \r\t\n"
 403 } -returnCodes error -match glob -result *
 404 test util-9.22 {TclGetIntForIndex} -body {
 405     string index a +
 406 } -returnCodes error -match glob -result *
 407 test util-9.23 {TclGetIntForIndex} -body {
 408     string index a -
 409 } -returnCodes error -match glob -result *
 410 test util-9.24 {TclGetIntForIndex} -body {
 411     string index a x
 412 } -returnCodes error -match glob -result *
 413 test util-9.25 {TclGetIntForIndex} -body {
 414     string index a +x
 415 } -returnCodes error -match glob -result *
 416 test util-9.26 {TclGetIntForIndex} -body {
 417     string index a -x
 418 } -returnCodes error -match glob -result *
 419 test util-9.27 {TclGetIntForIndex} -body {
 420     string index a 0y
 421 } -returnCodes error -match glob -result *
 422 test util-9.28 {TclGetIntForIndex} -body {
 423     string index a 1*
 424 } -returnCodes error -match glob -result *
 425 test util-9.29 {TclGetIntForIndex} -body {
 426     string index a 0+
 427 } -returnCodes error -match glob -result *
 428 test util-9.30 {TclGetIntForIndex} -body {
 429     string index a {0+ }
 430 } -returnCodes error -match glob -result *
 431 test util-9.31 {TclGetIntForIndex} -body {
 432     string index a 0x
 433 } -returnCodes error -match glob -result *
 434 test util-9.32 {TclGetIntForIndex} -constraints tcl -body {
 435     string index a 0x1FFFFFFFF+0
 436 } -returnCodes error -match glob -result *
 437 test util-9.33 {TclGetIntForIndex} -constraints tcl -body {
 438     string index a 100000000000+0
 439 } -returnCodes error -match glob -result *
 440 test util-9.34 {TclGetIntForIndex} -body {
 441     string index a 1.0
 442 } -returnCodes error -match glob -result *
 443 test util-9.35 {TclGetIntForIndex} -body {
 444     string index a 1e23
 445 } -returnCodes error -match glob -result *
 446 test util-9.36 {TclGetIntForIndex} -body {
 447     string index a 1.5e2
 448 } -returnCodes error -match glob -result *
 449 test util-9.37 {TclGetIntForIndex} -body {
 450     string index a 0+x
 451 } -returnCodes error -match glob -result *
 452 test util-9.38 {TclGetIntForIndex} -body {
 453     string index a 0+0x
 454 } -returnCodes error -match glob -result *
 455 test util-9.39 {TclGetIntForIndex} -body {
 456     string index a 0+0xg
 457 } -returnCodes error -match glob -result *
 458 test util-9.40 {TclGetIntForIndex} -body {
 459     string index a 0+0xg
 460 } -returnCodes error -match glob -result *
 461 test util-9.41 {TclGetIntForIndex} -body {
 462     string index a 0+1.0
 463 } -returnCodes error -match glob -result *
 464 test util-9.42 {TclGetIntForIndex} -body {
 465     string index a 0+1e2
 466 } -returnCodes error -match glob -result *
 467 test util-9.43 {TclGetIntForIndex} -body {
 468     string index a 0+1.5e1
 469 } -returnCodes error -match glob -result *
 470 test util-9.44 {TclGetIntForIndex} -constraints tcl -body {
 471     string index a 0+1000000000000
 472 } -returnCodes error -match glob -result *
 473
 474
 475 # cleanup
 476 ::tcltest::cleanupTests
 477 return
 478
 479 # Local Variables:
 480 # mode: tcl
 481 # End: