diff options
| -rw-r--r-- | ChangeLog | 50 | ||||
| -rw-r--r-- | generic/tclOO.c | 48 | ||||
| -rw-r--r-- | tests/oo.test | 19 |
3 files changed, 92 insertions, 25 deletions
@@ -1,38 +1,48 @@ +2009-11-24 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOO.c (FinalizeAlloc, Tcl_NewObjectInstance): + [Bug 2903011]: Make it an error to destroy an object in a constructor, + and also make sure that an object is not deleted twice in the error + case. + 2009-11-24 Pat Thoyts <patthoyts@users.sourceforge.net> - * tests/fCmd.test: [Bug 2893771] Teach [file stat] to handle locked + * tests/fCmd.test: [Bug 2893771]: Teach [file stat] to handle locked * win/tclWinFile.c: files so that [file exists] no longer lies. 2009-11-23 Jan Nijtmans <nijtmans@users.sf.net> - * library/tclIndex (regenerated) to reflect various changes - in safe.tcl and other files. + * library/tclIndex: (regenerated) to reflect various changes in + safe.tcl and other files. 2009-11-23 Kevin Kenny <kennykb@acm.org> - * tests/fCmd.test (fCmd-30.1): Changed registry location of the - 'My Documents' folder to the one that's correct for Windows 2000, - XP, Server 2003, Vista, Server 2008, and Windows 7. - (See http://support.microsoft.com/kb/310746) + * tests/fCmd.test (fCmd-30.1): Changed registry location of the 'My + Documents' folder to the one that's correct for Windows 2000, XP, + Server 2003, Vista, Server 2008, and Windows 7. (See + http://support.microsoft.com/kb/310746) 2009-11-23 Jan Nijtmans <nijtmans@users.sf.net> - * win/tclWinDde.c #undef STATIC_BUILD, in order to make sure that - * win/tclWinReg.c Xxxxx_Init is always exported even when Tcl is - * generic/tclTest.c built static (otherwise we cannot create a DLL). - * generic/tclThreadTest.c Make all functions static, except TclThread_Init. - * tests/fCmd.test Enable fCmd-30.1 when registry is available. - * win/tcl.m4 Fix ${SHLIB_LD_LIBS} definition, fix conflicts - * win/Makefile.in Simplifications related to tcl.m4 changes. - * win/configure.in between static libraries and import library on windows. - * win/configure (regenerated) - * win/makefile.vc Add stub library to necessary link lines + * win/tclWinDde.c: #undef STATIC_BUILD, in order to make sure + * win/tclWinReg.c: that Xxxxx_Init is always exported even when + * generic/tclTest.c: Tcl is built static (otherwise we cannot + create a DLL). + * generic/tclThreadTest.c: Make all functions static, except + TclThread_Init. + * tests/fCmd.test: Enable fCmd-30.1 when registry is available. + * win/tcl.m4: Fix ${SHLIB_LD_LIBS} definition, fix conflicts + * win/Makefile.in: Simplifications related to tcl.m4 changes. + * win/configure.in: Between static libraries and import library on + windows. + * win/configure: (regenerated) + * win/makefile.vc: Add stub library to necessary link lines. 2009-11-23 Kevin B. Kenny <kennykb@acm.org> - * generic/tclThreadTest.c (NewTestThread): [Bug 2901803] - Further machinations to get NewTestThread actually to launch - the thread, not just compile. + * generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Further + machinations to get NewTestThread actually to launch the thread, not + just compile. 2009-11-22 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclOO.c b/generic/tclOO.c index a4e8cce..242496f 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.25 2009/11/18 21:59:51 nijtmans Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.26 2009/11/24 12:00:08 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -1334,7 +1334,7 @@ Tcl_NewObjectInstance( TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL); if (contextPtr != NULL) { - int result; + int result, flags; Tcl_InterpState state; AddRef(oPtr); @@ -1343,11 +1343,32 @@ Tcl_NewObjectInstance( contextPtr->skip = skip; result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); + flags = oPtr->flags; + + /* + * It's an error if the object was whacked in the constructor. + * Force this if it isn't already an error (don't want to lose + * errors by accident...) [Bug 2903011] + */ + + if (result != TCL_ERROR && (flags & OBJECT_DELETED)) { + Tcl_SetResult(interp, "object deleted in constructor", + TCL_STATIC); + result = TCL_ERROR; + } TclOODeleteContext(contextPtr); DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); - Tcl_DeleteCommandFromToken(interp, oPtr->command); + + /* + * Take care to not delete a deleted object; that would be + * bad. [Bug 2903011] + */ + + if (!(flags & OBJECT_DELETED)) { + Tcl_DeleteCommandFromToken(interp, oPtr->command); + } return NULL; } Tcl_RestoreInterpState(interp, state); @@ -1458,12 +1479,31 @@ FinalizeAlloc( Object *oPtr = data[1]; Tcl_InterpState state = data[2]; Tcl_Object *objectPtr = data[3]; + int flags = oPtr->flags; + + /* + * It's an error if the object was whacked in the constructor. Force this + * if it isn't already an error (don't want to lose errors by accident...) + * [Bug 2903011] + */ + if (result != TCL_ERROR && (flags & OBJECT_DELETED)) { + Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC); + result = TCL_ERROR; + } TclOODeleteContext(contextPtr); DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); - Tcl_DeleteCommandFromToken(interp, oPtr->command); + + /* + * Take care to not delete a deleted object; that would be bad. [Bug + * 2903011] + */ + + if (!(flags & OBJECT_DELETED)) { + Tcl_DeleteCommandFromToken(interp, oPtr->command); + } return TCL_ERROR; } Tcl_RestoreInterpState(interp, state); diff --git a/tests/oo.test b/tests/oo.test index a976a7d..4c289ab 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: oo.test,v 1.30 2009/10/22 15:39:58 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.31 2009/11/24 12:00:08 dkf Exp $ package require TclOO 0.6.1 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -2332,6 +2332,23 @@ test oo-29.1 {self class with object-defined methods} -setup { } -returnCodes error -cleanup { obj destroy } -result {method not defined by a class} + +test oo-30.1 {Bug 2903011: deleting an object in a constructor} -setup { + oo::class create cls +} -body { + oo::define cls {constructor {} {[self] destroy}} + cls new +} -returnCodes error -cleanup { + cls destroy +} -result {object deleted in constructor} +test oo-30.2 {Bug 2903011: deleting an object in a constructor} -setup { + oo::class create cls +} -body { + oo::define cls {constructor {} {my destroy}} + cls new +} -returnCodes error -cleanup { + cls destroy +} -result {object deleted in constructor} cleanupTests return |