summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-01-25 14:39:55 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-01-25 14:39:55 (GMT)
commit68fbac8d0f24ffb16077c6c3ecd6c1a61ab16bb1 (patch)
treecd1368cc4eeee7ad19d71b6daad4256bcffb9205
parent8df49a02756833a2aefa9dcba660412037e4f1c4 (diff)
downloadtcl-68fbac8d0f24ffb16077c6c3ecd6c1a61ab16bb1.zip
tcl-68fbac8d0f24ffb16077c6c3ecd6c1a61ab16bb1.tar.gz
tcl-68fbac8d0f24ffb16077c6c3ecd6c1a61ab16bb1.tar.bz2
* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
copying an object, make sure that the configuration of the variable resolver is also duplicated.
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclOO.c20
-rw-r--r--tests/oo.test22
3 files changed, 48 insertions, 2 deletions
diff --git a/ChangeLog b/ChangeLog
index 7753272..3d69427 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,12 @@
+2012-01-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
+ copying an object, make sure that the configuration of the variable
+ resolver is also duplicated.
+
2012-01-22 Jan Nijtmans <nijtmans@users.sf.net>
- * tools/uniClass.tcl: [Frq 3473670]: Various Unicode-related
+ * tools/uniClass.tcl: [FRQ 3473670]: Various Unicode-related
* tools/uniParse.tcl: speedups/robustness. Enhanced tools to
* generic/tclUniData.c: be able to handle characters > 0xffff
* generic/tclUtf.c: Done in all branches in order to simplify
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 8b76eeb..8ac2039 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1643,7 +1643,7 @@ Tcl_CopyObjectInstance(
FOREACH_HASH_DECLS;
Method *mPtr;
Class *mixinPtr;
- Tcl_Obj *keyPtr, *filterObj;
+ Tcl_Obj *keyPtr, *filterObj, *variableObj;
int i;
/*
@@ -1712,6 +1712,15 @@ Tcl_CopyObjectInstance(
}
/*
+ * Copy the object's variable resolution list to the new object.
+ */
+
+ DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
+ FOREACH(variableObj, o2Ptr->variables) {
+ Tcl_IncrRefCount(variableObj);
+ }
+
+ /*
* Copy the object's flags to the new object, clearing those that must be
* kept object-local. The duplicate is never deleted at this point, nor is
* it the root of the object system or in the midst of processing a filter
@@ -1794,6 +1803,15 @@ Tcl_CopyObjectInstance(
}
/*
+ * Copy the source class's variable resolution list.
+ */
+
+ DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
+ FOREACH(variableObj, cls2Ptr->variables) {
+ Tcl_IncrRefCount(variableObj);
+ }
+
+ /*
* Duplicate the source class's mixins (which cannot be circular
* references to the duplicate).
*/
diff --git a/tests/oo.test b/tests/oo.test
index e5a17f1..67535c9 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1650,6 +1650,28 @@ test oo-15.3 {OO: class cloning} {
bar destroy
return $result
} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
+test oo-15.4 {OO: object cloning - Bug 3474460} -setup {
+ oo::class create ArbitraryClass
+} -body {
+ ArbitraryClass create foo
+ oo::objdefine foo variable a b c
+ oo::copy foo bar
+ info object variable bar
+} -cleanup {
+ ArbitraryClass destroy
+} -result {a b c}
+test oo-15.5 {OO: class cloning - Bug 3474460} -setup {
+ oo::class create ArbitraryClass
+} -body {
+ oo::class create Foo {
+ superclass ArbitraryClass
+ variable a b c
+ }
+ oo::copy Foo Bar
+ info class variable Bar
+} -cleanup {
+ ArbitraryClass destroy
+} -result {a b c}
test oo-16.1 {OO: object introspection} -body {
info object