summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog50
-rw-r--r--generic/tclOO.c48
-rw-r--r--tests/oo.test19
3 files changed, 92 insertions, 25 deletions
diff --git a/ChangeLog b/ChangeLog
index d5b9889..53c9f3e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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