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