diff options
| -rw-r--r-- | ChangeLog | 20 | ||||
| -rw-r--r-- | generic/tclOODefineCmds.c | 16 | ||||
| -rw-r--r-- | tests/oo.test | 23 |
3 files changed, 50 insertions, 9 deletions
@@ -1,10 +1,16 @@ -2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net> +2009-01-27 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOODefineCmds.c (Tcl_ClassSetConstructor): + [Bug 2531577]: Ensure that caches of constructor chains are cleared + when the constructor is changed. + +2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * generic/tclInt.h: Fix [Bug 1028264]: WSACleanup() too early. * generic/tclEvent.c: The fix introduces "late exit handlers" * win/tclWinSock.c: for similar late process-wide cleanups. -2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net> +2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * win/tclWinSocl.c: Fix [Bug 2446662]: resync Win behavior on RST with that of unix (EOF). @@ -20,15 +26,15 @@ 2009-01-22 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tclCompile.h: CONSTify TclPrintInstruction (TIP #27) + * generic/tclCompile.h: CONSTify TclPrintInstruction (TIP #27) * generic/tclCompile.c - * generic/tclInt.h: CONSTify TclpNativeJoinPath (TIP #27) + * generic/tclInt.h: CONSTify TclpNativeJoinPath (TIP #27) * generic/tclFileName.c - * generic/tcl.decls {unix win} is equivalent to {generic} + * generic/tcl.decls: {unix win} is equivalent to {generic} * generic/tclInt.decls - * generic/tclDecls.h (regenerated) + * generic/tclDecls.h: (regenerated) * generic/tclIntDecls.h - * generic/tclGetDate.y: Single internal const decoration. + * generic/tclGetDate.y: Single internal const decoration. * generic/tclDate.c: 2009-01-22 Kevin B. Kenny <kennykb@acm.org> diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 5b1f354..ac65ee4 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -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: tclOODefineCmds.c,v 1.8 2008/12/02 19:40:41 dgp Exp $ + * RCS: @(#) $Id: tclOODefineCmds.c,v 1.9 2009/01/27 11:11:47 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -1933,6 +1933,16 @@ Tcl_ClassSetConstructor( if (method != (Tcl_Method) clsPtr->constructorPtr) { TclOODelMethodRef(clsPtr->constructorPtr); clsPtr->constructorPtr = (Method *) method; + + /* + * Remember to invalidate the cached constructor chain for this class. + * [Bug 2531577] + */ + + if (clsPtr->constructorChainPtr) { + TclOODeleteChain(clsPtr->constructorChainPtr); + clsPtr->constructorChainPtr = NULL; + } BumpGlobalEpoch(interp, clsPtr); } } @@ -1948,6 +1958,10 @@ Tcl_ClassSetDestructor( if (method != (Tcl_Method) clsPtr->destructorPtr) { TclOODelMethodRef(clsPtr->destructorPtr); clsPtr->destructorPtr = (Method *) method; + if (clsPtr->destructorChainPtr) { + TclOODeleteChain(clsPtr->destructorChainPtr); + clsPtr->destructorChainPtr = NULL; + } BumpGlobalEpoch(interp, clsPtr); } } diff --git a/tests/oo.test b/tests/oo.test index b7029ea..5db928e 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.20 2009/01/07 11:58:08 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.21 2009/01/27 11:11:47 dkf Exp $ package require TclOO 0.6.1 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -245,6 +245,27 @@ test oo-2.2 {basic test of OO functionality: constructor} { testClass destroy return $result } {::foo->construct ::foo->bar} +test oo-2.4 {OO constructor - Bug 2531577} -setup { + oo::class create foo +} -body { + oo::define foo constructor {} return + [foo new] destroy + oo::define foo constructor {} {} + llength [info command [foo new]] +} -cleanup { + foo destroy +} -result 1 +test oo-2.5 {OO constructor - Bug 2531577} -setup { + oo::class create foo + set result {} +} -body { + oo::define foo constructor {} {error x} + lappend result [catch {foo new}] + oo::define foo constructor {} {} + lappend result [llength [info command [foo new]]] +} -cleanup { + foo destroy +} -result {1 1} test oo-3.1 {basic test of OO functionality: destructor} -setup { # This is a bit complex because it needs to run in a sub-interp as |