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