diff options
author | andreas_kupries <akupries@shaw.ca> | 2010-09-01 19:42:27 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2010-09-01 19:42:27 (GMT) |
commit | a41c388edc014807c1b1a669e449e2f70cf42641 (patch) | |
tree | 30e30115955a0d384b8b161ea77c76fc062247ee /tests/appendComp.test | |
parent | 5dc85f7462c6fb97367890ba0a95a1049a0573ab (diff) | |
download | tcl-a41c388edc014807c1b1a669e449e2f70cf42641.zip tcl-a41c388edc014807c1b1a669e449e2f70cf42641.tar.gz tcl-a41c388edc014807c1b1a669e449e2f70cf42641.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/appendComp.test')
-rw-r--r-- | tests/appendComp.test | 84 |
1 files changed, 78 insertions, 6 deletions
diff --git a/tests/appendComp.test b/tests/appendComp.test index c946d35..dc009ce 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.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: appendComp.test,v 1.9 2005/05/10 18:34:56 kennykb Exp $ +# RCS: @(#) $Id: appendComp.test,v 1.9.10.1 2010/09/01 19:42:42 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -257,7 +257,7 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} { } bar } {0 1 {can't read "x": no such variable}} -test appendComp-7.2 {lappend var triggers read trace, index var} { +test appendComp-7.2 {lappend var triggers read trace, index var} {bug-3057639} { proc bar {} { catch {unset myvar} catch {unset ::result} @@ -268,7 +268,7 @@ test appendComp-7.2 {lappend var triggers read trace, index var} { } bar } {0 {myvar {} r}} -test appendComp-7.3 {lappend var triggers read trace, stack var} { +test appendComp-7.3 {lappend var triggers read trace, stack var} {bug-3057639} { proc bar {} { catch {unset ::myvar} catch {unset ::result} @@ -279,7 +279,7 @@ test appendComp-7.3 {lappend var triggers read trace, stack var} { } bar } {0 {::myvar {} r}} -test appendComp-7.4 {lappend var triggers read trace, array var} { +test appendComp-7.4 {lappend var triggers read trace, array var} {bug-3057639} { # 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 {} { @@ -305,7 +305,7 @@ test appendComp-7.5 {lappend var triggers read trace, array var} { } bar } {0 {myvar b r}} -test appendComp-7.6 {lappend var triggers read trace, array var exists} { +test appendComp-7.6 {lappend var triggers read trace, array var exists} {bug-3057639} { proc bar {} { catch {unset myvar} catch {unset ::result} @@ -317,7 +317,7 @@ test appendComp-7.6 {lappend var triggers read trace, array var exists} { } bar } {0 {myvar b r}} -test appendComp-7.7 {lappend var triggers read trace, array stack var} { +test appendComp-7.7 {lappend var triggers read trace, array stack var} {bug-3057639} { proc bar {} { catch {unset ::myvar} catch {unset ::result} @@ -365,6 +365,78 @@ test appendComp-8.1 {defer error to runtime} -setup { 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} { + catch {unset myvar} + array set myvar {} + 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 +} {0 {{new value}}} + + +test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} { + catch {unset ::env(__DUMMY__)} + proc foo {} { + lappend ::env(__DUMMY__) "new value" + } + list [catch { foo } msg] $msg +} {0 {{new value}}} + + + +test appendComp-9.2 {bug 3057639, append compiled, 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 "BOOM. no such variable" + } + } + trace add variable myvar read nonull + proc foo {} { + append ::myvar(key) "new value" + } + list [catch { foo } msg] $msg +} {0 {new value}} + + +test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} { + catch {unset ::env(__DUMMY__)} + proc foo {} { + append ::env(__DUMMY__) "new value" + } + list [catch { foo } msg] $msg +} {0 {new value}} + + + + + catch {unset i x result y} catch {rename foo ""} catch {rename bar ""} |