os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/appendComp.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/appendComp.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,362 @@
1.4 +# Commands covered: append lappend
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994-1996 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: appendComp.test,v 1.5.4.1 2004/10/28 00:01:05 dgp Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +catch {unset x}
1.24 +
1.25 +test appendComp-1.1 {append command} {
1.26 + catch {unset x}
1.27 + proc foo {} {append ::x 1 2 abc "long string"}
1.28 + list [foo] $x
1.29 +} {{12abclong string} {12abclong string}}
1.30 +test appendComp-1.2 {append command} {
1.31 + proc foo {} {
1.32 + set x ""
1.33 + list [append x first] [append x second] [append x third] $x
1.34 + }
1.35 + foo
1.36 +} {first firstsecond firstsecondthird firstsecondthird}
1.37 +test appendComp-1.3 {append command} {
1.38 + proc foo {} {
1.39 + set x "abcd"
1.40 + append x
1.41 + }
1.42 + foo
1.43 +} abcd
1.44 +
1.45 +test appendComp-2.1 {long appends} {
1.46 + proc foo {} {
1.47 + set x ""
1.48 + for {set i 0} {$i < 1000} {set i [expr $i+1]} {
1.49 + append x "foobar "
1.50 + }
1.51 + set y "foobar"
1.52 + set y "$y $y $y $y $y $y $y $y $y $y"
1.53 + set y "$y $y $y $y $y $y $y $y $y $y"
1.54 + set y "$y $y $y $y $y $y $y $y $y $y "
1.55 + expr {$x == $y}
1.56 + }
1.57 + foo
1.58 +} 1
1.59 +
1.60 +test appendComp-3.1 {append errors} {
1.61 + proc foo {} {append}
1.62 + list [catch {foo} msg] $msg
1.63 +} {1 {wrong # args: should be "append varName ?value value ...?"}}
1.64 +test appendComp-3.2 {append errors} {
1.65 + proc foo {} {
1.66 + set x ""
1.67 + append x(0) 44
1.68 + }
1.69 + list [catch {foo} msg] $msg
1.70 +} {1 {can't set "x(0)": variable isn't array}}
1.71 +test appendComp-3.3 {append errors} {
1.72 + proc foo {} {
1.73 + catch {unset x}
1.74 + append x
1.75 + }
1.76 + list [catch {foo} msg] $msg
1.77 +} {1 {can't read "x": no such variable}}
1.78 +
1.79 +test appendComp-4.1 {lappend command} {
1.80 + proc foo {} {
1.81 + global x
1.82 + catch {unset x}
1.83 + lappend x 1 2 abc "long string"
1.84 + }
1.85 + list [foo] $x
1.86 +} {{1 2 abc {long string}} {1 2 abc {long string}}}
1.87 +test appendComp-4.2 {lappend command} {
1.88 + proc foo {} {
1.89 + set x ""
1.90 + list [lappend x first] [lappend x second] [lappend x third] $x
1.91 + }
1.92 + foo
1.93 +} {first {first second} {first second third} {first second third}}
1.94 +test appendComp-4.3 {lappend command} {
1.95 + proc foo {} {
1.96 + global x
1.97 + set x old
1.98 + unset x
1.99 + lappend x new
1.100 + }
1.101 + set result [foo]
1.102 + rename foo {}
1.103 + set result
1.104 +} {new}
1.105 +test appendComp-4.4 {lappend command} {
1.106 + proc foo {} {
1.107 + set x {}
1.108 + lappend x \{\ abc
1.109 + }
1.110 + foo
1.111 +} {\{\ abc}
1.112 +test appendComp-4.5 {lappend command} {
1.113 + proc foo {} {
1.114 + set x {}
1.115 + lappend x \{ abc
1.116 + }
1.117 + foo
1.118 +} {\{ abc}
1.119 +test appendComp-4.6 {lappend command} {
1.120 + proc foo {} {
1.121 + set x {1 2 3}
1.122 + lappend x
1.123 + }
1.124 + foo
1.125 +} {1 2 3}
1.126 +test appendComp-4.7 {lappend command} {
1.127 + proc foo {} {
1.128 + set x "a\{"
1.129 + lappend x abc
1.130 + }
1.131 + foo
1.132 +} "a\\\{ abc"
1.133 +test appendComp-4.8 {lappend command} {
1.134 + proc foo {} {
1.135 + set x "\\\{"
1.136 + lappend x abc
1.137 + }
1.138 + foo
1.139 +} "\\{ abc"
1.140 +test appendComp-4.9 {lappend command} {
1.141 + proc foo {} {
1.142 + set x " \{"
1.143 + list [catch {lappend x abc} msg] $msg
1.144 + }
1.145 + foo
1.146 +} {1 {unmatched open brace in list}}
1.147 +test appendComp-4.10 {lappend command} {
1.148 + proc foo {} {
1.149 + set x " \{"
1.150 + list [catch {lappend x abc} msg] $msg
1.151 + }
1.152 + foo
1.153 +} {1 {unmatched open brace in list}}
1.154 +test appendComp-4.11 {lappend command} {
1.155 + proc foo {} {
1.156 + set x "\{\{\{"
1.157 + list [catch {lappend x abc} msg] $msg
1.158 + }
1.159 + foo
1.160 +} {1 {unmatched open brace in list}}
1.161 +test appendComp-4.12 {lappend command} {
1.162 + proc foo {} {
1.163 + set x "x \{\{\{"
1.164 + list [catch {lappend x abc} msg] $msg
1.165 + }
1.166 + foo
1.167 +} {1 {unmatched open brace in list}}
1.168 +test appendComp-4.13 {lappend command} {
1.169 + proc foo {} {
1.170 + set x "x\{\{\{"
1.171 + lappend x abc
1.172 + }
1.173 + foo
1.174 +} "x\\\{\\\{\\\{ abc"
1.175 +test appendComp-4.14 {lappend command} {
1.176 + proc foo {} {
1.177 + set x " "
1.178 + lappend x abc
1.179 + }
1.180 + foo
1.181 +} "abc"
1.182 +test appendComp-4.15 {lappend command} {
1.183 + proc foo {} {
1.184 + set x "\\ "
1.185 + lappend x abc
1.186 + }
1.187 + foo
1.188 +} "{ } abc"
1.189 +test appendComp-4.16 {lappend command} {
1.190 + proc foo {} {
1.191 + set x "x "
1.192 + lappend x abc
1.193 + }
1.194 + foo
1.195 +} "x abc"
1.196 +test appendComp-4.17 {lappend command} {
1.197 + proc foo {} { lappend x }
1.198 + foo
1.199 +} {}
1.200 +test appendComp-4.18 {lappend command} {
1.201 + proc foo {} { lappend x {} }
1.202 + foo
1.203 +} {{}}
1.204 +test appendComp-4.19 {lappend command} {
1.205 + proc foo {} { lappend x(0) }
1.206 + foo
1.207 +} {}
1.208 +test appendComp-4.20 {lappend command} {
1.209 + proc foo {} { lappend x(0) abc }
1.210 + foo
1.211 +} {abc}
1.212 +
1.213 +proc check {var size} {
1.214 + set l [llength $var]
1.215 + if {$l != $size} {
1.216 + return "length mismatch: should have been $size, was $l"
1.217 + }
1.218 + for {set i 0} {$i < $size} {set i [expr $i+1]} {
1.219 + set j [lindex $var $i]
1.220 + if {$j != "item $i"} {
1.221 + return "element $i should have been \"item $i\", was \"$j\""
1.222 + }
1.223 + }
1.224 + return ok
1.225 +}
1.226 +test appendComp-5.1 {long lappends} {
1.227 + catch {unset x}
1.228 + set x ""
1.229 + for {set i 0} {$i < 300} {set i [expr $i+1]} {
1.230 + lappend x "item $i"
1.231 + }
1.232 + check $x 300
1.233 +} ok
1.234 +
1.235 +test appendComp-6.1 {lappend errors} {
1.236 + proc foo {} {lappend}
1.237 + list [catch {foo} msg] $msg
1.238 +} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
1.239 +test appendComp-6.2 {lappend errors} {
1.240 + proc foo {} {
1.241 + set x ""
1.242 + lappend x(0) 44
1.243 + }
1.244 + list [catch {foo} msg] $msg
1.245 +} {1 {can't set "x(0)": variable isn't array}}
1.246 +
1.247 +test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
1.248 + proc bar {} {
1.249 + global x
1.250 + catch {rename foo ""}
1.251 + catch {unset x}
1.252 + trace variable x w foo
1.253 + proc foo {} {global x; unset x}
1.254 + catch {lappend x 1}
1.255 + proc foo {args} {global x; unset x}
1.256 + info exists x
1.257 + set x
1.258 + lappend x 1
1.259 + list [info exists x] [catch {set x} msg] $msg
1.260 + }
1.261 + bar
1.262 +} {0 1 {can't read "x": no such variable}}
1.263 +test appendComp-7.2 {lappend var triggers read trace, index var} {
1.264 + proc bar {} {
1.265 + catch {unset myvar}
1.266 + catch {unset ::result}
1.267 + trace variable myvar r foo
1.268 + proc foo {args} {append ::result $args}
1.269 + lappend myvar a
1.270 + list [catch {set ::result} msg] $msg
1.271 + }
1.272 + bar
1.273 +} {0 {myvar {} r}}
1.274 +test appendComp-7.3 {lappend var triggers read trace, stack var} {
1.275 + proc bar {} {
1.276 + catch {unset ::myvar}
1.277 + catch {unset ::result}
1.278 + trace variable ::myvar r foo
1.279 + proc foo {args} {append ::result $args}
1.280 + lappend ::myvar a
1.281 + list [catch {set ::result} msg] $msg
1.282 + }
1.283 + bar
1.284 +} {0 {::myvar {} r}}
1.285 +test appendComp-7.4 {lappend var triggers read trace, array var} {
1.286 + # The behavior of read triggers on lappend changed in 8.0 to
1.287 + # not trigger them. Maybe not correct, but been there a while.
1.288 + proc bar {} {
1.289 + catch {unset myvar}
1.290 + catch {unset ::result}
1.291 + trace variable myvar r foo
1.292 + proc foo {args} {append ::result $args}
1.293 + lappend myvar(b) a
1.294 + list [catch {set ::result} msg] $msg
1.295 + }
1.296 + bar
1.297 +} {0 {myvar b r}}
1.298 +test appendComp-7.5 {lappend var triggers read trace, array var} {
1.299 + # The behavior of read triggers on lappend changed in 8.0 to
1.300 + # not trigger them. Maybe not correct, but been there a while.
1.301 + proc bar {} {
1.302 + catch {unset myvar}
1.303 + catch {unset ::result}
1.304 + trace variable myvar r foo
1.305 + proc foo {args} {append ::result $args}
1.306 + lappend myvar(b) a b
1.307 + list [catch {set ::result} msg] $msg
1.308 + }
1.309 + bar
1.310 +} {0 {myvar b r}}
1.311 +test appendComp-7.6 {lappend var triggers read trace, array var exists} {
1.312 + proc bar {} {
1.313 + catch {unset myvar}
1.314 + catch {unset ::result}
1.315 + set myvar(0) 1
1.316 + trace variable myvar r foo
1.317 + proc foo {args} {append ::result $args}
1.318 + lappend myvar(b) a
1.319 + list [catch {set ::result} msg] $msg
1.320 + }
1.321 + bar
1.322 +} {0 {myvar b r}}
1.323 +test appendComp-7.7 {lappend var triggers read trace, array stack var} {
1.324 + proc bar {} {
1.325 + catch {unset ::myvar}
1.326 + catch {unset ::result}
1.327 + trace variable ::myvar r foo
1.328 + proc foo {args} {append ::result $args}
1.329 + lappend ::myvar(b) a
1.330 + list [catch {set ::result} msg] $msg
1.331 + }
1.332 + bar
1.333 +} {0 {::myvar b r}}
1.334 +test appendComp-7.8 {lappend var triggers read trace, array stack var} {
1.335 + proc bar {} {
1.336 + catch {unset ::myvar}
1.337 + catch {unset ::result}
1.338 + trace variable ::myvar r foo
1.339 + proc foo {args} {append ::result $args}
1.340 + lappend ::myvar(b) a b
1.341 + list [catch {set ::result} msg] $msg
1.342 + }
1.343 + bar
1.344 +} {0 {::myvar b r}}
1.345 +test appendComp-7.9 {append var does not trigger read trace} {
1.346 + proc bar {} {
1.347 + catch {unset myvar}
1.348 + catch {unset ::result}
1.349 + trace variable myvar r foo
1.350 + proc foo {args} {append ::result $args}
1.351 + append myvar a
1.352 + info exists ::result
1.353 + }
1.354 + bar
1.355 +} {0}
1.356 +
1.357 +catch {unset i x result y}
1.358 +catch {rename foo ""}
1.359 +catch {rename bar ""}
1.360 +catch {rename check ""}
1.361 +catch {rename bar {}}
1.362 +
1.363 +# cleanup
1.364 +::tcltest::cleanupTests
1.365 +return