Fix [Bug 3514761] and related ensemble/construction problems.

3 files changed, 71 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index bb3f9f0..4c961d0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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