On Saturday 20 January 2001 04:39, Kristoffer Lawson wrote:
Apparently a bug I think was fixed at one point has managed to creep in:
[~] Class Foo
Foo
[~] Foo instproc init {foo} {
[self] instvar {foo fooAlias}
puts "yeah"
}
[~] Foo ob bar
variable "foo" already exists
while evaluating {Foo ob bar}
Ie. although an alias is created, the foo variable conflicts.
I don't think that we have really fixed this bug already, because with
Tcl_VariableObjCmd & Tcl_UpVar (which we have used), we can't get around this
problem. I've implemented a solution, which is rather complicated & copies
alot of Tcl's internal code, because Tcl does not export some important
functions ...
I hope we find something more simple ... but I'll attach the fix for the time
being. If you require it now, please exchange the function
GetInstVarAliasIntoCurrentScope in xotcl.c against the code attached down
below. Otherwise, it'll be also in 0.84.
--Uwe
--
Uwe Zdun
Specification of Software Systems, University of Essen
Phone: +49 201 81 00 332, Fax: +49 201 81 00 398
zdun@xotcl.org, uwe.zdun@uni-essen.de
#############################################################################
/*
* We need NewVar from tclVar.c ... but its not exported
*/
static Var *NewVar() {
register Var *varPtr;
varPtr = (Var *) ckalloc(sizeof(Var));
varPtr->value.objPtr = NULL;
varPtr->name = NULL;
varPtr->nsPtr = NULL;
varPtr->hPtr = NULL;
varPtr->refCount = 0;
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
return varPtr;
}
/*
* Provide functionality similar to Tcl's VariableObjCmd for instvared
* vars with alias (VariableObjCmd does not accept aliases)
*
* We have to copy a lot of code from MakeUpvar, because Tcl does not
* export it (sigh)
*/
static XOTCLINLINE int
GetInstVarAliasIntoCurrentScope(Tcl_Interp* in, char* varName, char* newName)
{
Interp *iPtr = (Interp *) in;
Var *varPtr, *otherPtr, *arrayPtr;
int result;
char *tail, *cp;
CallFrame frame;
Tcl_CallFrame *procFrame;
CallFrame *savedFramePtr = NULL;
CallFrame *varFramePtr;
int new;
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
/* Look up var in the current namespace context, creating
* it if necessary. */
otherPtr = TclLookupVar(in, varName, (char *) NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
if (newName == NULL) {
return XOTclVarErrMsg(in, "can't define alias to ",
varName, ": alias not given.", NULL);
}
if (otherPtr == NULL) {
return TCL_ERROR;
}
/*
* Mark the variable as a namespace variable
*/
if (!(otherPtr->flags & VAR_NAMESPACE_VAR)) {
otherPtr->flags |= VAR_NAMESPACE_VAR;
}
varFramePtr = iPtr->varFramePtr;
/*
* If we are executing inside a Tcl procedure, create a local
* variable linked to the new namespace variable "varName".
*/
if ((iPtr->varFramePtr != NULL)
&& iPtr->varFramePtr->isProcCallFrame) {
Proc *procPtr = varFramePtr->procPtr;
int localCt = procPtr->numCompiledLocals;
CompiledLocal *localPtr = procPtr->firstLocalPtr;
Var *localVarPtr = varFramePtr->compiledLocals;
int nameLen = strlen(newName);
int i;
varPtr = NULL;
for (i = 0; i < localCt; i++) { /* look in compiled locals */
if (!TclIsVarTemporary(localPtr)) {
char *localName = localVarPtr->name;
if ((newName[0] == localName[0])
&& (nameLen == localPtr->nameLength)
&& (strcmp(newName, localName) == 0)) {
varPtr = localVarPtr;
new = 0;
break;
}
}
localVarPtr++;
localPtr = localPtr->nextPtr;
}
if (varPtr == NULL) { /* look in frame's local var hashtable */
tablePtr = varFramePtr->varTablePtr;
if (tablePtr == NULL) {
tablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
varFramePtr->varTablePtr = tablePtr;
}
hPtr = Tcl_CreateHashEntry(tablePtr, newName, &new);
if (new) {
varPtr = NewVar();
Tcl_SetHashValue(hPtr, varPtr);
varPtr->hPtr = hPtr;
varPtr->nsPtr = varFramePtr->nsPtr;
} else {
varPtr = (Var *) Tcl_GetHashValue(hPtr);
}
}
if (!new) {
if ((varPtr == otherPtr) || TclIsVarLink(varPtr) ||
!TclIsVarUndefined(varPtr) || (varPtr->tracePtr != NULL)) {
return XOTclVarErrMsg(in, "can't set variable alias ", newName,
": name already exists", 0);
}
}
TclSetVarLink(varPtr);
TclClearVarUndefined(varPtr);
varPtr->value.linkPtr = otherPtr;
otherPtr->refCount++;
}
return TCL_OK;
}
