diff options
author | andreas_kupries <akupries@shaw.ca> | 2010-09-01 20:36:19 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2010-09-01 20:36:19 (GMT) |
commit | 8ac914140fefc051814651ad831c28796081762e (patch) | |
tree | a95b86a73cfd6d6a6a817fbedbae61190cdc635e /tests/append.test | |
parent | 56d46328e2d43b83bfc1ba4686263df989d47958 (diff) | |
download | tcl-8ac914140fefc051814651ad831c28796081762e.zip tcl-8ac914140fefc051814651ad831c28796081762e.tar.gz tcl-8ac914140fefc051814651ad831c28796081762e.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.test | 53 |
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 ""} |