Tcl Source Code

Check-in [15f9fcba6e]
Login

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

Overview
Comment:insure that 'coroutine eval' runs the initial command in the proper context, [Bug 3282869]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 15f9fcba6e6a5ae0bd74680dc4219c31aecfaf25
User & Date: mig 2011-04-11 10:37:39
Context
2011-04-12
07:26
revert 6b6ef4e0b1, removing the temporary tests again check-in: b580ef3c9e user: jan.nijtmans tags: trunk
2011-04-11
11:10
merge trunk check-in: b34a5b7358 user: mig tags: mig-alloc-reform
11:09
merge trunk check-in: b936648e57 user: mig tags: mig-no280
10:37
insure that 'coroutine eval' runs the initial command in the proper context, [Bug 3282869] check-in: 15f9fcba6e user: mig tags: trunk
07:31
fix for [Bug 3281728]: Tcl sources from 2011-04-06 do not build on GCC9 (RH9) check-in: e0421a23a8 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7






2011-04-11  Jan Nijtmans  <[email protected]>
	* generic/tcl.h:    fix for [Bug 3281728]: Tcl sources from 2011-04-06 do
	* unix/tcl.m4:      not build on GCC9 (RH9)
	* unix/configure:

2011-04-08  Jan Nijtmans  <[email protected]>

>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2011-04-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* tests/coroutine.test: insure that 'coroutine eval' runs the initial
	command in the proper context, [Bug 3282869]
	
2011-04-11  Jan Nijtmans  <[email protected]>
	* generic/tcl.h:    fix for [Bug 3281728]: Tcl sources from 2011-04-06 do
	* unix/tcl.m4:      not build on GCC9 (RH9)
	* unix/configure:

2011-04-08  Jan Nijtmans  <[email protected]>

Changes to generic/tclBasic.c.

8862
8863
8864
8865
8866
8867
8868

8869
8870
8871
8872
8873
8874
8875
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *fullName, *procName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_DString ds;

    
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    /*







>







8862
8863
8864
8865
8866
8867
8868
8869
8870
8871
8872
8873
8874
8875
8876
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *fullName, *procName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_DString ds;
    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
    
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    /*
8948
8949
8950
8951
8952
8953
8954
8955
8956
8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968
8969
8970
8971
8972
8973
8974



8975
8976
8977
8978
8979
8980
8981



8982
8983
8984
8985
8986
8987
8988
		    &isNew);

	    Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
	}
    }

    /*
     * Save the base context.
     */

    corPtr->running.framePtr = iPtr->rootFramePtr;
    corPtr->running.varFramePtr = iPtr->rootFramePtr;
    corPtr->running.cmdFramePtr = NULL;
    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
    corPtr->stackLevel = NULL;
    corPtr->auxNumLevels = 0;
    iPtr->numLevels--;
    
    /*
     * Create the coro's execEnv, switch to it to push the exit and coro
     * command callbacks, then switch back. 
     */

    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    corPtr->eePtr->corPtr = corPtr;
    



    iPtr->execEnvPtr = corPtr->eePtr;

    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
	    NULL, NULL, NULL);

    iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);



    iPtr->execEnvPtr = corPtr->callerEEPtr;
    
    /*
     * Now just resume the coroutine. Take care to insure that the command is
     * looked up in the correct namespace.
     */








|



















>
>
>





|

>
>
>







8949
8950
8951
8952
8953
8954
8955
8956
8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
8987
8988
8989
8990
8991
8992
8993
8994
8995
		    &isNew);

	    Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
	}
    }

    /*
     * Create the base context.
     */

    corPtr->running.framePtr = iPtr->rootFramePtr;
    corPtr->running.varFramePtr = iPtr->rootFramePtr;
    corPtr->running.cmdFramePtr = NULL;
    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
    corPtr->stackLevel = NULL;
    corPtr->auxNumLevels = 0;
    iPtr->numLevels--;
    
    /*
     * Create the coro's execEnv, switch to it to push the exit and coro
     * command callbacks, then switch back. 
     */

    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    corPtr->eePtr->corPtr = corPtr;
    
    SAVE_CONTEXT(corPtr->caller);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;

    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
	    NULL, NULL, NULL);

    iPtr->lookupNsPtr = lookupNsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    
    /*
     * Now just resume the coroutine. Take care to insure that the command is
     * looked up in the correct namespace.
     */

Changes to tests/coroutine.test.

430
431
432
433
434
435
436
























437
438
439
440
441
442
443
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $start}]
} -cleanup {
    rename getbytes {}
    unset i ns start end
} -result 0

























test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
    proc nestedYield {{val {}}} {
	yield $val
    }
    proc getNumLevel {} {







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







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $start}]
} -cleanup {
    rename getbytes {}
    unset i ns start end
} -result 0

test coroutine-4.6 {compile context, bug #3282869} -setup {
    unset ::x
    proc f x {
	coroutine D eval {yield X$x;yield Y}
    }
} -body {
    f 12
} -cleanup {
    rename f {}
} -returnCodes error -match glob -result {can't read *}

test coroutine-4.7 {compile context, bug #3282869} -setup {
    proc f x {
	coroutine D eval {yield X$x;yield Y$x}
    }
} -body {
    set ::x 15
    set ::x [f 12]
    D
} -cleanup {
    unset ::x
    rename f {}
} -result YX15

test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
    proc nestedYield {{val {}}} {
	yield $val
    }
    proc getNumLevel {} {