1# This file is a -*- tcl -*- test script 2 3# Commands covered: lset 4# 5# This file contains a collection of tests for one or more of the Tcl 6# built-in commands. Sourcing this file into Tcl runs the tests and 7# generates output for errors. No output means no errors were found. 8# 9# Copyright © 2001 Kevin B. Kenny. All rights reserved. 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 22proc failTrace {name1 name2 op} { 23 error "trace failed" 24} 25 26testConstraint testevalex [llength [info commands testevalex]] 27 28set noRead {} 29trace add variable noRead read failTrace 30set noWrite {a b c} 31trace add variable noWrite write failTrace 32 33test lset-1.1 {lset, not compiled, arg count} testevalex { 34 list [catch {testevalex lset} msg] $msg 35} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}" 36test lset-1.2 {lset, not compiled, no such var} testevalex { 37 list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg 38} "1 {can't read \"noSuchVar\": no such variable}" 39test lset-1.3 {lset, not compiled, var not readable} testevalex { 40 list [catch {testevalex {lset noRead 0 {}}} msg] $msg 41} "1 {can't read \"noRead\": trace failed}" 42 43test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex { 44 set x {0 1 2} 45 list [testevalex {lset x 0 3}] $x 46} {{3 1 2} {3 1 2}} 47test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex { 48 set x {0 1 2} 49 list [catch { 50 testevalex {lset x {{bad}1} 3} 51 } msg] $msg 52} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}} 53 54test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex { 55 set x {0 1 2} 56 list [testevalex {lset x 0 $x}] $x 57} {{{0 1 2} 1 2} {{0 1 2} 1 2}} 58test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex { 59 set x {0 1} 60 set y $x 61 list [testevalex {lset x 0 2}] $x $y 62} {{2 1} {2 1} {0 1}} 63test lset-3.3 {lset, not compiled, 3 args, data duplicated} testevalex { 64 set x {0 1} 65 set y $x 66 list [testevalex {lset x 0 $x}] $x $y 67} {{{0 1} 1} {{0 1} 1} {0 1}} 68test lset-3.4 {lset, not compiled, 3 args, data duplicated} testevalex { 69 set x {0 1 2} 70 list [testevalex {lset x [list 0] $x}] $x 71} {{{0 1 2} 1 2} {{0 1 2} 1 2}} 72test lset-3.5 {lset, not compiled, 3 args, data duplicated} testevalex { 73 set x {0 1} 74 set y $x 75 list [testevalex {lset x [list 0] 2}] $x $y 76} {{2 1} {2 1} {0 1}} 77test lset-3.6 {lset, not compiled, 3 args, data duplicated} testevalex { 78 set x {0 1} 79 set y $x 80 list [testevalex {lset x [list 0] $x}] $x $y 81} {{{0 1} 1} {{0 1} 1} {0 1}} 82 83test lset-4.1 {lset, not compiled, 3 args, not a list} testevalex { 84 set a "x \{" 85 list [catch { 86 testevalex {lset a [list 0] y} 87 } msg] $msg 88} {1 {unmatched open brace in list}} 89test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex { 90 set a {x y z} 91 list [catch { 92 testevalex {lset a [list 2a2] w} 93 } msg] $msg 94} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} 95test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { 96 set a {x y z} 97 list [catch { 98 testevalex {lset a [list -1] w} 99 } msg] $msg 100} {1 {index "-1" out of range}} 101test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex { 102 set a {x y z} 103 list [catch { 104 testevalex {lset a [list 4] w} 105 } msg] $msg 106} {1 {index "4" out of range}} 107test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex { 108 set a {x y z} 109 list [catch { 110 testevalex {lset a [list end--2] w} 111 } msg] $msg 112} {1 {index "end--2" out of range}} 113test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex { 114 set a {x y z} 115 list [catch { 116 testevalex {lset a [list end+2] w} 117 } msg] $msg 118} {1 {index "end+2" out of range}} 119test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex { 120 set a {x y z} 121 list [catch { 122 testevalex {lset a [list end-3] w} 123 } msg] $msg 124} {1 {index "end-3" out of range}} 125test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex { 126 set a "x \{" 127 list [catch { 128 testevalex {lset a 0 y} 129 } msg] $msg 130} {1 {unmatched open brace in list}} 131test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex { 132 set a {x y z} 133 list [catch { 134 testevalex {lset a 2a2 w} 135 } msg] $msg 136} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} 137test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { 138 set a {x y z} 139 list [catch { 140 testevalex {lset a -1 w} 141 } msg] $msg 142} {1 {index "-1" out of range}} 143test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex { 144 set a {x y z} 145 list [catch { 146 testevalex {lset a 4 w} 147 } msg] $msg 148} {1 {index "4" out of range}} 149test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex { 150 set a {x y z} 151 list [catch { 152 testevalex {lset a end--2 w} 153 } msg] $msg 154} {1 {index "end--2" out of range}} 155test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex { 156 set a {x y z} 157 list [catch { 158 testevalex {lset a end+2 w} 159 } msg] $msg 160} {1 {index "end+2" out of range}} 161test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex { 162 set a {x y z} 163 list [catch { 164 testevalex {lset a end-3 w} 165 } msg] $msg 166} {1 {index "end-3" out of range}} 167 168test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex { 169 list [catch { 170 testevalex {lset noWrite 0 d} 171 } msg] $msg $noWrite 172} {1 {can't set "noWrite": trace failed} {d b c}} 173test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex { 174 list [catch { 175 testevalex {lset noWrite [list 0] d} 176 } msg] $msg $noWrite 177} {1 {can't set "noWrite": trace failed} {d b c}} 178 179test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex { 180 set a {x y z} 181 list [testevalex {lset a 0 a}] $a 182} {{a y z} {a y z}} 183test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex { 184 set a {x y z} 185 list [testevalex {lset a [list 0] a}] $a 186} {{a y z} {a y z}} 187test lset-6.3 {lset, not compiled, 1-d list basics} testevalex { 188 set a {x y z} 189 list [testevalex {lset a 2 a}] $a 190} {{x y a} {x y a}} 191test lset-6.4 {lset, not compiled, 1-d list basics} testevalex { 192 set a {x y z} 193 list [testevalex {lset a [list 2] a}] $a 194} {{x y a} {x y a}} 195test lset-6.5 {lset, not compiled, 1-d list basics} testevalex { 196 set a {x y z} 197 list [testevalex {lset a end a}] $a 198} {{x y a} {x y a}} 199test lset-6.6 {lset, not compiled, 1-d list basics} testevalex { 200 set a {x y z} 201 list [testevalex {lset a [list end] a}] $a 202} {{x y a} {x y a}} 203test lset-6.7 {lset, not compiled, 1-d list basics} testevalex { 204 set a {x y z} 205 list [testevalex {lset a end-0 a}] $a 206} {{x y a} {x y a}} 207test lset-6.8 {lset, not compiled, 1-d list basics} testevalex { 208 set a {x y z} 209 list [testevalex {lset a [list end-0] a}] $a 210} {{x y a} {x y a}} 211test lset-6.9 {lset, not compiled, 1-d list basics} testevalex { 212 set a {x y z} 213 list [testevalex {lset a end-2 a}] $a 214} {{a y z} {a y z}} 215test lset-6.10 {lset, not compiled, 1-d list basics} testevalex { 216 set a {x y z} 217 list [testevalex {lset a [list end-2] a}] $a 218} {{a y z} {a y z}} 219 220test lset-7.1 {lset, not compiled, data sharing} testevalex { 221 set a 0 222 list [testevalex {lset a $a {gag me}}] $a 223} {{{gag me}} {{gag me}}} 224test lset-7.2 {lset, not compiled, data sharing} testevalex { 225 set a [list 0] 226 list [testevalex {lset a $a {gag me}}] $a 227} {{{gag me}} {{gag me}}} 228test lset-7.3 {lset, not compiled, data sharing} testevalex { 229 set a {x y} 230 list [testevalex {lset a 0 $a}] $a 231} {{{x y} y} {{x y} y}} 232test lset-7.4 {lset, not compiled, data sharing} testevalex { 233 set a {x y} 234 list [testevalex {lset a [list 0] $a}] $a 235} {{{x y} y} {{x y} y}} 236test lset-7.5 {lset, not compiled, data sharing} testevalex { 237 set n 0 238 set a {x y} 239 list [testevalex {lset a $n $n}] $a $n 240} {{0 y} {0 y} 0} 241test lset-7.6 {lset, not compiled, data sharing} testevalex { 242 set n [list 0] 243 set a {x y} 244 list [testevalex {lset a $n $n}] $a $n 245} {{0 y} {0 y} 0} 246test lset-7.7 {lset, not compiled, data sharing} testevalex { 247 set n 0 248 set a [list $n $n] 249 list [testevalex {lset a $n 1}] $a $n 250} {{1 0} {1 0} 0} 251test lset-7.8 {lset, not compiled, data sharing} testevalex { 252 set n [list 0] 253 set a [list $n $n] 254 list [testevalex {lset a $n 1}] $a $n 255} {{1 0} {1 0} 0} 256test lset-7.9 {lset, not compiled, data sharing} testevalex { 257 set a 0 258 list [testevalex {lset a $a $a}] $a 259} {0 0} 260test lset-7.10 {lset, not compiled, data sharing} testevalex { 261 set a [list 0] 262 list [testevalex {lset a $a $a}] $a 263} {0 0} 264 265test lset-8.1 {lset, not compiled, malformed sublist} testevalex { 266 set a [list "a \{" b] 267 list [catch {testevalex {lset a 0 1 c}} msg] $msg 268} {1 {unmatched open brace in list}} 269test lset-8.2 {lset, not compiled, malformed sublist} testevalex { 270 set a [list "a \{" b] 271 list [catch {testevalex {lset a {0 1} c}} msg] $msg 272} {1 {unmatched open brace in list}} 273test lset-8.3 {lset, not compiled, bad second index} testevalex { 274 set a {{b c} {d e}} 275 list [catch {testevalex {lset a 0 2a2 f}} msg] $msg 276} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} 277test lset-8.4 {lset, not compiled, bad second index} testevalex { 278 set a {{b c} {d e}} 279 list [catch {testevalex {lset a {0 2a2} f}} msg] $msg 280} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} 281test lset-8.5 {lset, not compiled, second index out of range} testevalex { 282 set a {{b c} {d e} {f g}} 283 list [catch {testevalex {lset a 2 -1 h}} msg] $msg 284} {1 {index "-1" out of range}} 285test lset-8.6 {lset, not compiled, second index out of range} testevalex { 286 set a {{b c} {d e} {f g}} 287 list [catch {testevalex {lset a {2 -1} h}} msg] $msg 288} {1 {index "-1" out of range}} 289test lset-8.7 {lset, not compiled, second index out of range} testevalex { 290 set a {{b c} {d e} {f g}} 291 list [catch {testevalex {lset a 2 3 h}} msg] $msg 292} {1 {index "3" out of range}} 293test lset-8.8 {lset, not compiled, second index out of range} testevalex { 294 set a {{b c} {d e} {f g}} 295 list [catch {testevalex {lset a {2 3} h}} msg] $msg 296} {1 {index "3" out of range}} 297test lset-8.9a {lset, not compiled, second index out of range} testevalex { 298 set a {{b c} {d e} {f g}} 299 list [catch {testevalex {lset a 2 end--2 h}} msg] $msg 300} {1 {index "end--2" out of range}} 301test lset-8.9b {lset, not compiled, second index out of range} testevalex { 302 set a {{b c} {d e} {f g}} 303 list [catch {testevalex {lset a 2 end+2 h}} msg] $msg 304} {1 {index "end+2" out of range}} 305test lset-8.10a {lset, not compiled, second index out of range} testevalex { 306 set a {{b c} {d e} {f g}} 307 list [catch {testevalex {lset a {2 end--2} h}} msg] $msg 308} {1 {index "end--2" out of range}} 309test lset-8.10b {lset, not compiled, second index out of range} testevalex { 310 set a {{b c} {d e} {f g}} 311 list [catch {testevalex {lset a {2 end+2} h}} msg] $msg 312} {1 {index "end+2" out of range}} 313test lset-8.11 {lset, not compiled, second index out of range} testevalex { 314 set a {{b c} {d e} {f g}} 315 list [catch {testevalex {lset a 2 end-2 h}} msg] $msg 316} {1 {index "end-2" out of range}} 317test lset-8.12 {lset, not compiled, second index out of range} testevalex { 318 set a {{b c} {d e} {f g}} 319 list [catch {testevalex {lset a {2 end-2} h}} msg] $msg 320} {1 {index "end-2" out of range}} 321 322test lset-9.1 {lset, not compiled, entire variable} testevalex { 323 set a x 324 list [testevalex {lset a y}] $a 325} {y y} 326test lset-9.2 {lset, not compiled, entire variable} testevalex { 327 set a x 328 list [testevalex {lset a {} y}] $a 329} {y y} 330 331test lset-10.1 {lset, not compiled, shared data} testevalex { 332 set row {p q} 333 set a [list $row $row] 334 list [testevalex {lset a 0 0 x}] $a 335} {{{x q} {p q}} {{x q} {p q}}} 336test lset-10.2 {lset, not compiled, shared data} testevalex { 337 set row {p q} 338 set a [list $row $row] 339 list [testevalex {lset a {0 0} x}] $a 340} {{{x q} {p q}} {{x q} {p q}}} 341test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex { 342 set a [list [list p q] [list r s]] 343 set b $a 344 list [testevalex {lset b {0 0} x}] $a 345} {{{x q} {r s}} {{p q} {r s}}} 346 347test lset-11.1 {lset, not compiled, 2-d basics} testevalex { 348 set a {{b c} {d e}} 349 list [testevalex {lset a 0 0 f}] $a 350} {{{f c} {d e}} {{f c} {d e}}} 351test lset-11.2 {lset, not compiled, 2-d basics} testevalex { 352 set a {{b c} {d e}} 353 list [testevalex {lset a {0 0} f}] $a 354} {{{f c} {d e}} {{f c} {d e}}} 355test lset-11.3 {lset, not compiled, 2-d basics} testevalex { 356 set a {{b c} {d e}} 357 list [testevalex {lset a 0 1 f}] $a 358} {{{b f} {d e}} {{b f} {d e}}} 359test lset-11.4 {lset, not compiled, 2-d basics} testevalex { 360 set a {{b c} {d e}} 361 list [testevalex {lset a {0 1} f}] $a 362} {{{b f} {d e}} {{b f} {d e}}} 363test lset-11.5 {lset, not compiled, 2-d basics} testevalex { 364 set a {{b c} {d e}} 365 list [testevalex {lset a 1 0 f}] $a 366} {{{b c} {f e}} {{b c} {f e}}} 367test lset-11.6 {lset, not compiled, 2-d basics} testevalex { 368 set a {{b c} {d e}} 369 list [testevalex {lset a {1 0} f}] $a 370} {{{b c} {f e}} {{b c} {f e}}} 371test lset-11.7 {lset, not compiled, 2-d basics} testevalex { 372 set a {{b c} {d e}} 373 list [testevalex {lset a 1 1 f}] $a 374} {{{b c} {d f}} {{b c} {d f}}} 375test lset-11.8 {lset, not compiled, 2-d basics} testevalex { 376 set a {{b c} {d e}} 377 list [testevalex {lset a {1 1} f}] $a 378} {{{b c} {d f}} {{b c} {d f}}} 379 380test lset-12.0 {lset, not compiled, typical sharing pattern} testevalex { 381 set zero 0 382 set row [list $zero $zero $zero $zero] 383 set ident [list $row $row $row $row] 384 for { set i 0 } { $i < 4 } { incr i } { 385 testevalex {lset ident $i $i 1} 386 } 387 set ident 388} {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}} 389 390test lset-13.0 {lset, not compiled, shimmering hell} testevalex { 391 set a 0 392 list [testevalex {lset a $a $a $a $a {gag me}}] $a 393} {{{{{{gag me}}}}} {{{{{gag me}}}}}} 394test lset-13.1 {lset, not compiled, shimmering hell} testevalex { 395 set a [list 0] 396 list [testevalex {lset a $a $a $a $a {gag me}}] $a 397} {{{{{{gag me}}}}} {{{{{gag me}}}}}} 398test lset-13.2 {lset, not compiled, shimmering hell} testevalex { 399 set a [list 0 0 0 0] 400 list [testevalex {lset a $a {gag me}}] $a 401} {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}} 402 403test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testevalex { 404 set a { { 1 2 } { 3 4 } } 405 catch { testevalex {lset a {1 5} 5} } 406 list $a [lindex $a 1] 407} "{ { 1 2 } { 3 4 } } { 3 4 }" 408test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex { 409 set a { { 1 2 } { 3 4 } } 410 catch { testevalex {lset a 1 5 5} } 411 list $a [lindex $a 1] 412} "{ { 1 2 } { 3 4 } } { 3 4 }" 413 414testConstraint testobj [llength [info commands testobj]] 415test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup { 416 teststringobj set 1 {{1 2} 3} 417 testobj convert 1 list 418 testobj duplicate 1 2 419 variable x [teststringobj get 1] 420 variable y [teststringobj get 2] 421 testobj freeallvars 422 set l [list $y z] 423 unset y 424} -constraints testobj -body { 425 lset l 0 0 0 5 426 lindex $x 0 0 427} -cleanup { 428 unset -nocomplain x l 429} -result 1 430 431test lset-16.1 {lset - grow a variable} testevalex { 432 set x {} 433 testevalex {lset x 0 {test 1}} 434 testevalex {lset x 1 {test 2}} 435 set x 436} {{test 1} {test 2}} 437test lset-16.2 {lset - multiple created sublists} testevalex { 438 set x {} 439 testevalex {lset x 0 0 {test 1}} 440} {{{test 1}}} 441test lset-16.3 {lset - sublists 3 deep} testevalex { 442 set x {} 443 testevalex {lset x 0 0 0 {test 1}} 444} {{{{test 1}}}} 445test lset-16.4 {lset - append to inner list} testevalex { 446 set x {test 1} 447 testevalex {lset x 1 1 2} 448 testevalex {lset x 1 2 3} 449 testevalex {lset x 1 2 1 4} 450} {test {1 2 {3 4}}} 451 452test lset-16.5 {lset - grow a variable} testevalex { 453 set x {} 454 testevalex {lset x end+1 {test 1}} 455 testevalex {lset x end+1 {test 2}} 456 set x 457} {{test 1} {test 2}} 458test lset-16.6 {lset - multiple created sublists} testevalex { 459 set x {} 460 testevalex {lset x end+1 end+1 {test 1}} 461} {{{test 1}}} 462test lset-16.7 {lset - sublists 3 deep} testevalex { 463 set x {} 464 testevalex {lset x end+1 end+1 end+1 {test 1}} 465} {{{{test 1}}}} 466test lset-16.8 {lset - append to inner list} testevalex { 467 set x {test 1} 468 testevalex {lset x end end+1 2} 469 testevalex {lset x end end+1 3} 470 testevalex {lset x end end end+1 4} 471} {test {1 2 {3 4}}} 472 473catch {unset noRead} 474catch {unset noWrite} 475catch {rename failTrace {}} 476catch {unset ::x} 477catch {unset ::y} 478 479# cleanup 480::tcltest::cleanupTests 481return 482