1# Commands covered:  none
2#
3# This file contains a collection of tests for Tcl's dynamic string library
4# procedures. Sourcing this file into Tcl runs the tests and generates output
5# for errors. No output means no errors were found.
6#
7# Copyright © 1993 The Regents of the University of California.
8# Copyright © 1994 Sun Microsystems, Inc.
9# Copyright © 1998-1999 Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution of
12# this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
14if {"::tcltest" ni [namespace children]} {
15    package require tcltest 2.5
16    namespace import -force ::tcltest::*
17}
18
19::tcltest::loadTestedCommands
20catch [list package require -exact tcl::test [info patchlevel]]
21
22testConstraint testdstring [llength [info commands testdstring]]
23if {[testConstraint testdstring]} {
24    testdstring free
25}
26
27test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {
28    testdstring free
29} -body {
30    testdstring append "abc" -1
31    list [testdstring get] [testdstring length]
32} -cleanup {
33    testdstring free
34} -result {abc 3}
35test dstring-1.2 {appending and retrieving} -constraints testdstring -setup {
36    testdstring free
37} -body {
38    testdstring append "abc" -1
39    testdstring append " xyzzy" 3
40    testdstring append " 12345" -1
41    list [testdstring get] [testdstring length]
42} -cleanup {
43    testdstring free
44} -result {{abc xy 12345} 12}
45test dstring-1.3 {appending and retrieving} -constraints testdstring -setup {
46    testdstring free
47} -body {
48    foreach l {a b c d e f g h i j k l m n o p} {
49	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
50    }
51    list [testdstring get] [testdstring length]
52} -cleanup {
53    testdstring free
54} -result {{aaaaaaaaaaaaaaaaaaaaa
55bbbbbbbbbbbbbbbbbbbbb
56ccccccccccccccccccccc
57ddddddddddddddddddddd
58eeeeeeeeeeeeeeeeeeeee
59fffffffffffffffffffff
60ggggggggggggggggggggg
61hhhhhhhhhhhhhhhhhhhhh
62iiiiiiiiiiiiiiiiiiiii
63jjjjjjjjjjjjjjjjjjjjj
64kkkkkkkkkkkkkkkkkkkkk
65lllllllllllllllllllll
66mmmmmmmmmmmmmmmmmmmmm
67nnnnnnnnnnnnnnnnnnnnn
68ooooooooooooooooooooo
69ppppppppppppppppppppp
70} 352}
71
72test dstring-2.1 {appending list elements} -constraints testdstring -setup {
73    testdstring free
74} -body {
75    testdstring element "abc"
76    testdstring element "d e f"
77    list [testdstring get] [testdstring length]
78} -cleanup {
79    testdstring free
80} -result {{abc {d e f}} 11}
81test dstring-2.2 {appending list elements} -constraints testdstring -setup {
82    testdstring free
83} -body {
84    testdstring element "x"
85    testdstring element "\{"
86    testdstring element "ab\}"
87    testdstring get
88} -cleanup {
89    testdstring free
90} -result {x \{ ab\}}
91test dstring-2.3 {appending list elements} -constraints testdstring -setup {
92    testdstring free
93} -body {
94    foreach l {a b c d e f g h i j k l m n o p} {
95	testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l
96    }
97    testdstring get
98} -cleanup {
99    testdstring free
100} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
101test dstring-2.4 {appending list elements} -constraints testdstring -setup {
102    testdstring free
103} -body {
104    testdstring append "a\{" -1
105    testdstring element abc
106    testdstring append "	\{" -1
107    testdstring element xyzzy
108    testdstring get
109} -cleanup {
110    testdstring free
111} -result "a{ abc	{xyzzy"
112test dstring-2.5 {appending list elements} -constraints testdstring -setup {
113    testdstring free
114} -body {
115    testdstring append " \{" -1
116    testdstring element abc
117    testdstring get
118} -cleanup {
119    testdstring free
120} -result " {abc"
121test dstring-2.6 {appending list elements} -constraints testdstring -setup {
122    testdstring free
123} -body {
124    testdstring append " " -1
125    testdstring element abc
126    testdstring get
127} -cleanup {
128    testdstring free
129} -result { abc}
130test dstring-2.7 {appending list elements} -constraints testdstring -setup {
131    testdstring free
132} -body {
133    testdstring append "\\ " -1
134    testdstring element abc
135    testdstring get
136} -cleanup {
137    testdstring free
138} -result "\\  abc"
139test dstring-2.8 {appending list elements} -constraints testdstring -setup {
140    testdstring free
141} -body {
142    testdstring append "x " -1
143    testdstring element abc
144    testdstring get
145} -cleanup {
146    testdstring free
147} -result {x abc}
148test dstring-2.9 {appending list elements} -constraints testdstring -setup {
149    testdstring free
150} -body {
151    testdstring element #
152    testdstring get
153} -cleanup {
154    testdstring free
155} -result {{#}}
156test dstring-2.10 {appending list elements} -constraints testdstring -setup {
157    testdstring free
158} -body {
159    testdstring append " " -1
160    testdstring element #
161    testdstring get
162} -cleanup {
163    testdstring free
164} -result { {#}}
165test dstring-2.11 {appending list elements} -constraints testdstring -setup {
166    testdstring free
167} -body {
168    testdstring append \t -1
169    testdstring element #
170    testdstring get
171} -cleanup {
172    testdstring free
173} -result \t{#}
174test dstring-2.12 {appending list elements} -constraints testdstring -setup {
175    testdstring free
176} -body {
177    testdstring append x -1
178    testdstring element #
179    testdstring get
180} -cleanup {
181    testdstring free
182} -result {x #}
183test dstring-2.13 {appending list elements} -constraints testdstring -setup {
184    testdstring free
185} -body {
186    # This test checks the sophistication in Tcl_DStringAppendElement's
187    # decision about whether #-quoting can be disabled.
188    testdstring append "x " -1
189    testdstring element #
190    testdstring get
191} -cleanup {
192    testdstring free
193} -result {x #}
194test dstring-2.14 {appending list elements} -constraints testdstring -setup {
195    testdstring free
196} -body {
197    testdstring append "  " -1
198    testdstring element #
199    testdstring get
200} -cleanup {
201    testdstring free
202} -result {  {#}}
203test dstring-2.15 {appending list elements} -constraints testdstring -setup {
204    testdstring free
205} -body {
206    # This test checks the sophistication in Tcl_DStringAppendElement's
207    # decision about whether #-quoting can be disabled.
208    testdstring append "x  " -1
209    testdstring element #
210    testdstring get
211} -cleanup {
212    testdstring free
213} -result {x  #}
214
215test dstring-3.1 {nested sublists} -constraints testdstring -setup {
216    testdstring free
217} -body {
218    testdstring start
219    testdstring element foo
220    testdstring element bar
221    testdstring end
222    testdstring element another
223    testdstring get
224} -cleanup {
225    testdstring free
226} -result {{foo bar} another}
227test dstring-3.2 {nested sublists} -constraints testdstring -setup {
228    testdstring free
229} -body {
230    testdstring start
231    testdstring start
232    testdstring element abc
233    testdstring element def
234    testdstring end
235    testdstring end
236    testdstring element ghi
237    testdstring get
238} -cleanup {
239    testdstring free
240} -result {{{abc def}} ghi}
241test dstring-3.3 {nested sublists} -constraints testdstring -setup {
242    testdstring free
243} -body {
244    testdstring start
245    testdstring start
246    testdstring start
247    testdstring element foo
248    testdstring element foo2
249    testdstring end
250    testdstring end
251    testdstring element foo3
252    testdstring end
253    testdstring element foo4
254    testdstring get
255} -cleanup {
256    testdstring free
257} -result {{{{foo foo2}} foo3} foo4}
258test dstring-3.4 {nested sublists} -constraints testdstring -setup {
259    testdstring free
260} -body {
261    testdstring element before
262    testdstring start
263    testdstring element during
264    testdstring element more
265    testdstring end
266    testdstring element last
267    testdstring get
268} -cleanup {
269    testdstring free
270} -result {before {during more} last}
271test dstring-3.5 {nested sublists} -constraints testdstring -setup {
272    testdstring free
273} -body {
274    testdstring element "\{"
275    testdstring start
276    testdstring element first
277    testdstring element second
278    testdstring end
279    testdstring get
280} -cleanup {
281    testdstring free
282} -result {\{ {first second}}
283test dstring-3.6 {appending list elements} -constraints testdstring -setup {
284    testdstring free
285} -body {
286    testdstring append x -1
287    testdstring start
288    testdstring element #
289    testdstring end
290    testdstring get
291} -cleanup {
292    testdstring free
293} -result {x {{#}}}
294test dstring-3.7 {appending list elements} -constraints testdstring -setup {
295    testdstring free
296} -body {
297    testdstring append x -1
298    testdstring start
299    testdstring append " " -1
300    testdstring element #
301    testdstring end
302    testdstring get
303} -cleanup {
304    testdstring free
305} -result {x { {#}}}
306test dstring-3.8 {appending list elements} -constraints testdstring -setup {
307    testdstring free
308} -body {
309    testdstring append x -1
310    testdstring start
311    testdstring append \t -1
312    testdstring element #
313    testdstring end
314    testdstring get
315} -cleanup {
316    testdstring free
317} -result "x {\t{#}}"
318test dstring-3.9 {appending list elements} -constraints testdstring -setup {
319    testdstring free
320} -body {
321    testdstring append x -1
322    testdstring start
323    testdstring append x -1
324    testdstring element #
325    testdstring end
326    testdstring get
327} -cleanup {
328    testdstring free
329} -result {x {x #}}
330test dstring-3.10 {appending list elements} -constraints testdstring -setup {
331    testdstring free
332} -body {
333    # This test checks the sophistication in Tcl_DStringAppendElement's
334    # decision about whether #-quoting can be disabled.
335    testdstring append x -1
336    testdstring start
337    testdstring append "x " -1
338    testdstring element #
339    testdstring end
340    testdstring get
341} -cleanup {
342    testdstring free
343} -result {x {x #}}
344test dstring-3.11 {appending list elements} -constraints testdstring -setup {
345    testdstring free
346} -body {
347    testdstring append x -1
348    testdstring start
349    testdstring append "  " -1
350    testdstring element #
351    testdstring end
352    testdstring get
353} -cleanup {
354    testdstring free
355} -result {x {  {#}}}
356test dstring-3.12 {appending list elements} -constraints testdstring -setup {
357    testdstring free
358} -body {
359    # This test checks the sophistication in Tcl_DStringAppendElement's
360    # decision about whether #-quoting can be disabled.
361    testdstring append x -1
362    testdstring start
363    testdstring append "x  " -1
364    testdstring element #
365    testdstring end
366    testdstring get
367} -cleanup {
368    testdstring free
369} -result {x {x  #}}
370
371test dstring-4.1 {truncation} -constraints testdstring -setup {
372    testdstring free
373} -body {
374    testdstring append "abcdefg" -1
375    testdstring trunc 3
376    list [testdstring get] [testdstring length]
377} -cleanup {
378    testdstring free
379} -result {abc 3}
380test dstring-4.2 {truncation} -constraints testdstring -setup {
381    testdstring free
382} -body {
383    testdstring append "xyzzy" -1
384    testdstring trunc 0
385    list [testdstring get] [testdstring length]
386} -cleanup {
387    testdstring free
388} -result {{} 0}
389
390test dstring-5.1 {copying to result} -constraints testdstring -setup {
391    testdstring free
392} -body {
393    testdstring append xyz -1
394    testdstring result
395} -cleanup {
396    testdstring free
397} -result xyz
398test dstring-5.2 {copying to result} -constraints testdstring -setup {
399    testdstring free
400    unset -nocomplain a
401} -body {
402    foreach l {a b c d e f g h i j k l m n o p} {
403	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
404    }
405    set a [testdstring result]
406    testdstring append abc -1
407    list $a [testdstring get]
408} -cleanup {
409    testdstring free
410} -result {{aaaaaaaaaaaaaaaaaaaaa
411bbbbbbbbbbbbbbbbbbbbb
412ccccccccccccccccccccc
413ddddddddddddddddddddd
414eeeeeeeeeeeeeeeeeeeee
415fffffffffffffffffffff
416ggggggggggggggggggggg
417hhhhhhhhhhhhhhhhhhhhh
418iiiiiiiiiiiiiiiiiiiii
419jjjjjjjjjjjjjjjjjjjjj
420kkkkkkkkkkkkkkkkkkkkk
421lllllllllllllllllllll
422mmmmmmmmmmmmmmmmmmmmm
423nnnnnnnnnnnnnnnnnnnnn
424ooooooooooooooooooooo
425ppppppppppppppppppppp
426} abc}
427
428test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup {
429    testdstring free
430} -body {
431    list [testdstring gresult staticsmall] [testdstring get]
432} -cleanup {
433    testdstring free
434} -result {{} short}
435test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup {
436    testdstring free
437} -body {
438    foreach l {a b c d e f g h i j k l m n o p} {
439	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
440    }
441    list [testdstring gresult staticsmall] [testdstring get]
442} -cleanup {
443    testdstring free
444} -result {{} short}
445test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body {
446    set result {}
447    lappend result [testdstring gresult staticlarge]
448    testdstring append x 1
449    lappend result [testdstring get]
450} -cleanup {
451    testdstring free
452} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
453second0 second1 second2 second3 second4 second5 second6 second7 second8 second9
454third0 third1 third2 third3 third4 third5 third6 third7 third8 third9
455fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9
456fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9
457sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9
458seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9
459x}}
460test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body {
461    set result {}
462    lappend result [testdstring gresult free]
463    testdstring append y 1
464    lappend result [testdstring get]
465} -cleanup {
466    testdstring free
467} -result {{} {This is a malloc-ed stringy}}
468test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body {
469    set result {}
470    lappend result [testdstring gresult special]
471    testdstring append z 1
472    lappend result [testdstring get]
473} -cleanup {
474    testdstring free
475} -result {{} {This is a specially-allocated stringz}}
476
477# cleanup
478if {[testConstraint testdstring]} {
479    testdstring free
480}
481::tcltest::cleanupTests
482return
483
484# Local Variables:
485# mode: tcl
486# fill-column: 78
487# End:
488