diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclOODefineCmds.c | 52 | ||||
| -rw-r--r-- | tests/oo.test | 18 |
3 files changed, 67 insertions, 7 deletions
@@ -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... |