[Xotcl] Re: [Xotcl] old bug

From: Uwe Zdun <uwe.zdun_at_uni-essen.de>
Date: Wed, 24 Jan 2001 18:32:04 +0100

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_at_xotcl.org, uwe.zdun_at_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;
}