1 files changed, 96 insertions, 10 deletions

diff --git a/tests/appendComp.test b/tests/appendComp.test
index 9692e2c..14e9567 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -10,11 +10,9 @@
 #
 # 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.3 2001/07/03 23:39:24 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 catch {unset x}
@@ -198,11 +196,11 @@ test appendComp-4.18 {lappend command} {
     proc foo {} { lappend x {} }
     foo
 } {{}}
-test append-4.19 {lappend command} {
+test appendComp-4.19 {lappend command} {
     proc foo {} { lappend x(0) }
     foo
 } {}
-test append-4.20 {lappend command} {
+test appendComp-4.20 {lappend command} {
     proc foo {} { lappend x(0) abc }
     foo
 } {abc}
@@ -257,7 +255,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 +266,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 +277,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 +303,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 +315,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}
@@ -351,9 +349,97 @@ test appendComp-7.9 {append var does not trigger read trace} {
     bar
 } {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} {
+    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 ""}
 catch {rename check ""}
+catch {rename bar {}}
 
 # cleanup
 ::tcltest::cleanupTests