1# Commands covered:  lreplace
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#
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
19test lreplace-1.1 {lreplace command} {
20    lreplace {1 2 3 4 5} 0 0 a
21} {a 2 3 4 5}
22test lreplace-1.2 {lreplace command} {
23    lreplace {1 2 3 4 5} 1 1 a
24} {1 a 3 4 5}
25test lreplace-1.3 {lreplace command} {
26    lreplace {1 2 3 4 5} 2 2 a
27} {1 2 a 4 5}
28test lreplace-1.4 {lreplace command} {
29    lreplace {1 2 3 4 5} 3 3 a
30} {1 2 3 a 5}
31test lreplace-1.5 {lreplace command} {
32    lreplace {1 2 3 4 5} 4 4 a
33} {1 2 3 4 a}
34test lreplace-1.6 {lreplace command} {
35    lreplace {1 2 3 4 5} 4 5 a
36} {1 2 3 4 a}
37test lreplace-1.7 {lreplace command} {
38    lreplace {1 2 3 4 5} -1 -1 a
39} {a 1 2 3 4 5}
40test lreplace-1.8 {lreplace command} {
41    lreplace {1 2 3 4 5} 2 end a b c d
42} {1 2 a b c d}
43test lreplace-1.9 {lreplace command} {
44    lreplace {1 2 3 4 5} 0 3
45} {5}
46test lreplace-1.10 {lreplace command} {
47    lreplace {1 2 3 4 5} 0 4
48} {}
49test lreplace-1.11 {lreplace command} {
50    lreplace {1 2 3 4 5} 0 1
51} {3 4 5}
52test lreplace-1.12 {lreplace command} {
53    lreplace {1 2 3 4 5} 2 3
54} {1 2 5}
55test lreplace-1.13 {lreplace command} {
56    lreplace {1 2 3 4 5} 3 end
57} {1 2 3}
58test lreplace-1.14 {lreplace command} {
59    lreplace {1 2 3 4 5} -1 4 a b c
60} {a b c}
61test lreplace-1.15 {lreplace command} {
62    lreplace {a b "c c" d e f} 3 3
63} {a b {c c} e f}
64test lreplace-1.16 {lreplace command} {
65    lreplace { 1 2 3 4 5} 0 0 a
66} {a 2 3 4 5}
67test lreplace-1.17 {lreplace command} {
68    lreplace {1 2 3 4 "5 6"} 4 4 a
69} {1 2 3 4 a}
70test lreplace-1.18 {lreplace command} {
71    lreplace {1 2 3 4 {5 6}} 4 4 a
72} {1 2 3 4 a}
73test lreplace-1.19 {lreplace command} {
74    lreplace {1 2 3 4} 2 end x y z
75} {1 2 x y z}
76test lreplace-1.20 {lreplace command} {
77    lreplace {1 2 3 4} end end a
78} {1 2 3 a}
79test lreplace-1.21 {lreplace command} {
80    lreplace {1 2 3 4} end 3 a
81} {1 2 3 a}
82test lreplace-1.22 {lreplace command} {
83    lreplace {1 2 3 4} end end
84} {1 2 3}
85test lreplace-1.23 {lreplace command} {
86    lreplace {1 2 3 4} 2 -1 xy
87} {1 2 xy 3 4}
88test lreplace-1.24 {lreplace command} {
89    lreplace {1 2 3 4} end -1 z
90} {1 2 3 z 4}
91test lreplace-1.25 {lreplace command} {
92    concat \"[lreplace {\}\     hello} end end]\"
93} {"\}\ "}
94test lreplace-1.26 {lreplace command} {
95    catch {unset foo}
96    set foo {a b}
97    list [set foo [lreplace $foo end end]] \
98        [set foo [lreplace $foo end end]] \
99        [set foo [lreplace $foo end end]]
100} {a {} {}}
101test lreplace-1.27 {lreplace command} -body {
102    lreplace x 1 1
103} -result x
104test lreplace-1.28 {lreplace command} -body {
105    lreplace x 1 1 y
106} -result {x y}
107test lreplace-1.29 {lreplace command} -body {
108    lreplace x 1 1 [error foo]
109} -returnCodes 1 -result {foo}
110test lreplace-1.30 {lreplace command} -body {
111    lreplace {not {}alist} 0 0 [error foo]
112} -returnCodes 1 -result {foo}
113
114test lreplace-2.1 {lreplace errors} -body {
115    list [catch lreplace msg] $msg
116} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
117test lreplace-2.2 {lreplace errors} -body {
118    list [catch {lreplace a b} msg] $msg
119} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
120test lreplace-2.3 {lreplace errors} -body {
121    list [catch {lreplace x a 10} msg] $msg
122} -result {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
123test lreplace-2.4 {lreplace errors} -body {
124    list [catch {lreplace x 10 x} msg] $msg
125} -result {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
126test lreplace-2.5 {lreplace errors} -body {
127    list [catch {lreplace x 10 1x} msg] $msg
128} -result {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
129test lreplace-2.6 {lreplace errors} -body {
130    list [catch {lreplace x 3 2} msg] $msg
131} -result {0 x}
132test lreplace-2.7 {lreplace errors} -body {
133    list [catch {lreplace x 2 2} msg] $msg
134} -result {0 x}
135
136test lreplace-3.1 {lreplace won't modify shared argument objects} {
137    proc p {} {
138        lreplace "a b c" 1 1 "x y"
139        return "a b c"
140    }
141    p
142} "a b c"
143
144test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} {
145    lreplace {} 1 1
146} {}
147test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} {
148    lreplace { } 1 1
149} {}
150test lreplace-4.3 {lreplace edge case} {
151    lreplace {1 2 3} 2 0
152} {1 2 3}
153test lreplace-4.4 {lreplace edge case} {
154    lreplace {1 2 3 4 5} 3 1
155} {1 2 3 4 5}
156test lreplace-4.5 {lreplace edge case} {
157    lreplace {1 2 3 4 5} 3 0 _
158} {1 2 3 _ 4 5}
159test lreplace-4.6 {lreplace end-x: bug a4cb3f06c4} {
160    lreplace {0 1 2 3 4} 0 end-2
161} {3 4}
162test lreplace-4.6.1 {lreplace end-x: bug a4cb3f06c4} {
163    lreplace {0 1 2 3 4} 0 end-2 a b c
164} {a b c 3 4}
165test lreplace-4.7 {lreplace with two end-indexes: increasing} {
166    lreplace {0 1 2 3 4} end-2 end-1
167} {0 1 4}
168test lreplace-4.7.1 {lreplace with two end-indexes: increasing} {
169    lreplace {0 1 2 3 4} end-2 end-1 a b c
170} {0 1 a b c 4}
171test lreplace-4.8 {lreplace with two end-indexes: equal} {
172    lreplace {0 1 2 3 4} end-2 end-2
173} {0 1 3 4}
174test lreplace-4.8.1 {lreplace with two end-indexes: equal} {
175    lreplace {0 1 2 3 4} end-2 end-2 a b c
176} {0 1 a b c 3 4}
177test lreplace-4.9 {lreplace with two end-indexes: decreasing} {
178    lreplace {0 1 2 3 4} end-2 end-3
179} {0 1 2 3 4}
180test lreplace-4.9.1 {lreplace with two end-indexes: decreasing} {
181    lreplace {0 1 2 3 4} end-2 end-3 a b c
182} {0 1 a b c 2 3 4}
183test lreplace-4.10 {lreplace with two equal indexes} {
184    lreplace {0 1 2 3 4} 2 2
185} {0 1 3 4}
186test lreplace-4.10.1 {lreplace with two equal indexes} {
187    lreplace {0 1 2 3 4} 2 2 a b c
188} {0 1 a b c 3 4}
189test lreplace-4.11 {lreplace end index first} {
190    lreplace {0 1 2 3 4} end-2 1 a b c
191} {0 1 a b c 2 3 4}
192test lreplace-4.12 {lreplace end index first} {
193    lreplace {0 1 2 3 4} end-2 2 a b c
194} {0 1 a b c 3 4}
195test lreplace-4.13 {lreplace empty list} {
196    lreplace {} 1 1 1
197} 1
198test lreplace-4.14 {lreplace empty list} {
199    lreplace {} 2 2 2
200} 2
201
202test lreplace-5.1 {compiled lreplace: Bug 47ac84309b} {
203    apply {x {
204	lreplace $x end 0
205    }} {a b c}
206} {a b c}
207test lreplace-5.2 {compiled lreplace: Bug 47ac84309b} {
208    apply {x {
209	lreplace $x end 0 A
210    }} {a b c}
211} {a b A c}
212
213# Testing for compiled behaviour. Far too many variations to check with
214# spelt-out tests. Note that this *just* checks whether the compiled version
215# and the interpreted version are the same, not whether the interpreted
216# version is correct.
217apply {{} {
218    set lss     {{} {a} {a b c} {a b c d}}
219    set ins     {{} A {A B}}
220    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
221    set lreplace lreplace
222
223    foreach ls $lss {
224	foreach a $idxs {
225	    foreach b $idxs {
226		foreach i $ins {
227		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
228		    set tester [list lreplace $ls $a $b {*}$i]
229		    set script [list catch $tester m]
230		    set script "list \[$script\] \$m"
231		    test lreplace-6.[incr n] {lreplace battery} -body \
232			[list apply [list {} $script]] -result $expected
233		}
234	    }
235	}
236    }
237}}
238
239# cleanup
240catch {unset foo}
241::tcltest::cleanupTests
242return
243
244# Local Variables:
245# mode: tcl
246# End:
247