1# Functionality covered: operation of the procedures in tclListObj.c that
2# implement the Tcl type manager for the list object type.
3#
4# This file contains a collection of tests for one or more of the Tcl
5# built-in commands. Sourcing this file into Tcl runs the tests and
6# generates output for errors.  No output means no errors were found.
7#
8# Copyright © 1995-1996 Sun Microsystems, Inc.
9# Copyright © 1998-1999 Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution
12# of 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 testobj [llength [info commands testobj]]
23
24catch {unset x}
25test listobj-1.1 {Tcl_GetListObjType} emptyTest {
26    # Test removed; tested an internal detail
27    # that's no longer correct, and duplicated test obj-1.1
28} {}
29
30test listobj-2.1 {Tcl_SetListObj, use in lappend} {
31    catch {unset x}
32    list [lappend x 1 abc def] [lappend x 1 ghi jkl] $x
33} {{1 abc def} {1 abc def 1 ghi jkl} {1 abc def 1 ghi jkl}}
34test listobj-2.2 {Tcl_SetListObj, use in ObjInterpProc} {
35    proc return_args {args} {
36        return $args
37    }
38    list [return_args] [return_args x] [return_args x y]
39} {{} x {x y}}
40test listobj-2.3 {Tcl_SetListObj, zero element count} {
41    list
42} {}
43
44test listobj-3.1 {Tcl_ListObjAppend, list conversion} {
45    catch {unset x}
46    list [lappend x 1 2 abc "long string"] $x
47} {{1 2 abc {long string}} {1 2 abc {long string}}}
48test listobj-3.2 {Tcl_ListObjAppend, list conversion} {
49    set x ""
50    list [lappend x first second] [lappend x third fourth] $x
51} {{first second} {first second third fourth} {first second third fourth}}
52test listobj-3.3 {Tcl_ListObjAppend, list conversion} {
53    set x "abc def"
54    list [lappend x first second] $x
55} {{abc def first second} {abc def first second}}
56test listobj-3.4 {Tcl_ListObjAppend, error in conversion} {
57    set x " \{"
58    list [catch {lappend x abc def} msg] $msg
59} {1 {unmatched open brace in list}}
60test listobj-3.5 {Tcl_ListObjAppend, force internal rep array to grow} {
61    set x ""
62    list [lappend x 1 1] [lappend x 2 2] [lappend x 3 3] [lappend x 4 4] \
63        [lappend x 5 5] [lappend x 6 6] [lappend x 7 7] [lappend x 8 8] $x
64} {{1 1} {1 1 2 2} {1 1 2 2 3 3} {1 1 2 2 3 3 4 4} {1 1 2 2 3 3 4 4 5 5} {1 1 2 2 3 3 4 4 5 5 6 6} {1 1 2 2 3 3 4 4 5 5 6 6 7 7} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8} {1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8}}
65
66test listobj-4.1 {Tcl_ListObjAppendElement, list conversion} {
67    catch {unset x}
68    list [lappend x 1] $x
69} {1 1}
70test listobj-4.2 {Tcl_ListObjAppendElement, list conversion} {
71    set x ""
72    list [lappend x first] [lappend x second] $x
73} {first {first second} {first second}}
74test listobj-4.3 {Tcl_ListObjAppendElement, list conversion} {
75    set x "abc def"
76    list [lappend x first] $x
77} {{abc def first} {abc def first}}
78test listobj-4.4 {Tcl_ListObjAppendElement, error in conversion} {
79    set x " \{"
80    list [catch {lappend x abc} msg] $msg
81} {1 {unmatched open brace in list}}
82test listobj-4.5 {Tcl_ListObjAppendElement, force internal rep array to grow} {
83    set x ""
84    list [lappend x 1] [lappend x 2] [lappend x 3] [lappend x 4] \
85        [lappend x 5] [lappend x 6] [lappend x 7] [lappend x 8] $x
86} {1 {1 2} {1 2 3} {1 2 3 4} {1 2 3 4 5} {1 2 3 4 5 6} {1 2 3 4 5 6 7} {1 2 3 4 5 6 7 8} {1 2 3 4 5 6 7 8}}
87
88test listobj-5.1 {Tcl_ListObjIndex, basic tests} {
89    lindex {a b c} 0
90} a
91test listobj-5.2 {Tcl_ListObjIndex, basic tests} {
92    lindex a 0
93} a
94test listobj-5.3 {Tcl_ListObjIndex, basic tests} {
95    lindex {a {b c d} x} 1
96} {b c d}
97test listobj-5.4 {Tcl_ListObjIndex, basic tests} {
98    lindex {a b c} 3
99} {}
100test listobj-5.5 {Tcl_ListObjIndex, basic tests} {
101    lindex {a b c} 100
102} {}
103test listobj-5.6 {Tcl_ListObjIndex, basic tests} {
104    lindex a 100
105} {}
106test listobj-5.7 {Tcl_ListObjIndex, basic tests} {
107    lindex {} -1
108} {}
109test listobj-5.8 {Tcl_ListObjIndex, error in conversion} {
110    set x " \{"
111    list [catch {lindex $x 0} msg] $msg
112} {1 {unmatched open brace in list}}
113
114test listobj-6.1 {Tcl_ListObjLength} {
115    llength {a b c d}
116} 4
117test listobj-6.2 {Tcl_ListObjLength} {
118    llength {a b c {a b {c d}} d}
119} 5
120test listobj-6.3 {Tcl_ListObjLength} {
121    llength {}
122} 0
123test listobj-6.4 {Tcl_ListObjLength, convert from non-list} {
124    llength 123
125} 1
126test listobj-6.5 {Tcl_ListObjLength, error converting from non-list} {
127    list [catch {llength "a b c \{"} msg] $msg
128} {1 {unmatched open brace in list}}
129test listobj-6.6 {Tcl_ListObjLength, error converting from non-list} {
130    list [catch {llength "a {b}c"} msg] $msg
131} {1 {list element in braces followed by "c" instead of space}}
132
133test listobj-7.1 {Tcl_ListObjReplace, conversion from non-list} {
134    lreplace 123 0 0 x
135} {x}
136test listobj-7.2 {Tcl_ListObjReplace, error converting from non-list} {
137    list [catch {lreplace "a b c \{" 1 1 x} msg] $msg
138} {1 {unmatched open brace in list}}
139test listobj-7.3 {Tcl_ListObjReplace, error converting from non-list} {
140    list [catch {lreplace "a {b}c" 1 2 x} msg] $msg
141} {1 {list element in braces followed by "c" instead of space}}
142test listobj-7.4 {Tcl_ListObjReplace, negative first element index} {
143    lreplace {1 2 3 4 5} -1 1 a
144} {a 3 4 5}
145test listobj-7.5 {Tcl_ListObjReplace, last element index >= num elems} {
146    lreplace {1 2 3 4 5} 3 7 a b c
147} {1 2 3 a b c}
148test listobj-7.6 {Tcl_ListObjReplace, first element index > last index} {
149    lreplace {1 2 3 4 5} 3 1 a b c
150} {1 2 3 a b c 4 5}
151test listobj-7.7 {Tcl_ListObjReplace, no new elements} {
152    lreplace {1 2 3 4 5} 1 1
153} {1 3 4 5}
154test listobj-7.8 {Tcl_ListObjReplace, shrink array in place} {
155    lreplace {1 2 3 4 5 6 7} 4 5
156} {1 2 3 4 7}
157test listobj-7.9 {Tcl_ListObjReplace, grow array in place} {
158    lreplace {1 2 3 4 5 6 7} 1 3 a b c d e
159} {1 a b c d e 5 6 7}
160test listobj-7.10 {Tcl_ListObjReplace, replace tail of array} {
161    lreplace {1 2 3 4 5 6 7} 3 6 a
162} {1 2 3 a}
163test listobj-7.11 {Tcl_ListObjReplace, must grow internal array} {
164    lreplace {1 2 3 4 5} 2 3 a b c d e f g h i j k l
165} {1 2 a b c d e f g h i j k l 5}
166test listobj-7.12 {Tcl_ListObjReplace, grow array, insert at start} {
167    lreplace {1 2 3 4 5} -1 -1 a b c d e f g h i j k l
168} {a b c d e f g h i j k l 1 2 3 4 5}
169test listobj-7.13 {Tcl_ListObjReplace, grow array, insert at end} {
170    lreplace {1 2 3 4 5} 4 1 a b c d e f g h i j k l
171} {1 2 3 4 a b c d e f g h i j k l 5}
172
173test listobj-8.1 {SetListFromAny} {
174    lindex {0 foo\x00help 2} 1
175} "foo\x00help"
176
177test listobj-9.1 {UpdateStringOfList} {
178    string length [list foo\x00help]
179} 8
180
181test listobj-10.1 {Bug [2971669]} {*}{
182    -constraints testobj
183    -setup {
184	testobj freeallvars
185    }
186    -body {
187	set result {}
188	lappend result \
189	    [testlistobj set 1 a b c d e] \
190	    [testlistobj replace 1 0x7fffffff 0x7fffffff f] \
191	    [testlistobj get 1]
192    }
193    -cleanup {
194	testobj freeallvars
195    }
196    -result {{a b c d e} {} {a b c d e f}}
197}
198
199test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
200    testobj bug3598580
201} 123
202
203# cleanup
204::tcltest::cleanupTests
205return
206
207# Local Variables:
208# mode: tcl
209# End:
210