diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | generic/tclOO.c | 23 | ||||
| -rw-r--r-- | tests/oo.test | 36 |
3 files changed, 71 insertions, 4 deletions
@@ -1,6 +1,16 @@ +2012-04-04 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance): + [Bug 3514761]: Fixed bogosity with automated argument description + handling when constructing an instance of a class that is itself a + member of an ensemble. Thanks to Andreas Kupries for identifying that + this was a problem case at all! + (Tcl_CopyObjectInstance): Fix potential bleed-over of ensemble + information into [oo::copy]. + 2012-04-04 Jan Nijtmans <nijtmans@users.sf.net> - * win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs plat imp + * win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs plat imp * generic/tclIOSock.c: * generic/tclInt.decls: * generic/tclIntDecls.h: @@ -8,8 +18,8 @@ 2012-04-03 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tclStubInit.c Remove the TclpGetTZName implementation for - * generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit) , re-generated + * generic/tclStubInit.c: Remove the TclpGetTZName implementation for + * generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit), re-generated * generic/tclIntPlatDecls.h: 2012-04-02 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclOO.c b/generic/tclOO.c index 9dd8162..1d1276d 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1624,6 +1624,15 @@ Tcl_NewObjectInstance( state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; + + /* + * Adjust the ensmble tracking record if necessary. [Bug 3514761] + */ + + if (((Interp*) interp)->ensembleRewrite.sourceObjs) { + ((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1; + ((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1; + } result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); @@ -1742,6 +1751,15 @@ TclNRNewObjectInstance( contextPtr->skip = skip; /* + * Adjust the ensmble tracking record if necessary. [Bug 3514761] + */ + + if (((Interp *) interp)->ensembleRewrite.sourceObjs) { + ((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1; + ((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1; + } + + /* * Fire off the constructors non-recursively. */ @@ -2050,6 +2068,7 @@ Tcl_CopyObjectInstance( } } + TclResetRewriteEnsemble(interp, 1); contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL); if (contextPtr) { args[0] = TclOOObjectName(interp, o2Ptr); @@ -2064,6 +2083,10 @@ Tcl_CopyObjectInstance( TclDecrRefCount(args[1]); TclDecrRefCount(args[2]); TclOODeleteContext(contextPtr); + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (while performing post-copy callback)"); + } if (result != TCL_OK) { Tcl_DeleteCommandFromToken(interp, o2Ptr->command); return NULL; diff --git a/tests/oo.test b/tests/oo.test index ccea42a..8c5aeb3 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -339,7 +339,7 @@ test oo-2.6 {OO constructor and tailcall - Bug 2414858} -setup { } -result good test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup { namespace eval k {} -} -constraints knownBug -body { +} -body { namespace eval k { oo::class create s { constructor {j} { @@ -353,6 +353,29 @@ test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup { } -returnCodes error -cleanup { namespace delete k } -result {wrong # args: should be "k s create X j"} +test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup { + namespace eval k {} +} -body { + namespace eval k { + oo::class create s { + constructor {j} { + # nothing + } + } + oo::class create t { + superclass s + constructor args { + k next {*}$args + } + } + interp alias {} ::k::next {} ::oo::Helpers::next + namespace export t next + namespace ensemble create + } + k t create X +} -returnCodes error -cleanup { + namespace delete k +} -result {wrong # args: should be "k next j"} 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 we're @@ -1742,6 +1765,17 @@ test oo-15.8 {OO: intercept object cloning} -setup { } -cleanup { Foo destroy } -result {cloned ::foo ::bar check ::foo ok check ::bar ok} +test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup { + oo::class create Foo +} -body { + oo::define Foo { + method <cloned> {a b} {} + } + interp alias {} Bar {} oo::copy [Foo create foo] + Bar bar +} -returnCodes error -cleanup { + Foo destroy +} -result {wrong # args: should be "::bar <cloned> a b"} test oo-16.1 {OO: object introspection} -body { info object |