os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/append.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/append.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,241 @@
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: append.test,v 1.7.12.1 2006/10/05 11:44:04 msofer 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 append-1.1 {append command} {
1.26 + catch {unset x}
1.27 + list [append x 1 2 abc "long string"] $x
1.28 +} {{12abclong string} {12abclong string}}
1.29 +test append-1.2 {append command} {
1.30 + set x ""
1.31 + list [append x first] [append x second] [append x third] $x
1.32 +} {first firstsecond firstsecondthird firstsecondthird}
1.33 +test append-1.3 {append command} {
1.34 + set x "abcd"
1.35 + append x
1.36 +} abcd
1.37 +
1.38 +test append-2.1 {long appends} {
1.39 + set x ""
1.40 + for {set i 0} {$i < 1000} {set i [expr $i+1]} {
1.41 + append x "foobar "
1.42 + }
1.43 + set y "foobar"
1.44 + set y "$y $y $y $y $y $y $y $y $y $y"
1.45 + set y "$y $y $y $y $y $y $y $y $y $y"
1.46 + set y "$y $y $y $y $y $y $y $y $y $y "
1.47 + expr {$x == $y}
1.48 +} 1
1.49 +
1.50 +test append-3.1 {append errors} {
1.51 + list [catch {append} msg] $msg
1.52 +} {1 {wrong # args: should be "append varName ?value value ...?"}}
1.53 +test append-3.2 {append errors} {
1.54 + set x ""
1.55 + list [catch {append x(0) 44} msg] $msg
1.56 +} {1 {can't set "x(0)": variable isn't array}}
1.57 +test append-3.3 {append errors} {
1.58 + catch {unset x}
1.59 + list [catch {append x} msg] $msg
1.60 +} {1 {can't read "x": no such variable}}
1.61 +
1.62 +test append-4.1 {lappend command} {
1.63 + catch {unset x}
1.64 + list [lappend x 1 2 abc "long string"] $x
1.65 +} {{1 2 abc {long string}} {1 2 abc {long string}}}
1.66 +test append-4.2 {lappend command} {
1.67 + set x ""
1.68 + list [lappend x first] [lappend x second] [lappend x third] $x
1.69 +} {first {first second} {first second third} {first second third}}
1.70 +test append-4.3 {lappend command} {
1.71 + proc foo {} {
1.72 + global x
1.73 + set x old
1.74 + unset x
1.75 + lappend x new
1.76 + }
1.77 + set result [foo]
1.78 + rename foo {}
1.79 + set result
1.80 +} {new}
1.81 +test append-4.4 {lappend command} {
1.82 + set x {}
1.83 + lappend x \{\ abc
1.84 +} {\{\ abc}
1.85 +test append-4.5 {lappend command} {
1.86 + set x {}
1.87 + lappend x \{ abc
1.88 +} {\{ abc}
1.89 +test append-4.6 {lappend command} {
1.90 + set x {1 2 3}
1.91 + lappend x
1.92 +} {1 2 3}
1.93 +test append-4.7 {lappend command} {
1.94 + set x "a\{"
1.95 + lappend x abc
1.96 +} "a\\\{ abc"
1.97 +test append-4.8 {lappend command} {
1.98 + set x "\\\{"
1.99 + lappend x abc
1.100 +} "\\{ abc"
1.101 +test append-4.9 {lappend command} {
1.102 + set x " \{"
1.103 + list [catch {lappend x abc} msg] $msg
1.104 +} {1 {unmatched open brace in list}}
1.105 +test append-4.10 {lappend command} {
1.106 + set x " \{"
1.107 + list [catch {lappend x abc} msg] $msg
1.108 +} {1 {unmatched open brace in list}}
1.109 +test append-4.11 {lappend command} {
1.110 + set x "\{\{\{"
1.111 + list [catch {lappend x abc} msg] $msg
1.112 +} {1 {unmatched open brace in list}}
1.113 +test append-4.12 {lappend command} {
1.114 + set x "x \{\{\{"
1.115 + list [catch {lappend x abc} msg] $msg
1.116 +} {1 {unmatched open brace in list}}
1.117 +test append-4.13 {lappend command} {
1.118 + set x "x\{\{\{"
1.119 + lappend x abc
1.120 +} "x\\\{\\\{\\\{ abc"
1.121 +test append-4.14 {lappend command} {
1.122 + set x " "
1.123 + lappend x abc
1.124 +} "abc"
1.125 +test append-4.15 {lappend command} {
1.126 + set x "\\ "
1.127 + lappend x abc
1.128 +} "{ } abc"
1.129 +test append-4.16 {lappend command} {
1.130 + set x "x "
1.131 + lappend x abc
1.132 +} "x abc"
1.133 +test append-4.17 {lappend command} {
1.134 + catch {unset x}
1.135 + lappend x
1.136 +} {}
1.137 +test append-4.18 {lappend command} {
1.138 + catch {unset x}
1.139 + lappend x {}
1.140 +} {{}}
1.141 +test append-4.19 {lappend command} {
1.142 + catch {unset x}
1.143 + lappend x(0)
1.144 +} {}
1.145 +test append-4.20 {lappend command} {
1.146 + catch {unset x}
1.147 + lappend x(0) abc
1.148 +} {abc}
1.149 +unset x
1.150 +test append-4.21 {lappend command} {
1.151 + set x \"
1.152 + list [catch {lappend x} msg] $msg
1.153 +} {1 {unmatched open quote in list}}
1.154 +test append-4.22 {lappend command} {
1.155 + set x \"
1.156 + list [catch {lappend x abc} msg] $msg
1.157 +} {1 {unmatched open quote in list}}
1.158 +
1.159 +proc check {var size} {
1.160 + set l [llength $var]
1.161 + if {$l != $size} {
1.162 + return "length mismatch: should have been $size, was $l"
1.163 + }
1.164 + for {set i 0} {$i < $size} {set i [expr $i+1]} {
1.165 + set j [lindex $var $i]
1.166 + if {$j != "item $i"} {
1.167 + return "element $i should have been \"item $i\", was \"$j\""
1.168 + }
1.169 + }
1.170 + return ok
1.171 +}
1.172 +test append-5.1 {long lappends} {
1.173 + catch {unset x}
1.174 + set x ""
1.175 + for {set i 0} {$i < 300} {set i [expr $i+1]} {
1.176 + lappend x "item $i"
1.177 + }
1.178 + check $x 300
1.179 +} ok
1.180 +
1.181 +test append-6.1 {lappend errors} {
1.182 + list [catch {lappend} msg] $msg
1.183 +} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
1.184 +test append-6.2 {lappend errors} {
1.185 + set x ""
1.186 + list [catch {lappend x(0) 44} msg] $msg
1.187 +} {1 {can't set "x(0)": variable isn't array}}
1.188 +
1.189 +test append-7.1 {lappend-created var and error in trace on that var} {
1.190 + catch {rename foo ""}
1.191 + catch {unset x}
1.192 + trace variable x w foo
1.193 + proc foo {} {global x; unset x}
1.194 + catch {lappend x 1}
1.195 + proc foo {args} {global x; unset x}
1.196 + info exists x
1.197 + set x
1.198 + lappend x 1
1.199 + list [info exists x] [catch {set x} msg] $msg
1.200 +} {0 1 {can't read "x": no such variable}}
1.201 +test append-7.2 {lappend var triggers read trace} {
1.202 + catch {unset myvar}
1.203 + catch {unset ::result}
1.204 + trace variable myvar r foo
1.205 + proc foo {args} {append ::result $args}
1.206 + lappend myvar a
1.207 + list [catch {set ::result} msg] $msg
1.208 +} {0 {myvar {} r}}
1.209 +test append-7.3 {lappend var triggers read trace, array var} {
1.210 + # The behavior of read triggers on lappend changed in 8.0 to
1.211 + # not trigger them, and was changed back in 8.4.
1.212 + catch {unset myvar}
1.213 + catch {unset ::result}
1.214 + trace variable myvar r foo
1.215 + proc foo {args} {append ::result $args}
1.216 + lappend myvar(b) a
1.217 + list [catch {set ::result} msg] $msg
1.218 +} {0 {myvar b r}}
1.219 +test append-7.4 {lappend var triggers read trace, array var exists} {
1.220 + catch {unset myvar}
1.221 + catch {unset ::result}
1.222 + set myvar(0) 1
1.223 + trace variable myvar r foo
1.224 + proc foo {args} {append ::result $args}
1.225 + lappend myvar(b) a
1.226 + list [catch {set ::result} msg] $msg
1.227 +} {0 {myvar b r}}
1.228 +test append-7.5 {append var does not trigger read trace} {
1.229 + catch {unset myvar}
1.230 + catch {unset ::result}
1.231 + trace variable myvar r foo
1.232 + proc foo {args} {append ::result $args}
1.233 + append myvar a
1.234 + info exists ::result
1.235 +} {0}
1.236 +
1.237 +
1.238 +catch {unset i x result y}
1.239 +catch {rename foo ""}
1.240 +catch {rename check ""}
1.241 +
1.242 +# cleanup
1.243 +::tcltest::cleanupTests
1.244 +return