From 8ac914140fefc051814651ad831c28796081762e Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Wed, 1 Sep 2010 20:36:19 +0000 Subject: * 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. --- ChangeLog | 28 ++++++++++++------ generic/tclExecute.c | 14 ++++----- generic/tclVar.c | 8 ++++-- tests/append.test | 53 +++++++++++++++++++++++++++++++++- tests/appendComp.test | 79 +++++++++++++++++++++++++++++++++++++++++++++++---- 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 + + * 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 - * 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 - * 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 - * 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 - * 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 - * 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 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 ""} -- cgit v0.12