# Commands covered:  append lappend

 #

 # This file contains a collection of tests for one or more of the Tcl

 # built-in commands.  Sourcing this file into Tcl runs the tests and

 # generates output for errors.  No output means no errors were found.

 #

 # Copyright (c) 1991-1993 The Regents of the University of California.

 # Copyright (c) 1994-1996 Sun Microsystems, Inc.

 # Copyright (c) 1998-1999 by Scriptics Corporation.

 #

 # See the file "license.terms" for information on usage and redistribution

 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 #

 # RCS: @(#) $Id: append.test,v 1.7.12.1 2006/10/05 11:44:04 msofer Exp $

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

     package require tcltest

     namespace import -force ::tcltest::*

 }

 catch {unset x}

 test append-1.1 {append command} {

     catch {unset x}

     list [append x 1 2 abc "long string"] $x

 } {{12abclong string} {12abclong string}}

 test append-1.2 {append command} {

     set x ""

     list [append x first] [append x second] [append x third] $x

 } {first firstsecond firstsecondthird firstsecondthird}

 test append-1.3 {append command} {

     set x "abcd"

     append x

 } abcd

 test append-2.1 {long appends} {

     set x ""

     for {set i 0} {$i < 1000} {set i [expr $i+1]} {

 	append x "foobar "

     }

     set y "foobar"

     set y "$y $y $y $y $y $y $y $y $y $y"

     set y "$y $y $y $y $y $y $y $y $y $y"

     set y "$y $y $y $y $y $y $y $y $y $y "

     expr {$x == $y}

 } 1

 test append-3.1 {append errors} {

     list [catch {append} msg] $msg

 } {1 {wrong # args: should be "append varName ?value value ...?"}}

 test append-3.2 {append errors} {

     set x ""

     list [catch {append x(0) 44} msg] $msg

 } {1 {can't set "x(0)": variable isn't array}}

 test append-3.3 {append errors} {

     catch {unset x}

     list [catch {append x} msg] $msg

 } {1 {can't read "x": no such variable}}

 test append-4.1 {lappend command} {

     catch {unset x}

     list [lappend x 1 2 abc "long string"] $x

 } {{1 2 abc {long string}} {1 2 abc {long string}}}

 test append-4.2 {lappend command} {

     set x ""

     list [lappend x first] [lappend x second] [lappend x third] $x

 } {first {first second} {first second third} {first second third}}

 test append-4.3 {lappend command} {

     proc foo {} {

 	global x

 	set x old

 	unset x

 	lappend x new

     }

     set result [foo]

     rename foo {}

     set result

 } {new}

 test append-4.4 {lappend command} {

     set x {}

     lappend x \{\  abc

 } {\{\  abc}

 test append-4.5 {lappend command} {

     set x {}

     lappend x \{ abc

 } {\{ abc}

 test append-4.6 {lappend command} {

     set x {1 2 3}

     lappend x

 } {1 2 3}

 test append-4.7 {lappend command} {

     set x "a\{"

     lappend x abc

 } "a\\\{ abc"

 test append-4.8 {lappend command} {

     set x "\\\{"

     lappend x abc

 } "\\{ abc"

 test append-4.9 {lappend command} {

     set x " \{"

     list [catch {lappend x abc} msg] $msg

 } {1 {unmatched open brace in list}}

 test append-4.10 {lappend command} {

     set x "	\{"

     list [catch {lappend x abc} msg] $msg

 } {1 {unmatched open brace in list}}

 test append-4.11 {lappend command} {

     set x "\{\{\{"

     list [catch {lappend x abc} msg] $msg

 } {1 {unmatched open brace in list}}

 test append-4.12 {lappend command} {

     set x "x \{\{\{"

     list [catch {lappend x abc} msg] $msg

 } {1 {unmatched open brace in list}}

 test append-4.13 {lappend command} {

     set x "x\{\{\{"

     lappend x abc

 } "x\\\{\\\{\\\{ abc"

 test append-4.14 {lappend command} {

     set x " "

     lappend x abc

 } "abc"

 test append-4.15 {lappend command} {

     set x "\\ "

     lappend x abc

 } "{ } abc"

 test append-4.16 {lappend command} {

     set x "x "

     lappend x abc

 } "x abc"

 test append-4.17 {lappend command} {

     catch {unset x}

     lappend x

 } {}

 test append-4.18 {lappend command} {

     catch {unset x}

     lappend x {}

 } {{}}

 test append-4.19 {lappend command} {

     catch {unset x}

     lappend x(0)

 } {}

 test append-4.20 {lappend command} {

     catch {unset x}

     lappend x(0) abc

 } {abc}

 unset x

 test append-4.21 {lappend command} {

     set x \"

     list [catch {lappend x} msg] $msg

 } {1 {unmatched open quote in list}}

 test append-4.22 {lappend command} {

     set x \"

     list [catch {lappend x abc} msg] $msg

 } {1 {unmatched open quote in list}}

 proc check {var size} {

     set l [llength $var]

     if {$l != $size} {

 	return "length mismatch: should have been $size, was $l"

     }

     for {set i 0} {$i < $size} {set i [expr $i+1]} {

 	set j [lindex $var $i]

 	if {$j != "item $i"} {

 	    return "element $i should have been \"item $i\", was \"$j\""

 	}

     }

     return ok

 }

 test append-5.1 {long lappends} {

     catch {unset x}

     set x ""

     for {set i 0} {$i < 300} {set i [expr $i+1]} {

 	lappend x "item $i"

     }

     check $x 300

 } ok

 test append-6.1 {lappend errors} {

     list [catch {lappend} msg] $msg

 } {1 {wrong # args: should be "lappend varName ?value value ...?"}}

 test append-6.2 {lappend errors} {

     set x ""

     list [catch {lappend x(0) 44} msg] $msg

 } {1 {can't set "x(0)": variable isn't array}}

 test append-7.1 {lappend-created var and error in trace on that var} {

     catch {rename foo ""}

     catch {unset x}

     trace variable x w foo

     proc foo {} {global x; unset x}

     catch {lappend x 1}

     proc foo {args} {global x; unset x}

     info exists x

     set x

     lappend x 1

     list [info exists x] [catch {set x} msg] $msg

 } {0 1 {can't read "x": no such variable}}

 test append-7.2 {lappend var triggers read trace} {

     catch {unset myvar}

     catch {unset ::result}

     trace variable myvar r foo

     proc foo {args} {append ::result $args}

     lappend myvar a

     list [catch {set ::result} msg] $msg

 } {0 {myvar {} r}}

 test append-7.3 {lappend var triggers read trace, array var} {

     # The behavior of read triggers on lappend changed in 8.0 to

     # not trigger them, and was changed back in 8.4.

     catch {unset myvar}

     catch {unset ::result}

     trace variable myvar r foo

     proc foo {args} {append ::result $args}

     lappend myvar(b) a

     list [catch {set ::result} msg] $msg

 } {0 {myvar b r}}

 test append-7.4 {lappend var triggers read trace, array var exists} {

     catch {unset myvar}

     catch {unset ::result}

     set myvar(0) 1

     trace variable myvar r foo

     proc foo {args} {append ::result $args}

     lappend myvar(b) a

     list [catch {set ::result} msg] $msg

 } {0 {myvar b r}}

 test append-7.5 {append var does not trigger read trace} {

     catch {unset myvar}

     catch {unset ::result}

     trace variable myvar r foo

     proc foo {args} {append ::result $args}

     append myvar a

     info exists ::result

 } {0}

 catch {unset i x result y}

 catch {rename foo ""}

 catch {rename check ""}

 # cleanup

 ::tcltest::cleanupTests

 return