From 68fbac8d0f24ffb16077c6c3ecd6c1a61ab16bb1 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 25 Jan 2012 14:39:55 +0000
Subject: 	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]:
 When 	copying an object, make sure that the configuration of the variable 
 resolver is also duplicated.

---
 ChangeLog       |  8 +++++++-
 generic/tclOO.c | 20 +++++++++++++++++++-
 tests/oo.test   | 22 ++++++++++++++++++++++
 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
-- 
cgit v0.12