[25] | 1 | # Commands covered: append lappend |
---|
| 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 (c) 1991-1993 The Regents of the University of California. |
---|
| 8 | # Copyright (c) 1994-1996 Sun Microsystems, Inc. |
---|
| 9 | # Copyright (c) 1998-1999 by 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 | # |
---|
| 14 | # RCS: @(#) $Id: appendComp.test,v 1.9 2005/05/10 18:34:56 kennykb Exp $ |
---|
| 15 | |
---|
| 16 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 17 | package require tcltest 2 |
---|
| 18 | namespace import -force ::tcltest::* |
---|
| 19 | } |
---|
| 20 | catch {unset x} |
---|
| 21 | |
---|
| 22 | test appendComp-1.1 {append command} { |
---|
| 23 | catch {unset x} |
---|
| 24 | proc foo {} {append ::x 1 2 abc "long string"} |
---|
| 25 | list [foo] $x |
---|
| 26 | } {{12abclong string} {12abclong string}} |
---|
| 27 | test appendComp-1.2 {append command} { |
---|
| 28 | proc foo {} { |
---|
| 29 | set x "" |
---|
| 30 | list [append x first] [append x second] [append x third] $x |
---|
| 31 | } |
---|
| 32 | foo |
---|
| 33 | } {first firstsecond firstsecondthird firstsecondthird} |
---|
| 34 | test appendComp-1.3 {append command} { |
---|
| 35 | proc foo {} { |
---|
| 36 | set x "abcd" |
---|
| 37 | append x |
---|
| 38 | } |
---|
| 39 | foo |
---|
| 40 | } abcd |
---|
| 41 | |
---|
| 42 | test appendComp-2.1 {long appends} { |
---|
| 43 | proc foo {} { |
---|
| 44 | set x "" |
---|
| 45 | for {set i 0} {$i < 1000} {set i [expr $i+1]} { |
---|
| 46 | append x "foobar " |
---|
| 47 | } |
---|
| 48 | set y "foobar" |
---|
| 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 | set y "$y $y $y $y $y $y $y $y $y $y " |
---|
| 52 | expr {$x == $y} |
---|
| 53 | } |
---|
| 54 | foo |
---|
| 55 | } 1 |
---|
| 56 | |
---|
| 57 | test appendComp-3.1 {append errors} { |
---|
| 58 | proc foo {} {append} |
---|
| 59 | list [catch {foo} msg] $msg |
---|
| 60 | } {1 {wrong # args: should be "append varName ?value value ...?"}} |
---|
| 61 | test appendComp-3.2 {append errors} { |
---|
| 62 | proc foo {} { |
---|
| 63 | set x "" |
---|
| 64 | append x(0) 44 |
---|
| 65 | } |
---|
| 66 | list [catch {foo} msg] $msg |
---|
| 67 | } {1 {can't set "x(0)": variable isn't array}} |
---|
| 68 | test appendComp-3.3 {append errors} { |
---|
| 69 | proc foo {} { |
---|
| 70 | catch {unset x} |
---|
| 71 | append x |
---|
| 72 | } |
---|
| 73 | list [catch {foo} msg] $msg |
---|
| 74 | } {1 {can't read "x": no such variable}} |
---|
| 75 | |
---|
| 76 | test appendComp-4.1 {lappend command} { |
---|
| 77 | proc foo {} { |
---|
| 78 | global x |
---|
| 79 | catch {unset x} |
---|
| 80 | lappend x 1 2 abc "long string" |
---|
| 81 | } |
---|
| 82 | list [foo] $x |
---|
| 83 | } {{1 2 abc {long string}} {1 2 abc {long string}}} |
---|
| 84 | test appendComp-4.2 {lappend command} { |
---|
| 85 | proc foo {} { |
---|
| 86 | set x "" |
---|
| 87 | list [lappend x first] [lappend x second] [lappend x third] $x |
---|
| 88 | } |
---|
| 89 | foo |
---|
| 90 | } {first {first second} {first second third} {first second third}} |
---|
| 91 | test appendComp-4.3 {lappend command} { |
---|
| 92 | proc foo {} { |
---|
| 93 | global x |
---|
| 94 | set x old |
---|
| 95 | unset x |
---|
| 96 | lappend x new |
---|
| 97 | } |
---|
| 98 | set result [foo] |
---|
| 99 | rename foo {} |
---|
| 100 | set result |
---|
| 101 | } {new} |
---|
| 102 | test appendComp-4.4 {lappend command} { |
---|
| 103 | proc foo {} { |
---|
| 104 | set x {} |
---|
| 105 | lappend x \{\ abc |
---|
| 106 | } |
---|
| 107 | foo |
---|
| 108 | } {\{\ abc} |
---|
| 109 | test appendComp-4.5 {lappend command} { |
---|
| 110 | proc foo {} { |
---|
| 111 | set x {} |
---|
| 112 | lappend x \{ abc |
---|
| 113 | } |
---|
| 114 | foo |
---|
| 115 | } {\{ abc} |
---|
| 116 | test appendComp-4.6 {lappend command} { |
---|
| 117 | proc foo {} { |
---|
| 118 | set x {1 2 3} |
---|
| 119 | lappend x |
---|
| 120 | } |
---|
| 121 | foo |
---|
| 122 | } {1 2 3} |
---|
| 123 | test appendComp-4.7 {lappend command} { |
---|
| 124 | proc foo {} { |
---|
| 125 | set x "a\{" |
---|
| 126 | lappend x abc |
---|
| 127 | } |
---|
| 128 | foo |
---|
| 129 | } "a\\\{ abc" |
---|
| 130 | test appendComp-4.8 {lappend command} { |
---|
| 131 | proc foo {} { |
---|
| 132 | set x "\\\{" |
---|
| 133 | lappend x abc |
---|
| 134 | } |
---|
| 135 | foo |
---|
| 136 | } "\\{ abc" |
---|
| 137 | test appendComp-4.9 {lappend command} { |
---|
| 138 | proc foo {} { |
---|
| 139 | set x " \{" |
---|
| 140 | list [catch {lappend x abc} msg] $msg |
---|
| 141 | } |
---|
| 142 | foo |
---|
| 143 | } {1 {unmatched open brace in list}} |
---|
| 144 | test appendComp-4.10 {lappend command} { |
---|
| 145 | proc foo {} { |
---|
| 146 | set x " \{" |
---|
| 147 | list [catch {lappend x abc} msg] $msg |
---|
| 148 | } |
---|
| 149 | foo |
---|
| 150 | } {1 {unmatched open brace in list}} |
---|
| 151 | test appendComp-4.11 {lappend command} { |
---|
| 152 | proc foo {} { |
---|
| 153 | set x "\{\{\{" |
---|
| 154 | list [catch {lappend x abc} msg] $msg |
---|
| 155 | } |
---|
| 156 | foo |
---|
| 157 | } {1 {unmatched open brace in list}} |
---|
| 158 | test appendComp-4.12 {lappend command} { |
---|
| 159 | proc foo {} { |
---|
| 160 | set x "x \{\{\{" |
---|
| 161 | list [catch {lappend x abc} msg] $msg |
---|
| 162 | } |
---|
| 163 | foo |
---|
| 164 | } {1 {unmatched open brace in list}} |
---|
| 165 | test appendComp-4.13 {lappend command} { |
---|
| 166 | proc foo {} { |
---|
| 167 | set x "x\{\{\{" |
---|
| 168 | lappend x abc |
---|
| 169 | } |
---|
| 170 | foo |
---|
| 171 | } "x\\\{\\\{\\\{ abc" |
---|
| 172 | test appendComp-4.14 {lappend command} { |
---|
| 173 | proc foo {} { |
---|
| 174 | set x " " |
---|
| 175 | lappend x abc |
---|
| 176 | } |
---|
| 177 | foo |
---|
| 178 | } "abc" |
---|
| 179 | test appendComp-4.15 {lappend command} { |
---|
| 180 | proc foo {} { |
---|
| 181 | set x "\\ " |
---|
| 182 | lappend x abc |
---|
| 183 | } |
---|
| 184 | foo |
---|
| 185 | } "{ } abc" |
---|
| 186 | test appendComp-4.16 {lappend command} { |
---|
| 187 | proc foo {} { |
---|
| 188 | set x "x " |
---|
| 189 | lappend x abc |
---|
| 190 | } |
---|
| 191 | foo |
---|
| 192 | } "x abc" |
---|
| 193 | test appendComp-4.17 {lappend command} { |
---|
| 194 | proc foo {} { lappend x } |
---|
| 195 | foo |
---|
| 196 | } {} |
---|
| 197 | test appendComp-4.18 {lappend command} { |
---|
| 198 | proc foo {} { lappend x {} } |
---|
| 199 | foo |
---|
| 200 | } {{}} |
---|
| 201 | test appendComp-4.19 {lappend command} { |
---|
| 202 | proc foo {} { lappend x(0) } |
---|
| 203 | foo |
---|
| 204 | } {} |
---|
| 205 | test appendComp-4.20 {lappend command} { |
---|
| 206 | proc foo {} { lappend x(0) abc } |
---|
| 207 | foo |
---|
| 208 | } {abc} |
---|
| 209 | |
---|
| 210 | proc check {var size} { |
---|
| 211 | set l [llength $var] |
---|
| 212 | if {$l != $size} { |
---|
| 213 | return "length mismatch: should have been $size, was $l" |
---|
| 214 | } |
---|
| 215 | for {set i 0} {$i < $size} {set i [expr $i+1]} { |
---|
| 216 | set j [lindex $var $i] |
---|
| 217 | if {$j != "item $i"} { |
---|
| 218 | return "element $i should have been \"item $i\", was \"$j\"" |
---|
| 219 | } |
---|
| 220 | } |
---|
| 221 | return ok |
---|
| 222 | } |
---|
| 223 | test appendComp-5.1 {long lappends} { |
---|
| 224 | catch {unset x} |
---|
| 225 | set x "" |
---|
| 226 | for {set i 0} {$i < 300} {set i [expr $i+1]} { |
---|
| 227 | lappend x "item $i" |
---|
| 228 | } |
---|
| 229 | check $x 300 |
---|
| 230 | } ok |
---|
| 231 | |
---|
| 232 | test appendComp-6.1 {lappend errors} { |
---|
| 233 | proc foo {} {lappend} |
---|
| 234 | list [catch {foo} msg] $msg |
---|
| 235 | } {1 {wrong # args: should be "lappend varName ?value value ...?"}} |
---|
| 236 | test appendComp-6.2 {lappend errors} { |
---|
| 237 | proc foo {} { |
---|
| 238 | set x "" |
---|
| 239 | lappend x(0) 44 |
---|
| 240 | } |
---|
| 241 | list [catch {foo} msg] $msg |
---|
| 242 | } {1 {can't set "x(0)": variable isn't array}} |
---|
| 243 | |
---|
| 244 | test appendComp-7.1 {lappendComp-created var and error in trace on that var} { |
---|
| 245 | proc bar {} { |
---|
| 246 | global x |
---|
| 247 | catch {rename foo ""} |
---|
| 248 | catch {unset x} |
---|
| 249 | trace variable x w foo |
---|
| 250 | proc foo {} {global x; unset x} |
---|
| 251 | catch {lappend x 1} |
---|
| 252 | proc foo {args} {global x; unset x} |
---|
| 253 | info exists x |
---|
| 254 | set x |
---|
| 255 | lappend x 1 |
---|
| 256 | list [info exists x] [catch {set x} msg] $msg |
---|
| 257 | } |
---|
| 258 | bar |
---|
| 259 | } {0 1 {can't read "x": no such variable}} |
---|
| 260 | test appendComp-7.2 {lappend var triggers read trace, index var} { |
---|
| 261 | proc bar {} { |
---|
| 262 | catch {unset myvar} |
---|
| 263 | catch {unset ::result} |
---|
| 264 | trace variable myvar r foo |
---|
| 265 | proc foo {args} {append ::result $args} |
---|
| 266 | lappend myvar a |
---|
| 267 | list [catch {set ::result} msg] $msg |
---|
| 268 | } |
---|
| 269 | bar |
---|
| 270 | } {0 {myvar {} r}} |
---|
| 271 | test appendComp-7.3 {lappend var triggers read trace, stack var} { |
---|
| 272 | proc bar {} { |
---|
| 273 | catch {unset ::myvar} |
---|
| 274 | catch {unset ::result} |
---|
| 275 | trace variable ::myvar r foo |
---|
| 276 | proc foo {args} {append ::result $args} |
---|
| 277 | lappend ::myvar a |
---|
| 278 | list [catch {set ::result} msg] $msg |
---|
| 279 | } |
---|
| 280 | bar |
---|
| 281 | } {0 {::myvar {} r}} |
---|
| 282 | test appendComp-7.4 {lappend var triggers read trace, array var} { |
---|
| 283 | # The behavior of read triggers on lappend changed in 8.0 to |
---|
| 284 | # not trigger them. Maybe not correct, but been there a while. |
---|
| 285 | proc bar {} { |
---|
| 286 | catch {unset myvar} |
---|
| 287 | catch {unset ::result} |
---|
| 288 | trace variable myvar r foo |
---|
| 289 | proc foo {args} {append ::result $args} |
---|
| 290 | lappend myvar(b) a |
---|
| 291 | list [catch {set ::result} msg] $msg |
---|
| 292 | } |
---|
| 293 | bar |
---|
| 294 | } {0 {myvar b r}} |
---|
| 295 | test appendComp-7.5 {lappend var triggers read trace, array var} { |
---|
| 296 | # The behavior of read triggers on lappend changed in 8.0 to |
---|
| 297 | # not trigger them. Maybe not correct, but been there a while. |
---|
| 298 | proc bar {} { |
---|
| 299 | catch {unset myvar} |
---|
| 300 | catch {unset ::result} |
---|
| 301 | trace variable myvar r foo |
---|
| 302 | proc foo {args} {append ::result $args} |
---|
| 303 | lappend myvar(b) a b |
---|
| 304 | list [catch {set ::result} msg] $msg |
---|
| 305 | } |
---|
| 306 | bar |
---|
| 307 | } {0 {myvar b r}} |
---|
| 308 | test appendComp-7.6 {lappend var triggers read trace, array var exists} { |
---|
| 309 | proc bar {} { |
---|
| 310 | catch {unset myvar} |
---|
| 311 | catch {unset ::result} |
---|
| 312 | set myvar(0) 1 |
---|
| 313 | trace variable myvar r foo |
---|
| 314 | proc foo {args} {append ::result $args} |
---|
| 315 | lappend myvar(b) a |
---|
| 316 | list [catch {set ::result} msg] $msg |
---|
| 317 | } |
---|
| 318 | bar |
---|
| 319 | } {0 {myvar b r}} |
---|
| 320 | test appendComp-7.7 {lappend var triggers read trace, array stack var} { |
---|
| 321 | proc bar {} { |
---|
| 322 | catch {unset ::myvar} |
---|
| 323 | catch {unset ::result} |
---|
| 324 | trace variable ::myvar r foo |
---|
| 325 | proc foo {args} {append ::result $args} |
---|
| 326 | lappend ::myvar(b) a |
---|
| 327 | list [catch {set ::result} msg] $msg |
---|
| 328 | } |
---|
| 329 | bar |
---|
| 330 | } {0 {::myvar b r}} |
---|
| 331 | test appendComp-7.8 {lappend var triggers read trace, array stack var} { |
---|
| 332 | proc bar {} { |
---|
| 333 | catch {unset ::myvar} |
---|
| 334 | catch {unset ::result} |
---|
| 335 | trace variable ::myvar r foo |
---|
| 336 | proc foo {args} {append ::result $args} |
---|
| 337 | lappend ::myvar(b) a b |
---|
| 338 | list [catch {set ::result} msg] $msg |
---|
| 339 | } |
---|
| 340 | bar |
---|
| 341 | } {0 {::myvar b r}} |
---|
| 342 | test appendComp-7.9 {append var does not trigger read trace} { |
---|
| 343 | proc bar {} { |
---|
| 344 | catch {unset myvar} |
---|
| 345 | catch {unset ::result} |
---|
| 346 | trace variable myvar r foo |
---|
| 347 | proc foo {args} {append ::result $args} |
---|
| 348 | append myvar a |
---|
| 349 | info exists ::result |
---|
| 350 | } |
---|
| 351 | bar |
---|
| 352 | } {0} |
---|
| 353 | |
---|
| 354 | test appendComp-8.1 {defer error to runtime} -setup { |
---|
| 355 | interp create slave |
---|
| 356 | } -body { |
---|
| 357 | slave eval { |
---|
| 358 | proc foo {} { |
---|
| 359 | proc append args {} |
---|
| 360 | append |
---|
| 361 | } |
---|
| 362 | foo |
---|
| 363 | } |
---|
| 364 | } -cleanup { |
---|
| 365 | interp delete slave |
---|
| 366 | } -result {} |
---|
| 367 | |
---|
| 368 | catch {unset i x result y} |
---|
| 369 | catch {rename foo ""} |
---|
| 370 | catch {rename bar ""} |
---|
| 371 | catch {rename check ""} |
---|
| 372 | catch {rename bar {}} |
---|
| 373 | |
---|
| 374 | # cleanup |
---|
| 375 | ::tcltest::cleanupTests |
---|
| 376 | return |
---|