1# Commands covered: append lappend 2# 3# This file contains a collection of tests for one or more of the Tcl built-in 4# commands. Sourcing this file into Tcl runs the tests and generates output 5# for errors. No output means no errors were found. 6# 7# Copyright © 1991-1993 The Regents of the University of California. 8# Copyright © 1994-1996 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} 18catch {unset x} 19 20test appendComp-1.1 {append command} -setup { 21 unset -nocomplain x 22} -body { 23 proc foo {} {append ::x 1 2 abc "long string"} 24 list [foo] $x 25} -result {{12abclong string} {12abclong string}} 26test appendComp-1.2 {append command} { 27 proc foo {} { 28 set x "" 29 list [append x first] [append x second] [append x third] $x 30 } 31 foo 32} {first firstsecond firstsecondthird firstsecondthird} 33test appendComp-1.3 {append command} { 34 proc foo {} { 35 set x "abcd" 36 append x 37 } 38 foo 39} abcd 40 41test appendComp-2.1 {long appends} { 42 proc foo {} { 43 set x "" 44 for {set i 0} {$i < 1000} {incr i} { 45 append x "foobar " 46 } 47 set y "foobar" 48 set y "$y $y $y $y $y $y $y $y $y $y" 49 set y "$y $y $y $y $y $y $y $y $y $y" 50 set y "$y $y $y $y $y $y $y $y $y $y " 51 expr {$x == $y} 52 } 53 foo 54} 1 55 56test appendComp-3.1 {append errors} -returnCodes error -body { 57 proc foo {} {append} 58 foo 59} -result {wrong # args: should be "append varName ?value ...?"} 60test appendComp-3.2 {append errors} -returnCodes error -body { 61 proc foo {} { 62 set x "" 63 append x(0) 44 64 } 65 foo 66} -result {can't set "x(0)": variable isn't array} 67test appendComp-3.3 {append errors} -returnCodes error -body { 68 proc foo {} { 69 unset -nocomplain x 70 append x 71 } 72 foo 73} -result {can't read "x": no such variable} 74 75test appendComp-4.1 {lappend command} { 76 proc foo {} { 77 global x 78 unset -nocomplain x 79 lappend x 1 2 abc "long string" 80 } 81 list [foo] $x 82} {{1 2 abc {long string}} {1 2 abc {long string}}} 83test appendComp-4.2 {lappend command} { 84 proc foo {} { 85 set x "" 86 list [lappend x first] [lappend x second] [lappend x third] $x 87 } 88 foo 89} {first {first second} {first second third} {first second third}} 90test appendComp-4.3 {lappend command} { 91 proc foo {} { 92 global x 93 set x old 94 unset x 95 lappend x new 96 } 97 set result [foo] 98 rename foo {} 99 set result 100} {new} 101test appendComp-4.4 {lappend command} { 102 proc foo {} { 103 set x {} 104 lappend x \{\ abc 105 } 106 foo 107} {\{\ abc} 108test appendComp-4.5 {lappend command} { 109 proc foo {} { 110 set x {} 111 lappend x \{ abc 112 } 113 foo 114} {\{ abc} 115test appendComp-4.6 {lappend command} { 116 proc foo {} { 117 set x {1 2 3} 118 lappend x 119 } 120 foo 121} {1 2 3} 122test appendComp-4.7 {lappend command} { 123 proc foo {} { 124 set x "a\{" 125 lappend x abc 126 } 127 foo 128} "a\\\{ abc" 129test appendComp-4.8 {lappend command} { 130 proc foo {} { 131 set x "\\\{" 132 lappend x abc 133 } 134 foo 135} "\\{ abc" 136test appendComp-4.9 {lappend command} -returnCodes error -body { 137 proc foo {} { 138 set x " \{" 139 lappend x abc 140 } 141 foo 142} -result {unmatched open brace in list} 143test appendComp-4.10 {lappend command} -returnCodes error -body { 144 proc foo {} { 145 set x " \{" 146 lappend x abc 147 } 148 foo 149} -result {unmatched open brace in list} 150test appendComp-4.11 {lappend command} -returnCodes error -body { 151 proc foo {} { 152 set x "\{\{\{" 153 lappend x abc 154 } 155 foo 156} -result {unmatched open brace in list} 157test appendComp-4.12 {lappend command} -returnCodes error -body { 158 proc foo {} { 159 set x "x \{\{\{" 160 lappend x abc 161 } 162 foo 163} -result {unmatched open brace in list} 164test appendComp-4.13 {lappend command} { 165 proc foo {} { 166 set x "x\{\{\{" 167 lappend x abc 168 } 169 foo 170} "x\\\{\\\{\\\{ abc" 171test appendComp-4.14 {lappend command} { 172 proc foo {} { 173 set x " " 174 lappend x abc 175 } 176 foo 177} "abc" 178test appendComp-4.15 {lappend command} { 179 proc foo {} { 180 set x "\\ " 181 lappend x abc 182 } 183 foo 184} "{ } abc" 185test appendComp-4.16 {lappend command} { 186 proc foo {} { 187 set x "x " 188 lappend x abc 189 } 190 foo 191} "x abc" 192test appendComp-4.17 {lappend command} { 193 proc foo {} { lappend x } 194 foo 195} {} 196test appendComp-4.18 {lappend command} { 197 proc foo {} { lappend x {} } 198 foo 199} {{}} 200test appendComp-4.19 {lappend command} { 201 proc foo {} { lappend x(0) } 202 foo 203} {} 204test appendComp-4.20 {lappend command} { 205 proc foo {} { lappend x(0) abc } 206 foo 207} {abc} 208 209test appendComp-5.1 {long lappends} -setup { 210 unset -nocomplain x 211 proc check {var size} { 212 set l [llength $var] 213 if {$l != $size} { 214 return "length mismatch: should have been $size, was $l" 215 } 216 for {set i 0} {$i < $size} {incr i} { 217 set j [lindex $var $i] 218 if {$j ne "item $i"} { 219 return "element $i should have been \"item $i\", was \"$j\"" 220 } 221 } 222 return ok 223 } 224} -body { 225 set x "" 226 for {set i 0} {$i < 300} {incr i} { 227 lappend x "item $i" 228 } 229 check $x 300 230} -cleanup { 231 unset -nocomplain x 232 catch {rename check ""} 233} -result ok 234 235test appendComp-6.1 {lappend errors} -returnCodes error -body { 236 proc foo {} {lappend} 237 foo 238} -result {wrong # args: should be "lappend varName ?value ...?"} 239test appendComp-6.2 {lappend errors} -returnCodes error -body { 240 proc foo {} { 241 set x "" 242 lappend x(0) 44 243 } 244 foo 245} -result {can't set "x(0)": variable isn't array} 246 247test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup { 248 catch {rename foo ""} 249 unset -nocomplain x 250} -body { 251 proc bar {} { 252 global x 253 trace variable x w foo 254 proc foo {} {global x; unset x} 255 catch {lappend x 1} 256 proc foo {args} {global x; unset x} 257 info exists x 258 set x 259 lappend x 1 260 list [info exists x] [catch {set x} msg] $msg 261 } 262 bar 263} -result {0 1 {can't read "x": no such variable}} 264test appendComp-7.2 {lappend var triggers read trace, index var} -setup { 265 unset -nocomplain ::result 266} -body { 267 proc bar {} { 268 trace variable myvar r foo 269 proc foo {args} {append ::result $args} 270 lappend myvar a 271 return $::result 272 } 273 bar 274} -result {myvar {} r} -constraints {bug-3057639} 275test appendComp-7.3 {lappend var triggers read trace, stack var} -setup { 276 unset -nocomplain ::result 277 unset -nocomplain ::myvar 278} -body { 279 proc bar {} { 280 trace variable ::myvar r foo 281 proc foo {args} {append ::result $args} 282 lappend ::myvar a 283 return $::result 284 } 285 bar 286} -result {::myvar {} r} -constraints {bug-3057639} 287test appendComp-7.4 {lappend var triggers read trace, array var} -setup { 288 unset -nocomplain ::result 289} -body { 290 # The behavior of read triggers on lappend changed in 8.0 to not trigger 291 # them. Maybe not correct, but been there a while. 292 proc bar {} { 293 trace variable myvar r foo 294 proc foo {args} {append ::result $args} 295 lappend myvar(b) a 296 return $::result 297 } 298 bar 299} -result {myvar b r} -constraints {bug-3057639} 300test appendComp-7.5 {lappend var triggers read trace, array var} -setup { 301 unset -nocomplain ::result 302} -body { 303 # The behavior of read triggers on lappend changed in 8.0 to not trigger 304 # them. Maybe not correct, but been there a while. 305 proc bar {} { 306 trace variable myvar r foo 307 proc foo {args} {append ::result $args} 308 lappend myvar(b) a b 309 return $::result 310 } 311 bar 312} -result {myvar b r} 313test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup { 314 unset -nocomplain ::result 315} -body { 316 proc bar {} { 317 set myvar(0) 1 318 trace variable myvar r foo 319 proc foo {args} {append ::result $args} 320 lappend myvar(b) a 321 return $::result 322 } 323 bar 324} -result {myvar b r} -constraints {bug-3057639} 325test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup { 326 unset -nocomplain ::myvar 327 unset -nocomplain ::result 328} -body { 329 proc bar {} { 330 trace variable ::myvar r foo 331 proc foo {args} {append ::result $args} 332 lappend ::myvar(b) a 333 return $::result 334 } 335 bar 336} -result {::myvar b r} -constraints {bug-3057639} 337test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup { 338 unset -nocomplain ::myvar 339 unset -nocomplain ::result 340} -body { 341 proc bar {} { 342 trace variable ::myvar r foo 343 proc foo {args} {append ::result $args} 344 lappend ::myvar(b) a b 345 return $::result 346 } 347 bar 348} -result {::myvar b r} 349test appendComp-7.9 {append var does not trigger read trace} -setup { 350 unset -nocomplain ::result 351} -body { 352 proc bar {} { 353 trace variable myvar r foo 354 proc foo {args} {append ::result $args} 355 append myvar a 356 info exists ::result 357 } 358 bar 359} -result {0} 360 361test appendComp-8.1 {defer error to runtime} -setup { 362 interp create child 363} -body { 364 child eval { 365 proc foo {} { 366 proc append args {} 367 append 368 } 369 foo 370 } 371} -cleanup { 372 interp delete child 373} -result {} 374 375# New tests for bug 3057639 to show off the more consistent behaviour of 376# lappend in both direct-eval and bytecompiled code paths (see append.test for 377# the direct-eval variants). lappend now behaves like append. 9.0/1 lappend - 378# 9.2/3 append. 379 380# Note also the tests above now constrained by bug-3057639, these changed 381# behaviour with the triggering of read traces in bc mode gone. 382 383# Going back to the tests below. The direct-eval tests are ok before and after 384# patch (no read traces run for lappend, append). The compiled tests are 385# failing for lappend (9.0/1) before the patch, showing how it invokes read 386# traces in the compiled path. The append tests are good (9.2/3). After the 387# patch the failues are gone. 388 389test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup { 390 unset -nocomplain myvar 391 array set myvar {} 392} -body { 393 proc nonull {var key val} { 394 upvar 1 $var lvar 395 if {![info exists lvar($key)]} { 396 return -code error "BOOM. no such variable" 397 } 398 } 399 trace add variable myvar read nonull 400 proc foo {} { 401 lappend ::myvar(key) "new value" 402 } 403 list [catch { foo } msg] $msg 404} -result {0 {{new value}}} 405test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup { 406 unset -nocomplain ::env(__DUMMY__) 407} -body { 408 proc foo {} { 409 lappend ::env(__DUMMY__) "new value" 410 } 411 list [catch { foo } msg] $msg 412} -cleanup { 413 unset -nocomplain ::env(__DUMMY__) 414} -result {0 {{new value}}} 415test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup { 416 unset -nocomplain myvar 417 array set myvar {} 418} -body { 419 proc nonull {var key val} { 420 upvar 1 $var lvar 421 if {![info exists lvar($key)]} { 422 return -code error "BOOM. no such variable" 423 } 424 } 425 trace add variable myvar read nonull 426 proc foo {} { 427 append ::myvar(key) "new value" 428 } 429 list [catch { foo } msg] $msg 430} -result {0 {new value}} 431test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup { 432 unset -nocomplain ::env(__DUMMY__) 433} -body { 434 proc foo {} { 435 append ::env(__DUMMY__) "new value" 436 } 437 list [catch { foo } msg] $msg 438} -cleanup { 439 unset -nocomplain ::env(__DUMMY__) 440} -result {0 {new value}} 441 442test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} { 443 apply {lst { 444 lappend lst 445 }} "# 1 2 3" 446} "# 1 2 3" 447test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body { 448 apply {lst { 449 lappend lst 450 }} "1 \{ 2" 451} -returnCodes error -result {unmatched open brace in list} 452test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} { 453 apply {lst { 454 lappend lst {*}[list] 455 }} "# 1 2 3" 456} "# 1 2 3" 457test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { 458 apply {lst { 459 lappend lst {*}[list] 460 }} "1 \{ 2" 461} -returnCodes error -result {unmatched open brace in list} 462 463catch {unset i x result y} 464catch {rename foo ""} 465catch {rename bar ""} 466catch {rename check ""} 467catch {rename bar {}} 468 469# cleanup 470::tcltest::cleanupTests 471return 472 473# Local Variables: 474# mode: tcl 475# fill-column: 78 476# End: 477