From ba795792d6185008b4de5f9c0463f26fa2ddab0a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 9 Apr 2012 21:38:27 +0000
Subject: Fix [Bug 3396896]

---
 ChangeLog                 |  4 ++++
 generic/tclOODefineCmds.c | 52 ++++++++++++++++++++++++++++++++++++++++++-----
 tests/oo.test             | 18 ++++++++++++++--
 3 files changed, 67 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index d66e5b7..c632c42 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2012-04-09  Donal K. Fellows  <dkf@users.sf.net>
 
+	* generic/tclOODefineCmds.c (ClassVarsSet, ObjVarsSet): [Bug 3396896]:
+	Ensure that the lists of variable names used to drive variable
+	resolution will never have the same name twice.
+
 	* generic/tclVar.c (AppendLocals): [Bug 2712377]: Fix problem with
 	reporting of declared variables in methods. It's really a problem with
 	how [info vars] interacts with variable resolvers; this is just a bit
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 926966b..3d72690 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2306,11 +2306,32 @@ ClassVarsSet(
 		    ckalloc(sizeof(Tcl_Obj *) * varc);
 	}
     }
+
+    oPtr->classPtr->variables.num = 0;
     if (varc > 0) {
-	memcpy(oPtr->classPtr->variables.list, varv,
-		sizeof(Tcl_Obj *) * varc);
+	int created, n;
+	Tcl_HashTable uniqueTable;
+
+	Tcl_InitObjHashTable(&uniqueTable);
+	for (i=n=0 ; i<varc ; i++) {
+	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+	    if (created) {
+		oPtr->classPtr->variables.list[n++] = varv[i];
+	    } else {
+		Tcl_DecrRefCount(varv[i]);
+	    }
+	}
+	oPtr->classPtr->variables.num = n;
+
+	/*
+	 * Shouldn't be necessary, but maintain num/list invariant.
+	 */
+
+	oPtr->classPtr->variables.list = (Tcl_Obj **)
+		ckrealloc((char *) oPtr->classPtr->variables.list,
+		sizeof(Tcl_Obj *) * n);
+	Tcl_DeleteHashTable(&uniqueTable);
     }
-    oPtr->classPtr->variables.num = varc;
     return TCL_OK;
 }
 
@@ -2563,10 +2584,31 @@ ObjVarsSet(
 		    ckalloc(sizeof(Tcl_Obj *) * varc);
 	}
     }
+    oPtr->variables.num = 0;
     if (varc > 0) {
-	memcpy(oPtr->variables.list, varv, sizeof(Tcl_Obj *)*varc);
+	int created, n;
+	Tcl_HashTable uniqueTable;
+
+	Tcl_InitObjHashTable(&uniqueTable);
+	for (i=n=0 ; i<varc ; i++) {
+	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+	    if (created) {
+		oPtr->variables.list[n++] = varv[i];
+	    } else {
+		Tcl_DecrRefCount(varv[i]);
+	    }
+	}
+	oPtr->variables.num = n;
+
+	/*
+	 * Shouldn't be necessary, but maintain num/list invariant.
+	 */
+
+	oPtr->variables.list = (Tcl_Obj **)
+		ckrealloc((char *) oPtr->variables.list,
+		sizeof(Tcl_Obj *) * n);
+	Tcl_DeleteHashTable(&uniqueTable);
     }
-    oPtr->variables.num = varc;
     return TCL_OK;
 }
 
diff --git a/tests/oo.test b/tests/oo.test
index a0e7345..f3c0bda 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2973,7 +2973,6 @@ test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup {
 	    lappend ::result | foo=$foo [info locals] [info locals *]
 	}
     }
-
     Foo create stuff
     stuff setvars what ever
     stuff dump1
@@ -3009,7 +3008,6 @@ test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup {
 	    lappend ::result | foo=$foo [info locals] [info locals *]
 	}
     }
-
     Foo create stuff
     stuff setvars what ever
     stuff dump1
@@ -3018,6 +3016,22 @@ test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup {
 } -cleanup {
     Foo destroy
 } -result {<1> foo=what v v <2> foo=what | foo=what v v}
+test oo-27.21 {variables declaration uniqueifies: Bug 3396896} -setup {
+    oo::class create Foo
+} -body {
+    oo::define Foo variable v v v t t v t
+    info class variable Foo
+} -cleanup {
+    Foo destroy
+} -result {v t}
+test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo variable v v v t t v t
+    info object variable foo
+} -cleanup {
+    foo destroy
+} -result {v t}
 
 # A feature that's not supported because the mechanism may change without
 # warning, but is supposed to work...
-- 
cgit v0.12