summaryrefslogtreecommitdiffstats
path: root/tests/append.test
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2010-09-01 20:36:19 (GMT)
committerandreas_kupries <akupries@shaw.ca>2010-09-01 20:36:19 (GMT)
commit4066f666ec143c0cff62ee47b91d1ebc6b97c7b5 (patch)
treea95b86a73cfd6d6a6a817fbedbae61190cdc635e /tests/append.test
parentc68b36c7cbd6a72f21c487db03a00e1a5e48f638 (diff)
downloadtcl-4066f666ec143c0cff62ee47b91d1ebc6b97c7b5.zip
tcl-4066f666ec143c0cff62ee47b91d1ebc6b97c7b5.tar.gz
tcl-4066f666ec143c0cff62ee47b91d1ebc6b97c7b5.tar.bz2
* generic/tclExecute.c: [Bug 3057639]. Applied patch by Jeff to
* generic/tclVar.c: make the behaviour of lappend in bytecompiled * tests/append.test: mode consistent with direct-eval and 'append' * tests/appendComp.test: generally. Added tests (append*-9.*) showing the difference.
Diffstat (limited to 'tests/append.test')
-rw-r--r--tests/append.test53
1 files changed, 52 insertions, 1 deletions
diff --git a/tests/append.test b/tests/append.test
index 312bc09..1d82a99 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -11,7 +11,7 @@
# 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 $
+# RCS: @(#) $Id: append.test,v 1.7.12.2 2010/09/01 20:36:20 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -232,6 +232,57 @@ test append-7.5 {append var does not trigger read trace} {
} {0}
+
+# New tests for bug 3057639 to show off the more consistent behaviour
+# of lappend in both direct-eval and bytecompiled code paths (see
+# appendComp.test for the compiled variants). lappend now behaves like
+# append. 9.0/1 lappend - 9.2/3 append
+
+test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} {
+ catch {unset myvar}
+ array set myvar {}
+ proc nonull {var key val} {
+ upvar 1 $var lvar
+ if {![info exists lvar($key)]} {
+ return -code error "no such variable"
+ }
+ }
+ trace add variable myvar read nonull
+ list [catch {
+ lappend myvar(key) "new value"
+ } msg] $msg
+} {0 {{new value}}}
+
+test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
+ catch {unset ::env(__DUMMY__)}
+ list [catch {
+ lappend ::env(__DUMMY__) "new value"
+ } msg] $msg
+} {0 {{new value}}}
+
+test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} {
+ catch {unset myvar}
+ array set myvar {}
+ proc nonull {var key val} {
+ upvar 1 $var lvar
+ if {![info exists lvar($key)]} {
+ return -code error "no such variable"
+ }
+ }
+ trace add variable myvar read nonull
+ list [catch {
+ append myvar(key) "new value"
+ } msg] $msg
+} {0 {new value}}
+
+test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
+ catch {unset ::env(__DUMMY__)}
+ list [catch {
+ append ::env(__DUMMY__) "new value"
+ } msg] $msg
+} {0 {new value}}
+
+
catch {unset i x result y}
catch {rename foo ""}
catch {rename check ""}