summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-10-22 15:39:58 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-10-22 15:39:58 (GMT)
commita14cd9979de8b9856c979aae40f3c8889b2d8d9b (patch)
treea045c04ec4a4410e0f5a548ea98550340520b1af /generic
parent0fca0c346fbe4fb05578bffffc93048a9e0db914 (diff)
downloadtcl-a14cd9979de8b9856c979aae40f3c8889b2d8d9b.zip
tcl-a14cd9979de8b9856c979aae40f3c8889b2d8d9b.tar.gz
tcl-a14cd9979de8b9856c979aae40f3c8889b2d8d9b.tar.bz2
Let [$obj varname x(y)] work. [Bug 2883857]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclOOBasic.c27
1 files changed, 25 insertions, 2 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index f70d4f9..f6e4542 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOBasic.c,v 1.18 2009/03/24 10:46:04 dkf Exp $
+ * RCS: @(#) $Id: tclOOBasic.c,v 1.19 2009/10/22 15:39:58 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -608,7 +608,30 @@ TclOO_Object_VarName(
}
varNamePtr = Tcl_NewObj();
- Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
+ if (aryVar != NULL) {
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
+
+ /*
+ * WARNING! This code pokes inside the implementation of hash tables!
+ */
+
+ hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
+ &search);
+ while (hPtr != NULL) {
+ if (varPtr == Tcl_GetHashValue(hPtr)) {
+ Tcl_AppendToObj(varNamePtr, "(", -1);
+ Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
+ Tcl_AppendToObj(varNamePtr, ")", -1);
+ break;
+ }
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ } else {
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
+ }
Tcl_SetObjResult(interp, varNamePtr);
return TCL_OK;
}