TclOO Package

2013-02-09  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 3603695]: Change
	the way that the 'varname' method is implemented so that there are no
	longer problems with interactions due to the resolver. Thanks to
	Taylor Venable <[email protected]> for identifying the problem.

2012-12-21  Donal K. Fellows  <[email protected]>

	=== RELEASE OF TCLOO VERSION 1.0 ===

	This officially corresponds to the version of TclOO that is included
	with Tcl 8.6.0, except for features (notably coroutine support) that
	require the 8.6 runtime and not-officially-observable differences like

    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{

    Var *varPtr, *aryVar;
    Tcl_Obj *varNamePtr, *argPtr;
    const char *arg;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }
    argPtr = objv[objc-1];
    arg = Tcl_GetString(argPtr);

    /*

     * Convert the variable name to fully-qualified form if it wasn't already.

     * This has to be done prior to lookup because we can run into problems
     * with resolvers otherwise. [Bug 3603695]
     *
     * We still need to do the lookup; the variable could be linked to another

     * variable and we want the target's name.
     */

    if (arg[0] == ':' && arg[1] == ':') {
	varNamePtr = argPtr;
    } else {
	Tcl_Namespace *namespacePtr =

		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));

	varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
	Tcl_AppendToObj(varNamePtr, "::", 2);

	Tcl_AppendObjToObj(varNamePtr, argPtr);
    }
    Tcl_IncrRefCount(varNamePtr);


    varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
	    TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);


    Tcl_DecrRefCount(varNamePtr);
    if (varPtr == NULL) {
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL);
	return TCL_ERROR;
    }

    /*
     * Now that we've pinned down what variable we're really talking about
     * (including traversing variable links), convert back to a name.
     */

    varNamePtr = Tcl_NewObj();
    if (aryVar != NULL) {
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch search;

	Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);

    oo::objdefine inst export varname eval
} -body {
    inst eval { variable x; array set x {y z} }
    inst varname x(y)
} -cleanup {
    SpecialClass destroy
} -result ::oo_test::x(y)
test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup {
    oo::class create testClass {
	variable foo
	export varname
	constructor {} {
	    variable foo x
	}
	method bar {obj} {
	    my varname foo
	    $obj varname foo
	}
    }
} -body {
    testClass create A
    testClass create B
    lsearch [list [A varname foo] [B varname foo]] [B bar A]
} -cleanup {
    testClass destroy
} -result 0

test oo-20.1 {OO: variable method} -body {
    oo::class create testClass {
	constructor {} {
	    my variable ok
	    set ok {}
	}