1# Commands covered: string 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1991-1993 The Regents of the University of California. 8# Copyright © 1994 Sun Microsystems, Inc. 9# Copyright © 1998-1999 Scriptics Corporation. 10# Copyright © 2001 Kevin B. Kenny. All rights reserved. 11# 12# See the file "license.terms" for information on usage and redistribution 13# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 15if {"::tcltest" ni [namespace children]} { 16 package require tcltest 2.5 17 namespace import -force ::tcltest::* 18} 19 20::tcltest::loadTestedCommands 21catch [list package require -exact tcl::test [info patchlevel]] 22 23# Helper commands to test various optimizations, code paths, and special cases. 24proc makeByteArray {s} {binary format a* $s} 25proc makeUnicode {s} {lindex [regexp -inline .* $s] 0} 26proc makeList {args} {return $args} 27proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s} 28 29# Some tests require the testobj command 30 31testConstraint testobj [expr {[info commands testobj] ne {}}] 32testConstraint testindexobj [expr {[info commands testindexobj] ne {}}] 33testConstraint testevalex [expr {[info commands testevalex] ne {}}] 34testConstraint utf16 [expr {[string length \U010000] == 2}] 35testConstraint testbytestring [llength [info commands testbytestring]] 36testConstraint nodep [info exists tcl_precision] 37 38# Used for constraining memory leak tests 39testConstraint memory [llength [info commands memory]] 40if {[testConstraint memory]} { 41 proc getbytes {} { 42 set lines [split [memory info] \n] 43 return [lindex $lines 3 3] 44 } 45 proc leaktest {script {iterations 3}} { 46 set end [getbytes] 47 for {set i 0} {$i < $iterations} {incr i} { 48 uplevel 1 $script 49 set tmp $end 50 set end [getbytes] 51 } 52 return [expr {$end - $tmp}] 53 } 54} 55 56proc representationpoke s { 57 set r [::tcl::unsupported::representation $s] 58 list [lindex $r 3] [string match {*, string representation "*"} $r] 59} 60 61foreach noComp {0 1} { 62 63if {$noComp} { 64 if {[info commands testevalex] eq {}} { 65 test string-0.1.$noComp "show testevalex availability" {testevalex} {list} {} 66 continue 67 } 68 interp alias {} run {} testevalex 69 set constraints testevalex 70} else { 71 interp alias {} run {} try 72 set constraints {} 73} 74 75 76test string-1.1.$noComp {error conditions} -body { 77 list [catch {run {string gorp a b}} msg] $msg 78} -match glob -result {1 {unknown or ambiguous subcommand "gorp": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} 79test string-1.2.$noComp {error conditions} { 80 list [catch {run {string}} msg] $msg 81} {1 {wrong # args: should be "string subcommand ?arg ...?"}} 82test stringComp-1.3.$noComp {error condition - undefined method during compile} { 83 # We don't want this to complain about 'never' because it may never 84 # be called, or string may get redefined. This must compile OK. 85 proc foo {str i} { 86 if {"yes" == "no"} { string never called but complains here } 87 string index $str $i 88 } 89 foo abc 0 90} a 91 92test string-2.1.$noComp {string compare, not enough args} { 93 list [catch {run {string compare a}} msg] $msg 94} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} 95test string-2.2.$noComp {string compare, bad args} { 96 list [catch {run {string compare a b c}} msg] $msg 97} {1 {bad option "a": must be -nocase or -length}} 98test string-2.3.$noComp {string compare, bad args} { 99 list [catch {run {string compare -length -nocase str1 str2}} msg] $msg 100} {1 {expected integer but got "-nocase"}} 101test string-2.4.$noComp {string compare, too many args} { 102 list [catch {run {string compare -length 10 -nocase str1 str2 str3}} msg] $msg 103} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} 104test string-2.5.$noComp {string compare with length unspecified} { 105 list [catch {run {string compare -length 10 10}} msg] $msg 106} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}} 107test string-2.6.$noComp {string compare} { 108 run {string compare abcde abdef} 109} -1 110test string-2.7.$noComp {string compare, shortest method name} { 111 run {string co abcde ABCDE} 112} 1 113test string-2.8.$noComp {string compare} { 114 run {string compare abcde abcde} 115} 0 116test string-2.9.$noComp {string compare with length} { 117 run {string compare -length 2 abcde abxyz} 118} 0 119test string-2.10.$noComp {string compare with special index} { 120 list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg 121} {1 {expected integer but got "end-3"}} 122test string-2.11.$noComp {string compare, unicode} { 123 run {string compare ab牦 ab牧} 124} -1 125test string-2.11.1.$noComp {string compare, unicode} { 126 run {string compare Ü Ü} 127} 0 128test string-2.11.2.$noComp {string compare, unicode} { 129 run {string compare Ü ü} 130} -1 131test string-2.11.3.$noComp {string compare, unicode} { 132 run {string compare ÜÜÜüü ÜÜÜÜÜ} 133} 1 134test string-2.12.$noComp {string compare, high bit} { 135 # This test will fail if the underlying comparison 136 # is using signed chars instead of unsigned chars. 137 # (like SunOS's default memcmp thus the compat/memcmp.c) 138 run {string compare "\x80" "@"} 139 # Nb this tests works also in utf-8 space because \x80 is 140 # translated into a 2 or more bytelength but whose first byte has 141 # the high bit set. 142} 1 143test string-2.13.$noComp {string compare -nocase} { 144 run {string compare -nocase abcde abdef} 145} -1 146test string-2.13.1.$noComp {string compare -nocase} { 147 run {string compare -nocase abcde Abdef} 148} -1 149test string-2.14.$noComp {string compare -nocase} { 150 run {string compare -nocase abcde ABCDE} 151} 0 152test string-2.15.$noComp {string compare -nocase} { 153 run {string compare -nocase abcde abcde} 154} 0 155test string-2.15.1.$noComp {string compare -nocase} { 156 run {string compare -nocase Ü Ü} 157} 0 158test string-2.15.2.$noComp {string compare -nocase} { 159 run {string compare -nocase ÜÜÜüü ÜÜÜÜÜ} 160} 0 161test string-2.16.$noComp {string compare -nocase with length} { 162 run {string compare -length 2 -nocase abcde Abxyz} 163} 0 164test string-2.17.$noComp {string compare -nocase with length} { 165 run {string compare -nocase -length 3 abcde Abxyz} 166} -1 167test string-2.18.$noComp {string compare -nocase with length <= 0} { 168 run {string compare -nocase -length -1 abcde AbCdEf} 169} -1 170test string-2.19.$noComp {string compare -nocase with excessive length} { 171 run {string compare -nocase -length 50 AbCdEf abcde} 172} 1 173test string-2.20.$noComp {string compare -len unicode} { 174 # These are strings that are 6 BYTELENGTH long, but the length 175 # shouldn't make a different because there are actually 3 CHARS long 176 run {string compare -len 5 ÜÜÜ ÜÜü} 177} -1 178test string-2.21.$noComp {string compare -nocase with special index} { 179 list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg 180} {1 {expected integer but got "end-3"}} 181test string-2.22.$noComp {string compare, null strings} { 182 run {string compare "" ""} 183} 0 184test string-2.23.$noComp {string compare, null strings} { 185 run {string compare "" foo} 186} -1 187test string-2.24.$noComp {string compare, null strings} { 188 run {string compare foo ""} 189} 1 190test string-2.25.$noComp {string compare -nocase, null strings} { 191 run {string compare -nocase "" ""} 192} 0 193test string-2.26.$noComp {string compare -nocase, null strings} { 194 run {string compare -nocase "" foo} 195} -1 196test string-2.27.$noComp {string compare -nocase, null strings} { 197 run {string compare -nocase foo ""} 198} 1 199test string-2.28.$noComp {string compare with length, unequal strings} { 200 run {string compare -length 2 abc abde} 201} 0 202test string-2.29.$noComp {string compare with length, unequal strings} { 203 run {string compare -length 2 ab abde} 204} 0 205test string-2.30.$noComp {string compare with NUL character vs. other ASCII} { 206 # Be careful here, since UTF-8 rep comparison with memcmp() of 207 # these puts chars in the wrong order 208 run {string compare \x00 \x01} 209} -1 210test string-2.31.$noComp {string compare, high bit} { 211 run {string compare "a\x80" "a@"} 212} 1 213test string-2.32.$noComp {string compare, high bit} { 214 run {string compare "a\x00" "a\x01"} 215} -1 216test string-2.33.$noComp {string compare, high bit} { 217 run {string compare "\x00\x00" "\x00\x01"} 218} -1 219test string-2.34.$noComp {string compare, binary equal} { 220 run {string compare [binary format a100 0] [binary format a100 0]} 221} 0 222test string-2.35.$noComp {string compare, binary neq} { 223 run {string compare [binary format a100a 0 1] [binary format a100a 0 0]} 224} 1 225test string-2.36.$noComp {string compare, binary neq unequal length} { 226 run {string compare [binary format a20a 0 1] [binary format a100a 0 0]} 227} 1 228 229# only need a few tests on equal, since it uses the same code as 230# string compare, but just modifies the return output 231test string-3.1.$noComp {string equal} { 232 run {string equal abcde abdef} 233} 0 234test string-3.2.$noComp {string equal} { 235 run {string e abcde ABCDE} 236} 0 237test string-3.3.$noComp {string equal} { 238 run {string equal abcde abcde} 239} 1 240test string-3.4.$noComp {string equal -nocase} { 241 run {string equal -nocase ÜÜÜÜüüüü ÜÜÜÜÜÜÜÜ} 242} 1 243test string-3.5.$noComp {string equal -nocase} { 244 run {string equal -nocase abcde abdef} 245} 0 246test string-3.6.$noComp {string equal -nocase} { 247 run {string eq -nocase abcde ABCDE} 248} 1 249test string-3.7.$noComp {string equal -nocase} { 250 run {string equal -nocase abcde abcde} 251} 1 252test string-3.8.$noComp {string equal with length, unequal strings} { 253 run {string equal -length 2 abc abde} 254} 1 255test string-3.9.$noComp {string equal, not enough args} { 256 list [catch {run {string equal a}} msg] $msg 257} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}} 258test string-3.10.$noComp {string equal, bad args} { 259 list [catch {run {string equal a b c}} msg] $msg 260} {1 {bad option "a": must be -nocase or -length}} 261test string-3.11.$noComp {string equal, bad args} { 262 list [catch {run {string equal -length -nocase str1 str2}} msg] $msg 263} {1 {expected integer but got "-nocase"}} 264test string-3.12.$noComp {string equal, too many args} { 265 list [catch {run {string equal -length 10 -nocase str1 str2 str3}} msg] $msg 266} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}} 267test string-3.13.$noComp {string equal with length unspecified} { 268 list [catch {run {string equal -length 10 10}} msg] $msg 269} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}} 270test string-3.14.$noComp {string equal with length} { 271 run {string equal -length 2 abcde abxyz} 272} 1 273test string-3.15.$noComp {string equal with special index} { 274 list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg 275} {1 {expected integer but got "end-3"}} 276 277test string-3.16.$noComp {string equal, unicode} { 278 run {string equal ab牦 ab牧} 279} 0 280test string-3.17.$noComp {string equal, unicode} { 281 run {string equal Ü Ü} 282} 1 283test string-3.18.$noComp {string equal, unicode} { 284 run {string equal Ü ü} 285} 0 286test string-3.19.$noComp {string equal, unicode} { 287 run {string equal ÜÜÜüü ÜÜÜÜÜ} 288} 0 289test string-3.20.$noComp {string equal, high bit} { 290 # This test will fail if the underlying comparison 291 # is using signed chars instead of unsigned chars. 292 # (like SunOS's default memcmp thus the compat/memcmp.c) 293 run {string equal "\x80" "@"} 294 # Nb this tests works also in utf8 space because \x80 is 295 # translated into a 2 or more bytelength but whose first byte has 296 # the high bit set. 297} 0 298test string-3.21.$noComp {string equal -nocase} { 299 run {string equal -nocase abcde Abdef} 300} 0 301test string-3.22.$noComp {string equal, -nocase unicode} { 302 run {string equal -nocase Ü Ü} 303} 1 304test string-3.23.$noComp {string equal, -nocase unicode} { 305 run {string equal -nocase ÜÜÜüü ÜÜÜÜÜ} 306} 1 307test string-3.24.$noComp {string equal -nocase with length} { 308 run {string equal -length 2 -nocase abcde Abxyz} 309} 1 310test string-3.25.$noComp {string equal -nocase with length} { 311 run {string equal -nocase -length 3 abcde Abxyz} 312} 0 313test string-3.26.$noComp {string equal -nocase with length <= 0} { 314 run {string equal -nocase -length -1 abcde AbCdEf} 315} 0 316test string-3.27.$noComp {string equal -nocase with excessive length} { 317 run {string equal -nocase -length 50 AbCdEf abcde} 318} 0 319test string-3.28.$noComp {string equal -len unicode} { 320 # These are strings that are 6 BYTELENGTH long, but the length 321 # shouldn't make a different because there are actually 3 CHARS long 322 run {string equal -len 5 ÜÜÜ ÜÜü} 323} 0 324test string-3.29.$noComp {string equal -nocase with special index} { 325 list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg 326} {1 {expected integer but got "end-3"}} 327test string-3.30.$noComp {string equal, null strings} { 328 run {string equal "" ""} 329} 1 330test string-3.31.$noComp {string equal, null strings} { 331 run {string equal "" foo} 332} 0 333test string-3.32.$noComp {string equal, null strings} { 334 run {string equal foo ""} 335} 0 336test string-3.33.$noComp {string equal -nocase, null strings} { 337 run {string equal -nocase "" ""} 338} 1 339test string-3.34.$noComp {string equal -nocase, null strings} { 340 run {string equal -nocase "" foo} 341} 0 342test string-3.35.$noComp {string equal -nocase, null strings} { 343 run {string equal -nocase foo ""} 344} 0 345test string-3.36.$noComp {string equal with NUL character vs. other ASCII} { 346 # Be careful here, since UTF-8 rep comparison with memcmp() of 347 # these puts chars in the wrong order 348 run {string equal \x00 \x01} 349} 0 350test string-3.37.$noComp {string equal, high bit} { 351 run {string equal "a\x80" "a@"} 352} 0 353test string-3.38.$noComp {string equal, high bit} { 354 run {string equal "a\x00" "a\x01"} 355} 0 356test string-3.39.$noComp {string equal, high bit} { 357 run {string equal "a\x00\x00" "a\x00\x01"} 358} 0 359test string-3.40.$noComp {string equal, binary equal} { 360 run {string equal [binary format a100 0] [binary format a100 0]} 361} 1 362test string-3.41.$noComp {string equal, binary neq} { 363 run {string equal [binary format a100a 0 1] [binary format a100a 0 0]} 364} 0 365test string-3.42.$noComp {string equal, binary neq inequal length} { 366 run {string equal [binary format a20a 0 1] [binary format a100a 0 0]} 367} 0 368 369 370test string-4.1.$noComp {string first, not enough args} { 371 list [catch {run {string first a}} msg] $msg 372} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} 373test string-4.2.$noComp {string first, bad args} { 374 list [catch {run {string first a b c}} msg] $msg 375} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} 376test string-4.3.$noComp {string first, too many args} { 377 list [catch {run {string first a b 5 d}} msg] $msg 378} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}} 379test string-4.4.$noComp {string first} { 380 run {string first bq abcdefgbcefgbqrs} 381} 12 382test string-4.5.$noComp {string first} { 383 run {string fir bcd abcdefgbcefgbqrs} 384} 1 385test string-4.6.$noComp {string first} { 386 run {string f b abcdefgbcefgbqrs} 387} 1 388test string-4.7.$noComp {string first} { 389 run {string first xxx x123xx345xxx789xxx012} 390} 9 391test string-4.8.$noComp {string first} { 392 run {string first "" x123xx345xxx789xxx012} 393} -1 394test string-4.9.$noComp {string first, unicode} { 395 run {string first x abc牦x} 396} 4 397test string-4.10.$noComp {string first, unicode} { 398 run {string first 牦 abc牦x} 399} 3 400test string-4.11.$noComp {string first, start index} { 401 run {string first 牦 abc牦x 3} 402} 3 403test string-4.12.$noComp {string first, start index} -body { 404 run {string first 牦 abc牦x 4} 405} -result -1 406test string-4.13.$noComp {string first, start index} -body { 407 run {string first 牦 abc牦x end-2} 408} -result 3 409test string-4.14.$noComp {string first, negative start index} -body { 410 run {string first b abc -1} 411} -result 1 412test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body { 413 # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded 414 # strings was incorrect, leading to an index returned by [string first] 415 # which pointed past the end of the string. 416 set uchar վ ;# character with two-byte encoding in utf-8 417 run {string first % %#$uchar$uchar#$uchar$uchar#% 3} 418} -result 8 419test string-4.16.$noComp {string first, normal string vs pure unicode string} -body { 420 set s hello 421 regexp ll $s m 422 # Representation checks are canaries 423 run {list [representationpoke $s] [representationpoke $m] \ 424 [string first $m $s]} 425} -result {{string 1} {string 0} 2} 426test string-4.17.$noComp {string first, corner case} -body { 427 run {string first a aaa 4294967295} 428} -result {-1} 429test string-4.18.$noComp {string first, corner case} -body { 430 run {string first a aaa -1} 431} -result {0} 432test string-4.19.$noComp {string first, corner case} -body { 433 run {string first a aaa end-5} 434} -result {0} 435test string-4.20.$noComp {string last, corner case} -body { 436 run {string last a aaa 4294967295} 437} -result {2} 438test string-4.21.$noComp {string last, corner case} -body { 439 run {string last a aaa -1} 440} -result {-1} 441test string-4.22.$noComp {string last, corner case} { 442 run {string last a aaa end-5} 443} {-1} 444 445test string-5.1.$noComp {string index} { 446 list [catch {run {string index}} msg] $msg 447} {1 {wrong # args: should be "string index string charIndex"}} 448test string-5.2.$noComp {string index} { 449 list [catch {run {string index a b c}} msg] $msg 450} {1 {wrong # args: should be "string index string charIndex"}} 451test string-5.3.$noComp {string index} { 452 run {string index abcde 0} 453} a 454test string-5.4.$noComp {string index} { 455 run {string ind abcde 4} 456} e 457test string-5.5.$noComp {string index} { 458 run {string index abcde 5} 459} {} 460test string-5.6.$noComp {string index} { 461 list [catch {run {string index abcde -10}} msg] $msg 462} {0 {}} 463test string-5.7.$noComp {string index} { 464 list [catch {run {string index a xyz}} msg] $msg 465} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} 466test string-5.8.$noComp {string index} { 467 run {string index abc end} 468} c 469test string-5.9.$noComp {string index} { 470 run {string index abc end-1} 471} b 472test string-5.10.$noComp {string index, unicode} { 473 run {string index abc牦d 4} 474} d 475test string-5.11.$noComp {string index, unicode} { 476 run {string index abc牦d 3} 477} 牦 478test string-5.12.$noComp {string index, unicode over char length, under byte length} -body { 479 run {string index ÜüÜü 6} 480} -result {} 481test string-5.13.$noComp {string index, bytearray object} { 482 run {string index [binary format a5 fuz] 0} 483} f 484test string-5.14.$noComp {string index, bytearray object} { 485 run {string index [binary format I* {0x50515253 0x52}] 3} 486} S 487test string-5.15.$noComp {string index, bytearray object} { 488 set b [binary format I* {0x50515253 0x52}] 489 set i1 [run {string index $b end-6}] 490 set i2 [run {string index $b 1}] 491 run {string compare $i1 $i2} 492} 0 493test string-5.16.$noComp {string index, bytearray object with string obj shimmering} { 494 set str "0123456789\x00 abcdedfghi" 495 binary scan $str H* dump 496 run {string compare [run {string index $str 10}] \x00} 497} 0 498test string-5.17.$noComp {string index, bad integer} -body { 499 list [catch {run {string index "abc" 0o8}} msg] $msg 500} -match glob -result {1 {*invalid octal number*}} 501test string-5.18.$noComp {string index, bad integer} -body { 502 list [catch {run {string index "abc" end-0o0289}} msg] $msg 503} -match glob -result {1 {*invalid octal number*}} 504test string-5.19.$noComp {string index, bytearray object out of bounds} { 505 run {string index [binary format I* {0x50515253 0x52}] -1} 506} {} 507test string-5.20.$noComp {string index, bytearray object out of bounds} -body { 508 run {string index [binary format I* {0x50515253 0x52}] 20} 509} -result {} 510test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body { 511 run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]} 512} -result [list \U100000 {} b] 513 514 515test string-6.1.$noComp {string is, not enough args} { 516 list [catch {run {string is}} msg] $msg 517} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} 518test string-6.2.$noComp {string is, not enough args} { 519 list [catch {run {string is alpha}} msg] $msg 520} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} 521test string-6.3.$noComp {string is, bad args} { 522 list [catch {run {string is alpha -failin str}} msg] $msg 523} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}} 524test string-6.4.$noComp {string is, too many args} { 525 list [catch {run {string is alpha -failin var -strict str more}} msg] $msg 526} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} 527test string-6.5.$noComp {string is, class check} { 528 list [catch {run {string is bogus str}} msg] $msg 529} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}} 530test string-6.6.$noComp {string is, ambiguous class} { 531 list [catch {run {string is al str}} msg] $msg 532} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}} 533test string-6.7.$noComp {string is alpha, all ok} { 534 run {string is alpha -strict -failindex var abc} 535} 1 536test string-6.8.$noComp {string is, error in var} { 537 list [run {string is alpha -failindex var abc5def}] $var 538} {0 3} 539test string-6.9.$noComp {string is, var shouldn't get set} { 540 catch {unset var} 541 list [catch {run {string is alpha -failindex var abc; set var}} msg] $msg 542} {1 {can't read "var": no such variable}} 543test string-6.10.$noComp {string is, ok on empty} { 544 run {string is alpha {}} 545} 1 546test string-6.11.$noComp {string is, -strict check against empty} { 547 run {string is alpha -strict {}} 548} 0 549test string-6.12.$noComp {string is alnum, true} { 550 run {string is alnum abc123} 551} 1 552test string-6.13.$noComp {string is alnum, false} { 553 list [run {string is alnum -failindex var abc1.23}] $var 554} {0 4} 555test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abcü}" 1 556test string-6.15.$noComp {string is alpha, true} { 557 run {string is alpha abc} 558} 1 559test string-6.16.$noComp {string is alpha, false} { 560 list [run {string is alpha -fail var a1bcde}] $var 561} {0 1} 562test string-6.17.$noComp {string is alpha, unicode} { 563 run {string is alpha abcü} 564} 1 565test string-6.18.$noComp {string is ascii, true} { 566 run {string is ascii abc\x7Fend\x00} 567} 1 568test string-6.19.$noComp {string is ascii, false} { 569 list [run {string is ascii -fail var abc\x00def\x80more}] $var 570} {0 7} 571test string-6.20.$noComp {string is boolean, true} { 572 run {string is boolean true} 573} 1 574test string-6.21.$noComp {string is boolean, true} { 575 run {string is boolean f} 576} 1 577test string-6.22.$noComp {string is boolean, true based on type} { 578 run {string is bool [run {string compare a a}]} 579} 1 580test string-6.23.$noComp {string is boolean, false} { 581 list [run {string is bool -fail var yada}] $var 582} {0 0} 583test string-6.24.$noComp {string is digit, true} { 584 run {string is digit 0123456789} 585} 1 586test string-6.25.$noComp {string is digit, false} { 587 list [run {string is digit -fail var 0123Ü567}] $var 588} {0 4} 589test string-6.26.$noComp {string is digit, false} { 590 list [run {string is digit -fail var +123567}] $var 591} {0 0} 592test string-6.27.$noComp {string is double, true} { 593 run {string is double 1} 594} 1 595test string-6.28.$noComp {string is double, true} { 596 run {string is double [expr {double(1)}]} 597} 1 598test string-6.29.$noComp {string is double, true} { 599 run {string is double 1.0} 600} 1 601test string-6.30.$noComp {string is double, true} { 602 run {string is double [run {string compare a a}]} 603} 1 604test string-6.31.$noComp {string is double, true} { 605 run {string is double " +1.0e-1 "} 606} 1 607test string-6.32.$noComp {string is double, true} { 608 run {string is double "\n1.0\v"} 609} 1 610test string-6.33.$noComp {string is double, false} { 611 list [run {string is double -fail var 1abc}] $var 612} {0 1} 613test string-6.34.$noComp {string is double, false} { 614 list [run {string is double -fail var abc}] $var 615} {0 0} 616test string-6.35.$noComp {string is double, false} { 617 list [run {string is double -fail var " 1.0e4e4 "}] $var 618} {0 8} 619test string-6.36.$noComp {string is double, false} { 620 list [run {string is double -fail var "\n"}] $var 621} {0 0} 622test string-6.37.$noComp {string is double, false on int overflow} -setup { 623 set var priorValue 624} -body { 625 # Make it the largest int recognizable, with one more digit for overflow 626 # Since bignums arrived in Tcl 8.5, the sense of this test changed. 627 # Now integer values that exceed native limits become bignums, and 628 # bignums can convert to doubles without error. 629 list [run {string is double -fail var 9223372036854775808}] $var 630} -result {1 priorValue} 631# string-6.38 removed, underflow on input is no longer an error. 632test string-6.39.$noComp {string is double, false} { 633 # This test is non-portable because IRIX thinks 634 # that .e1 is a valid double - this is really a bug 635 # on IRIX as .e1 should NOT be a valid double 636 # 637 # Portable now. Tcl 8.5 does its own double parsing. 638 639 list [run {string is double -fail var .e1}] $var 640} {0 0} 641test string-6.40.$noComp {string is false, true} { 642 run {string is false false} 643} 1 644test string-6.41.$noComp {string is false, true} { 645 run {string is false FaLsE} 646} 1 647test string-6.42.$noComp {string is false, true} { 648 run {string is false N} 649} 1 650test string-6.43.$noComp {string is false, true} { 651 run {string is false 0} 652} 1 653test string-6.44.$noComp {string is false, true} { 654 run {string is false off} 655} 1 656test string-6.45.$noComp {string is false, false} { 657 list [run {string is false -fail var abc}] $var 658} {0 0} 659test string-6.46.$noComp {string is false, false} { 660 catch {unset var} 661 list [run {string is false -fail var Y}] $var 662} {0 0} 663test string-6.47.$noComp {string is false, false} { 664 catch {unset var} 665 list [run {string is false -fail var offensive}] $var 666} {0 0} 667test string-6.48.$noComp {string is integer, true} { 668 run {string is integer +1234567890} 669} 1 670test string-6.49.$noComp {string is integer, true on type} { 671 run {string is integer [expr {int(50.0)}]} 672} 1 673test string-6.50.$noComp {string is integer, true} { 674 run {string is integer [list -10]} 675} 1 676test string-6.51.$noComp {string is integer, true as hex} { 677 run {string is integer 0xabcdef} 678} 1 679test string-6.52.$noComp {string is integer, true as octal} { 680 run {string is integer 012345} 681} 1 682test string-6.53.$noComp {string is integer, true with whitespace} { 683 run {string is integer " \n1234\v"} 684} 1 685test string-6.54.$noComp {string is integer, false} { 686 list [run {string is integer -fail var 123abc}] $var 687} {0 3} 688test string-6.55.$noComp {string is integer, no overflow possible} { 689 run {string is integer +9223372036854775808} 690} 1 691test string-6.56.$noComp {string is integer, false} { 692 list [run {string is integer -fail var [expr {double(1)}]}] $var 693} {0 1} 694test string-6.57.$noComp {string is integer, false} { 695 list [run {string is integer -fail var " "}] $var 696} {0 0} 697test string-6.58.$noComp {string is integer, false on bad octal} { 698 list [run {string is integer -fail var 0o36963}] $var 699} {0 4} 700test string-6.58.1.$noComp {string is integer, false on bad octal} { 701 list [run {string is integer -fail var 0o36963}] $var 702} {0 4} 703test string-6.59.$noComp {string is integer, false on bad hex} { 704 list [run {string is integer -fail var 0X345XYZ}] $var 705} {0 5} 706test string-6.60.$noComp {string is lower, true} { 707 run {string is lower abc} 708} 1 709test string-6.61.$noComp {string is lower, unicode true} { 710 run {string is lower abcüue} 711} 1 712test string-6.62.$noComp {string is lower, false} { 713 list [run {string is lower -fail var aBc}] $var 714} {0 1} 715test string-6.63.$noComp {string is lower, false} { 716 list [run {string is lower -fail var abc1}] $var 717} {0 3} 718test string-6.64.$noComp {string is lower, unicode false} { 719 list [run {string is lower -fail var abÜUE}] $var 720} {0 2} 721test string-6.65.$noComp {string is space, true} { 722 run {string is space " \t\n\v\f"} 723} 1 724test string-6.66.$noComp {string is space, false} { 725 list [run {string is space -fail var " \t\n\v1\f"}] $var 726} {0 4} 727test string-6.67.$noComp {string is true, true} { 728 run {string is true true} 729} 1 730test string-6.68.$noComp {string is true, true} { 731 run {string is true TrU} 732} 1 733test string-6.69.$noComp {string is true, true} { 734 run {string is true ye} 735} 1 736test string-6.70.$noComp {string is true, true} { 737 run {string is true 1} 738} 1 739test string-6.71.$noComp {string is true, true} { 740 run {string is true on} 741} 1 742test string-6.72.$noComp {string is true, false} { 743 list [run {string is true -fail var onto}] $var 744} {0 0} 745test string-6.73.$noComp {string is true, false} { 746 catch {unset var} 747 list [run {string is true -fail var 25}] $var 748} {0 0} 749test string-6.74.$noComp {string is true, false} { 750 catch {unset var} 751 list [run {string is true -fail var no}] $var 752} {0 0} 753test string-6.75.$noComp {string is upper, true} { 754 run {string is upper ABC} 755} 1 756test string-6.76.$noComp {string is upper, unicode true} { 757 run {string is upper ABCÜUE} 758} 1 759test string-6.77.$noComp {string is upper, false} { 760 list [run {string is upper -fail var AbC}] $var 761} {0 1} 762test string-6.78.$noComp {string is upper, false} { 763 list [run {string is upper -fail var AB2C}] $var 764} {0 2} 765test string-6.79.$noComp {string is upper, unicode false} { 766 list [run {string is upper -fail var ABCüue}] $var 767} {0 3} 768test string-6.80.$noComp {string is wordchar, true} { 769 run {string is wordchar abc_123} 770} 1 771test string-6.81.$noComp {string is wordchar, unicode true} { 772 run {string is wordchar abcüabÜAB倁\U1D7CA} 773} 1 774test string-6.82.$noComp {string is wordchar, false} { 775 list [run {string is wordchar -fail var abcd.ef}] $var 776} {0 4} 777test string-6.83.$noComp {string is wordchar, unicode false} { 778 list [run {string is wordchar -fail var abc\x80def}] $var 779} {0 3} 780test string-6.84.$noComp {string is control} { 781 ## Control chars are in the ranges 782 ## 00..1F && 7F..9F 783 list [run {string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60}] $var 784} {0 7} 785test string-6.85.$noComp {string is control} { 786 run {string is control \u0100} 787} 0 788test string-6.86.$noComp {string is graph} { 789 ## graph is any print char, except space 790 list [run {string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "}] $var 791} {0 14} 792test string-6.87.$noComp {string is print} { 793 ## basically any printable char 794 list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\x10"}] $var 795} {0 15} 796test string-6.88.$noComp {string is punct} { 797 ## any graph char that isn't alnum 798 list [run {string is punct -fail var "_!@#\xBEq0"}] $var 799} {0 4} 800test string-6.89.$noComp {string is xdigit} { 801 list [run {string is xdigit -fail var 0123456789\x61bcdefABCDEFg}] $var 802} {0 22} 803 804test string-6.90.$noComp {string is integer, bad integers} { 805 # SF bug #634856 806 set result "" 807 set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] 808 foreach num $numbers { 809 lappend result [run {string is int -strict $num}] 810 } 811 return $result 812} {1 1 0 0 0 1 0 0} 813test string-6.91.$noComp {string is double, bad doubles} { 814 set result "" 815 set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"] 816 foreach num $numbers { 817 lappend result [run {string is double -strict $num}] 818 } 819 return $result 820} {1 1 0 0 0 1 0 0} 821test string-6.92.$noComp {string is integer, no 64-bit overflow} { 822 # Bug 718878 823 set x 0x10000000000000000 824 run {string is integer $x} 825} 1 826test string-6.93.$noComp {string is integer, no 64-bit overflow} { 827 # Bug 718878 828 set x 0x10000000000000000 829 append x "" 830 run {string is integer $x} 831} 1 832test string-6.94.$noComp {string is integer, no 64-bit overflow} { 833 # Bug 718878 834 set x 0x10000000000000000 835 run {string is integer [expr {$x}]} 836} 1 837test string-6.95.$noComp {string is wideinteger, true} { 838 run {string is wideinteger +1234567890} 839} 1 840test string-6.96.$noComp {string is wideinteger, true on type} { 841 run {string is wideinteger [expr {wide(50.0)}]} 842} 1 843test string-6.97.$noComp {string is wideinteger, true} { 844 run {string is wideinteger [list -10]} 845} 1 846test string-6.98.$noComp {string is wideinteger, true as hex} { 847 run {string is wideinteger 0xabcdef} 848} 1 849test string-6.99.$noComp {string is wideinteger, true as octal} { 850 run {string is wideinteger 0123456} 851} 1 852test string-6.100.$noComp {string is wideinteger, true with whitespace} { 853 run {string is wideinteger " \n1234\v"} 854} 1 855test string-6.101.$noComp {string is wideinteger, false} { 856 list [run {string is wideinteger -fail var 123abc}] $var 857} {0 3} 858test string-6.102.$noComp {string is wideinteger, false on overflow} { 859 list [run {string is wideinteger -fail var +9223372036854775808}] $var 860} {0 -1} 861test string-6.103.$noComp {string is wideinteger, false} { 862 list [run {string is wideinteger -fail var [expr {double(1)}]}] $var 863} {0 1} 864test string-6.104.$noComp {string is wideinteger, false} { 865 list [run {string is wideinteger -fail var " "}] $var 866} {0 0} 867test string-6.105.$noComp {string is wideinteger, false on bad octal} { 868 list [run {string is wideinteger -fail var 0o36963}] $var 869} {0 4} 870test string-6.105.1.$noComp {string is wideinteger, false on bad octal} { 871 list [run {string is wideinteger -fail var 0o36963}] $var 872} {0 4} 873test string-6.106.$noComp {string is wideinteger, false on bad hex} { 874 list [run {string is wideinteger -fail var 0X345XYZ}] $var 875} {0 5} 876test string-6.107.$noComp {string is integer, bad integers} { 877 # SF bug #634856 878 set result "" 879 set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] 880 foreach num $numbers { 881 lappend result [run {string is wideinteger -strict $num}] 882 } 883 return $result 884} {1 1 0 0 0 1 0 0} 885test string-6.108.$noComp {string is double, Bug 1382287} { 886 set x 2turtledoves 887 run {string is double $x} 888 run {string is double $x} 889} 0 890test string-6.109.$noComp {string is double, Bug 1360532} { 891 run {string is double 1\xA0} 892} 0 893test string-6.110.$noComp {string is entier, true} { 894 run {string is entier +1234567890} 895} 1 896test string-6.111.$noComp {string is entier, true on type} { 897 run {string is entier [expr {wide(50.0)}]} 898} 1 899test string-6.112.$noComp {string is entier, true} { 900 run {string is entier [list -10]} 901} 1 902test string-6.113.$noComp {string is entier, true as hex} { 903 run {string is entier 0xabcdef} 904} 1 905test string-6.114.$noComp {string is entier, true as octal} { 906 run {string is entier 0123456} 907} 1 908test string-6.115.$noComp {string is entier, true with whitespace} { 909 run {string is entier " \n1234\v"} 910} 1 911test string-6.116.$noComp {string is entier, false} { 912 list [run {string is entier -fail var 123abc}] $var 913} {0 3} 914test string-6.117.$noComp {string is entier, false} { 915 list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var 916} {0 84} 917test string-6.118.$noComp {string is entier, false} { 918 list [run {string is entier -fail var [expr {double(1)}]}] $var 919} {0 1} 920test string-6.119.$noComp {string is entier, false} { 921 list [run {string is entier -fail var " "}] $var 922} {0 0} 923test string-6.120.$noComp {string is entier, false on bad octal} { 924 list [run {string is entier -fail var 0o36963}] $var 925} {0 4} 926test string-6.121.1.$noComp {string is entier, false on bad octal} { 927 list [run {string is entier -fail var 0o36963}] $var 928} {0 4} 929test string-6.122.$noComp {string is entier, false on bad hex} { 930 list [run {string is entier -fail var 0X345XYZ}] $var 931} {0 5} 932test string-6.123.$noComp {string is entier, bad integers} { 933 # SF bug #634856 934 set result "" 935 set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"] 936 foreach num $numbers { 937 lappend result [run {string is entier -strict $num}] 938 } 939 return $result 940} {1 1 0 0 0 1 0 0} 941test string-6.124.$noComp {string is entier, true} { 942 run {string is entier +1234567890123456789012345678901234567890} 943} 1 944test string-6.125.$noComp {string is entier, true} { 945 run {string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]} 946} 1 947test string-6.126.$noComp {string is entier, true as hex} { 948 run {string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef} 949} 1 950test string-6.127.$noComp {string is entier, true as octal} { 951 run {string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456} 952} 1 953test string-6.128.$noComp {string is entier, true with whitespace} { 954 run {string is entier " \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"} 955} 1 956test string-6.129.$noComp {string is entier, false on bad octal} { 957 list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var 958} {0 87} 959test string-6.130.1.$noComp {string is entier, false on bad octal} { 960 list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var 961} {0 87} 962test string-6.131.$noComp {string is entier, false on bad hex} { 963 list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var 964} {0 88} 965test string-6.132.$noComp {string is unicode} { 966 run {string is unicode \U10FFFD\uD7FF\uE000\uFDCF\uFDF0} 967} 1 968test string-6.133.$noComp {string is unicode, upper surrogate} { 969 run {string is unicode \uD800} 970} 0 971test string-6.134.$noComp {string is unicode, lower surrogate} { 972 run {string is unicode \uDFFF} 973} 0 974test string-6.135.$noComp {string is unicode, noncharacter} { 975 run {string is unicode \uFFFE} 976} 0 977test string-6.136.$noComp {string is unicode, noncharacter} { 978 run {string is unicode \uFFFF} 979} 0 980test string-6.137.$noComp {string is unicode, noncharacter} { 981 run {string is unicode \uFDD0} 982} 0 983test string-6.138.$noComp {string is unicode, noncharacter} { 984 run {string is unicode \uFDEF} 985} 0 986 987 988test string-7.1.$noComp {string last, not enough args} { 989 list [catch {run {string last a}} msg] $msg 990} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}} 991test string-7.2.$noComp {string last, bad args} { 992 list [catch {run {string last a b c}} msg] $msg 993} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} 994test string-7.3.$noComp {string last, too many args} { 995 list [catch {run {string last a b c d}} msg] $msg 996} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}} 997test string-7.4.$noComp {string last} { 998 run {string la xxx xxxx123xx345x678} 999} 1 1000test string-7.5.$noComp {string last} { 1001 run {string last xx xxxx123xx345x678} 1002} 7 1003test string-7.6.$noComp {string last} { 1004 run {string las x xxxx123xx345x678} 1005} 12 1006test string-7.7.$noComp {string last, unicode} { 1007 run {string las x xxxx12牦xx345x678} 1008} 12 1009test string-7.8.$noComp {string last, unicode} { 1010 run {string las 牦 xxxx12牦xx345x678} 1011} 6 1012test string-7.9.$noComp {string last, stop index} { 1013 run {string las 牦 xxxx12牦xx345x678} 1014} 6 1015test string-7.10.$noComp {string last, unicode} { 1016 run {string las 牦 xxxx12牦xx345x678} 1017} 6 1018test string-7.11.$noComp {string last, start index} { 1019 run {string last 牦 abc牦x 3} 1020} 3 1021test string-7.12.$noComp {string last, start index} { 1022 run {string last 牦 abc牦x 2} 1023} -1 1024test string-7.13.$noComp {string last, start index} { 1025 ## Constrain to last 'a' should work 1026 run {string last ba badbad end-1} 1027} 3 1028test string-7.14.$noComp {string last, start index} { 1029 ## Constrain to last 'b' should skip last 'ba' 1030 run {string last ba badbad end-2} 1031} 0 1032test string-7.15.$noComp {string last, start index} { 1033 run {string last Üa ÜadÜad 0} 1034} -1 1035test string-7.16.$noComp {string last, start index} { 1036 run {string last Üa ÜadÜad end-1} 1037} 3 1038 1039test string-8.1.$noComp {string bytelength} nodep { 1040 list [catch {run {string bytelength}} msg] $msg 1041} {1 {wrong # args: should be "string bytelength string"}} 1042test string-8.2.$noComp {string bytelength} nodep { 1043 list [catch {run {string bytelength a b}} msg] $msg 1044} {1 {wrong # args: should be "string bytelength string"}} 1045test string-8.3.$noComp {string bytelength} nodep { 1046 run {string bytelength "\xC7"} 1047} 2 1048test string-8.4.$noComp {string bytelength} nodep { 1049 run {string b ""} 1050} 0 1051 1052test string-9.1.$noComp {string length} { 1053 list [catch {run {string length}} msg] $msg 1054} {1 {wrong # args: should be "string length string"}} 1055test string-9.2.$noComp {string length} { 1056 list [catch {run {string length a b}} msg] $msg 1057} {1 {wrong # args: should be "string length string"}} 1058test string-9.3.$noComp {string length} { 1059 run {string length "a little string"} 1060} 15 1061test string-9.4.$noComp {string length} { 1062 run {string le ""} 1063} 0 1064test string-9.5.$noComp {string length, unicode} { 1065 run {string le "abcd牦"} 1066} 5 1067test string-9.6.$noComp {string length, bytearray object} { 1068 run {string length [binary format a5 foo]} 1069} 5 1070test string-9.7.$noComp {string length, bytearray object} { 1071 run {string length [binary format I* {0x50515253 0x52}]} 1072} 8 1073 1074test string-10.1.$noComp {string map, not enough args} { 1075 list [catch {run {string map}} msg] $msg 1076} {1 {wrong # args: should be "string map ?-nocase? charMap string"}} 1077test string-10.2.$noComp {string map, bad args} { 1078 list [catch {run {string map {a b} abba oops}} msg] $msg 1079} {1 {bad option "a b": must be -nocase}} 1080test string-10.3.$noComp {string map, too many args} { 1081 list [catch {run {string map -nocase {a b} str1 str2}} msg] $msg 1082} {1 {wrong # args: should be "string map ?-nocase? charMap string"}} 1083test string-10.4.$noComp {string map} { 1084 run {string map {a b} abba} 1085} {bbbb} 1086test string-10.5.$noComp {string map} { 1087 run {string map {a b} a} 1088} {b} 1089test string-10.6.$noComp {string map -nocase} { 1090 run {string map -nocase {a b} Abba} 1091} {bbbb} 1092test string-10.7.$noComp {string map} { 1093 run {string map {abc 321 ab * a A} aabcabaababcab} 1094} {A321*A*321*} 1095test string-10.8.$noComp {string map -nocase} { 1096 run {string map -nocase {aBc 321 Ab * a A} aabcabaababcab} 1097} {A321*A*321*} 1098test string-10.9.$noComp {string map -nocase} { 1099 run {string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb} 1100} {A321*A*321*} 1101test string-10.10.$noComp {string map} { 1102 list [catch {run {string map {a b c} abba}} msg] $msg 1103} {1 {char map list unbalanced}} 1104test string-10.11.$noComp {string map, nulls} { 1105 run {string map {\x00 NULL blah \x00nix} {qwerty}} 1106} {qwerty} 1107test string-10.12.$noComp {string map, unicode} { 1108 run {string map [list ü ue UE Ü] "aüueUE\x00EU"} 1109} aueueÜ\x00EU 1110test string-10.13.$noComp {string map, -nocase unicode} { 1111 run {string map -nocase [list ü ue UE Ü] "aüueUE\x00EU"} 1112} aueÜÜ\x00EU 1113test string-10.14.$noComp {string map, -nocase null arguments} { 1114 run {string map -nocase {{} abc} foo} 1115} foo 1116test string-10.15.$noComp {string map, one pair case} { 1117 run {string map -nocase {abc 32} aAbCaBaAbAbcAb} 1118} {a32aBaAb32Ab} 1119test string-10.16.$noComp {string map, one pair case} { 1120 run {string map -nocase {ab 4321} aAbCaBaAbAbcAb} 1121} {a4321C4321a43214321c4321} 1122test string-10.17.$noComp {string map, one pair case} { 1123 run {string map {Ab 4321} aAbCaBaAbAbcAb} 1124} {a4321CaBa43214321c4321} 1125test string-10.18.$noComp {string map, empty argument} { 1126 run {string map -nocase {{} abc} foo} 1127} foo 1128test string-10.19.$noComp {string map, empty arguments} { 1129 run {string map -nocase {{} abc f bar {} def} foo} 1130} baroo 1131test string-10.20.$noComp {string map, dictionaries don't alter map ordering} { 1132 set map {aa X a Y} 1133 list [run {string map [dict create aa X a Y] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}] 1134} {XY XY 2 XY} 1135test string-10.20.1.$noComp {string map, dictionaries don't alter map ordering} { 1136 set map {a X b Y a Z} 1137 list [run {string map [dict create a X b Y a Z] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}] 1138} {ZZZ XXX 2 XXX} 1139test string-10.21.$noComp {string map, ABR checks} { 1140 run {string map {longstring foob} long} 1141} long 1142test string-10.22.$noComp {string map, ABR checks} { 1143 run {string map {long foob} long} 1144} foob 1145test string-10.23.$noComp {string map, ABR checks} { 1146 run {string map {lon foob} long} 1147} foobg 1148test string-10.24.$noComp {string map, ABR checks} { 1149 run {string map {lon foob} longlo} 1150} foobglo 1151test string-10.25.$noComp {string map, ABR checks} { 1152 run {string map {lon foob} longlon} 1153} foobgfoob 1154test string-10.26.$noComp {string map, ABR checks} { 1155 run {string map {longstring foob longstring bar} long} 1156} long 1157test string-10.27.$noComp {string map, ABR checks} { 1158 run {string map {long foob longstring bar} long} 1159} foob 1160test string-10.28.$noComp {string map, ABR checks} { 1161 run {string map {lon foob longstring bar} long} 1162} foobg 1163test string-10.29.$noComp {string map, ABR checks} { 1164 run {string map {lon foob longstring bar} longlo} 1165} foobglo 1166test string-10.30.$noComp {string map, ABR checks} { 1167 run {string map {lon foob longstring bar} longlon} 1168} foobgfoob 1169test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} { 1170 set a {a b} 1171 run {string map $a $a} 1172} {b b} 1173 1174test string-11.1.$noComp {string match, not enough args} { 1175 list [catch {run {string match a}} msg] $msg 1176} {1 {wrong # args: should be "string match ?-nocase? pattern string"}} 1177test string-11.2.$noComp {string match, too many args} { 1178 list [catch {run {string match a b c d}} msg] $msg 1179} {1 {wrong # args: should be "string match ?-nocase? pattern string"}} 1180test string-11.3.$noComp {string match} { 1181 run {string match abc abc} 1182} 1 1183test string-11.4.$noComp {string match} { 1184 run {string mat abc abd} 1185} 0 1186test string-11.5.$noComp {string match} { 1187 run {string match ab*c abc} 1188} 1 1189test string-11.6.$noComp {string match} { 1190 run {string match ab**c abc} 1191} 1 1192test string-11.7.$noComp {string match} { 1193 run {string match ab* abcdef} 1194} 1 1195test string-11.8.$noComp {string match} { 1196 run {string match *c abc} 1197} 1 1198test string-11.9.$noComp {string match} { 1199 run {string match *3*6*9 0123456789} 1200} 1 1201test string-11.9.1.$noComp {string match} { 1202 run {string match *3*6*89 0123456789} 1203} 1 1204test string-11.9.2.$noComp {string match} { 1205 run {string match *3*456*89 0123456789} 1206} 1 1207test string-11.9.3.$noComp {string match} { 1208 run {string match *3*6* 0123456789} 1209} 1 1210test string-11.9.4.$noComp {string match} { 1211 run {string match *3*56* 0123456789} 1212} 1 1213test string-11.9.5.$noComp {string match} { 1214 run {string match *3*456*** 0123456789} 1215} 1 1216test string-11.9.6.$noComp {string match} { 1217 run {string match **3*456** 0123456789} 1218} 1 1219test string-11.9.7.$noComp {string match} { 1220 run {string match *3***456* 0123456789} 1221} 1 1222test string-11.9.8.$noComp {string match} { 1223 run {string match *3***\[456]* 0123456789} 1224} 1 1225test string-11.9.9.$noComp {string match} { 1226 run {string match *3***\[4-6]* 0123456789} 1227} 1 1228test string-11.9.10.$noComp {string match} { 1229 run {string match *3***\[4-6] 0123456789} 1230} 0 1231test string-11.9.11.$noComp {string match} { 1232 run {string match *3***\[4-6] 0123456} 1233} 1 1234test string-11.10.$noComp {string match} { 1235 run {string match *3*6*9 01234567890} 1236} 0 1237test string-11.10.1.$noComp {string match} { 1238 run {string match *3*6*89 01234567890} 1239} 0 1240test string-11.10.2.$noComp {string match} { 1241 run {string match *3*456*89 01234567890} 1242} 0 1243test string-11.10.3.$noComp {string match} { 1244 run {string match **3*456*89 01234567890} 1245} 0 1246test string-11.10.4.$noComp {string match} { 1247 run {string match *3*456***89 01234567890} 1248} 0 1249test string-11.11.$noComp {string match} { 1250 run {string match a?c abc} 1251} 1 1252test string-11.12.$noComp {string match} { 1253 run {string match a??c abc} 1254} 0 1255test string-11.13.$noComp {string match} { 1256 run {string match ?1??4???8? 0123456789} 1257} 1 1258test string-11.14.$noComp {string match} { 1259 run {string match {[abc]bc} abc} 1260} 1 1261test string-11.15.$noComp {string match} { 1262 run {string match {a[abc]c} abc} 1263} 1 1264test string-11.16.$noComp {string match} { 1265 run {string match {a[xyz]c} abc} 1266} 0 1267test string-11.17.$noComp {string match} { 1268 run {string match {12[2-7]45} 12345} 1269} 1 1270test string-11.18.$noComp {string match} { 1271 run {string match {12[ab2-4cd]45} 12345} 1272} 1 1273test string-11.19.$noComp {string match} { 1274 run {string match {12[ab2-4cd]45} 12b45} 1275} 1 1276test string-11.20.$noComp {string match} { 1277 run {string match {12[ab2-4cd]45} 12d45} 1278} 1 1279test string-11.21.$noComp {string match} { 1280 run {string match {12[ab2-4cd]45} 12145} 1281} 0 1282test string-11.22.$noComp {string match} { 1283 run {string match {12[ab2-4cd]45} 12545} 1284} 0 1285test string-11.23.$noComp {string match} { 1286 run {string match {a\*b} a*b} 1287} 1 1288test string-11.24.$noComp {string match} { 1289 run {string match {a\*b} ab} 1290} 0 1291test string-11.25.$noComp {string match} { 1292 run {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"} 1293} 1 1294test string-11.26.$noComp {string match} { 1295 run {string match ** ""} 1296} 1 1297test string-11.27.$noComp {string match} { 1298 run {string match *. ""} 1299} 0 1300test string-11.28.$noComp {string match} { 1301 run {string match "" ""} 1302} 1 1303test string-11.29.$noComp {string match} { 1304 run {string match \[a a} 1305} 1 1306test string-11.30.$noComp {string match, bad args} { 1307 list [catch {run {string match - b c}} msg] $msg 1308} {1 {bad option "-": must be -nocase}} 1309test string-11.31.$noComp {string match case} { 1310 run {string match a A} 1311} 0 1312test string-11.32.$noComp {string match nocase} { 1313 run {string match -n a A} 1314} 1 1315test string-11.33.$noComp {string match nocase} { 1316 run {string match -nocase aÜ Aü} 1317} 1 1318test string-11.34.$noComp {string match nocase} { 1319 run {string match -nocase a*f ABCDEf} 1320} 1 1321test string-11.35.$noComp {string match case, false hope} { 1322 # This is true because '_' lies between the A-Z and a-z ranges 1323 run {string match {[A-z]} _} 1324} 1 1325test string-11.36.$noComp {string match nocase range} { 1326 # This is false because although '_' lies between the A-Z and a-z ranges, 1327 # we lower case the end points before checking the ranges. 1328 run {string match -nocase {[A-z]} _} 1329} 0 1330test string-11.37.$noComp {string match nocase} { 1331 run {string match -nocase {[A-fh-Z]} g} 1332} 0 1333test string-11.38.$noComp {string match case, reverse range} { 1334 run {string match {[A-fh-Z]} g} 1335} 1 1336test string-11.39.$noComp {string match, *\ case} { 1337 run {string match {*\abc} abc} 1338} 1 1339test string-11.39.1.$noComp {string match, *\ case} { 1340 run {string match {*ab\c} abc} 1341} 1 1342test string-11.39.2.$noComp {string match, *\ case} { 1343 run {string match {*ab\*} ab*} 1344} 1 1345test string-11.39.3.$noComp {string match, *\ case} { 1346 run {string match {*ab\*} abc} 1347} 0 1348test string-11.39.4.$noComp {string match, *\ case} { 1349 run {string match {*ab\\*} {ab\c}} 1350} 1 1351test string-11.39.5.$noComp {string match, *\ case} { 1352 run {string match {*ab\\*} {ab\*}} 1353} 1 1354test string-11.40.$noComp {string match, *special case} { 1355 run {string match {*[ab]} abc} 1356} 0 1357test string-11.41.$noComp {string match, *special case} { 1358 run {string match {*[ab]*} abc} 1359} 1 1360test string-11.42.$noComp {string match, *special case} { 1361 run {string match "*\\" "\\"} 1362} 0 1363test string-11.43.$noComp {string match, *special case} { 1364 run {string match "*\\\\" "\\"} 1365} 1 1366test string-11.44.$noComp {string match, *special case} { 1367 run {string match "*???" "12345"} 1368} 1 1369test string-11.45.$noComp {string match, *special case} { 1370 run {string match "*???" "12"} 1371} 0 1372test string-11.46.$noComp {string match, *special case} { 1373 run {string match "*\\*" "abc*"} 1374} 1 1375test string-11.47.$noComp {string match, *special case} { 1376 run {string match "*\\*" "*"} 1377} 1 1378test string-11.48.$noComp {string match, *special case} { 1379 run {string match "*\\*" "*abc"} 1380} 0 1381test string-11.49.$noComp {string match, *special case} { 1382 run {string match "?\\*" "a*"} 1383} 1 1384test string-11.50.$noComp {string match, *special case} { 1385 run {string match "\\" "\\"} 1386} 0 1387test string-11.51.$noComp {string match; *, -nocase and UTF-8} { 1388 run {string match -nocase [binary format I 717316707] \ 1389 [binary format I 2028036707]} 1390} 1 1391test string-11.52.$noComp {string match, null char in string} { 1392 set out "" 1393 set ptn "*abc*" 1394 foreach elem [list "\x00@abc" "@abc" "\x00@abc\x00" "blahabcblah"] { 1395 lappend out [run {string match $ptn $elem}] 1396 } 1397 set out 1398} {1 1 1 1} 1399test string-11.53.$noComp {string match, null char in pattern} { 1400 set out "" 1401 foreach {ptn elem} [list \ 1402 "*\x00abc\x00" "\x00abc\x00" \ 1403 "*\x00abc\x00" "\x00abc\x00ef" \ 1404 "*\x00abc\x00*" "\x00abc\x00ef" \ 1405 "*\x00abc\x00" "@\x00abc\x00ef" \ 1406 "*\x00abc\x00*" "@\x00abc\x00ef" \ 1407 ] { 1408 lappend out [run {string match $ptn $elem}] 1409 } 1410 set out 1411} {1 0 1 0 1} 1412test string-11.54.$noComp {string match, failure} { 1413 set longString "" 1414 for {set i 0} {$i < 10} {incr i} { 1415 append longString "abcdefghijklmnopqrstuvwxy\x00z01234567890123" 1416 } 1417 run {string first $longString 123} 1418 list [run {string match *cba* $longString}] \ 1419 [run {string match *a*l*\x00* $longString}] \ 1420 [run {string match *a*l*\x00*123 $longString}] \ 1421 [run {string match *a*l*\x00*123* $longString}] \ 1422 [run {string match *a*l*\x00*cba* $longString}] \ 1423 [run {string match *===* $longString}] 1424} {0 1 1 1 0 0} 1425test string-11.55.$noComp {string match, invalid binary optimization} { 1426 [format string] match \u0141 [binary format c 65] 1427} 0 1428 1429test stringComp-12.1.0.$noComp {Bug 3588366: end-offsets before start} { 1430 apply {s { 1431 string range $s 0 end-5 1432 }} 12345 1433} {} 1434test string-12.1.$noComp {string range} { 1435 list [catch {run {string range}} msg] $msg 1436} {1 {wrong # args: should be "string range string first last"}} 1437test string-12.2.$noComp {string range} { 1438 list [catch {run {string range a 1}} msg] $msg 1439} {1 {wrong # args: should be "string range string first last"}} 1440test string-12.3.$noComp {string range} { 1441 list [catch {run {string range a 1 2 3}} msg] $msg 1442} {1 {wrong # args: should be "string range string first last"}} 1443test string-12.4.$noComp {string range} { 1444 run {string range abcdefghijklmnop 2 14} 1445} {cdefghijklmno} 1446test string-12.5.$noComp {string range, last > length} { 1447 run {string range abcdefghijklmnop 7 1000} 1448} {hijklmnop} 1449test string-12.6.$noComp {string range} { 1450 run {string range abcdefghijklmnop 10 end} 1451} {klmnop} 1452test string-12.7.$noComp {string range, last < first} { 1453 run {string range abcdefghijklmnop 10 9} 1454} {} 1455test string-12.8.$noComp {string range, first < 0} { 1456 run {string range abcdefghijklmnop -3 2} 1457} {abc} 1458test string-12.9.$noComp {string range} { 1459 run {string range abcdefghijklmnop -3 -2} 1460} {} 1461test string-12.10.$noComp {string range} { 1462 run {string range abcdefghijklmnop 1000 1010} 1463} {} 1464test string-12.11.$noComp {string range} { 1465 run {string range abcdefghijklmnop -100 end} 1466} {abcdefghijklmnop} 1467test string-12.12.$noComp {string range} { 1468 list [catch {run {string range abc abc 1}} msg] $msg 1469} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} 1470test string-12.13.$noComp {string range} { 1471 list [catch {run {string range abc 1 eof}} msg] $msg 1472} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} 1473test string-12.14.$noComp {string range} { 1474 run {string range abcdefghijklmnop end-1 end} 1475} {op} 1476test string-12.15.$noComp {string range} { 1477 run {string range abcdefghijklmnop end 1000} 1478} {p} 1479test string-12.16.$noComp {string range} { 1480 run {string range abcdefghijklmnop end end-1} 1481} {} 1482test string-12.17.$noComp {string range, unicode} { 1483 run {string range ab牦cdefghijklmnop 5 5} 1484} e 1485test string-12.18.$noComp {string range, unicode} { 1486 run {string range ab牦cdefghijklmnop 2 3} 1487} 牦c 1488test string-12.19.$noComp {string range, bytearray object} { 1489 set b [binary format I* {0x50515253 0x52}] 1490 set r1 [run {string range $b 1 end-1}] 1491 set r2 [run {string range $b 1 6}] 1492 run {string equal $r1 $r2} 1493} 1 1494test string-12.20.$noComp {string range, out of bounds indices} { 1495 run {string range \xFF 0 1} 1496} \xFF 1497# Bug 1410553 1498test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} { 1499 set bytes "\x00 \x03 \x41" 1500 set rxBuffer {} 1501 foreach ch $bytes { 1502 append rxBuffer $ch 1503 if {$ch eq "\x03"} { 1504 run {string length $rxBuffer} 1505 } 1506 } 1507 set rxCRC [run {string range $rxBuffer end-1 end}] 1508 binary scan [join $bytes {}] "H*" input_hex 1509 binary scan $rxBuffer "H*" rxBuffer_hex 1510 binary scan $rxCRC "H*" rxCRC_hex 1511 list $input_hex $rxBuffer_hex $rxCRC_hex 1512} {000341 000341 0341} 1513test string-12.22.$noComp {string range, shimmering binary/index} { 1514 set s 0000000001 1515 binary scan $s a* x 1516 run {string range $s $s end} 1517} 000000001 1518test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf16 { 1519 run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]} 1520} [list \U100000 {} b] 1521test string-12.24.$noComp {bignum index arithmetic} -setup { 1522 proc demo {i j} {string range fubar $i $j} 1523} -cleanup { 1524 rename demo {} 1525} -body { 1526 demo 2 0+0x10000000000000000 1527} -result bar 1528test string-12.25.$noComp {bignum index arithmetic} -setup { 1529 proc demo {i j} {string range fubar $i $j} 1530} -cleanup { 1531 rename demo {} 1532} -body { 1533 demo 0x10000000000000000-0xffffffffffffffff 3 1534} -result uba 1535 1536test string-13.1.$noComp {string repeat} { 1537 list [catch {run {string repeat}} msg] $msg 1538} {1 {wrong # args: should be "string repeat string count"}} 1539test string-13.2.$noComp {string repeat} { 1540 list [catch {run {string repeat abc 10 oops}} msg] $msg 1541} {1 {wrong # args: should be "string repeat string count"}} 1542test string-13.3.$noComp {string repeat} { 1543 run {string repeat {} 100} 1544} {} 1545test string-13.4.$noComp {string repeat} { 1546 run {string repeat { } 5} 1547} { } 1548test string-13.5.$noComp {string repeat} { 1549 run {string repeat abc 3} 1550} {abcabcabc} 1551test string-13.6.$noComp {string repeat} { 1552 run {string repeat abc -1} 1553} {} 1554test string-13.7.$noComp {string repeat} { 1555 list [catch {run {string repeat abc end}} msg] $msg 1556} {1 {expected integer but got "end"}} 1557test string-13.8.$noComp {string repeat} { 1558 run {string repeat {} -1000} 1559} {} 1560test string-13.9.$noComp {string repeat} { 1561 run {string repeat {} 0} 1562} {} 1563test string-13.10.$noComp {string repeat} { 1564 run {string repeat def 0} 1565} {} 1566test string-13.11.$noComp {string repeat} { 1567 run {string repeat def 1} 1568} def 1569test string-13.12.$noComp {string repeat} { 1570 run {string repeat ab牦cd 3} 1571} ab牦cdab牦cdab牦cd 1572test string-13.13.$noComp {string repeat} { 1573 run {string repeat \x00 3} 1574} \x00\x00\x00 1575test string-13.14.$noComp {string repeat} { 1576 # The string range will ensure us that string repeat gets a unicode string 1577 run {string repeat [run {string range ab牦cd 2 3}] 3} 1578} 牦c牦c牦c 1579 1580test string-14.1.$noComp {string replace} { 1581 list [catch {run {string replace}} msg] $msg 1582} {1 {wrong # args: should be "string replace string first last ?string?"}} 1583test string-14.2.$noComp {string replace} { 1584 list [catch {run {string replace a 1}} msg] $msg 1585} {1 {wrong # args: should be "string replace string first last ?string?"}} 1586test string-14.3.$noComp {string replace} { 1587 list [catch {run {string replace a 1 2 3 4}} msg] $msg 1588} {1 {wrong # args: should be "string replace string first last ?string?"}} 1589test string-14.4.$noComp {string replace} { 1590} {} 1591test string-14.5.$noComp {string replace} { 1592 run {string replace abcdefghijklmnop 2 14} 1593} {abp} 1594test string-14.6.$noComp {string replace} -body { 1595 run {string replace abcdefghijklmnop 7 1000} 1596} -result {abcdefg} 1597test string-14.7.$noComp {string replace} { 1598 run {string replace abcdefghijklmnop 10 end} 1599} {abcdefghij} 1600test string-14.8.$noComp {string replace} { 1601 run {string replace abcdefghijklmnop 10 9} 1602} {abcdefghijklmnop} 1603test string-14.9.$noComp {string replace} { 1604 run {string replace abcdefghijklmnop -3 2} 1605} {defghijklmnop} 1606test string-14.10.$noComp {string replace} { 1607 run {string replace abcdefghijklmnop -3 -2} 1608} {abcdefghijklmnop} 1609test string-14.11.$noComp {string replace} -body { 1610 run {string replace abcdefghijklmnop 1000 1010} 1611} -result {abcdefghijklmnop} 1612test string-14.12.$noComp {string replace} { 1613 run {string replace abcdefghijklmnop -100 end} 1614} {} 1615test string-14.13.$noComp {string replace} { 1616 list [catch {run {string replace abc abc 1}} msg] $msg 1617} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} 1618test string-14.14.$noComp {string replace} { 1619 list [catch {run {string replace abc 1 eof}} msg] $msg 1620} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} 1621test string-14.15.$noComp {string replace} { 1622 run {string replace abcdefghijklmnop end-10 end-2 NEW} 1623} {abcdeNEWop} 1624test string-14.16.$noComp {string replace} { 1625 run {string replace abcdefghijklmnop 0 end foo} 1626} {foo} 1627test string-14.17.$noComp {string replace} { 1628 run {string replace abcdefghijklmnop end end-1} 1629} {abcdefghijklmnop} 1630test string-14.18.$noComp {string replace} { 1631 run {string replace abcdefghijklmnop 10 9 XXX} 1632} {abcdefghijklmnop} 1633test string-14.19.$noComp {string replace} { 1634 run {string replace {} -1 0 A} 1635} A 1636test string-14.20.$noComp {string replace} { 1637 run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\ 1638 [makeByteArray NEW]} 1639} {abcdeNEWop} 1640test string-14.21.$noComp {string replace (surrogates)} { 1641 run {string replace \uD83D? 1 end \uDE02} 1642} \uD83D\uDE02 1643test string-14.22.$noComp {string replace (surrogates)} { 1644 run {string replace ?\uDE02 0 end-1 \uD83D} 1645} \uD83D\uDE02 1646test string-14.23.$noComp {string replace \xC0 \x80} testbytestring { 1647 run {string length [string replace [testbytestring \xC0]? 1 end [testbytestring \x80]]} 1648} 2 1649test string-14.24.$noComp {string replace \xC0 \x80} testbytestring { 1650 run {string length [string replace ?[testbytestring \x80] 0 end-1 [testbytestring \xC0]]} 1651} 2 1652 1653 1654test stringComp-14.21.$noComp {Bug 82e7f67325} { 1655 apply {x { 1656 set a [join $x {}] 1657 lappend b [string length [string replace ___! 0 2 $a]] 1658 lappend b [string length [string replace ___! 0 2 $a[unset a]]] 1659 }} {a b} 1660} {3 3} 1661test stringComp-14.22.$noComp {Bug 82e7f67325} memory { 1662 # As in stringComp-14.1, but make sure we don't retain too many refs 1663 leaktest { 1664 apply {x { 1665 set a [join $x {}] 1666 lappend b [string length [string replace ___! 0 2 $a]] 1667 lappend b [string length [string replace ___! 0 2 $a[unset a]]] 1668 }} {a b} 1669 } 1670} {0} 1671test stringComp-14.23.$noComp {Bug 0dca3bfa8f} { 1672 apply {arg { 1673 set argCopy $arg 1674 set arg [string replace $arg 1 2 aa] 1675 # Crashes in comparison before fix 1676 expr {$arg ne $argCopy} 1677 }} abcde 1678} 1 1679test stringComp-14.24.$noComp {Bug 1af8de570511} { 1680 apply {{x y} { 1681 # Generate an unshared string value 1682 set val "" 1683 for { set i 0 } { $i < $x } { incr i } { 1684 set val [format "0%s" $val] 1685 } 1686 string replace $val[unset val] 1 1 $y 1687 }} 4 x 1688} 0x00 1689test stringComp-14.25.$noComp {} { 1690 string length [string replace [string repeat a\xFE 2] 3 end {}] 1691} 3 1692test stringComp-14.26.$noComp {} { 1693 run {string replace abcd 0x10000000000000000-0xffffffffffffffff 2 e} 1694} aed 1695 1696test string-15.1.$noComp {string tolower not enough args} { 1697 list [catch {run {string tolower}} msg] $msg 1698} {1 {wrong # args: should be "string tolower string ?first? ?last?"}} 1699test string-15.2.$noComp {string tolower bad args} { 1700 list [catch {run {string tolower a b}} msg] $msg 1701} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} 1702test string-15.3.$noComp {string tolower too many args} { 1703 list [catch {run {string tolower ABC 1 end oops}} msg] $msg 1704} {1 {wrong # args: should be "string tolower string ?first? ?last?"}} 1705test string-15.4.$noComp {string tolower} { 1706 run {string tolower ABCDeF} 1707} {abcdef} 1708test string-15.5.$noComp {string tolower} { 1709 run {string tolower "ABC XyZ"} 1710} {abc xyz} 1711test string-15.6.$noComp {string tolower} { 1712 run {string tolower {123#$&*()}} 1713} {123#$&*()} 1714test string-15.7.$noComp {string tolower} { 1715 run {string tolower ABC 1} 1716} AbC 1717test string-15.8.$noComp {string tolower} { 1718 run {string tolower ABC 1 end} 1719} Abc 1720test string-15.9.$noComp {string tolower} { 1721 run {string tolower ABC 0 end-1} 1722} abC 1723test string-15.10.$noComp {string tolower, unicode} { 1724 run {string tolower ABCabc\xC7\xE7} 1725} "abcabc\xE7\xE7" 1726test string-15.11.$noComp {string tolower, compiled} { 1727 lindex [run {string tolower [list A B [list C]]}] 1 1728} b 1729 1730test string-16.1.$noComp {string toupper} { 1731 list [catch {run {string toupper}} msg] $msg 1732} {1 {wrong # args: should be "string toupper string ?first? ?last?"}} 1733test string-16.2.$noComp {string toupper} { 1734 list [catch {run {string toupper a b}} msg] $msg 1735} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} 1736test string-16.3.$noComp {string toupper} { 1737 list [catch {run {string toupper a 1 end oops}} msg] $msg 1738} {1 {wrong # args: should be "string toupper string ?first? ?last?"}} 1739test string-16.4.$noComp {string toupper} { 1740 run {string toupper abCDEf} 1741} {ABCDEF} 1742test string-16.5.$noComp {string toupper} { 1743 run {string toupper "abc xYz"} 1744} {ABC XYZ} 1745test string-16.6.$noComp {string toupper} { 1746 run {string toupper {123#$&*()}} 1747} {123#$&*()} 1748test string-16.7.$noComp {string toupper} { 1749 run {string toupper abc 1} 1750} aBc 1751test string-16.8.$noComp {string toupper} { 1752 run {string toupper abc 1 end} 1753} aBC 1754test string-16.9.$noComp {string toupper} { 1755 run {string toupper abc 0 end-1} 1756} ABc 1757test string-16.10.$noComp {string toupper, unicode} { 1758 run {string toupper ABCabc\xC7\xE7} 1759} "ABCABC\xC7\xC7" 1760test string-16.11.$noComp {string toupper, compiled} { 1761 lindex [run {string toupper [list a b [list c]]}] 1 1762} B 1763 1764test string-17.1.$noComp {string totitle} { 1765 list [catch {run {string totitle}} msg] $msg 1766} {1 {wrong # args: should be "string totitle string ?first? ?last?"}} 1767test string-17.2.$noComp {string totitle} { 1768 list [catch {run {string totitle a b}} msg] $msg 1769} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} 1770test string-17.3.$noComp {string totitle} { 1771 run {string totitle abCDEf} 1772} {Abcdef} 1773test string-17.4.$noComp {string totitle} { 1774 run {string totitle "abc xYz"} 1775} {Abc xyz} 1776test string-17.5.$noComp {string totitle} { 1777 run {string totitle {123#$&*()}} 1778} {123#$&*()} 1779test string-17.6.$noComp {string totitle, unicode} { 1780 run {string totitle ABCabc\xC7\xE7} 1781} "Abcabc\xE7\xE7" 1782test string-17.7.$noComp {string totitle, unicode} { 1783 run {string totitle \u01F3BCabc\xC7\xE7} 1784} "\u01F2bcabc\xE7\xE7" 1785test string-17.8.$noComp {string totitle, compiled} { 1786 lindex [run {string totitle [list aa bb [list cc]]}] 0 1787} Aa 1788test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} utf16 { 1789 run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \ 1790 [string totitle a\U118c0c 3 3]} 1791} [list a\U118a0c a\U118c0C a\U118c0C] 1792 1793test string-18.1.$noComp {string trim} { 1794 list [catch {run {string trim}} msg] $msg 1795} {1 {wrong # args: should be "string trim string ?chars?"}} 1796test string-18.2.$noComp {string trim} { 1797 list [catch {run {string trim a b c}} msg] $msg 1798} {1 {wrong # args: should be "string trim string ?chars?"}} 1799test string-18.3.$noComp {string trim} { 1800 run {string trim " XYZ "} 1801} {XYZ} 1802test string-18.4.$noComp {string trim} { 1803 run {string trim "\t\nXYZ\t\n\r\n"} 1804} {XYZ} 1805test string-18.5.$noComp {string trim} { 1806 run {string trim " A XYZ A "} 1807} {A XYZ A} 1808test string-18.6.$noComp {string trim} { 1809 run {string trim "XXYYZZABC XXYYZZ" ZYX} 1810} {ABC } 1811test string-18.7.$noComp {string trim} { 1812 run {string trim " \t\r "} 1813} {} 1814test string-18.8.$noComp {string trim} { 1815 run {string trim {abcdefg} {}} 1816} {abcdefg} 1817test string-18.9.$noComp {string trim} { 1818 run {string trim {}} 1819} {} 1820test string-18.10.$noComp {string trim} { 1821 run {string trim ABC DEF} 1822} {ABC} 1823test string-18.11.$noComp {string trim, unicode} { 1824 run {string trim "\xE7\xE8 AB\xE7C \xE8\xE7" \xE7\xE8} 1825} " AB\xE7C " 1826test string-18.12.$noComp {string trim, unicode default} { 1827 run {string trim \uFEFF\x00\x85\xA0\u1680\u180EABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} 1828} ABC\u1361 1829 1830test string-19.1.$noComp {string trimleft} { 1831 list [catch {run {string trimleft}} msg] $msg 1832} {1 {wrong # args: should be "string trimleft string ?chars?"}} 1833test string-19.2.$noComp {string trimleft} { 1834 run {string trimleft " XYZ "} 1835} {XYZ } 1836test string-19.3.$noComp {string trimleft, unicode default} { 1837 run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC} 1838} \u1361ABC 1839 1840test string-20.1.$noComp {string trimright errors} { 1841 list [catch {run {string trimright}} msg] $msg 1842} {1 {wrong # args: should be "string trimright string ?chars?"}} 1843test string-20.2.$noComp {string trimright errors} -body { 1844 list [catch {run {string trimg a}} msg] $msg 1845} -match glob -result {1 {unknown or ambiguous subcommand "trimg": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} 1846test string-20.3.$noComp {string trimright} { 1847 run {string trimright " XYZ "} 1848} { XYZ} 1849test string-20.4.$noComp {string trimright} { 1850 run {string trimright " "} 1851} {} 1852test string-20.5.$noComp {string trimright} { 1853 run {string trimright ""} 1854} {} 1855test string-20.6.$noComp {string trimright, unicode default} { 1856 run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} 1857} ABC\u1361 1858test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} {testbytestring} { 1859 set result {} 1860 set a [testbytestring \xC0\x80\xA0] 1861 set b foo$a 1862 set m [list \x00 U \xA0 V [testbytestring \xA0] W] 1863 lappend result [string map $m $b] 1864 lappend result [string map $m [run {string trimright $b x}]] 1865 lappend result [string map $m [run {string trimright $b \x00}]] 1866 lappend result [string map $m [run {string trimleft $b fox}]] 1867 lappend result [string map $m [run {string trimleft $b fo\x00}]] 1868 lappend result [string map $m [run {string trim $b fox}]] 1869 lappend result [string map $m [run {string trim $b fo\x00}]] 1870} [list {*}[lrepeat 3 fooUV] {*}[lrepeat 2 UV V]] 1871test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} {testbytestring} { 1872 set result {} 1873 set a [testbytestring \xE8\xA0] 1874 set b foo$a 1875 set m [list \xE8 U \xA0 V [testbytestring \xE8] W [testbytestring \xA0] X]] 1876 lappend result [string map $m $b] 1877 lappend result [string map $m [run {string trimright $b x}]] 1878 lappend result [string map $m [run {string trimright $b \xE8}]] 1879 lappend result [string map $m [run {string trimright $b [testbytestring \xE8]}]] 1880 lappend result [string map $m [run {string trimright $b \xA0}]] 1881 lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]] 1882 lappend result [string map $m [run {string trimright $b \xE8\xA0}]] 1883 lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]] 1884 lappend result [string map $m [run {string trimright $b \x00}]] 1885} [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV] 1886 1887test string-21.1.$noComp {string wordend} -body { 1888 list [catch {run {string wordend a}} msg] $msg 1889} -result {1 {wrong # args: should be "string wordend string index"}} 1890test string-21.2.$noComp {string wordend} -body { 1891 list [catch {run {string wordend a b c}} msg] $msg 1892} -result {1 {wrong # args: should be "string wordend string index"}} 1893test string-21.3.$noComp {string wordend} -body { 1894 list [catch {run {string wordend a gorp}} msg] $msg 1895} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} 1896test string-21.4.$noComp {string wordend} -body { 1897 run {string wordend abc. -1} 1898} -result 3 1899test string-21.5.$noComp {string wordend} -body { 1900 run {string wordend abc. 100} 1901} -result 4 1902test string-21.6.$noComp {string wordend} -body { 1903 run {string wordend "word_one two three" 2} 1904} -result 8 1905test string-21.7.$noComp {string wordend} -body { 1906 run {string wordend "one .&# three" 5} 1907} -result 6 1908test string-21.8.$noComp {string wordend} -body { 1909 run {string worde "x.y" 0} 1910} -result 1 1911test string-21.9.$noComp {string wordend} -body { 1912 run {string worde "x.y" end-1} 1913} -result 2 1914test string-21.10.$noComp {string wordend, unicode} -body { 1915 run {string wordend "xyz\xC7de fg" 0} 1916} -result 6 1917test string-21.11.$noComp {string wordend, unicode} -body { 1918 run {string wordend "xyz\uC700de fg" 0} 1919} -result 6 1920test string-21.12.$noComp {string wordend, unicode} -body { 1921 run {string wordend "xyz\u203Fde fg" 0} 1922} -result 6 1923test string-21.13.$noComp {string wordend, unicode} -body { 1924 run {string wordend "xyz\u2045de fg" 0} 1925} -result 3 1926test string-21.14.$noComp {string wordend, unicode} -body { 1927 run {string wordend "\uC700\uC700 abc" 8} 1928} -result 6 1929test string-21.15.$noComp {string wordend, unicode} -body { 1930 run {string wordend "\U1D7CA\U1D7CA abc" 0} 1931} -result 2 1932test string-21.16.$noComp {string wordend, unicode} -constraints utf16 -body { 1933 run {string wordend "\U1D7CA\U1D7CA abc" 10} 1934} -result 8 1935test string-21.17.$noComp {string trim, unicode} { 1936 run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} 1937} "Hello world!" 1938test string-21.18.$noComp {string trimleft, unicode} { 1939 run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} 1940} "Hello world!\uD83D\uDE02" 1941test string-21.19.$noComp {string trimright, unicode} { 1942 run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} 1943} "\uD83D\uDE02Hello world!" 1944test string-21.20.$noComp {string trim, unicode} { 1945 run {string trim "\uF602Hello world!\uF602" \uD83D\uDE02} 1946} "\uF602Hello world!\uF602" 1947test string-21.21.$noComp {string trimleft, unicode} { 1948 run {string trimleft "\uF602Hello world!\uF602" \uD83D\uDE02} 1949} "\uF602Hello world!\uF602" 1950test string-21.22.$noComp {string trimright, unicode} { 1951 run {string trimright "\uF602Hello world!\uF602" \uD83D\uDE02} 1952} "\uF602Hello world!\uF602" 1953test string-21.23.$noComp {string trim, unicode} { 1954 run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} 1955} "\uD83D\uDE02Hello world!\uD83D\uDE02" 1956test string-21.24.$noComp {string trimleft, unicode} { 1957 run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} 1958} "\uD83D\uDE02Hello world!\uD83D\uDE02" 1959test string-21.25.$noComp {string trimright, unicode} { 1960 run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} 1961} "\uD83D\uDE02Hello world!\uD83D\uDE02" 1962 1963test string-22.1.$noComp {string wordstart} -body { 1964 list [catch {run {string word a}} msg] $msg 1965} -match glob -result {1 {unknown or ambiguous subcommand "word": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} 1966test string-22.2.$noComp {string wordstart} -body { 1967 list [catch {run {string wordstart a}} msg] $msg 1968} -result {1 {wrong # args: should be "string wordstart string index"}} 1969test string-22.3.$noComp {string wordstart} -body { 1970 list [catch {run {string wordstart a b c}} msg] $msg 1971} -result {1 {wrong # args: should be "string wordstart string index"}} 1972test string-22.4.$noComp {string wordstart} -body { 1973 list [catch {run {string wordstart a gorp}} msg] $msg 1974} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} 1975test string-22.5.$noComp {string wordstart} -body { 1976 run {string wordstart "one two three_words" 400} 1977} -result 8 1978test string-22.6.$noComp {string wordstart} -body { 1979 run {string wordstart "one two three_words" 2} 1980} -result 0 1981test string-22.7.$noComp {string wordstart} -body { 1982 run {string wordstart "one two three_words" -2} 1983} -result 0 1984test string-22.8.$noComp {string wordstart} -body { 1985 run {string wordstart "one .*&^ three" 6} 1986} -result 6 1987test string-22.9.$noComp {string wordstart} -body { 1988 run {string wordstart "one two three" 4} 1989} -result 4 1990test string-22.10.$noComp {string wordstart} -body { 1991 run {string wordstart "one two three" end-5} 1992} -result 7 1993test string-22.11.$noComp {string wordstart, unicode} -body { 1994 run {string wordstart "one tw\xC7o three" 7} 1995} -result 4 1996test string-22.12.$noComp {string wordstart, unicode} -body { 1997 run {string wordstart "ab\uC700\uC700 cdef ghi" 12} 1998} -result 10 1999test string-22.13.$noComp {string wordstart, unicode} -body { 2000 run {string wordstart "\uC700\uC700 abc" 8} 2001} -result 3 2002test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbytestring -body { 2003 # See Bug c61818e4c9 2004 set demo [testbytestring "abc def\xE0\xA9ghi"] 2005 run {string index $demo [string wordstart $demo 10]} 2006} -result g 2007test string-22.15.$noComp {string wordstart, unicode} -body { 2008 run {string wordstart "\U1D7CA\U1D7CA abc" 0} 2009} -result 0 2010test string-22.16.$noComp {string wordstart, unicode} -constraints utf16 -body { 2011 run {string wordstart "\U1D7CA\U1D7CA abc" 10} 2012} -result 5 2013 2014test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj { 2015 set x 5 2016 catch {testindexobj $x foo bar soom} 2017 run {string is boolean $x} 2018} 0 2019test string-23.1.$noComp {string is command with empty string} { 2020 set s "" 2021 list \ 2022 [run {string is alnum $s}] \ 2023 [run {string is alpha $s}] \ 2024 [run {string is ascii $s}] \ 2025 [run {string is control $s}] \ 2026 [run {string is boolean $s}] \ 2027 [run {string is digit $s}] \ 2028 [run {string is double $s}] \ 2029 [run {string is false $s}] \ 2030 [run {string is graph $s}] \ 2031 [run {string is integer $s}] \ 2032 [run {string is lower $s}] \ 2033 [run {string is print $s}] \ 2034 [run {string is punct $s}] \ 2035 [run {string is space $s}] \ 2036 [run {string is true $s}] \ 2037 [run {string is upper $s}] \ 2038 [run {string is wordchar $s}] \ 2039 [run {string is xdigit $s}] \ 2040 2041} {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1} 2042test string-23.2.$noComp {string is command with empty string} { 2043 set s "" 2044 list \ 2045 [run {string is alnum -strict $s}] \ 2046 [run {string is alpha -strict $s}] \ 2047 [run {string is ascii -strict $s}] \ 2048 [run {string is control -strict $s}] \ 2049 [run {string is boolean -strict $s}] \ 2050 [run {string is digit -strict $s}] \ 2051 [run {string is double -strict $s}] \ 2052 [run {string is false -strict $s}] \ 2053 [run {string is graph -strict $s}] \ 2054 [run {string is integer -strict $s}] \ 2055 [run {string is lower -strict $s}] \ 2056 [run {string is print -strict $s}] \ 2057 [run {string is punct -strict $s}] \ 2058 [run {string is space -strict $s}] \ 2059 [run {string is true -strict $s}] \ 2060 [run {string is upper -strict $s}] \ 2061 [run {string is wordchar -strict $s}] \ 2062 [run {string is xdigit -strict $s}] \ 2063 2064} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} 2065 2066test string-24.1.$noComp {string reverse command} -body { 2067 run {string reverse} 2068} -returnCodes error -result "wrong # args: should be \"string reverse string\"" 2069test string-24.2.$noComp {string reverse command} -body { 2070 run {string reverse a b} 2071} -returnCodes error -result "wrong # args: should be \"string reverse string\"" 2072test string-24.3.$noComp {string reverse command - shared string} { 2073 set x abcde 2074 run {string reverse $x} 2075} edcba 2076test string-24.4.$noComp {string reverse command - unshared string} { 2077 set x abc 2078 set y de 2079 run {string reverse $x$y} 2080} edcba 2081test string-24.5.$noComp {string reverse command - shared unicode string} { 2082 set x abcde\uD0AD 2083 run {string reverse $x} 2084} \uD0ADedcba 2085test string-24.6.$noComp {string reverse command - unshared string} { 2086 set x abc 2087 set y de\uD0AD 2088 run {string reverse $x$y} 2089} \uD0ADedcba 2090test string-24.7.$noComp {string reverse command - simple case} { 2091 run {string reverse a} 2092} a 2093test string-24.8.$noComp {string reverse command - simple case} { 2094 run {string reverse \uD0AD} 2095} \uD0AD 2096test string-24.9.$noComp {string reverse command - simple case} { 2097 run {string reverse {}} 2098} {} 2099test string-24.10.$noComp {string reverse command - corner case} { 2100 set x \uBEEF\uD0AD 2101 run {string reverse $x} 2102} \uD0AD\uBEEF 2103test string-24.11.$noComp {string reverse command - corner case} { 2104 set x \uBEEF 2105 set y \uD0AD 2106 run {string reverse $x$y} 2107} \uD0AD\uBEEF 2108test string-24.12.$noComp {string reverse command - corner case} { 2109 set x \uBEEF 2110 set y \uD0AD 2111 run {string is ascii [run {string reverse $x$y}]} 2112} 0 2113test string-24.13.$noComp {string reverse command - pure Unicode string} { 2114 run {string reverse [run {string range \uBEEF\uD0AD\uBEEF\uD0AD\uBEEF\uD0AD 1 5}]} 2115} \uD0AD\uBEEF\uD0AD\uBEEF\uD0AD 2116test string-24.14.$noComp {string reverse command - pure bytearray} { 2117 binary scan [run {string reverse [binary format H* 010203]}] H* x 2118 set x 2119} 030201 2120test string-24.15.$noComp {string reverse command - pure bytearray} { 2121 binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x 2122 set x 2123} 030201 2124test string-24.16.$noComp {string reverse command - surrogates} { 2125 run {string reverse \u0444bulb\uD83D\uDE02} 2126} \uD83D\uDE02blub\u0444 2127test string-24.17.$noComp {string reverse command - surrogates} { 2128 run {string reverse \uD83D\uDE02hello\uD83D\uDE02} 2129} \uD83D\uDE02olleh\uD83D\uDE02 2130test string-24.18.$noComp {string reverse command - surrogates} { 2131 set s \u0444bulb\uD83D\uDE02 2132 # shim shimmery ... 2133 string index $s 0 2134 run {string reverse $s} 2135} \uD83D\uDE02blub\u0444 2136test string-24.19.$noComp {string reverse command - surrogates} { 2137 set s \uD83D\uDE02hello\uD83D\uDE02 2138 # shim shimmery ... 2139 string index $s 0 2140 run {string reverse $s} 2141} \uD83D\uDE02olleh\uD83D\uDE02 2142 2143test string-25.1.$noComp {string is list} { 2144 run {string is list {a b c}} 2145} 1 2146test string-25.2.$noComp {string is list} { 2147 run {string is list "a \{b c"} 2148} 0 2149test string-25.3.$noComp {string is list} { 2150 run {string is list {a {b c}d e}} 2151} 0 2152test string-25.4.$noComp {string is list} { 2153 run {string is list {}} 2154} 1 2155test string-25.5.$noComp {string is list} { 2156 run {string is list -strict {a b c}} 2157} 1 2158test string-25.6.$noComp {string is list} { 2159 run {string is list -strict "a \{b c"} 2160} 0 2161test string-25.7.$noComp {string is list} { 2162 run {string is list -strict {a {b c}d e}} 2163} 0 2164test string-25.8.$noComp {string is list} { 2165 run {string is list -strict {}} 2166} 1 2167test string-25.9.$noComp {string is list} { 2168 set x {} 2169 list [run {string is list -failindex x {a b c}}] $x 2170} {1 {}} 2171test string-25.10.$noComp {string is list} { 2172 set x {} 2173 list [run {string is list -failindex x "a \{b c"}] $x 2174} {0 2} 2175test string-25.11.$noComp {string is list} { 2176 set x {} 2177 list [run {string is list -failindex x {a b {b c}d e}}] $x 2178} {0 4} 2179test string-25.12.$noComp {string is list} { 2180 set x {} 2181 list [run {string is list -failindex x {}}] $x 2182} {1 {}} 2183test string-25.13.$noComp {string is list} { 2184 set x {} 2185 list [run {string is list -failindex x { {b c}d e}}] $x 2186} {0 2} 2187test string-25.14.$noComp {string is list} { 2188 set x {} 2189 list [run {string is list -failindex x "\uABCD {b c}d e"}] $x 2190} {0 2} 2191 2192test string-26.1.$noComp {tcl::prefix, not enough args} -body { 2193 tcl::prefix match a 2194} -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"} 2195test string-26.2.$noComp {tcl::prefix, bad args} -body { 2196 tcl::prefix match a b c 2197} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message} 2198test string-26.2.1.$noComp {tcl::prefix, empty table} -body { 2199 tcl::prefix match {} foo 2200} -returnCodes 1 -result {bad option "foo": no valid options} 2201test string-26.3.$noComp {tcl::prefix, bad args} -body { 2202 tcl::prefix match -error "{}x" -exact str1 str2 2203} -returnCodes 1 -result {list element in braces followed by "x" instead of space} 2204test string-26.3.1.$noComp {tcl::prefix, bad args} -body { 2205 tcl::prefix match -error "x" -exact str1 str2 2206} -returnCodes 1 -result {error options must have an even number of elements} 2207test string-26.3.2.$noComp {tcl::prefix, bad args} -body { 2208 tcl::prefix match -error str1 str2 2209} -returnCodes 1 -result {missing value for -error} 2210test string-26.4.$noComp {tcl::prefix, bad args} -body { 2211 tcl::prefix match -message str1 str2 2212} -returnCodes 1 -result {missing value for -message} 2213test string-26.5.$noComp {tcl::prefix} { 2214 tcl::prefix match {apa bepa cepa depa} cepa 2215} cepa 2216test string-26.6.$noComp {tcl::prefix} { 2217 tcl::prefix match {apa bepa cepa depa} be 2218} bepa 2219test string-26.7.$noComp {tcl::prefix} -body { 2220 tcl::prefix match -exact {apa bepa cepa depa} be 2221} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa} 2222test string-26.8.$noComp {tcl::prefix} -body { 2223 tcl::prefix match -message wombat {apa bepa bear depa} be 2224} -returnCodes 1 -result {ambiguous wombat "be": must be apa, bepa, bear, or depa} 2225test string-26.9.$noComp {tcl::prefix} -body { 2226 tcl::prefix match -error {} {apa bepa bear depa} be 2227} -returnCodes 0 -result {} 2228test string-26.10.$noComp {tcl::prefix} -body { 2229 tcl::prefix match -error {-level 1} {apa bepa bear depa} be 2230} -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa} 2231test string-26.10.1.$noComp {tcl::prefix} -setup { 2232 proc _testprefix {args} { 2233 array set opts {-a x -b y -c y} 2234 foreach {opt val} $args { 2235 set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt] 2236 set opts($opt) $val 2237 } 2238 array get opts 2239 } 2240} -body { 2241 set a [catch {_testprefix -x u} result options] 2242 dict get $options -errorinfo 2243} -cleanup { 2244 rename _testprefix {} 2245} -result {bad option "-x": must be -a, -b, or -c 2246 while executing 2247"_testprefix -x u"} 2248 2249# Helper for memory stress tests 2250# Repeat each body in a local space checking that memory does not increase 2251proc MemStress {args} { 2252 set res {} 2253 foreach body $args { 2254 set end 0 2255 for {set i 0} {$i < 5} {incr i} { 2256 proc MemStress_Body {} $body 2257 uplevel 1 MemStress_Body 2258 rename MemStress_Body {} 2259 set tmp $end 2260 set end [lindex [lindex [split [memory info] "\n"] 3] 3] 2261 } 2262 lappend res [expr {$end - $tmp}] 2263 } 2264 return $res 2265} 2266 2267test string-26.11.$noComp {tcl::prefix: testing for leaks} -body { 2268 # This test is made to stress object reference management 2269 MemStress { 2270 set table {hejj miff gurk} 2271 set item [lindex $table 1] 2272 # If not careful, this can cause a circular reference 2273 # that will cause a leak. 2274 tcl::prefix match $table $item 2275 } { 2276 # A similar case with nested lists 2277 set table2 {hejj {miff maff} gurk} 2278 set item [lindex [lindex $table2 1] 0] 2279 tcl::prefix match $table2 $item 2280 } { 2281 # A similar case with dict 2282 set table3 {hejj {miff maff} gurk2} 2283 set item [lindex [dict keys [lindex $table3 1]] 0] 2284 tcl::prefix match $table3 $item 2285 } 2286} -constraints memory -result {0 0 0} 2287 2288test string-26.12.$noComp {tcl::prefix: testing for leaks} -body { 2289 # This is a memory leak test in a form that might actually happen 2290 # in real code. The shared literal "miff" causes a connection 2291 # between the item and the table. 2292 MemStress { 2293 proc stress1 {item} { 2294 set table [list hejj miff gurk] 2295 tcl::prefix match $table $item 2296 } 2297 proc stress2 {} { 2298 stress1 miff 2299 } 2300 stress2 2301 rename stress1 {} 2302 rename stress2 {} 2303 } 2304} -constraints memory -result 0 2305 2306test string-26.13.$noComp {tcl::prefix: testing for leaks} -body { 2307 # This test is made to stress object reference management 2308 MemStress { 2309 set table [list hejj miff] 2310 set item $table 2311 set error $table 2312 # Use the same objects in all places 2313 catch { 2314 tcl::prefix match -error $error $table $item 2315 } 2316 } 2317} -constraints memory -result {0} 2318 2319test string-27.1.$noComp {tcl::prefix all, not enough args} -body { 2320 tcl::prefix all a 2321} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"} 2322test string-27.2.$noComp {tcl::prefix all, bad args} -body { 2323 tcl::prefix all a b c 2324} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"} 2325test string-27.3.$noComp {tcl::prefix all, bad args} -body { 2326 tcl::prefix all "{}x" str2 2327} -returnCodes 1 -result {list element in braces followed by "x" instead of space} 2328test string-27.4.$noComp {tcl::prefix all} { 2329 tcl::prefix all {apa bepa cepa depa} c 2330} cepa 2331test string-27.5.$noComp {tcl::prefix all} { 2332 tcl::prefix all {apa bepa cepa depa} cepa 2333} cepa 2334test string-27.6.$noComp {tcl::prefix all} { 2335 tcl::prefix all {apa bepa cepa depa} cepax 2336} {} 2337test string-27.7.$noComp {tcl::prefix all} { 2338 tcl::prefix all {apa aska appa} a 2339} {apa aska appa} 2340test string-27.8.$noComp {tcl::prefix all} { 2341 tcl::prefix all {apa aska appa} ap 2342} {apa appa} 2343test string-27.9.$noComp {tcl::prefix all} { 2344 tcl::prefix all {apa aska appa} p 2345} {} 2346test string-27.10.$noComp {tcl::prefix all} { 2347 tcl::prefix all {apa aska appa} {} 2348} {apa aska appa} 2349 2350test string-28.1.$noComp {tcl::prefix longest, not enough args} -body { 2351 tcl::prefix longest a 2352} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"} 2353test string-28.2.$noComp {tcl::prefix longest, bad args} -body { 2354 tcl::prefix longest a b c 2355} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"} 2356test string-28.3.$noComp {tcl::prefix longest, bad args} -body { 2357 tcl::prefix longest "{}x" str2 2358} -returnCodes 1 -result {list element in braces followed by "x" instead of space} 2359test string-28.4.$noComp {tcl::prefix longest} { 2360 tcl::prefix longest {apa bepa cepa depa} c 2361} cepa 2362test string-28.5.$noComp {tcl::prefix longest} { 2363 tcl::prefix longest {apa bepa cepa depa} cepa 2364} cepa 2365test string-28.6.$noComp {tcl::prefix longest} { 2366 tcl::prefix longest {apa bepa cepa depa} cepax 2367} {} 2368test string-28.7.$noComp {tcl::prefix longest} { 2369 tcl::prefix longest {apa aska appa} a 2370} a 2371test string-28.8.$noComp {tcl::prefix longest} { 2372 tcl::prefix longest {apa aska appa} ap 2373} ap 2374test string-28.9.$noComp {tcl::prefix longest} { 2375 tcl::prefix longest {apa bska appa} a 2376} ap 2377test string-28.10.$noComp {tcl::prefix longest} { 2378 tcl::prefix longest {apa bska appa} {} 2379} {} 2380test string-28.11.$noComp {tcl::prefix longest} { 2381 tcl::prefix longest {{} bska appa} {} 2382} {} 2383test string-28.12.$noComp {tcl::prefix longest} { 2384 tcl::prefix longest {apa {} appa} {} 2385} {} 2386test string-28.13.$noComp {tcl::prefix longest} { 2387 # Test utf-8 handling 2388 tcl::prefix longest {ax\x90 bep ax\x91} a 2389} ax 2390 2391test string-29.1.$noComp {string cat, no arg} { 2392 run {string cat} 2393} "" 2394test string-29.2.$noComp {string cat, single arg} { 2395 set x FOO 2396 run {string compare $x [run {string cat $x}]} 2397} 0 2398test string-29.3.$noComp {string cat, two args} { 2399 set x FOO 2400 run {string compare $x$x [run {string cat $x $x}]} 2401} 0 2402test string-29.4.$noComp {string cat, many args} { 2403 set x FOO 2404 set n 260 2405 set xx [run {string repeat $x $n}] 2406 set vv [run {string repeat {$x} $n}] 2407 set vvs [run {string repeat {$x } $n}] 2408 set r1 [run {string compare $xx [subst $vv]}] 2409 set r2 [run {string compare $xx [eval "run {string cat $vvs}"]}] 2410 list $r1 $r2 2411} {0 0} 2412if {$noComp} { 2413test string-29.5.$noComp {string cat, efficiency} -body { 2414 tcl::unsupported::representation [run {string cat [list x] [list]}] 2415} -match glob -result {*no string representation} 2416test string-29.6.$noComp {string cat, efficiency} -body { 2417 tcl::unsupported::representation [run {string cat [list] [list x]}] 2418} -match glob -result {*no string representation} 2419test string-29.7.$noComp {string cat, efficiency} -body { 2420 tcl::unsupported::representation [run {string cat [list x] [list] [list]}] 2421} -match glob -result {*no string representation} 2422test string-29.8.$noComp {string cat, efficiency} -body { 2423 tcl::unsupported::representation [run {string cat [list] [list x] [list]}] 2424} -match glob -result {*no string representation} 2425test string-29.9.$noComp {string cat, efficiency} -body { 2426 tcl::unsupported::representation [run {string cat [list] [list] [list x]}] 2427} -match glob -result {*no string representation} 2428test string-29.10.$noComp {string cat, efficiency} -body { 2429 tcl::unsupported::representation [run {string cat [list x] [list x]}] 2430} -match glob -result {*, string representation "xx"} 2431test string-29.11.$noComp {string cat, efficiency} -body { 2432 tcl::unsupported::representation \ 2433 [run {string cat [list x] [encoding convertto utf-8 {}]}] 2434} -match glob -result {*no string representation} 2435test string-29.12.$noComp {string cat, efficiency} -body { 2436 tcl::unsupported::representation \ 2437 [run {string cat [encoding convertto utf-8 {}] [list x]}] 2438} -match glob -result {*, string representation "x"} 2439test string-29.13.$noComp {string cat, efficiency} -body { 2440 tcl::unsupported::representation [run {string cat \ 2441 [encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}] 2442} -match glob -result {*, string representation "x"} 2443test string-29.14.$noComp {string cat, efficiency} -setup { 2444 set e [encoding convertto utf-8 {}] 2445} -cleanup { 2446 unset e 2447} -body { 2448 tcl::unsupported::representation [run {string cat $e $e [list x]}] 2449} -match glob -result {*no string representation} 2450test string-29.15.$noComp {string cat, efficiency} -setup { 2451 set e [encoding convertto utf-8 {}] 2452 set f [encoding convertto utf-8 {}] 2453} -cleanup { 2454 unset e f 2455} -body { 2456 tcl::unsupported::representation [run {string cat $e $f $e $f [list x]}] 2457} -match glob -result {*no string representation} 2458} 2459 2460test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} { 2461 run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]} 2462} hellohello 2463test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} { 2464 run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"} 2465} hellohello 2466 2467# Note: string-31.* tests use [tcl::string::insert] rather than [string insert] 2468# to dodge ticket [3397978fff] which would cause all arguments to be shared, 2469# thereby preventing the optimizations from being tested. 2470test string-31.1.$noComp {string insert, start of string} { 2471 run {tcl::string::insert 0123 0 _} 2472} _0123 2473test string-31.2.$noComp {string insert, middle of string} { 2474 run {tcl::string::insert 0123 2 _} 2475} 01_23 2476test string-31.3.$noComp {string insert, end of string} { 2477 run {tcl::string::insert 0123 4 _} 2478} 0123_ 2479test string-31.4.$noComp {string insert, start of string, end-relative} { 2480 run {tcl::string::insert 0123 end-4 _} 2481} _0123 2482test string-31.5.$noComp {string insert, middle of string, end-relative} { 2483 run {tcl::string::insert 0123 end-2 _} 2484} 01_23 2485test string-31.6.$noComp {string insert, end of string, end-relative} { 2486 run {tcl::string::insert 0123 end _} 2487} 0123_ 2488test string-31.7.$noComp {string insert, empty target string} { 2489 run {tcl::string::insert {} 0 _} 2490} _ 2491test string-31.8.$noComp {string insert, empty insert string} { 2492 run {tcl::string::insert 0123 0 {}} 2493} 0123 2494test string-31.9.$noComp {string insert, empty strings} { 2495 run {tcl::string::insert {} 0 {}} 2496} {} 2497test string-31.10.$noComp {string insert, negative index} { 2498 run {tcl::string::insert 0123 -1 _} 2499} _0123 2500test string-31.11.$noComp {string insert, index beyond end} { 2501 run {tcl::string::insert 0123 5 _} 2502} 0123_ 2503test string-31.12.$noComp {string insert, start of string, pure byte array} { 2504 run {tcl::string::insert [makeByteArray 0123] 0 [makeByteArray _]} 2505} _0123 2506test string-31.13.$noComp {string insert, middle of string, pure byte array} { 2507 run {tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]} 2508} 01_23 2509test string-31.14.$noComp {string insert, end of string, pure byte array} { 2510 run {tcl::string::insert [makeByteArray 0123] 4 [makeByteArray _]} 2511} 0123_ 2512test string-31.15.$noComp {string insert, pure byte array, neither shared} { 2513 run {tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]} 2514} 01_23 2515test string-31.16.$noComp {string insert, pure byte array, first shared} { 2516 run {tcl::string::insert [makeShared [makeByteArray 0123]] 2\ 2517 [makeByteArray _]} 2518} 01_23 2519test string-31.17.$noComp {string insert, pure byte array, second shared} { 2520 run {tcl::string::insert [makeByteArray 0123] 2\ 2521 [makeShared [makeByteArray _]]} 2522} 01_23 2523test string-31.18.$noComp {string insert, pure byte array, both shared} { 2524 run {tcl::string::insert [makeShared [makeByteArray 0123]] 2\ 2525 [makeShared [makeByteArray _]]} 2526} 01_23 2527test string-31.19.$noComp {string insert, start of string, pure Unicode} { 2528 run {tcl::string::insert [makeUnicode 0123] 0 [makeUnicode _]} 2529} _0123 2530test string-31.20.$noComp {string insert, middle of string, pure Unicode} { 2531 run {tcl::string::insert [makeUnicode 0123] 2 [makeUnicode _]} 2532} 01_23 2533test string-31.21.$noComp {string insert, end of string, pure Unicode} { 2534 run {tcl::string::insert [makeUnicode 0123] 4 [makeUnicode _]} 2535} 0123_ 2536test string-31.22.$noComp {string insert, str start, pure Uni, first shared} { 2537 run {tcl::string::insert [makeShared [makeUnicode 0123]] 0 [makeUnicode _]} 2538} _0123 2539test string-31.23.$noComp {string insert, string mid, pure Uni, 2nd shared} { 2540 run {tcl::string::insert [makeUnicode 0123] 2 [makeShared [makeUnicode _]]} 2541} 01_23 2542test string-31.24.$noComp {string insert, string end, pure Uni, both shared} { 2543 run {tcl::string::insert [makeShared [makeUnicode 0123]] 4\ 2544 [makeShared [makeUnicode _]]} 2545} 0123_ 2546test string-31.25.$noComp {string insert, neither byte array nor Unicode} { 2547 run {tcl::string::insert [makeList a b c] 1 zzzzzz} 2548} {azzzzzz b c} 2549test string-31.26.$noComp {[11229bad5f] string insert, compiler} -setup { 2550 set i 2 2551} -body { 2552 run {tcl::string::insert abcd $i xyz} 2553} -cleanup { 2554 unset i 2555} -result abxyzcd 2556 2557test string-32.1.$noComp {string is dict} { 2558 string is dict {a b c d} 2559} 1 2560test string-32.1a.$noComp {string is dict} { 2561 string is dict {a b c} 2562} 0 2563test string-32.2.$noComp {string is dict} { 2564 string is dict "a \{b c" 2565} 0 2566test string-32.3.$noComp {string is dict} { 2567 string is dict {a {b c}d e} 2568} 0 2569test string-32.4.$noComp {string is dict} { 2570 string is dict {} 2571} 1 2572test string-32.5.$noComp {string is dict} { 2573 string is dict -strict {a b c d} 2574} 1 2575test string-32.5a.$noComp {string is dict} { 2576 string is dict -strict {a b c} 2577} 0 2578test string-32.6.$noComp {string is dict} { 2579 string is dict -strict "a \{b c" 2580} 0 2581test string-32.7.$noComp {string is dict} { 2582 string is dict -strict {a {b c}d e} 2583} 0 2584test string-32.8.$noComp {string is dict} { 2585 string is dict -strict {} 2586} 1 2587test string-32.9.$noComp {string is dict} { 2588 set x {} 2589 list [string is dict -failindex x {a b c d}] $x 2590} {1 {}} 2591test string-32.9a.$noComp {string is dict} { 2592 set x {} 2593 list [string is dict -failindex x {a b c}] $x 2594} {0 -1} 2595test string-32.10.$noComp {string is dict} { 2596 set x {} 2597 list [string is dict -failindex x "a \{b c d"] $x 2598} {0 2} 2599test string-32.10a.$noComp {string is dict} { 2600 set x {} 2601 list [string is dict -failindex x "a \{b c"] $x 2602} {0 2} 2603test string-32.11.$noComp {string is dict} { 2604 set x {} 2605 list [string is dict -failindex x {a b {b c}d e}] $x 2606} {0 4} 2607test string-32.12.$noComp {string is dict} { 2608 set x {} 2609 list [string is dict -failindex x {}] $x 2610} {1 {}} 2611test string-32.13.$noComp {string is dict} { 2612 set x {} 2613 list [string is dict -failindex x { {b c}d e}] $x 2614} {0 2} 2615test string-32.14.$noComp {string is dict} { 2616 set x {} 2617 list [string is dict -failindex x "\uABCD {b c}d e"] $x 2618} {0 2} 2619test string-32.15.$noComp {string is dict, valid dict} { 2620 string is dict {a b c d e f} 2621} 1 2622test string-32.16.$noComp {string is dict, invalid dict} { 2623 string is dict a 2624} 0 2625test string-32.17.$noComp {string is dict, valid dict packed in invalid dict} { 2626 string is dict {{a b c d e f g h}} 2627} 0 2628 2629}; # foreach noComp {0 1} 2630 2631# cleanup 2632rename MemStress {} 2633rename makeByteArray {} 2634rename makeUnicode {} 2635rename makeList {} 2636rename makeShared {} 2637catch {rename foo {}} 2638::tcltest::cleanupTests 2639return 2640 2641# Local Variables: 2642# mode: tcl 2643# End: 2644