diff options
Diffstat (limited to 'tcl8.6/tests/appendComp.test')
| -rw-r--r-- | tcl8.6/tests/appendComp.test | 476 |
1 files changed, 0 insertions, 476 deletions
diff --git a/tcl8.6/tests/appendComp.test b/tcl8.6/tests/appendComp.test deleted file mode 100644 index bbf5f9c..0000000 --- a/tcl8.6/tests/appendComp.test +++ /dev/null @@ -1,476 +0,0 @@ -# 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. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} -catch {unset x} - -test appendComp-1.1 {append command} -setup { - unset -nocomplain x -} -body { - proc foo {} {append ::x 1 2 abc "long string"} - list [foo] $x -} -result {{12abclong string} {12abclong string}} -test appendComp-1.2 {append command} { - proc foo {} { - set x "" - list [append x first] [append x second] [append x third] $x - } - foo -} {first firstsecond firstsecondthird firstsecondthird} -test appendComp-1.3 {append command} { - proc foo {} { - set x "abcd" - append x - } - foo -} abcd - -test appendComp-2.1 {long appends} { - proc foo {} { - 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} - } - foo -} 1 - -test appendComp-3.1 {append errors} -returnCodes error -body { - proc foo {} {append} - foo -} -result {wrong # args: should be "append varName ?value ...?"} -test appendComp-3.2 {append errors} -returnCodes error -body { - proc foo {} { - set x "" - append x(0) 44 - } - foo -} -result {can't set "x(0)": variable isn't array} -test appendComp-3.3 {append errors} -returnCodes error -body { - proc foo {} { - unset -nocomplain x - append x - } - foo -} -result {can't read "x": no such variable} - -test appendComp-4.1 {lappend command} { - proc foo {} { - global x - unset -nocomplain x - lappend x 1 2 abc "long string" - } - list [foo] $x -} {{1 2 abc {long string}} {1 2 abc {long string}}} -test appendComp-4.2 {lappend command} { - proc foo {} { - set x "" - list [lappend x first] [lappend x second] [lappend x third] $x - } - foo -} {first {first second} {first second third} {first second third}} -test appendComp-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 appendComp-4.4 {lappend command} { - proc foo {} { - set x {} - lappend x \{\ abc - } - foo -} {\{\ abc} -test appendComp-4.5 {lappend command} { - proc foo {} { - set x {} - lappend x \{ abc - } - foo -} {\{ abc} -test appendComp-4.6 {lappend command} { - proc foo {} { - set x {1 2 3} - lappend x - } - foo -} {1 2 3} -test appendComp-4.7 {lappend command} { - proc foo {} { - set x "a\{" - lappend x abc - } - foo -} "a\\\{ abc" -test appendComp-4.8 {lappend command} { - proc foo {} { - set x "\\\{" - lappend x abc - } - foo -} "\\{ abc" -test appendComp-4.9 {lappend command} -returnCodes error -body { - proc foo {} { - set x " \{" - lappend x abc - } - foo -} -result {unmatched open brace in list} -test appendComp-4.10 {lappend command} -returnCodes error -body { - proc foo {} { - set x " \{" - lappend x abc - } - foo -} -result {unmatched open brace in list} -test appendComp-4.11 {lappend command} -returnCodes error -body { - proc foo {} { - set x "\{\{\{" - lappend x abc - } - foo -} -result {unmatched open brace in list} -test appendComp-4.12 {lappend command} -returnCodes error -body { - proc foo {} { - set x "x \{\{\{" - lappend x abc - } - foo -} -result {unmatched open brace in list} -test appendComp-4.13 {lappend command} { - proc foo {} { - set x "x\{\{\{" - lappend x abc - } - foo -} "x\\\{\\\{\\\{ abc" -test appendComp-4.14 {lappend command} { - proc foo {} { - set x " " - lappend x abc - } - foo -} "abc" -test appendComp-4.15 {lappend command} { - proc foo {} { - set x "\\ " - lappend x abc - } - foo -} "{ } abc" -test appendComp-4.16 {lappend command} { - proc foo {} { - set x "x " - lappend x abc - } - foo -} "x abc" -test appendComp-4.17 {lappend command} { - proc foo {} { lappend x } - foo -} {} -test appendComp-4.18 {lappend command} { - proc foo {} { lappend x {} } - foo -} {{}} -test appendComp-4.19 {lappend command} { - proc foo {} { lappend x(0) } - foo -} {} -test appendComp-4.20 {lappend command} { - proc foo {} { lappend x(0) abc } - foo -} {abc} - -test appendComp-5.1 {long lappends} -setup { - unset -nocomplain x - 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} {incr i} { - set j [lindex $var $i] - if {$j ne "item $i"} { - return "element $i should have been \"item $i\", was \"$j\"" - } - } - return ok - } -} -body { - set x "" - for {set i 0} {$i < 300} {set i [expr $i+1]} { - lappend x "item $i" - } - check $x 300 -} -cleanup { - unset -nocomplain x - catch {rename check ""} -} -result ok - -test appendComp-6.1 {lappend errors} -returnCodes error -body { - proc foo {} {lappend} - foo -} -result {wrong # args: should be "lappend varName ?value ...?"} -test appendComp-6.2 {lappend errors} -returnCodes error -body { - proc foo {} { - set x "" - lappend x(0) 44 - } - foo -} -result {can't set "x(0)": variable isn't array} - -test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup { - catch {rename foo ""} - unset -nocomplain x -} -body { - proc bar {} { - global 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 - } - bar -} -result {0 1 {can't read "x": no such variable}} -test appendComp-7.2 {lappend var triggers read trace, index var} -setup { - unset -nocomplain ::result -} -body { - proc bar {} { - trace variable myvar r foo - proc foo {args} {append ::result $args} - lappend myvar a - return $::result - } - bar -} -result {myvar {} r} -constraints {bug-3057639} -test appendComp-7.3 {lappend var triggers read trace, stack var} -setup { - unset -nocomplain ::result - unset -nocomplain ::myvar -} -body { - proc bar {} { - trace variable ::myvar r foo - proc foo {args} {append ::result $args} - lappend ::myvar a - return $::result - } - bar -} -result {::myvar {} r} -constraints {bug-3057639} -test appendComp-7.4 {lappend var triggers read trace, array var} -setup { - unset -nocomplain ::result -} -body { - # The behavior of read triggers on lappend changed in 8.0 to not trigger - # them. Maybe not correct, but been there a while. - proc bar {} { - trace variable myvar r foo - proc foo {args} {append ::result $args} - lappend myvar(b) a - return $::result - } - bar -} -result {myvar b r} -constraints {bug-3057639} -test appendComp-7.5 {lappend var triggers read trace, array var} -setup { - unset -nocomplain ::result -} -body { - # The behavior of read triggers on lappend changed in 8.0 to not trigger - # them. Maybe not correct, but been there a while. - proc bar {} { - trace variable myvar r foo - proc foo {args} {append ::result $args} - lappend myvar(b) a b - return $::result - } - bar -} -result {myvar b r} -test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup { - unset -nocomplain ::result -} -body { - proc bar {} { - set myvar(0) 1 - trace variable myvar r foo - proc foo {args} {append ::result $args} - lappend myvar(b) a - return $::result - } - bar -} -result {myvar b r} -constraints {bug-3057639} -test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup { - unset -nocomplain ::myvar - unset -nocomplain ::result -} -body { - proc bar {} { - trace variable ::myvar r foo - proc foo {args} {append ::result $args} - lappend ::myvar(b) a - return $::result - } - bar -} -result {::myvar b r} -constraints {bug-3057639} -test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup { - unset -nocomplain ::myvar - unset -nocomplain ::result -} -body { - proc bar {} { - trace variable ::myvar r foo - proc foo {args} {append ::result $args} - lappend ::myvar(b) a b - return $::result - } - bar -} -result {::myvar b r} -test appendComp-7.9 {append var does not trigger read trace} -setup { - unset -nocomplain ::result -} -body { - proc bar {} { - trace variable myvar r foo - proc foo {args} {append ::result $args} - append myvar a - info exists ::result - } - bar -} -result {0} - -test appendComp-8.1 {defer error to runtime} -setup { - interp create slave -} -body { - slave eval { - proc foo {} { - proc append args {} - append - } - foo - } -} -cleanup { - interp delete slave -} -result {} - -# New tests for bug 3057639 to show off the more consistent behaviour of -# lappend in both direct-eval and bytecompiled code paths (see append.test for -# the direct-eval variants). lappend now behaves like append. 9.0/1 lappend - -# 9.2/3 append. - -# Note also the tests above now constrained by bug-3057639, these changed -# behaviour with the triggering of read traces in bc mode gone. - -# Going back to the tests below. The direct-eval tests are ok before and after -# patch (no read traces run for lappend, append). The compiled tests are -# failing for lappend (9.0/1) before the patch, showing how it invokes read -# traces in the compiled path. The append tests are good (9.2/3). After the -# patch the failues are gone. - -test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup { - unset -nocomplain myvar - array set myvar {} -} -body { - proc nonull {var key val} { - upvar 1 $var lvar - if {![info exists lvar($key)]} { - return -code error "BOOM. no such variable" - } - } - trace add variable myvar read nonull - proc foo {} { - lappend ::myvar(key) "new value" - } - list [catch { foo } msg] $msg -} -result {0 {{new value}}} -test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup { - unset -nocomplain ::env(__DUMMY__) -} -body { - proc foo {} { - lappend ::env(__DUMMY__) "new value" - } - list [catch { foo } msg] $msg -} -cleanup { - unset -nocomplain ::env(__DUMMY__) -} -result {0 {{new value}}} -test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup { - unset -nocomplain myvar - array set myvar {} -} -body { - proc nonull {var key val} { - upvar 1 $var lvar - if {![info exists lvar($key)]} { - return -code error "BOOM. no such variable" - } - } - trace add variable myvar read nonull - proc foo {} { - append ::myvar(key) "new value" - } - list [catch { foo } msg] $msg -} -result {0 {new value}} -test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup { - unset -nocomplain ::env(__DUMMY__) -} -body { - proc foo {} { - append ::env(__DUMMY__) "new value" - } - list [catch { foo } msg] $msg -} -cleanup { - unset -nocomplain ::env(__DUMMY__) -} -result {0 {new value}} - -test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} { - apply {lst { - lappend lst - }} "# 1 2 3" -} "# 1 2 3" -test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body { - apply {lst { - lappend lst - }} "1 \{ 2" -} -returnCodes error -result {unmatched open brace in list} -test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} { - apply {lst { - lappend lst {*}[list] - }} "# 1 2 3" -} "# 1 2 3" -test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { - apply {lst { - lappend lst {*}[list] - }} "1 \{ 2" -} -returnCodes error -result {unmatched open brace in list} - -catch {unset i x result y} -catch {rename foo ""} -catch {rename bar ""} -catch {rename check ""} -catch {rename bar {}} - -# cleanup -::tcltest::cleanupTests -return - -# Local Variables: -# mode: tcl -# fill-column: 78 -# End: |