summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog28
-rw-r--r--generic/tclExecute.c14
-rw-r--r--generic/tclVar.c8
-rw-r--r--tests/append.test53
-rw-r--r--tests/appendComp.test79
5 files changed, 156 insertions, 26 deletions
diff --git a/ChangeLog b/ChangeLog
index 6f34a50..585820d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,27 +1,37 @@
+2010-09-01 Andreas Kupries <andreask@activestate.com>
+
+ * 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.
+
2010-07-25 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.h [Bug 3030870] make itcl 3.x built with pre-8.6 work in 8.6
- * generic/tclBasic.c revert tclInt.h to what it was before, and relax the relation
- between Tcl_CallFrame and CallFrame.
+ * generic/tclInt.h: [Bug 3030870] make itcl 3.x built with pre-8.6
+ * generic/tclBasic.c: work in 8.6 revert tclInt.h to what it was
+ before, and relax the relation between Tcl_CallFrame and
+ CallFrame.
2010-07-18 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tcl.h [Bug 3031278] fixed merge problem in previous commit.
+ * generic/tcl.h: [Bug 3031278] fixed merge problem in previous
+ commit.
2010-07-17 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tcl.h [Bug 3030870] make itcl 3.x built with pre-8.6 work in 8.6
- * generic/tclInt.h
+ * generic/tcl.h: [Bug 3030870] make itcl 3.x built with pre-8.6
+ * generic/tclInt.h: work in 8.6
2010-07-16 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tcl.h (Backport) take over definitions of _WIN32,
+ * generic/tcl.h: (Backport) take over definitions of _WIN32,
DLLIMPORT, DLLEXPORT and TCL_LL_MODIFIER macros from Tcl8.5/8.6
2010-06-28 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclPosixStr.c [Bug 3019634] errno.h and tclWinPort.h have
- conflicting definitions.
+ * generic/tclPosixStr.c: [Bug 3019634] errno.h and tclWinPort.h
+ have conflicting definitions.
2010-06-09 Andreas Kupries <andreask@activestate.com>
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 401f485..dbc5ecc 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.94.2.31 2010/02/22 23:19:17 nijtmans Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.32 2010/09/01 20:36:19 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1880,14 +1880,14 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = stackPtr[stackTop]; /* value to append */
part2 = NULL;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreStk;
case INST_LAPPEND_ARRAY_STK:
valuePtr = stackPtr[stackTop]; /* value to append */
part2 = TclGetString(stackPtr[stackTop - 1]);
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreStk;
case INST_APPEND_STK:
@@ -1943,14 +1943,14 @@ TclExecuteByteCode(interp, codePtr)
opnd = TclGetUInt4AtPtr(pc+1);
pcAdjustment = 5;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreArray;
case INST_LAPPEND_ARRAY1:
opnd = TclGetUInt1AtPtr(pc+1);
pcAdjustment = 2;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreArray;
case INST_APPEND_ARRAY4:
@@ -2000,14 +2000,14 @@ TclExecuteByteCode(interp, codePtr)
opnd = TclGetUInt4AtPtr(pc+1);
pcAdjustment = 5;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreScalar;
case INST_LAPPEND_SCALAR1:
opnd = TclGetUInt1AtPtr(pc+1);
pcAdjustment = 2;
storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ | TCL_LIST_ELEMENT);
goto doStoreScalar;
case INST_APPEND_SCALAR4:
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 78505ff..3063158 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.69.2.15 2009/08/25 20:59:11 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.69.2.16 2010/09/01 20:36:20 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1602,8 +1602,10 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
/*
* Invoke any read traces that have been set for the variable if it
- * is requested; this is only done in the core by the INST_LAPPEND_*
- * instructions.
+ * requested. This was done for INST_LAPPEND_* but that was inconsistent
+ * with the non-bc instruction, and would cause failures trying to
+ * lappend to any non-existing ::env var, which is inconsistent with
+ * documented behavior. [Bug #3057639].
*/
if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL)
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 ""}
diff --git a/tests/appendComp.test b/tests/appendComp.test
index 16ffb32..8f7e3d4 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.5.4.1 2004/10/28 00:01:05 dgp Exp $
+# RCS: @(#) $Id: appendComp.test,v 1.5.4.2 2010/09/01 20:36:20 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -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}
@@ -351,6 +351,73 @@ test appendComp-7.9 {append var does not trigger read trace} {
bar
} {0}
+# 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-02 19:07:08 (GMT)