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} 18::tcltest::loadTestedCommands 19unset -nocomplain x 20catch [list package require -exact tcl::test [info patchlevel]] 21 22testConstraint testbytestring [llength [info commands testbytestring]] 23 24test append-1.1 {append command} { 25 unset -nocomplain x 26 list [append x 1 2 abc "long string"] $x 27} {{12abclong string} {12abclong string}} 28test append-1.2 {append command} { 29 set x "" 30 list [append x first] [append x second] [append x third] $x 31} {first firstsecond firstsecondthird firstsecondthird} 32test append-1.3 {append command} { 33 set x "abcd" 34 append x 35} abcd 36 37test append-2.1 {long appends} { 38 set x "" 39 for {set i 0} {$i < 1000} {incr i} { 40 append x "foobar " 41 } 42 set y "foobar" 43 set y "$y $y $y $y $y $y $y $y $y $y" 44 set y "$y $y $y $y $y $y $y $y $y $y" 45 set y "$y $y $y $y $y $y $y $y $y $y " 46 expr {$x == $y} 47} 1 48 49test append-3.1 {append errors} -returnCodes error -body { 50 append 51} -result {wrong # args: should be "append varName ?value ...?"} 52test append-3.2 {append errors} -returnCodes error -body { 53 set x "" 54 append x(0) 44 55} -result {can't set "x(0)": variable isn't array} 56test append-3.3 {append errors} -returnCodes error -body { 57 unset -nocomplain x 58 append x 59} -result {can't read "x": no such variable} 60test append-3.4 {append surrogates} -body { 61 set x \uD83D 62 append x \uDE02 63} -result \uD83D\uDE02 64test append-3.5 {append surrogates} -body { 65 set x \uD83D 66 set x $x\uDE02 67} -result \uD83D\uDE02 68test append-3.6 {append surrogates} -body { 69 set x \uDE02 70 set x \uD83D$x 71} -result \uD83D\uDE02 72test append-3.7 {append \xC0 \x80} -constraints testbytestring -body { 73 set x [testbytestring \xC0] 74 string length [append x [testbytestring \x80]] 75} -result 2 76test append-3.8 {append \xC0 \x80} -constraints testbytestring -body { 77 set x [testbytestring \xC0] 78 string length $x[testbytestring \x80] 79} -result 2 80test append-3.9 {append \xC0 \x80} -constraints testbytestring -body { 81 set x [testbytestring \x80] 82 string length [testbytestring \xC0]$x 83} -result 2 84test append-3.10 {append surrogates} -body { 85 set x \uD83D 86 string range $x 0 end 87 append x \uDE02 88} -result [string range \uD83D\uDE02 0 end] 89 90test append-4.1 {lappend command} { 91 unset -nocomplain x 92 list [lappend x 1 2 abc "long string"] $x 93} {{1 2 abc {long string}} {1 2 abc {long string}}} 94test append-4.2 {lappend command} { 95 set x "" 96 list [lappend x first] [lappend x second] [lappend x third] $x 97} {first {first second} {first second third} {first second third}} 98test append-4.3 {lappend command} -body { 99 proc foo {} { 100 global x 101 set x old 102 unset x 103 lappend x new 104 } 105 foo 106} -cleanup { 107 rename foo {} 108} -result {new} 109test append-4.4 {lappend command} { 110 set x {} 111 lappend x \{\ abc 112} {\{\ abc} 113test append-4.5 {lappend command} { 114 set x {} 115 lappend x \{ abc 116} {\{ abc} 117test append-4.6 {lappend command} { 118 set x {1 2 3} 119 lappend x 120} {1 2 3} 121test append-4.7 {lappend command} { 122 set x "a\{" 123 lappend x abc 124} "a\\\{ abc" 125test append-4.8 {lappend command} { 126 set x "\\\{" 127 lappend x abc 128} "\\{ abc" 129test append-4.9 {lappend command} -returnCodes error -body { 130 set x " \{" 131 lappend x abc 132} -result {unmatched open brace in list} 133test append-4.10 {lappend command} -returnCodes error -body { 134 set x " \{" 135 lappend x abc 136} -result {unmatched open brace in list} 137test append-4.11 {lappend command} -returnCodes error -body { 138 set x "\{\{\{" 139 lappend x abc 140} -result {unmatched open brace in list} 141test append-4.12 {lappend command} -returnCodes error -body { 142 set x "x \{\{\{" 143 lappend x abc 144} -result {unmatched open brace in list} 145test append-4.13 {lappend command} { 146 set x "x\{\{\{" 147 lappend x abc 148} "x\\\{\\\{\\\{ abc" 149test append-4.14 {lappend command} { 150 set x " " 151 lappend x abc 152} "abc" 153test append-4.15 {lappend command} { 154 set x "\\ " 155 lappend x abc 156} "{ } abc" 157test append-4.16 {lappend command} { 158 set x "x " 159 lappend x abc 160} "x abc" 161test append-4.17 {lappend command} { 162 unset -nocomplain x 163 lappend x 164} {} 165test append-4.18 {lappend command} { 166 unset -nocomplain x 167 lappend x {} 168} {{}} 169test append-4.19 {lappend command} { 170 unset -nocomplain x 171 lappend x(0) 172} {} 173test append-4.20 {lappend command} { 174 unset -nocomplain x 175 lappend x(0) abc 176} {abc} 177unset -nocomplain x 178test append-4.21 {lappend command} -returnCodes error -body { 179 set x \" 180 lappend x 181} -result {unmatched open quote in list} 182test append-4.22 {lappend command} -returnCodes error -body { 183 set x \" 184 lappend x abc 185} -result {unmatched open quote in list} 186 187test append-5.1 {long lappends} -setup { 188 unset -nocomplain x 189 proc check {var size} { 190 set l [llength $var] 191 if {$l != $size} { 192 return "length mismatch: should have been $size, was $l" 193 } 194 for {set i 0} {$i < $size} {incr i} { 195 set j [lindex $var $i] 196 if {$j ne "item $i"} { 197 return "element $i should have been \"item $i\", was \"$j\"" 198 } 199 } 200 return ok 201 } 202} -body { 203 set x "" 204 for {set i 0} {$i < 300} {incr i} { 205 lappend x "item $i" 206 } 207 check $x 300 208} -cleanup { 209 rename check {} 210} -result ok 211 212test append-6.1 {lappend errors} -returnCodes error -body { 213 lappend 214} -result {wrong # args: should be "lappend varName ?value ...?"} 215test append-6.2 {lappend errors} -returnCodes error -body { 216 set x "" 217 lappend x(0) 44 218} -result {can't set "x(0)": variable isn't array} 219 220test append-7.1 {lappend-created var and error in trace on that var} -setup { 221 catch {rename foo ""} 222 unset -nocomplain x 223} -body { 224 trace variable x w foo 225 proc foo {} {global x; unset x} 226 catch {lappend x 1} 227 proc foo {args} {global x; unset x} 228 info exists x 229 set x 230 lappend x 1 231 list [info exists x] [catch {set x} msg] $msg 232} -result {0 1 {can't read "x": no such variable}} 233test append-7.2 {lappend var triggers read trace} -setup { 234 unset -nocomplain myvar 235 unset -nocomplain ::result 236} -body { 237 trace variable myvar r foo 238 proc foo {args} {append ::result $args} 239 lappend myvar a 240 return $::result 241} -result {myvar {} r} 242test append-7.3 {lappend var triggers read trace, array var} -setup { 243 unset -nocomplain myvar 244 unset -nocomplain ::result 245} -body { 246 # The behavior of read triggers on lappend changed in 8.0 to not trigger 247 # them, and was changed back in 8.4. 248 trace variable myvar r foo 249 proc foo {args} {append ::result $args} 250 lappend myvar(b) a 251 return $::result 252} -result {myvar b r} 253test append-7.4 {lappend var triggers read trace, array var exists} -setup { 254 unset -nocomplain myvar 255 unset -nocomplain ::result 256} -body { 257 set myvar(0) 1 258 trace variable myvar r foo 259 proc foo {args} {append ::result $args} 260 lappend myvar(b) a 261 return $::result 262} -result {myvar b r} 263test append-7.5 {append var does not trigger read trace} -setup { 264 unset -nocomplain myvar 265 unset -nocomplain ::result 266} -body { 267 trace variable myvar r foo 268 proc foo {args} {append ::result $args} 269 append myvar a 270 info exists ::result 271} -result {0} 272 273# THERE ARE NO append-8.* TESTS 274 275# New tests for bug 3057639 to show off the more consistent behaviour of 276# lappend in both direct-eval and bytecompiled code paths (see appendComp.test 277# for the compiled variants). lappend now behaves like append. 9.0/1 lappend - 278# 9.2/3 append 279 280test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} -setup { 281 unset -nocomplain myvar 282} -body { 283 array set myvar {} 284 proc nonull {var key val} { 285 upvar 1 $var lvar 286 if {![info exists lvar($key)]} { 287 return -code error "no such variable" 288 } 289 } 290 trace add variable myvar read nonull 291 list [catch { 292 lappend myvar(key) "new value" 293 } msg] $msg 294} -result {0 {{new value}}} 295test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup { 296 unset -nocomplain ::env(__DUMMY__) 297} -body { 298 list [catch { 299 lappend ::env(__DUMMY__) "new value" 300 } msg] $msg 301} -cleanup { 302 unset -nocomplain ::env(__DUMMY__) 303} -result {0 {{new value}}} 304test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} -setup { 305 unset -nocomplain myvar 306} -body { 307 array set myvar {} 308 proc nonull {var key val} { 309 upvar 1 $var lvar 310 if {![info exists lvar($key)]} { 311 return -code error "no such variable" 312 } 313 } 314 trace add variable myvar read nonull 315 list [catch { 316 append myvar(key) "new value" 317 } msg] $msg 318} -result {0 {new value}} 319test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup { 320 unset -nocomplain ::env(__DUMMY__) 321} -body { 322 list [catch { 323 append ::env(__DUMMY__) "new value" 324 } msg] $msg 325} -cleanup { 326 unset -nocomplain ::env(__DUMMY__) 327} -result {0 {new value}} 328 329test append-10.1 {Bug 214cc0eb22: lappend with no values} { 330 set lst "# 1 2 3" 331 [subst lappend] lst 332} "# 1 2 3" 333test append-10.2 {Bug 214cc0eb22: lappend with no values} -body { 334 set lst "1 \{ 2" 335 [subst lappend] lst 336} -returnCodes error -result {unmatched open brace in list} 337test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} { 338 set lst "# 1 2 3" 339 [subst lappend] lst {*}[list] 340} "# 1 2 3" 341test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { 342 set lst "1 \{ 2" 343 [subst lappend] lst {*}[list] 344} -returnCodes error -result {unmatched open brace in list} 345 346unset -nocomplain i x result y 347catch {rename foo ""} 348 349# cleanup 350::tcltest::cleanupTests 351return 352 353# Local Variables: 354# mode: tcl 355# fill-column: 78 356# End: 357