diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-10-22 15:39:58 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-10-22 15:39:58 (GMT) |
| commit | a14cd9979de8b9856c979aae40f3c8889b2d8d9b (patch) | |
| tree | a045c04ec4a4410e0f5a548ea98550340520b1af /generic | |
| parent | 0fca0c346fbe4fb05578bffffc93048a9e0db914 (diff) | |
| download | tcl-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.c | 27 |
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; } |