summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/append.test54
-rw-r--r--tests/appendComp.test81
2 files changed, 128 insertions, 7 deletions
diff --git a/tests/append.test b/tests/append.test
index eb76c94..3c000df 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.11 2008/09/08 10:49:04 dkf Exp $
+# RCS: @(#) $Id: append.test,v 1.12 2010/09/01 20:35:33 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -239,6 +239,58 @@ test append-7.5 {append var does not trigger read trace} -setup {
info exists ::result
} -result {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 ""}
diff --git a/tests/appendComp.test b/tests/appendComp.test
index 90b2af5..9523d2d 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.12 2008/10/14 18:49:47 dgp Exp $
+# RCS: @(#) $Id: appendComp.test,v 1.13 2010/09/01 20:35:33 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -268,7 +268,7 @@ test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
return $::result
}
bar
-} -result {myvar {} r}
+} -result {myvar {} r} -constraints {bug-3057639}
test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
unset -nocomplain ::result
unset -nocomplain ::myvar
@@ -280,7 +280,7 @@ test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
return $::result
}
bar
-} -result {::myvar {} r}
+} -result {::myvar {} r} -constraints {bug-3057639}
test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
catch {unset ::result}
} -body {
@@ -293,7 +293,7 @@ test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
return $::result
}
bar
-} -result {myvar b r}
+} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
catch {unset ::result}
} -body {
@@ -318,7 +318,7 @@ test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
return $::result
}
bar
-} -result {myvar b r}
+} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
catch {unset ::myvar}
catch {unset ::result}
@@ -330,7 +330,7 @@ test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
return $::result
}
bar
-} -result {::myvar b r}
+} -result {::myvar b r} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
catch {unset ::myvar}
catch {unset ::result}
@@ -369,6 +369,75 @@ 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 ""}
generated by cgit v0.12 at 2024-11-17 22:23:46 (GMT)