TclOO Package

Check-in [ef16735886]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Bug 3603695: Change the way that the [oo::object] '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.

Note that due to some subtleties, this test was not failing in the packaged version of TclOO. The code is backported anyway though, as it is rather cleaner than the previous version.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ef1673588672172740068b00e25a7cc56f19b6dc
User & Date: dkf 2013-02-09 12:38:22
Original Comment: [Bug 3603695]: Change the way that the [oo::object] '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.

Note that due to some subtleties, this test was not failing in the packaged version of TclOO. The code is backported anyway though, as it is rather cleaner than the previous version.

Context
2013-04-10
09:12
Tests from Bug 3610404 but constrained with knownBug because of a problem that is probably in Tcl 8.5 itself. It's believed that TclOO in 8.5 is otherwise unaffected by bug 3610404. check-in: 568146bba2 user: dkf tags: trunk
2013-02-09
12:38
Bug 3603695: Change the way that the [oo::object] '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.

Note that due to some subtleties, this test was not failing in the packaged version of TclOO. The code is backported anyway though, as it is rather cleaner than the previous version. check-in: ef16735886 user: dkf tags: trunk

2013-01-29
10:20
minor fix to benchmarking code check-in: ad4ace340a user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.








1
2
3
4
5
6
7






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
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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

Changes to generic/tclOOBasic.c.

585
586
587
588
589
590
591
592
593
594

595
596
597
598
599
600


601
602
603
604
605
606
607
608

609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630



631




632

633
634
635





636
637
638
639
640
641
642
    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. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *aryVar;
    Tcl_Obj *varNamePtr;


    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }



    /*
     * Switch to the object's namespace for the duration of this call. Like
     * this, the variable is looked up in the namespace of the object, and not
     * in the namespace of the caller. Otherwise this would only work if the
     * caller was a method of the object itself, which might not be true if
     * the method was exported. This is a bit of a hack, but the simplest way
     * to do this (pushing a stack frame would be horribly expensive by

     * comparison, and is only done when we'd otherwise interfere with the
     * global namespace).
     */

    if (iPtr->varFramePtr == NULL) {
	Tcl_CallFrame *dummyFrame;

	TclPushStackFrame(interp, &dummyFrame,
		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),0);
	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
	TclPopStackFrame(interp);
    } else {
	Namespace *savedNsPtr;

	savedNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *)
		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
	iPtr->varFramePtr->nsPtr = savedNsPtr;
    }








    if (varPtr == NULL) {

	return TCL_ERROR;
    }






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

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







<

|
>






>
>


<
<
|
|
|
<
>
|
|


|
|
<
<
<
<
<
<

|
<
<
<

<
<
<
|
>
>
>
|
>
>
>
>

>



>
>
>
>
>







585
586
587
588
589
590
591

592
593
594
595
596
597
598
599
600
601
602
603
604


605
606
607

608
609
610
611
612
613
614






615
616



617



618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
    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);

Changes to tests/oo.test.

2153
2154
2155
2156
2157
2158
2159



















2160
2161
2162
2163
2164
2165
2166
    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-20.1 {OO: variable method} -body {
    oo::class create testClass {
	constructor {} {
	    my variable ok
	    set ok {}
	}






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
    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 {}
	}