diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclOO.c | 20 | ||||
| -rw-r--r-- | tests/oo.test | 22 |
3 files changed, 48 insertions, 2 deletions
@@ -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 |