summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-04-09 21:38:27 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-04-09 21:38:27 (GMT)
commitba795792d6185008b4de5f9c0463f26fa2ddab0a (patch)
treebbf70e95747797972530e153c0ffee4c8c954486
parent4d8a945fc474dc4d42a6c0903f3eb2e0b62bd9a4 (diff)
downloadtcl-ba795792d6185008b4de5f9c0463f26fa2ddab0a.zip
tcl-ba795792d6185008b4de5f9c0463f26fa2ddab0a.tar.gz
tcl-ba795792d6185008b4de5f9c0463f26fa2ddab0a.tar.bz2
Fix [Bug 3396896]
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclOODefineCmds.c52
-rw-r--r--tests/oo.test18
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...