diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclEvent.c | 15 | ||||
| -rw-r--r-- | tests/event.test | 19 |
3 files changed, 33 insertions, 6 deletions
@@ -1,5 +1,10 @@ 2007-03-12 Don Porter <dgp@users.sourceforge.net> + * generic/tclEvent.c (HandleBgErrors): Make efficient private copy + * tests/event.test (event-5.3): of the command prefix for the interp's + background error handling command to avoid panics due to pointers + to memory invalid after shimmering. [Bug 1670155] + * generic/tclNamesp.c (NsEnsembleImplementationCmd): Make efficient * tests/namespace.test (namespace-42.8): private copy of the command prefix as we invoke the command appropriate to a particular diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 8c0c34c..2f03444 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.69 2006/11/13 08:23:07 das Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.70 2007/03/12 19:28:49 dgp Exp $ */ #include "tclInt.h" @@ -200,11 +200,16 @@ HandleBgErrors( int code, prefixObjc; Tcl_Obj **prefixObjv, **tempObjv; + /* + * Note we copy the handler command prefix each pass through, so + * we do support one handler setting another handler. + */ + + Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); + errPtr = assocPtr->firstBgPtr; - Tcl_IncrRefCount(assocPtr->cmdPrefix); - Tcl_ListObjGetElements(NULL, assocPtr->cmdPrefix, &prefixObjc, - &prefixObjv); + Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; @@ -216,7 +221,7 @@ HandleBgErrors( * Discard the command and the information about the error report. */ - Tcl_DecrRefCount(assocPtr->cmdPrefix); + Tcl_DecrRefCount(copyObj); Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); assocPtr->firstBgPtr = errPtr->nextPtr; diff --git a/tests/event.test b/tests/event.test index e2553d6..101a17e 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.23 2006/11/27 20:16:03 kennykb Exp $ +# RCS: @(#) $Id: event.test,v 1.24 2007/03/12 19:28:50 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -188,6 +188,23 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} { rename bgerror {} set x } {{a simple error}} +test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup { + variable x + proc demo args {variable x done} + variable target [list [namespace which demo] x] + proc trial args {variable target; string length $target} + trace add execution demo enter [namespace code trial] + variable save [interp bgerror {}] + interp bgerror {} $target +} -body { + after 0 {error bar} + vwait [namespace which -variable x] +} -cleanup { + interp bgerror {} $save + unset x target save + rename demo {} + rename trial {} +} -result {} test event-6.1 {BgErrorDeleteProc procedure} { catch {interp delete foo} |