summaryrefslogtreecommitdiffstats
path: root/generic/tclOO.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-04-04 20:51:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-04-04 20:51:06 (GMT)
commitf9c97ea67073aa3e2fa22b80e826b3d491e3440c (patch)
tree4629d081436796671ba3419500517e5bf2be9674 /generic/tclOO.c
parenta6573529e52eff368bc5f159290de355ab90ab78 (diff)
downloadtcl-f9c97ea67073aa3e2fa22b80e826b3d491e3440c.zip
tcl-f9c97ea67073aa3e2fa22b80e826b3d491e3440c.tar.gz
tcl-f9c97ea67073aa3e2fa22b80e826b3d491e3440c.tar.bz2
Fix [Bug 3514761] and related ensemble/construction problems.
Diffstat (limited to 'generic/tclOO.c')
-rw-r--r--generic/tclOO.c23
1 files changed, 23 insertions, 0 deletions
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;