diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2019-06-20 19:42:23 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2019-06-20 19:42:23 (GMT) |
| commit | 6a1b394c2da63d8204ce3121cd7c3992095ed39c (patch) | |
| tree | cd552820b4d7b29c631e4c5b3227f86ee27232a0 | |
| parent | b9e23e625db49329730aee16e407dcb2929a5160 (diff) | |
| parent | 2f8cb2ab854a2e311b49c8276bb59a76adaeafeb (diff) | |
| download | tcl-6a1b394c2da63d8204ce3121cd7c3992095ed39c.zip tcl-6a1b394c2da63d8204ce3121cd7c3992095ed39c.tar.gz tcl-6a1b394c2da63d8204ce3121cd7c3992095ed39c.tar.bz2 | |
[6bdadfba7d] Stop crash with multi-lappend and failing writes
| -rw-r--r-- | generic/tclExecute.c | 21 | ||||
| -rw-r--r-- | tests/execute.test | 39 |
2 files changed, 52 insertions, 8 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 91c6a42..484efe0 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3482,31 +3482,36 @@ TEBCresume( { int createdNewObj = 0; + Tcl_Obj *valueToAssign; if (!objResultPtr) { - objResultPtr = valuePtr; + valueToAssign = valuePtr; } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { if (Tcl_IsShared(objResultPtr)) { - objResultPtr = Tcl_DuplicateObj(objResultPtr); + valueToAssign = Tcl_DuplicateObj(objResultPtr); createdNewObj = 1; + } else { + valueToAssign = objResultPtr; } - if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv) - != TCL_OK) { + if (Tcl_ListObjReplace(interp, valueToAssign, len, 0, + objc, objv) != TCL_OK) { + if (createdNewObj) { + TclDecrRefCount(valueToAssign); + } goto errorInLappendListPtr; } } DECACHE_STACK_INFO(); + Tcl_IncrRefCount(valueToAssign); objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, - part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd); + part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd); + TclDecrRefCount(valueToAssign); CACHE_STACK_INFO(); if (!objResultPtr) { errorInLappendListPtr: - if (createdNewObj) { - TclDecrRefCount(objResultPtr); - } TRACE_ERROR(interp); goto gotError; } diff --git a/tests/execute.test b/tests/execute.test index 3b62bc9..808574b 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1066,6 +1066,45 @@ test execute-11.3 {Bug a0ece9d6d4} -setup { trace remove execution crash enterstep {apply {args {info frame -2}}} rename crash {} } -result 1 + +test execute-12.1 {failing multi-lappend to unshared} -setup { + unset -nocomplain x y +} -body { + set x 1 + lappend x 2 3 + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 +} -cleanup { + unset -nocomplain x y +} -returnCodes error -result {can't set "x": boo} +test execute-12.2 {failing multi-lappend to shared} -setup { + unset -nocomplain x y +} -body { + set x 1 + lappend x 2 3 + set y $x + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 +} -cleanup { + unset -nocomplain x y +} -returnCodes error -result {can't set "x": boo} +test execute-12.3 {failing multi-lappend to unshared: LVT} -body { + apply {{} { + set x 1 + lappend x 2 3 + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 + }} +} -returnCodes error -result {can't set "x": boo} +test execute-12.4 {failing multi-lappend to shared: LVT} -body { + apply {{} { + set x 1 + lappend x 2 3 + set y $x + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 + }} +} -returnCodes error -result {can't set "x": boo} # cleanup if {[info commands testobj] != {}} { |