summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog16
-rw-r--r--generic/tclOO.c23
-rw-r--r--tests/oo.test36
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