Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/appendComp.test@bde4ae8d615e

     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.5.4.1 2004/10/28 00:01:05 dgp Exp $

    16 if {[lsearch [namespace children] ::tcltest] == -1} {

    17     package require tcltest

    18     namespace import -force ::tcltest::*

    19 }

    20 catch {unset x}

    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

    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

    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}}

    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}

   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

   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}}

   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}

   354 catch {unset i x result y}

   355 catch {rename foo ""}

   356 catch {rename bar ""}

   357 catch {rename check ""}

   358 catch {rename bar {}}

   360 # cleanup

   361 ::tcltest::cleanupTests

   362 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--