Tcl Source Code

Changes On Branch bug-e593adf103-core-8
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch bug-e593adf103-core-8 Excluding Merge-Ins

This is equivalent to a diff from 14ebe914be to 37f9d3e1fe

2018-11-01
16:28
Replace logical and with bitwise & Leaf check-in: 37f9d3e1fe user: pooryorick tags: bug-e593adf103-core-8
16:06
Fix issue with oPtr->command, which might be NULL. check-in: 311f6dcc5b user: pooryorick tags: bug-e593adf103-core-8
2018-10-29
19:57
Fix compilation on Visual C++ 6.0, which doesn't have LLONG_MIN/LLONG_MAX check-in: 28c1c59dbb user: jan.nijtmans tags: core-8-branch
19:23
merge 8.7 check-in: cca06bb4a1 user: pooryorick tags: bug-e593adf103-core-8
18:19
Work started eliminating long outdated compat routines that now cause cross-compiling failure far mo... Closed-Leaf check-in: c671a610ec user: dgp tags: bug-840660e5a1
15:37
merge 8.7 Closed-Leaf check-in: 9220ded810 user: dgp tags: tip-445
15:04
merge 8.7 check-in: f3611d1ed1 user: dgp tags: trunk
14:39
merge mark check-in: 14ebe914be user: dgp tags: core-8-branch
14:38
[TIP 525] Backport package tcltest 2.5 check-in: 09e38054c3 user: dgp tags: core-8-6-branch
13:36
[TIP 525] Revise [tcltest::runAllTests] to return indicator of any failure. check-in: a4ea2b2387 user: dgp tags: core-8-branch

Changes to doc/namespace.n.

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
.MT
(i.e., an empty string),
but this command returns \fB::\fR for the global namespace
as a convenience to programmers.
.TP
\fBnamespace delete \fR?\fInamespace namespace ...\fR?
.
Each namespace \fInamespace\fR is deleted
and all variables, procedures, and child namespaces
contained in the namespace are deleted.
If a procedure is currently executing inside the namespace,
the namespace will be kept alive until the procedure returns;
however, the namespace is marked to prevent other code from
looking it up by name.
If a namespace does not exist, this command returns an error.
If no namespace names are given, this command does nothing.
.TP
\fBnamespace ensemble\fR \fIsubcommand\fR ?\fIarg ...\fR?
.
Creates and manipulates a command that is formed out of an ensemble of
subcommands.  See the section \fBENSEMBLES\fR below for further






|
|
|
|
<
<
<







76
77
78
79
80
81
82
83
84
85
86



87
88
89
90
91
92
93
.MT
(i.e., an empty string),
but this command returns \fB::\fR for the global namespace
as a convenience to programmers.
.TP
\fBnamespace delete \fR?\fInamespace namespace ...\fR?
.
Each namespace \fInamespace\fR is deleted and its ensemble commands, child
namespaces, commands, and variables are deleted in that order. Any evaluation
levels using the namespace as the current namespace then use the global
namespace instead.



If a namespace does not exist, this command returns an error.
If no namespace names are given, this command does nothing.
.TP
\fBnamespace ensemble\fR \fIsubcommand\fR ?\fIarg ...\fR?
.
Creates and manipulates a command that is formed out of an ensemble of
subcommands.  See the section \fBENSEMBLES\fR below for further

Changes to generic/tcl.h.

886
887
888
889
890
891
892

893
894
895
896
897
898
899
    void *dummy7;
    void *dummy8;
    int dummy9;
    void *dummy10;
    void *dummy11;
    void *dummy12;
    void *dummy13;

} Tcl_CallFrame;

/*
 *----------------------------------------------------------------------------
 * Information about commands that is returned by Tcl_GetCommandInfo and
 * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based command
 * function while proc is a traditional Tcl argc/argv string-based function.






>







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
    void *dummy7;
    void *dummy8;
    int dummy9;
    void *dummy10;
    void *dummy11;
    void *dummy12;
    void *dummy13;
    void *dummy14;
} Tcl_CallFrame;

/*
 *----------------------------------------------------------------------------
 * Information about commands that is returned by Tcl_GetCommandInfo and
 * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based command
 * function while proc is a traditional Tcl argc/argv string-based function.

Changes to generic/tclBasic.c.

857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
...
890
891
892
893
894
895
896

897
898
899
900
901
902
903
....
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
....
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
....
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
....
2425
2426
2427
2428
2429
2430
2431

2432
2433
2434
2435
2436
2437
2438
....
2623
2624
2625
2626
2627
2628
2629

2630
2631
2632
2633
2634
2635
2636
....
2670
2671
2672
2673
2674
2675
2676

2677
2678
2679
2680
2681
2682
2683
....
2955
2956
2957
2958
2959
2960
2961

2962
2963



2964
2965
2966
2967
2968
2969
2970
....
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
....
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
....
3527
3528
3529
3530
3531
3532
3533

3534
3535
3536
3537
3538
3539
3540
....
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530

4531
4532
4533
4534
4535
4536
4537
....
4566
4567
4568
4569
4570
4571
4572

4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583

4584
4585
4586
4587
4588
4589
4590
....
4599
4600
4601
4602
4603
4604
4605
4606

4607
4608
4609
4610
4611
4612

4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
....
4664
4665
4666
4667
4668
4669
4670







4671
4672
4673
4674
4675
4676
4677
4678
....
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
....
5012
5013
5014
5015
5016
5017
5018


5019
5020
5021
5022
5023
5024
5025
....
5033
5034
5035
5036
5037
5038
5039

5040
5041
5042
5043
5044
5045
5046
....
8611
8612
8613
8614
8615
8616
8617

8618

8619
8620
8621
8622
8623
8624
8625
....
8630
8631
8632
8633
8634
8635
8636



8637
8638
8639
8640
8641
8642
8643
....
8674
8675
8676
8677
8678
8679
8680
8681


8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
8696
8697
8698
8699
8700
8701
8702
8703
8704
8705
8706
8707
8708
8709
8710
....
8718
8719
8720
8721
8722
8723
8724
8725
8726
8727
8728
8729
8730
8731
8732
8733
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744
8745
8746
8747
8748
8749
8750
8751
8752


8753

8754
8755
8756
8757
8758
8759
8760
8761
....
8845
8846
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
8869
8870
8871
8872
8873
8874
8875
8876
8877
8878
8879
8880
8881
8882
8883
8884
8885
8886
8887
8888
8889
8890
8891
8892
8893
8894
8895
8896
8897
8898
....
8999
9000
9001
9002
9003
9004
9005


9006
9007
9008
9009
9010
9011
9012
....
9373
9374
9375
9376
9377
9378
9379

9380
9381
9382
9383
9384
9385
9386
    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;
................................................................................

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;

	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;
	    cmdPtr->objProc = cmdInfoPtr->objProc;
	    cmdPtr->objClientData = NULL;
................................................................................
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
    TclpSetVariables(interp);

#if TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
     * introspect on the interpreter level of thread safety.
     */

................................................................................
     *
     * Dismantle the namespace after freeing the iPtr->handle so that each
     * bytecode releases its literals without caring to update the literal
     * table, as it will be freed later in this function without further use.
     */

    TclHandleFree(iPtr->handle);
    TclTeardownNamespace(iPtr->globalNsPtr);

    /*
     * Delete all the hidden commands.
     */

    hTablePtr = iPtr->hiddenCmdTablePtr;
    if (hTablePtr != NULL) {
................................................................................
	    }
	    ckfree(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    ckfree(iPtr->rootFramePtr);
    iPtr->rootFramePtr = NULL;
    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
................................................................................
	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;

    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;
    cmdPtr->objClientData = cmdPtr;
    cmdPtr->proc = proc;
    cmdPtr->clientData = clientData;
................................................................................
	/*
         * Make sure namespace doesn't get deallocated.
         */

	cmdPtr->nsPtr->refCount++;

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);

	nsPtr = (Namespace *) TclEnsureNamespace(interp,
                (Tcl_Namespace *) cmdPtr->nsPtr);
	TclNsDecrRefCount(cmdPtr->nsPtr);

	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
	    oldRefPtr = cmdPtr->importRefPtr;
	    cmdPtr->importRefPtr = NULL;
................................................................................
	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;

    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
    cmdPtr->objClientData = clientData;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
................................................................................
     * way it was and report the error.
     */

    result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
    if (result != TCL_OK) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = oldHPtr;

	cmdPtr->nsPtr = cmdNsPtr;
	goto done;



    }

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough. These might refer to the same variable,
     * but that's no big deal.
................................................................................
    cmdPtr->flags |= CMD_IS_DELETED;

    /*
     * Call trace functions for the command being deleted. Then delete its
     * traces.
     */

    cmdPtr->nsPtr->refCount++;

    if (cmdPtr->tracePtr != NULL) {
	CommandTrace *tracePtr;
	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

	/*
	 * Now delete these traces.
	 */
................................................................................
    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
    TclNsDecrRefCount(cmdPtr->nsPtr);

    /*
     * If the command being deleted has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-deleted command.
     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
................................................................................
     * from a CmdName Tcl object in some ByteCode code sequence. In that case,
     * delay the cleanup until all references are either discarded (when a
     * ByteCode is freed) or replaced by a new reference (when a cached
     * CmdName Command reference is found to be invalid and
     * TclNRExecuteByteCode looks up the command in the command hashtable).
     */


    TclCleanupCommandMacro(cmdPtr);
    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    return TCL_OK;
}

static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Command *cmdPtr = NULL, *preCmdPtr = data[0];
    int flags = PTR2INT(data[1]);
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
    Interp *iPtr = (Interp *) interp;
    Namespace *lookupNsPtr = NULL;
    int enterTracesDone = 0;


    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).
     */

    if (!(flags & TCL_EVAL_NOERR)) {
................................................................................
	 * TODO: Is that a bug?
	 */

	lookupNsPtr = iPtr->lookupNsPtr;
	iPtr->lookupNsPtr = NULL;
    } else if (flags & TCL_EVAL_INVOKE) {
	lookupNsPtr = iPtr->globalNsPtr;

    } else {

	/*
	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
	 */

	TclResetRewriteEnsemble(interp, 1);

	if (flags & TCL_EVAL_GLOBAL) {
	    TEOV_SwitchVarFrame(interp);
	    lookupNsPtr = iPtr->globalNsPtr;

	}
    }

    /*
     * Lookup the Command to dispatch.
     */

................................................................................
	    /*
	     * When it's been deleted, and we're told not to attempt
	     * resolving it ourselves, all we can do is raise an error.
	     */
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to invoke a deleted command"));
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
	    return TCL_ERROR;

	}
    }
    if (cmdPtr == NULL) {
	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
	if (!cmdPtr) {
	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);

	}
    }

    if (enterTracesDone || iPtr->tracePtr
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {

	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
		objc, objv);
	Tcl_IncrRefCount(commandPtr);

	if (!enterTracesDone) {

	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
		    objc, objv);

	    /*
	     * Send any exception from enter traces back as an exception
	     * raised by the traced command.
	     * TODO: Is this a bug?  Letting an execution trace BREAK or
	     * CONTINUE or RETURN in the place of the traced command?
	     * Would either converting all exceptions to TCL_ERROR, or
	     * just swallowing them be better?  (Swallowing them has the
	     * problem of permanently hiding program errors.)
	     */

	    if (code != TCL_OK) {
		Tcl_DecrRefCount(commandPtr);
		return code;
	    }

	    /*
	     * If the enter traces made the resolved cmdPtr unusable, go
	     * back and resolve again, but next time don't run enter
	     * traces again.
	     */
................................................................................
	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
		    commandPtr, cmdPtr, objv);
    }

    TclNRAddCallback(interp, Dispatch,
	    cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
	    cmdPtr->objClientData, INT2PTR(objc), objv);







    return TCL_OK;
}

static int
Dispatch(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
................................................................................
    iPtr->numLevels--;

     /*
      * If there is a tailcall, schedule it next
      */

    if (data[1] && (data[1] != INT2PTR(1))) {
        TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
    }

    /* OPT ??
     * Do not interrupt a series of cleanups with async or limit checks:
     * just check at the end?
     */

................................................................................
	TclStackFree(interp, newObjv);
	return TCL_ERROR;
    }

    if (lookupNsPtr) {
	savedNsPtr = varFramePtr->nsPtr;
	varFramePtr->nsPtr = lookupNsPtr;


    }
    TclSkipTailcall(interp);
    TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
	    newObjv, savedNsPtr, NULL);
    return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
}

................................................................................
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];
    Namespace *savedNsPtr = data[2];

    int i;

    if (savedNsPtr) {

	iPtr->varFramePtr->nsPtr = savedNsPtr;
    }

    /*
     * Release any resources we locked and allocated during the handler call.
     */

................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclSetTailcall(
    Tcl_Interp *interp,

    Tcl_Obj *listPtr)

{
    /*
     * Find the splicing spot: right before the NRCommand of the thing
     * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
     * (used by command redirectors).
     */

................................................................................
            break;
        }
    }
    if (!runPtr) {
        Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
    }
    runPtr->data[1] = listPtr;



}
 
/*
 *----------------------------------------------------------------------
 *
 * TclNRTailcallObjCmd --
 *
................................................................................
    }

    /*
     * Invocation without args just clears a scheduled tailcall; invocation
     * with an argument replaces any previously scheduled tailcall.
     */

    if (iPtr->varFramePtr->tailcallPtr) {


        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
        iPtr->varFramePtr->tailcallPtr = NULL;
    }

    /*
     * Create the callback to actually evaluate the tailcalled
     * command, then set it in the varFrame so that PopCallFrame can use it
     * at the proper time.
     */

    if (objc > 1) {
        Tcl_Obj *listPtr, *nsObjPtr;
        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;

        /* The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled. */

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
    return TCL_RETURN;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
int
TclNRTailcallEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    int objc;
    Tcl_Obj **objv;

    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
    nsObjPtr = objv[0];

    if (result == TCL_OK) {
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    }

    if (result != TCL_OK) {
        /*
         * Tailcall execution was preempted, eg by an intervening catch or by
         * a now-gone namespace: cleanup and return.
         */

	Tcl_DecrRefCount(listPtr);
        return result;
    }

    /*
     * Perform the tailcall
     */

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);


    iPtr->lookupNsPtr = (Namespace *) nsPtr;

    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}

int
TclNRReleaseValues(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
................................................................................
int
TclNRYieldToObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    Tcl_Obj *listPtr, *nsObjPtr;
    Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yieldto can only be called in a coroutine", -1));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    if (((Namespace *) nsPtr)->flags & NS_DYING) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"yieldto called in deleted namespace", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
		NULL);
        return TCL_ERROR;
    }

    /*
     * Add the tailcall in the caller env, then just yield.
     *
     * This is essentially code from TclNRTailcallObjCmd
     */

    listPtr = Tcl_NewListObj(objc, objv);
    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    TclSetTailcall(interp, listPtr);
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}
 
static int
RewindCoroutineCallback(
................................................................................
    NRE_ASSERT(TOP_CB(interp) == NULL);
    NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
    NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback));

    cmdPtr->deleteProc = NULL;
    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);


    TclCleanupCommandMacro(cmdPtr);

    corPtr->eePtr->corPtr = NULL;
    TclDeleteExecEnv(corPtr->eePtr);
    corPtr->eePtr = NULL;

    corPtr->stackLevel = NULL;
................................................................................
    iPtr->execEnvPtr = corPtr->eePtr;

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

    /* ensure that the command is looked up in the correct namespace */
    iPtr->lookupNsPtr = lookupNsPtr;

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

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;







|







 







>







 







|







 







|







 







<
<
<
<
<






<







 







>







 







>







 







>







 







>


>
>
>







 







<
<







 







<







 







>







 







|








>







 







>











>







 







|
>





|
>













|












|

|







 







>
>
>
>
>
>
>
|







 







|







 







>
>







 







>







 







>
|
>







 







>
>
>







 







|
>
>
|
|




|




|
|
<
<
<
<
<
<
<
<
|







 







|
|




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







>
>

>
|







 







|
|
|













<
<
<
<
<
<
<
<





<
|
<
<






|







 







>
>







 







>







857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
...
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
....
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
....
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
....
1760
1761
1762
1763
1764
1765
1766





1767
1768
1769
1770
1771
1772

1773
1774
1775
1776
1777
1778
1779
....
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
....
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
....
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
....
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
....
3415
3416
3417
3418
3419
3420
3421


3422
3423
3424
3425
3426
3427
3428
....
3442
3443
3444
3445
3446
3447
3448

3449
3450
3451
3452
3453
3454
3455
....
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
....
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
....
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
....
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
....
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
....
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
....
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
....
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
....
8626
8627
8628
8629
8630
8631
8632
8633
8634
8635
8636
8637
8638
8639
8640
8641
8642
....
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663
....
8694
8695
8696
8697
8698
8699
8700
8701
8702
8703
8704
8705
8706
8707
8708
8709
8710
8711
8712
8713
8714
8715
8716








8717
8718
8719
8720
8721
8722
8723
8724
....
8732
8733
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744















8745
8746
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
....
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
8869








8870
8871
8872
8873
8874

8875


8876
8877
8878
8879
8880
8881
8882
8883
8884
8885
8886
8887
8888
8889
....
8990
8991
8992
8993
8994
8995
8996
8997
8998
8999
9000
9001
9002
9003
9004
9005
....
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;
................................................................................

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    iPtr->globalNsPtr->refCount++;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;
	    cmdPtr->objProc = cmdInfoPtr->objProc;
	    cmdPtr->objClientData = NULL;
................................................................................
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
    TclpSetVariables(interp);

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
     * introspect on the interpreter level of thread safety.
     */

................................................................................
     *
     * Dismantle the namespace after freeing the iPtr->handle so that each
     * bytecode releases its literals without caring to update the literal
     * table, as it will be freed later in this function without further use.
     */

    TclHandleFree(iPtr->handle);
    Tcl_DeleteNamespace((Tcl_Namespace *)iPtr->globalNsPtr);

    /*
     * Delete all the hidden commands.
     */

    hTablePtr = iPtr->hiddenCmdTablePtr;
    if (hTablePtr != NULL) {
................................................................................
	    }
	    ckfree(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }






    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    ckfree(iPtr->rootFramePtr);
    iPtr->rootFramePtr = NULL;


    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
................................................................................
	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    nsPtr->refCount++;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;
    cmdPtr->objClientData = cmdPtr;
    cmdPtr->proc = proc;
    cmdPtr->clientData = clientData;
................................................................................
	/*
         * Make sure namespace doesn't get deallocated.
         */

	cmdPtr->nsPtr->refCount++;

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);

	nsPtr = (Namespace *) TclEnsureNamespace(interp,
                (Tcl_Namespace *) cmdPtr->nsPtr);
	TclNsDecrRefCount(cmdPtr->nsPtr);

	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
	    oldRefPtr = cmdPtr->importRefPtr;
	    cmdPtr->importRefPtr = NULL;
................................................................................
	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    nsPtr->refCount++;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
    cmdPtr->objClientData = clientData;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
................................................................................
     * way it was and report the error.
     */

    result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
    if (result != TCL_OK) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = oldHPtr;
	/* reference count was already incremented above */
	cmdPtr->nsPtr = cmdNsPtr;
	goto done;
    } else {
	cmdPtr->nsPtr->refCount++;
	TclNsDecrRefCount(cmdNsPtr);
    }

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough. These might refer to the same variable,
     * but that's no big deal.
................................................................................
    cmdPtr->flags |= CMD_IS_DELETED;

    /*
     * Call trace functions for the command being deleted. Then delete its
     * traces.
     */



    if (cmdPtr->tracePtr != NULL) {
	CommandTrace *tracePtr;
	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

	/*
	 * Now delete these traces.
	 */
................................................................................
    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);


    /*
     * If the command being deleted has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-deleted command.
     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
................................................................................
     * from a CmdName Tcl object in some ByteCode code sequence. In that case,
     * delay the cleanup until all references are either discarded (when a
     * ByteCode is freed) or replaced by a new reference (when a cached
     * CmdName Command reference is found to be invalid and
     * TclNRExecuteByteCode looks up the command in the command hashtable).
     */

    TclNsDecrRefCount(cmdPtr->nsPtr);
    TclCleanupCommandMacro(cmdPtr);
    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    return TCL_OK;
}

static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)		    /* ignored */
{
    Command *cmdPtr = NULL, *preCmdPtr = data[0];
    int flags = PTR2INT(data[1]);
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
    Interp *iPtr = (Interp *) interp;
    Namespace *lookupNsPtr = NULL;
    int enterTracesDone = 0;
    result = TCL_OK;

    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).
     */

    if (!(flags & TCL_EVAL_NOERR)) {
................................................................................
	 * TODO: Is that a bug?
	 */

	lookupNsPtr = iPtr->lookupNsPtr;
	iPtr->lookupNsPtr = NULL;
    } else if (flags & TCL_EVAL_INVOKE) {
	lookupNsPtr = iPtr->globalNsPtr;
	lookupNsPtr->refCount++;
    } else {

	/*
	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
	 */

	TclResetRewriteEnsemble(interp, 1);

	if (flags & TCL_EVAL_GLOBAL) {
	    TEOV_SwitchVarFrame(interp);
	    lookupNsPtr = iPtr->globalNsPtr;
	    lookupNsPtr->refCount++;
	}
    }

    /*
     * Lookup the Command to dispatch.
     */

................................................................................
	    /*
	     * When it's been deleted, and we're told not to attempt
	     * resolving it ourselves, all we can do is raise an error.
	     */
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to invoke a deleted command"));
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
    }
    if (cmdPtr == NULL) {
	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
	if (!cmdPtr) {
	    result = TEOV_NotFound(interp, objc, objv, lookupNsPtr);
	    goto cleanup;
	}
    }

    if (enterTracesDone || iPtr->tracePtr
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {

	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
		objc, objv);
	Tcl_IncrRefCount(commandPtr);

	if (!enterTracesDone) {

	    result = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
		    objc, objv);

	    /*
	     * Send any exception from enter traces back as an exception
	     * raised by the traced command.
	     * TODO: Is this a bug?  Letting an execution trace BREAK or
	     * CONTINUE or RETURN in the place of the traced command?
	     * Would either converting all exceptions to TCL_ERROR, or
	     * just swallowing them be better?  (Swallowing them has the
	     * problem of permanently hiding program errors.)
	     */

	    if (result != TCL_OK) {
		Tcl_DecrRefCount(commandPtr);
		goto cleanup;
	    }

	    /*
	     * If the enter traces made the resolved cmdPtr unusable, go
	     * back and resolve again, but next time don't run enter
	     * traces again.
	     */
................................................................................
	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
		    commandPtr, cmdPtr, objv);
    }

    TclNRAddCallback(interp, Dispatch,
	    cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
	    cmdPtr->objClientData, INT2PTR(objc), objv);

cleanup:

    if (lookupNsPtr) {
	TclNsDecrRefCount(lookupNsPtr);
    }

    return result;
}

static int
Dispatch(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
................................................................................
    iPtr->numLevels--;

     /*
      * If there is a tailcall, schedule it next
      */

    if (data[1] && (data[1] != INT2PTR(1))) {
        TclNRAddCallback(interp, TclNRTailcallEval, data[1], data[2], NULL, NULL);
    }

    /* OPT ??
     * Do not interrupt a series of cleanups with async or limit checks:
     * just check at the end?
     */

................................................................................
	TclStackFree(interp, newObjv);
	return TCL_ERROR;
    }

    if (lookupNsPtr) {
	savedNsPtr = varFramePtr->nsPtr;
	varFramePtr->nsPtr = lookupNsPtr;
	/* Corresponding TclNsDecrRefCount is in TEOV_NotFoundCallback. */
	varFramePtr->nsPtr->refCount++;
    }
    TclSkipTailcall(interp);
    TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
	    newObjv, savedNsPtr, NULL);
    return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
}

................................................................................
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];
    Namespace *savedNsPtr = data[2];

    int i;

    if (savedNsPtr) {
	TclNsDecrRefCount(iPtr->varFramePtr->nsPtr);
	iPtr->varFramePtr->nsPtr = savedNsPtr;
    }

    /*
     * Release any resources we locked and allocated during the handler call.
     */

................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclSetTailcall(
    Tcl_Interp *interp,
    Namespace *nsPtr,
    Tcl_Obj *listPtr
    )
{
    /*
     * Find the splicing spot: right before the NRCommand of the thing
     * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
     * (used by command redirectors).
     */

................................................................................
            break;
        }
    }
    if (!runPtr) {
        Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
    }
    runPtr->data[1] = listPtr;
    runPtr->data[2] = nsPtr;
    /* Corresponding TclNsDecrRefCount is in EvalObjvCore */
    nsPtr->refCount++;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclNRTailcallObjCmd --
 *
................................................................................
    }

    /*
     * Invocation without args just clears a scheduled tailcall; invocation
     * with an argument replaces any previously scheduled tailcall.
     */

    if (iPtr->varFramePtr->tailcallNsPtr) {
        TclNsDecrRefCount(iPtr->varFramePtr->tailcallNsPtr);
        iPtr->varFramePtr->tailcallNsPtr = NULL;
        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallCmdPtr);
        iPtr->varFramePtr->tailcallCmdPtr = NULL;
    }

    /*
     * Create the callback to actually evaluate the tailcalled
     * command, then set it in the varFrame so that Tcl_PopCallFrame can use it
     * at the proper time.
     */

    if (objc > 1) {
        iPtr->varFramePtr->tailcallNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->tailcallNsPtr->refCount++;








        iPtr->varFramePtr->tailcallCmdPtr = Tcl_NewListObj(objc-1, objv+1);
    }
    return TCL_RETURN;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
int
TclNRTailcallEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = data[0];
    Tcl_Namespace *nsPtr = data[1];
    int objc;
    Tcl_Obj **objv;

    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
















    /*
     * Perform the tailcall
     */

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);

    /* Reference count already incremented in TclSetTailcall. */
    iPtr->lookupNsPtr = (Namespace *) nsPtr;

    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}

int
TclNRReleaseValues(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
................................................................................
int
TclNRYieldToObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *listPtr;
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    Namespace *nsPtr = (Namespace *)TclGetCurrentNamespace(interp);

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yieldto can only be called in a coroutine", -1));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }









    /*
     * Add the tailcall in the caller env, then just yield.
     *
     * This is essentially code from TclNRTailcallObjCmd
     */

    listPtr = Tcl_NewListObj(objc-1, objv+1);



    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    TclSetTailcall(interp, nsPtr, listPtr);
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}
 
static int
RewindCoroutineCallback(
................................................................................
    NRE_ASSERT(TOP_CB(interp) == NULL);
    NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
    NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback));

    cmdPtr->deleteProc = NULL;
    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);

    /* Corresponding cmdPtr->refCount ++ is in TclNRCoroutineObjCmd */ 
    TclCleanupCommandMacro(cmdPtr);

    corPtr->eePtr->corPtr = NULL;
    TclDeleteExecEnv(corPtr->eePtr);
    corPtr->eePtr = NULL;

    corPtr->stackLevel = NULL;
................................................................................
    iPtr->execEnvPtr = corPtr->eePtr;

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

    /* ensure that the command is looked up in the correct namespace */
    iPtr->lookupNsPtr = lookupNsPtr;
    lookupNsPtr->refCount++;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
    iPtr->numLevels--;

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;

Changes to generic/tclCompCmdsSZ.c.

2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
....
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
    int i;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
	    || envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /* make room for the nsObjPtr */
    /* TODO: Doesn't this have to be a known value? */
    CompileWord(envPtr, tokenPtr, interp, 0);
    for (i=1 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords,	envPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileThrowCmd --
................................................................................
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    int i;

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }

    OP(		NS_CURRENT);
    for (i = 1 ; i < parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    OP4(	LIST, i);
    OP(		YIELD_TO_INVOKE);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *






<
<
<




|







 







<




|







2614
2615
2616
2617
2618
2619
2620



2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
....
3930
3931
3932
3933
3934
3935
3936

3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
    int i;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
	    || envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }




    for (i=1 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords - 1,	envPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileThrowCmd --
................................................................................
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    int i;

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }


    for (i = 1 ; i < parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    OP4(	LIST, i-1);
    OP(		YIELD_TO_INVOKE);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclCompile.c.

1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
....
2802
2803
2804
2805
2806
2807
2808

2809
2810
2811
2812
2813
2814
2815
    }

    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);

    ckfree(codePtr);
}
 
/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
................................................................................
    }

    p = ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;

    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);
    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
    } else {
	codePtr->flags = 0;






>







 







>







1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
....
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
    }

    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    TclNsDecrRefCount(codePtr->nsPtr);
    ckfree(codePtr);
}
 
/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
................................................................................
    }

    p = ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsPtr->refCount++;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);
    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
    } else {
	codePtr->flags = 0;

Changes to generic/tclEnsemble.c.

146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
....
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
....
1907
1908
1909
1910
1911
1912
1913

1914
1915
1916
1917
1918
1919
1920
	    *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
    Tcl_Command token;
    Tcl_DictSearch search;
    Tcl_Obj *listObj;
    const char *simpleName;
    int index, done;

    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tried to manipulate ensemble of deleted namespace",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
................................................................................
	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DYING) {
	/*
	 * Don't know how we got here, but make things give up quickly.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "ensemble activated for deleted namespace", -1));
................................................................................
	/*
	 * Hand off to the target command.
	 */

	TclSkipTailcall(interp);
	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;

	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered






|







 







|







 







>







146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
....
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
....
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
	    *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
    Tcl_Command token;
    Tcl_DictSearch search;
    Tcl_Obj *listObj;
    const char *simpleName;
    int index, done;

    if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tried to manipulate ensemble of deleted namespace",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
................................................................................
	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DEAD) {
	/*
	 * Don't know how we got here, but make things give up quickly.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "ensemble activated for deleted namespace", -1));
................................................................................
	/*
	 * Hand off to the target command.
	 */

	TclSkipTailcall(interp);
	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
	ensemblePtr->nsPtr->refCount++;
	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered

Changes to generic/tclExecute.c.

2391
2392
2393
2394
2395
2396
2397
2398

2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
....
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449

2450
2451
2452
2453
2454
2455
2456
....
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
....
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510

2511


2512
2513
2514
2515
2516
2517
2518
2519
	    fflush(stdout);
	}
#endif
	yieldParameter = 0;
	Tcl_SetObjResult(interp, OBJ_AT_TOS);
	goto doYield;

    case INST_YIELD_TO_INVOKE:

	corPtr = iPtr->execEnvPtr->corPtr;
	valuePtr = OBJ_AT_TOS;
	if (!corPtr) {
	    TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
		    O2S(valuePtr)));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yieldto can only be called in a coroutine", -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
		    NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
		    O2S(valuePtr)));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yieldto called in deleted namespace", -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
		    NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
................................................................................
	 * Install a tailcall record in the caller and continue with the
	 * yield. The yield is switched into multi-return mode (via the
	 * 'yieldParameter').
	 */

	Tcl_IncrRefCount(valuePtr);
	iPtr->execEnvPtr = corPtr->callerEEPtr;
	TclSetTailcall(interp, valuePtr);
	iPtr->execEnvPtr = corPtr->eePtr;
	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/


    doYield:
	/* TIP #280: Record the last piece of info needed by
	 * 'TclGetSrcInfoForPc', and push the frame.
	 */

	bcFramePtr->data.tebc.pc = (char *) pc;
	iPtr->cmdFramePtr = bcFramePtr;
................................................................................
	TEBC_YIELD();
	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
		INT2PTR(yieldParameter), NULL, NULL);
	return TCL_OK;
    }

    case INST_TAILCALL: {
	Tcl_Obj *listPtr, *nsObjPtr;

	opnd = TclGetUInt1AtPtr(pc+1);

	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tailcall can only be called from a proc or lambda", -1));
................................................................................

	/*
	 * Push the evaluation of the called command into the NR callback
	 * stack.
	 */

	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
	if (iPtr->varFramePtr->tailcallPtr) {
	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);

	}


	iPtr->varFramePtr->tailcallPtr = listPtr;

	result = TCL_RETURN;
	cleanup = opnd;
	goto processExceptionReturn;
    }

    case INST_DONE:






|
>










<
<
<
<
<
<
<
<
<
<
<







 







|



>







 







|







 







|
|
|
|
>

>
>
|







2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409











2410
2411
2412
2413
2414
2415
2416
....
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
....
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
....
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
	    fflush(stdout);
	}
#endif
	yieldParameter = 0;
	Tcl_SetObjResult(interp, OBJ_AT_TOS);
	goto doYield;

    case INST_YIELD_TO_INVOKE: {
	Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
	corPtr = iPtr->execEnvPtr->corPtr;
	valuePtr = OBJ_AT_TOS;
	if (!corPtr) {
	    TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
		    O2S(valuePtr)));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yieldto can only be called in a coroutine", -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
		    NULL);











	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
................................................................................
	 * Install a tailcall record in the caller and continue with the
	 * yield. The yield is switched into multi-return mode (via the
	 * 'yieldParameter').
	 */

	Tcl_IncrRefCount(valuePtr);
	iPtr->execEnvPtr = corPtr->callerEEPtr;
	TclSetTailcall(interp, currNsPtr, valuePtr);
	iPtr->execEnvPtr = corPtr->eePtr;
	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/

    }
    doYield:
	/* TIP #280: Record the last piece of info needed by
	 * 'TclGetSrcInfoForPc', and push the frame.
	 */

	bcFramePtr->data.tebc.pc = (char *) pc;
	iPtr->cmdFramePtr = bcFramePtr;
................................................................................
	TEBC_YIELD();
	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
		INT2PTR(yieldParameter), NULL, NULL);
	return TCL_OK;
    }

    case INST_TAILCALL: {
	Tcl_Obj *listPtr;

	opnd = TclGetUInt1AtPtr(pc+1);

	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tailcall can only be called from a proc or lambda", -1));
................................................................................

	/*
	 * Push the evaluation of the called command into the NR callback
	 * stack.
	 */

	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	if (iPtr->varFramePtr->tailcallNsPtr) {
	    TclNsDecrRefCount(iPtr->varFramePtr->tailcallNsPtr);
	    iPtr->varFramePtr->tailcallNsPtr = NULL;
	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallCmdPtr);
	    iPtr->varFramePtr->tailcallCmdPtr = NULL;
	}
	iPtr->varFramePtr->tailcallNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->tailcallNsPtr->refCount++;
	iPtr->varFramePtr->tailcallCmdPtr = listPtr;

	result = TCL_RETURN;
	cleanup = opnd;
	goto processExceptionReturn;
    }

    case INST_DONE:

Changes to generic/tclInt.h.

290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
....
1152
1153
1154
1155
1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1166
....
2825
2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836
2837
2838
2839
....
4829
4830
4831
4832
4833
4834
4835
4836


4837
4838
4839
4840
4841
4842
4843
				 * NULL, there are no children. */
#endif
    unsigned long nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;		/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    int activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
				 * freed until activationCount becomes zero. */
    unsigned int refCount;	/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently
				 * registered in the namespace. Indexed by
				 * strings; values have type (Command *).
				 * Commands imported by Tcl_Import have
................................................................................
 *		namespace and no call frames still refer to it. Its variables
 *		and command have already been destroyed. This bit allows the
 *		namespace resolution code to recognize that the namespace is
 *		"deleted". When the last namespaceName object in any byte code
 *		unit that refers to the namespace has been freed (i.e., when
 *		the namespace's refCount is 0), the namespace's storage will
 *		be freed.
 * NS_KILLED -	1 means that TclTeardownNamespace has already been called on
 *		this namespace and it should not be called again [Bug 1355942]
 * NS_SUPPRESS_COMPILATION -
 *		Marks the commands in this namespace for not being compiled,
 *		forcing them to be looked up every time.
 */

#define NS_DYING	0x01
#define NS_DEAD		0x02
#define NS_KILLED	0x04
#define NS_SUPPRESS_COMPILATION	0x08

................................................................................
				 * sets it, and it should only ever be set by
				 * the code that is pushing the frame. In that
				 * case, the code that sets it should also
				 * have some means of discovering what the
				 * meaning of the value is, which we do not
				 * specify. */
    LocalCache *localCachePtr;

    Tcl_Obj    *tailcallPtr;
				/* NULL if no tailcall is scheduled */
} CallFrame;

#define FRAME_IS_PROC	0x1
#define FRAME_IS_LAMBDA 0x2
#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
				 * clientData field contains a CallContext
................................................................................
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;

MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);

MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);

/* These two can be considered for the public api */
MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);

/*
................................................................................

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

#define TclGetCurrentNamespace(interp) \
    (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr



#define TclGetGlobalNamespace(interp) \
    (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr

/*
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in






<
<
<
<







 







|
|
|
|
|







 







>
|







 







|
>







 







|
>
>







290
291
292
293
294
295
296




297
298
299
300
301
302
303
...
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
....
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
....
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
....
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
				 * NULL, there are no children. */
#endif
    unsigned long nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;		/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */




    unsigned int refCount;	/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently
				 * registered in the namespace. Indexed by
				 * strings; values have type (Command *).
				 * Commands imported by Tcl_Import have
................................................................................
 *		namespace and no call frames still refer to it. Its variables
 *		and command have already been destroyed. This bit allows the
 *		namespace resolution code to recognize that the namespace is
 *		"deleted". When the last namespaceName object in any byte code
 *		unit that refers to the namespace has been freed (i.e., when
 *		the namespace's refCount is 0), the namespace's storage will
 *		be freed.
 * NS_KILLED -	Obsolete. Previously, 1 meant that TclTeardownNamespace has
 *		already been called on this namespace and it should not be
 *		called again [Bug 1355942] NS_SUPPRESS_COMPILATION - Marks the
 *		commands in this namespace for not being compiled, forcing them
 *		to be looked up every time.
 */

#define NS_DYING	0x01
#define NS_DEAD		0x02
#define NS_KILLED	0x04
#define NS_SUPPRESS_COMPILATION	0x08

................................................................................
				 * sets it, and it should only ever be set by
				 * the code that is pushing the frame. In that
				 * case, the code that sets it should also
				 * have some means of discovering what the
				 * meaning of the value is, which we do not
				 * specify. */
    LocalCache *localCachePtr;
    Namespace * tailcallNsPtr;
    Tcl_Obj *tailcallCmdPtr;
				/* NULL if no tailcall is scheduled */
} CallFrame;

#define FRAME_IS_PROC	0x1
#define FRAME_IS_LAMBDA 0x2
#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
				 * clientData field contains a CallContext
................................................................................
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;

MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Namespace *nsPtr,
			    Tcl_Obj *listPtr);
MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);

/* These two can be considered for the public api */
MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);

/*
................................................................................

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

#define TclGetCurrentNamespace(interp) \
    (Tcl_Namespace *) ((((Interp *)(interp))->varFramePtr->nsPtr->flags & NS_DEAD) \
	? ((Interp *) (interp))->globalNsPtr \
	: ((Interp *) (interp))->varFramePtr->nsPtr)

#define TclGetGlobalNamespace(interp) \
    (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr

/*
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in

Changes to generic/tclNamesp.c.

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
...
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
...
403
404
405
406
407
408
409
410
411
412
413
414

415
416
417
418
419
420
421
422
423
424



425
426
427
428
429
430
431
...
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
...
901
902
903
904
905
906
907

908
909
910
911
912
913
914
915
916
917
918
919

920
921
922
923
924
925
926
...
929
930
931
932
933
934
935
936
937
938
939
940


941




















942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967










968
969






























































































970
971
972
973
974

975
976
977
978
979


980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018

1019
1020


1021
1022
1023
1024
1025
1026
1027
1028
1029



1030
1031


1032
1033











1034
1035
1036
1037
1038



1039
1040
1041

1042








1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
....
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
....
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268

1269
1270
1271
1272
1273
1274
1275
....
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
....
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
....
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
....
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
....
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
....
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
....
2667
2668
2669
2670
2671
2672
2673
2674
2675


2676
2677
2678
2679
2680
2681
2682

2683
2684
2685
2686
2687
2688
2689
....
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
....
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
....
4698
4699
4700
4701
4702
4703
4704



4705
4706
4707
4708
4709
4710
4711
....
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803

4804
4805
4806
4807

4808
4809
4810
4811
4812
4813
4814
    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else {
	nsPtr = (Namespace *) namespacePtr;

	/*
	 * TODO: Examine whether it would be better to guard based on NS_DYING
	 * or NS_KILLED. It appears that these are not tested because they can
	 * be set in a global interp that has been [namespace delete]d, but
	 * which never really completely goes away because of lingering global
	 * things like ::errorInfo and [::unknown] and hidden commands.
	 * Review of those designs might permit stricter checking here.
	 */

	if (nsPtr->flags & NS_DEAD) {
	    Tcl_Panic("Trying to push call frame for dead namespace");
	    /*NOTREACHED*/
	}
    }

    nsPtr->activationCount++;
    framePtr->nsPtr = nsPtr;
    framePtr->isProcCallFrame = isProcCallFrame;
    framePtr->objc = 0;
    framePtr->objv = NULL;
    framePtr->callerPtr = iPtr->framePtr;
    framePtr->callerVarPtr = iPtr->varFramePtr;
    if (iPtr->varFramePtr != NULL) {
................................................................................
    }
    framePtr->procPtr = NULL;		/* no called procedure */
    framePtr->varTablePtr = NULL;	/* and no local variables */
    framePtr->numCompiledLocals = 0;
    framePtr->compiledLocals = NULL;
    framePtr->clientData = NULL;
    framePtr->localCachePtr = NULL;
    framePtr->tailcallPtr = NULL;


    /*
     * Push the new call frame onto the interpreter's stack of procedure call
     * frames making it the current frame.
     */

    iPtr->framePtr = framePtr;
................................................................................

void
Tcl_PopCallFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
{
    register Interp *iPtr = (Interp *) interp;
    register CallFrame *framePtr = iPtr->framePtr;
    Namespace *nsPtr;

    /*
     * It's important to remove the call frame from the interpreter's stack of
     * call frames before deleting local variables, so that traces invoked by
     * the variable deletion don't see the partially-deleted frame.
     */

................................................................................
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */


    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);



    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclPushStackFrame --
................................................................................
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
#else
    nsPtr->childTablePtr = NULL;
#endif
    nsPtr->nsId = ++(tsdPtr->numNsCreated);
    nsPtr->interp = interp;
    nsPtr->flags = 0;
    nsPtr->activationCount = 0;
    nsPtr->refCount = 0;
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
    nsPtr->exportArrayPtr = NULL;
    nsPtr->numExportPatterns = 0;
    nsPtr->maxExportPatterns = 0;
    nsPtr->cmdRefEpoch = 0;
    nsPtr->resolverEpoch = 0;
................................................................................
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteNamespace(
    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
{

    register Namespace *nsPtr = (Namespace *) namespacePtr;
    Interp *iPtr = (Interp *) nsPtr->interp;
    Namespace *globalNsPtr = (Namespace *)
	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Command *cmdPtr;

    /*
     * Ensure that this namespace doesn't get deallocated in the meantime.
     */
    nsPtr->refCount++;


    /*
     * Give anyone interested - notably TclOO - a chance to use this namespace
     * normally despite the fact that the namespace is going to go. Allows the
     * calling of destructors. Will only be called once (unless re-established
     * by the called function). [Bug 2950259]
     *
................................................................................
     * being careful with reentrancy.
     */

    if (nsPtr->earlyDeleteProc != NULL) {
	Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc;

	nsPtr->earlyDeleteProc = NULL;
	nsPtr->activationCount++;
	earlyDeleteProc(nsPtr->clientData);
	nsPtr->activationCount--;
    }



    /*




















     * Delete all coroutine commands now: break the circular ref cycle between
     * the namespace and the coroutine command [Bug 2724403]. This code is
     * essentially duplicated in TclTeardownNamespace() for all other
     * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
     *
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == TclNRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}
    }

    /*
     * If the namespace has associated ensemble commands, delete them first.
     * This leaves the actual contents of the namespace alone (unless they are
     * linked ensemble commands, of course). Note that this code is actually
     * reentrant so command delete traces won't purturb things badly.










     */































































































    while (nsPtr->ensembles != NULL) {
	EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;

	/*
	 * Splice out and link to indicate that we've already been killed.

	 */

	nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
	ensemblePtr->next = ensemblePtr;
	Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);


    }

    /*
     * If the namespace has a registered unknown handler (TIP 181), then free
     * it here.
     */

    if (nsPtr->unknownHandlerPtr != NULL) {
	Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
	nsPtr->unknownHandlerPtr = NULL;
    }

    /*
     * If the namespace is on the call frame stack, it is marked as "dying"
     * (NS_DYING is OR'd into its flags): the namespace can't be looked up by
     * name but its commands and variables are still usable by those active
     * call frames. When all active call frames referring to the namespace
     * have been popped from the Tcl stack, Tcl_PopCallFrame will call this
     * function again to delete everything in the namespace. If no nsName
     * objects refer to the namespace (i.e., if its refCount is zero), its
     * commands and variables are deleted and the storage for its namespace
     * structure is freed. Otherwise, if its refCount is nonzero, the
     * namespace's commands and variables are deleted but the structure isn't
     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
     * namespace resolution code to recognize that the namespace is "deleted".
     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.

     */

    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
	    }
	}

	nsPtr->parentPtr = NULL;
    } else if (!(nsPtr->flags & NS_KILLED)) {


	/*
	 * Delete the namespace and everything in it. If this is the global
	 * namespace, then clear it but don't free its storage unless the
	 * interpreter is being torn down. Set the NS_KILLED flag to avoid
	 * recursive calls here - if the namespace is really in the process of
	 * being deleted, ignore any second call.
	 */

	nsPtr->flags |= (NS_DYING|NS_KILLED);




	TclTeardownNamespace(nsPtr);



	if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {











	    /*
	     * If this is the global namespace, then it may have residual
	     * "errorInfo" and "errorCode" variables for errors that occurred
	     * while it was being torn down. Try to clear the variable list
	     * one last time.



	     */

	    TclDeleteNamespaceVars(nsPtr);










#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		ckfree(nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    nsPtr ->flags |= NS_DEAD;

	} else {
	    /*
	     * Restore the ::errorInfo and ::errorCode traces.
	     */

	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);

	    /*
	     * We didn't really kill it, so remove the KILLED marks, so it can
	     * get killed later, avoiding mem leaks.
	     */

	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
	}
    }
    TclNsDecrRefCount(nsPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
................................................................................
 */

void
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    int i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	int length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    cmds[i] = Tcl_GetHashValue(entryPtr);
	    cmds[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmds[i]);
	    TclCleanupCommandMacro(cmds[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, cmds);
    }
    Tcl_DeleteHashTable(&nsPtr->cmdTable);
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    /*
     * Remove the namespace from its parent's child hashtable.
     */

    if (nsPtr->parentPtr != NULL) {
	entryPtr = Tcl_FindHashEntry(
		TclGetNamespaceChildTable((Tcl_Namespace *)
			nsPtr->parentPtr), nsPtr->name);
	if (entryPtr != NULL) {
	    Tcl_DeleteHashEntry(entryPtr);
	}
    }
    nsPtr->parentPtr = NULL;

    /*
     * Delete the namespace path if one is installed.
     */

    if (nsPtr->commandPathLength != 0) {
	UnlinkNsPath(nsPtr);
	nsPtr->commandPathLength = 0;
    }
    if (nsPtr->commandPathSourceList != NULL) {
	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;

	do {
	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
	    }
	    nsPathPtr->nsPtr = NULL;
	    nsPathPtr = nsPathPtr->nextPtr;
	} while (nsPathPtr != NULL);
	nsPtr->commandPathSourceList = NULL;
    }

    /*
     * Delete all the child namespaces.
     *
     * BE CAREFUL: When each child is deleted, it will divorce itself from its
     * parent. You can't traverse a hash table properly if its elements are
     * being deleted.  Because of traces (and the desire to avoid the
     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	int length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    children[i] = Tcl_GetHashValue(entryPtr);
	    children[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
	    TclNsDecrRefCount(children[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, children);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	while (nsPtr->childTablePtr->numEntries > 0) {
	    int length = nsPtr->childTablePtr->numEntries;
	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Namespace *) * length);

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
		children[i] = Tcl_GetHashValue(entryPtr);
		children[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
		TclNsDecrRefCount(children[i]);
	    }
	    TclStackFree((Tcl_Interp *) iPtr, children);
	}
    }
#endif

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    ckfree(nsPtr->exportArrayPtr[i]);
................................................................................
	}
	ckfree(nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.
     */

    if (nsPtr->deleteProc != NULL) {
	nsPtr->deleteProc(nsPtr->clientData);
    }
    nsPtr->deleteProc = NULL;
    nsPtr->clientData = NULL;

    /*
     * Reset the namespace's id field to ensure that this namespace won't be
     * interpreted as valid by, e.g., the cache validation code for cached
     * command references in Tcl_GetCommandFromObj.
     */

    nsPtr->nsId = 0;

}
 
/*
 *----------------------------------------------------------------------
 *
 * NamespaceFree --
 *
................................................................................
 *----------------------------------------------------------------------
 */

void
TclNsDecrRefCount(
    Namespace *nsPtr)
{
    if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
	NamespaceFree(nsPtr);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Export --
................................................................................
     * namespace context. Note that we always treat two or more adjacent ":"s
     * as a namespace separator.
     */

    if (flags & TCL_GLOBAL_ONLY) {
	nsPtr = globalNsPtr;
    } else if (nsPtr == NULL) {
	nsPtr = iPtr->varFramePtr->nsPtr;
    }

    start = qualName;			/* Points to start of qualifying
					 * namespace. */
    if ((*qualName == ':') && (*(qualName+1) == ':')) {
	start = qualName+2;		/* Skip over the initial :: */
	while (*start == ':') {
................................................................................
 */
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DYING)) {
	    return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
		    || !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

................................................................................
	    if (pathNsPtr == NULL) {
		continue;
	    }
	    (void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

................................................................................
	 */

	if (cmdPtr == NULL) {
	    (void) TclGetNamespaceForQualName(interp, name, NULL,
		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    } else {
................................................................................

	/*
	 * Look for the command in the command table of its namespace. Be sure
	 * to check both possible search paths: from the specified namespace
	 * context and from the global namespace.
	 */

	for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
	    if ((nsPtr[search] != NULL) && (simpleName != NULL)) {


		entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
			simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

    }

    if (cmdPtr != NULL) {
	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
	return (Tcl_Command) cmdPtr;
    }

................................................................................
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * cross interps.
	 */

	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
		&& (!refNsPtr || (refNsPtr ==
		(Namespace *) TclGetCurrentNamespace(interp)))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
................................................................................
     * command line are valid, and report any errors.
     */

    for (i = 1;  i < objc;  i++) {
	name = TclGetString(objv[i]);
	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
	if ((namespacePtr == NULL)
		|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "unknown namespace \"%s\" in namespace delete command",
		    TclGetString(objv[i])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
		    TclGetString(objv[i]), NULL);
	    return TCL_ERROR;
	}
................................................................................
	/*
	 * Decrement the reference count for the cached namespace. If the
	 * namespace is dead, and there are no more references to it, free
	 * it.
	 */

	TclNsDecrRefCount(resNamePtr->nsPtr);



	ckfree(resNamePtr);
    }
    objPtr->typePtr = NULL;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     */

    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
	/*
	 * Our failed lookup proves any previously cached nsName intrep is no
	 * longer valid. Get rid of it so we no longer waste memory storing
	 * it, nor time determining its invalidity again and again.
	 */

	if (objPtr->typePtr == &nsNameType) {
	    TclFreeIntRep(objPtr);
	}
	return TCL_ERROR;
    }

    nsPtr->refCount++;
    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;

    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);

    }
    resNamePtr->refCount = 1;
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    objPtr->typePtr = &nsNameType;
    return TCL_OK;
}






|
|












|







 







|
>







 







<







 







|
<
<


>
|
<
<
<
<
<


|
|
>
>
>







 







|
|







 







>
|


|
|



|
|
|
|
>







 







<

<


>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

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

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

|
<
>
|

<
<
<
>
>













<
<
<
<
<
<
<
<
<
<
<
<
<
<
>


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

<
>
>
>
|
<
>
>

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

<
>

>
>
>
>
>
>
>
>

|

|
|
|
|

<
<
<
>
|
|
|
|

|
|

|
|
|
|

|
|
<
<







 







<
<
<


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>







 







|
|







 







|







 







|







 







|







 







|







 







|







 







|
|
>
>
|
|
|
|
|
|
|
>







 







|







 







|







 







>
>
>







 







|












<


>




>







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
...
375
376
377
378
379
380
381

382
383
384
385
386
387
388
...
403
404
405
406
407
408
409
410


411
412
413
414





415
416
417
418
419
420
421
422
423
424
425
426
427
428
...
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
...
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
...
928
929
930
931
932
933
934

935

936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982




983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089

1090
1091

1092
1093
1094



1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109














1110
1111
1112


1113
1114
1115
1116
1117
1118
1119
1120
1121
1122

1123
1124
1125
1126




1127
1128

1129
1130
1131
1132

1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147




1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170



1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186


1187
1188
1189
1190
1191
1192
1193
....
1209
1210
1211
1212
1213
1214
1215



1216
1217





































































































































1218
1219
1220
1221
1222
1223
1224
....
1225
1226
1227
1228
1229
1230
1231

















1232
1233
1234
1235
1236
1237
1238
1239
....
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
....
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
....
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
....
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
....
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
....
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
....
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
....
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
....
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
....
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
....
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770

4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else {
	nsPtr = (Namespace *) namespacePtr;

	/*
	 * TODO: Examine whether it would be better to guard based on NS_DYING.
	 * It appears that these are not tested because they can
	 * be set in a global interp that has been [namespace delete]d, but
	 * which never really completely goes away because of lingering global
	 * things like ::errorInfo and [::unknown] and hidden commands.
	 * Review of those designs might permit stricter checking here.
	 */

	if (nsPtr->flags & NS_DEAD) {
	    Tcl_Panic("Trying to push call frame for dead namespace");
	    /*NOTREACHED*/
	}
    }

    nsPtr->refCount++;
    framePtr->nsPtr = nsPtr;
    framePtr->isProcCallFrame = isProcCallFrame;
    framePtr->objc = 0;
    framePtr->objv = NULL;
    framePtr->callerPtr = iPtr->framePtr;
    framePtr->callerVarPtr = iPtr->varFramePtr;
    if (iPtr->varFramePtr != NULL) {
................................................................................
    }
    framePtr->procPtr = NULL;		/* no called procedure */
    framePtr->varTablePtr = NULL;	/* and no local variables */
    framePtr->numCompiledLocals = 0;
    framePtr->compiledLocals = NULL;
    framePtr->clientData = NULL;
    framePtr->localCachePtr = NULL;
    framePtr->tailcallNsPtr = NULL;
    framePtr->tailcallCmdPtr = NULL;

    /*
     * Push the new call frame onto the interpreter's stack of procedure call
     * frames making it the current frame.
     */

    iPtr->framePtr = framePtr;
................................................................................

void
Tcl_PopCallFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
{
    register Interp *iPtr = (Interp *) interp;
    register CallFrame *framePtr = iPtr->framePtr;


    /*
     * It's important to remove the call frame from the interpreter's stack of
     * call frames before deleting local variables, so that traces invoked by
     * the variable deletion don't see the partially-deleted frame.
     */

................................................................................
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames.


     */

    /* Corresponds to refCount++ in Tcl_PushCallFrame */
    TclNsDecrRefCount(framePtr->nsPtr);





    framePtr->nsPtr = NULL;

    if (framePtr->tailcallNsPtr) {
	TclSetTailcall(interp, framePtr->tailcallNsPtr,
	    framePtr->tailcallCmdPtr);
	TclNsDecrRefCount(framePtr->tailcallNsPtr);
	framePtr->tailcallNsPtr = NULL;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclPushStackFrame --
................................................................................
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
#else
    nsPtr->childTablePtr = NULL;
#endif
    nsPtr->nsId = ++(tsdPtr->numNsCreated);
    nsPtr->interp = interp;
    nsPtr->flags = 0;
    /* Corresponding TclNsDecrRefCount is at the end of Tcl_DeleteNamespace */
    nsPtr->refCount = 1;
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
    nsPtr->exportArrayPtr = NULL;
    nsPtr->numExportPatterns = 0;
    nsPtr->maxExportPatterns = 0;
    nsPtr->cmdRefEpoch = 0;
    nsPtr->resolverEpoch = 0;
................................................................................
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteNamespace(
    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
{
    int i, newChildren;
    register Namespace *nsPtr = (Namespace *) namespacePtr, *childPtr ;
    Interp *iPtr = (Interp *) nsPtr->interp;
    Namespace *globalNsPtr = (Namespace *)
	TclGetGlobalNamespace((Tcl_Interp *) iPtr);
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Command *cmdPtr;

    if (nsPtr->flags & NS_DYING) {
	return;
    }

    nsPtr->flags |= NS_DYING;

    /*
     * Give anyone interested - notably TclOO - a chance to use this namespace
     * normally despite the fact that the namespace is going to go. Allows the
     * calling of destructors. Will only be called once (unless re-established
     * by the called function). [Bug 2950259]
     *
................................................................................
     * being careful with reentrancy.
     */

    if (nsPtr->earlyDeleteProc != NULL) {
	Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc;

	nsPtr->earlyDeleteProc = NULL;

	earlyDeleteProc(nsPtr->clientData);

    }

    do {

	/*
	 * If the namespace has associated ensemble commands, delete them first.
	 * This leaves the actual contents of the namespace alone (unless they are
	 * linked ensemble commands, of course). Note that this code is actually
	 * reentrant so command delete traces won't purturb things badly.
	 */

	while (nsPtr->ensembles != NULL) {
	    EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;

	    /*
	     * Splice out and link to indicate that we've already been killed.
	     */

	    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
	    ensemblePtr->next = ensemblePtr;
	    Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
	}


	/*
	 * Delete all coroutine commands now: break the circular ref cycle between
	 * the namespace and the coroutine command [Bug 2724403]. This code is
	 * essentially duplicated in TclTeardownNamespace() for all other
	 * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
	 *
	 * NOTE: we could avoid traversing the ns's command list by keeping a
	 * separate list of coros.
	 */

	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;) {
	    cmdPtr = Tcl_GetHashValue(entryPtr);
	    if (cmdPtr->nreProc == TclNRInterpCoroutine) {
		Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
			(Tcl_Command) cmdPtr);
		entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    } else {
		entryPtr = Tcl_NextHashEntry(&search);
	    }
	}

	/*




	 * Delete all the child namespaces.
	 *
	 * BE CAREFUL: When each child is deleted, it will divorce itself from its
	 * parent. You can't traverse a hash table properly if its elements are
	 * being deleted.  Because of traces (and the desire to avoid the
	 * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
	 * f97d4ee020]) we copy to a temporary array and then delete all those
	 * namespaces.
	 *
	 * Important: leave the hash table itself still live.
	 */

#ifndef BREAK_NAMESPACE_COMPAT
	do {
	    int length = nsPtr->childTable.numEntries;
	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Namespace *) * length);
	    newChildren = 0;

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
		children[i] = Tcl_GetHashValue(entryPtr);
		children[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
		TclNsDecrRefCount(children[i]);
	    }
	    TclStackFree((Tcl_Interp *) iPtr, children);
	    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
		childPtr = Tcl_GetHashValue(entryPtr);
		if (!(childPtr->flags & NS_DYING)) {
		    newChildren = 1;
		    break;
		}
	    }

	} while (newChildren);
#else
	if (nsPtr->childTablePtr != NULL) {
	    while (nsPtr->childTablePtr->numEntries > 0) {
		int length = nsPtr->childTablePtr->numEntries;
		Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
			sizeof(Namespace *) * length);

		i = 0;
		for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
			entryPtr != NULL;
			entryPtr = Tcl_NextHashEntry(&search)) {
		    children[i] = Tcl_GetHashValue(entryPtr);
		    children[i]->refCount++;
		    i++;
		}
		for (i = 0 ; i < length ; i++) {
		    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
		    TclNsDecrRefCount(children[i]);
		}
		TclStackFree((Tcl_Interp *) iPtr, children);
	    }
	}
#endif
	/*
	 * Delete all commands in this namespace. Be careful when traversing the
	 * hash table: when each command is deleted, it removes itself from the
	 * command table. Because of traces (and the desire to avoid the quadratic
	 * problems of just using Tcl_FirstHashEntry over and over, [Bug
	 * f97d4ee020]) we copy to a temporary array and then delete all those
	 * commands.
	 */

	while (nsPtr->cmdTable.numEntries > 0) {
	    int length = nsPtr->cmdTable.numEntries;
	    Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Command *) * length);

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
		cmds[i] = Tcl_GetHashValue(entryPtr);
		cmds[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
			(Tcl_Command) cmds[i]);
		TclCleanupCommandMacro(cmds[i]);
	    }
	    TclStackFree((Tcl_Interp *) iPtr, cmds);
	}

	/*
	 * Destroying the namespace's variable table, which may trigger traces.
	 * Variable table should be cleared but not freed!
	 * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
	 */

	TclDeleteNamespaceVars(nsPtr);
	TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    } while (nsPtr->varTable.table.numEntries > 0
	|| newChildren || nsPtr->ensembles != NULL);


    /*

     * Free any client data associated with the namespace.
     */




    if (nsPtr->deleteProc != NULL) {
	nsPtr->deleteProc(nsPtr->clientData);
    }

    /*
     * If the namespace has a registered unknown handler (TIP 181), then free
     * it here.
     */

    if (nsPtr->unknownHandlerPtr != NULL) {
	Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
	nsPtr->unknownHandlerPtr = NULL;
    }

    /*














     * Remove the namespace from its parent's child hashtable.
     */



    if (nsPtr->parentPtr != NULL) {
	entryPtr = Tcl_FindHashEntry(
		TclGetNamespaceChildTable((Tcl_Namespace *)
			nsPtr->parentPtr), nsPtr->name);
	if (entryPtr != NULL) {
	    Tcl_DeleteHashEntry(entryPtr);
	}
    }

    nsPtr->parentPtr = NULL;



    /*
     * Delete the namespace path if one is installed.




     */


    if (nsPtr->commandPathLength != 0) {
	UnlinkNsPath(nsPtr);
	nsPtr->commandPathLength = 0;
    }

    if (nsPtr->commandPathSourceList != NULL) {
	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;


	do {
	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
	    }
	    nsPathPtr->nsPtr = NULL;
	    nsPathPtr = nsPathPtr->nextPtr;
	} while (nsPathPtr != NULL);
	nsPtr->commandPathSourceList = NULL;
    }


    /*




     * Reset the namespace's id field to ensure that this namespace won't be
     * interpreted as valid by, e.g., the cache validation code for cached
     * command references in Tcl_GetCommandFromObj.
     */


    nsPtr->nsId = 0;

    if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {

	/* No variables or commands are allowed after this point */
	nsPtr->flags |= NS_DEAD;
	Tcl_DeleteHashTable(&nsPtr->varTable.table);
	Tcl_DeleteHashTable(&nsPtr->cmdTable);


#ifndef BREAK_NAMESPACE_COMPAT
	Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	if (nsPtr->childTablePtr != NULL) {
	    Tcl_DeleteHashTable(nsPtr->childTablePtr);
	    ckfree(nsPtr->childTablePtr);
	}
#endif



	TclNsDecrRefCount(nsPtr);
    } else {
	/*
	 * Restore the ::errorInfo and ::errorCode traces.
	 */

	EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
	EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);

	/*
	 * We didn't really kill it, so remove the KILLED marks, so it can
	 * get killed later, avoiding mem leaks.
	 */

	nsPtr->flags &= ~(NS_DYING|NS_DEAD);
    }


}
 
/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
................................................................................
 */

void
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{



    int i;






































































































































    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    ckfree(nsPtr->exportArrayPtr[i]);
................................................................................
	}
	ckfree(nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }


















    NamespaceFree(nsPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * NamespaceFree --
 *
................................................................................
 *----------------------------------------------------------------------
 */

void
TclNsDecrRefCount(
    Namespace *nsPtr)
{
    if (nsPtr->refCount-- == 1) {
	TclTeardownNamespace(nsPtr);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Export --
................................................................................
     * namespace context. Note that we always treat two or more adjacent ":"s
     * as a namespace separator.
     */

    if (flags & TCL_GLOBAL_ONLY) {
	nsPtr = globalNsPtr;
    } else if (nsPtr == NULL) {
	nsPtr = (Namespace *)TclGetCurrentNamespace(iPtr);
    }

    start = qualName;			/* Points to start of qualifying
					 * namespace. */
    if ((*qualName == ':') && (*(qualName+1) == ':')) {
	start = qualName+2;		/* Skip over the initial :: */
	while (*start == ':') {
................................................................................
 */
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DEAD)) {
	    return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
		    || !(realNsPtr->flags & NS_DEAD)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

................................................................................
	    if (pathNsPtr == NULL) {
		continue;
	    }
	    (void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DEAD)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

................................................................................
	 */

	if (cmdPtr == NULL) {
	    (void) TclGetNamespaceForQualName(interp, name, NULL,
		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DEAD)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    } else {
................................................................................

	/*
	 * Look for the command in the command table of its namespace. Be sure
	 * to check both possible search paths: from the specified namespace
	 * context and from the global namespace.
	 */

	    for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
		if ((nsPtr[search] != NULL) && (simpleName != NULL)
		    && !(nsPtr[search]->flags & NS_DEAD)) {

		    entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
			    simpleName);
		    if (entryPtr != NULL) {
			cmdPtr = Tcl_GetHashValue(entryPtr);
		    }
		}
	    }

    }

    if (cmdPtr != NULL) {
	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
	return (Tcl_Command) cmdPtr;
    }

................................................................................
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * cross interps.
	 */

	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DEAD) && (interp == nsPtr->interp)
		&& (!refNsPtr || (refNsPtr ==
		(Namespace *) TclGetCurrentNamespace(interp)))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
................................................................................
     * command line are valid, and report any errors.
     */

    for (i = 1;  i < objc;  i++) {
	name = TclGetString(objv[i]);
	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
	if ((namespacePtr == NULL)
		|| (((Namespace *) namespacePtr)->flags & NS_DEAD)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "unknown namespace \"%s\" in namespace delete command",
		    TclGetString(objv[i])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
		    TclGetString(objv[i]), NULL);
	    return TCL_ERROR;
	}
................................................................................
	/*
	 * Decrement the reference count for the cached namespace. If the
	 * namespace is dead, and there are no more references to it, free
	 * it.
	 */

	TclNsDecrRefCount(resNamePtr->nsPtr);
	if (resNamePtr->refNsPtr) {
	    TclNsDecrRefCount(resNamePtr->refNsPtr);
	}
	ckfree(resNamePtr);
    }
    objPtr->typePtr = NULL;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     */

    if ((nsPtr == NULL) || (nsPtr->flags & NS_DEAD)) {
	/*
	 * Our failed lookup proves any previously cached nsName intrep is no
	 * longer valid. Get rid of it so we no longer waste memory storing
	 * it, nor time determining its invalidity again and again.
	 */

	if (objPtr->typePtr == &nsNameType) {
	    TclFreeIntRep(objPtr);
	}
	return TCL_ERROR;
    }


    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    nsPtr->refCount++;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
	resNamePtr->refNsPtr->refCount++;
    }
    resNamePtr->refCount = 1;
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    objPtr->typePtr = &nsNameType;
    return TCL_OK;
}

Changes to generic/tclOO.c.

1142
1143
1144
1145
1146
1147
1148

1149
1150
1151
1152
1153
1154
1155
1156
    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the command that refers to the object at this point (if
     * it still exists) because otherwise its pointer to the object
     * points into freed memory.
     */


    if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command






>
|







1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the command that refers to the object at this point (if
     * it still exists) because otherwise its pointer to the object
     * points into freed memory.
     */

    if (oPtr->command == NULL || ((
	Command *)oPtr->command)->flags & CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command

Changes to generic/tclOOMethod.c.

864
865
866
867
868
869
870


871
872
873
874
875
876
877
....
1486
1487
1488
1489
1490
1491
1492


1493
1494
1495
1496
1497
1498
1499
     * alternative is *so* slow...
     */

    if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
	ByteCode *codePtr =
		pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;



	codePtr->nsPtr = nsPtr;
    }
    result = TclProcCompileProc(interp, pmPtr->procPtr,
	    pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
    if (result != TCL_OK) {
	goto failureReturn;
    }
................................................................................
    /*
     * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
     * of the TCL_EVAL_NOERR flag results in an evaluation configuration
     * very much like TCL_EVAL_INVOKE.
     */
    ((Interp *)interp)->lookupNsPtr
	    = (Namespace *) contextPtr->oPtr->namespacePtr;


    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
}

static int
FinalizeForwardCall(
    ClientData data[],
    Tcl_Interp *interp,






>
>







 







>
>







864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
....
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
     * alternative is *so* slow...
     */

    if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
	ByteCode *codePtr =
		pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;

	nsPtr->refCount++;
	TclNsDecrRefCount(codePtr->nsPtr);
	codePtr->nsPtr = nsPtr;
    }
    result = TclProcCompileProc(interp, pmPtr->procPtr,
	    pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
    if (result != TCL_OK) {
	goto failureReturn;
    }
................................................................................
    /*
     * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
     * of the TCL_EVAL_NOERR flag results in an evaluation configuration
     * very much like TCL_EVAL_INVOKE.
     */
    ((Interp *)interp)->lookupNsPtr
	    = (Namespace *) contextPtr->oPtr->namespacePtr;
    /* Corresponding TclNrDecrRefCount is in EvalObjvCore */ 
    ((Namespace *)contextPtr->oPtr->namespacePtr)->refCount++;
    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
}

static int
FinalizeForwardCall(
    ClientData data[],
    Tcl_Interp *interp,

Changes to generic/tclObj.c.

4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    if (objPtr->typePtr == &tclCmdNameType) {
        register Command *cmdPtr = resPtr->cmdPtr;

        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                && (interp == cmdPtr->nsPtr->interp)
                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
            register Namespace *refNsPtr = (Namespace *)
                    TclGetCurrentNamespace(interp);

            if ((resPtr->refNsPtr == NULL)
                || ((refNsPtr == resPtr->refNsPtr)
                    && (resPtr->refNsId == refNsPtr->nsId)
                    && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {






|







4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    if (objPtr->typePtr == &tclCmdNameType) {
        register Command *cmdPtr = resPtr->cmdPtr;

        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                && (interp == cmdPtr->nsPtr->interp)
                && !(cmdPtr->nsPtr->flags & NS_DEAD)) {
            register Namespace *refNsPtr = (Namespace *)
                    TclGetCurrentNamespace(interp);

            if ((resPtr->refNsPtr == NULL)
                || ((refNsPtr == resPtr->refNsPtr)
                    && (resPtr->refNsId == refNsPtr->nsId)
                    && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {

Changes to generic/tclProc.c.

1889
1890
1891
1892
1893
1894
1895


1896
1897
1898
1899
1900
1901
1902
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;


	    codePtr->nsPtr = nsPtr;
	} else {
	    TclFreeIntRep(bodyPtr);
	}
    }

    if (bodyPtr->typePtr != &tclByteCodeType) {






>
>







1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    nsPtr->refCount++;
	    TclNsDecrRefCount(codePtr->nsPtr);
	    codePtr->nsPtr = nsPtr;
	} else {
	    TclFreeIntRep(bodyPtr);
	}
    }

    if (bodyPtr->typePtr != &tclByteCodeType) {

Changes to generic/tclVar.c.

815
816
817
818
819
820
821



822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
	cxtNsPtr = iPtr->globalNsPtr;
    } else {
	cxtNsPtr = iPtr->varFramePtr->nsPtr;



    }

    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & TCL_AVOID_RESOLVERS)) {
	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}






>
>
>









|







815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
	cxtNsPtr = iPtr->globalNsPtr;
    } else {
	cxtNsPtr = iPtr->varFramePtr->nsPtr;
	if (cxtNsPtr->flags & NS_DEAD) {
	    cxtNsPtr = iPtr->globalNsPtr;
	}
    }

    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & TCL_AVOID_RESOLVERS) && !(cxtNsPtr->flags & NS_DEAD)) {
	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}

Changes to tests/basic.test.

987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
    list [catch foo m] $m
} -cleanup {
    unset -nocomplain m
    interp delete slave
} -result {0 {}}

# Clean up after expand tests
unset noComp l1 l2 constraints
rename l3 {}
rename run {}

 #cleanup
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {namespace delete george}
catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
unset -nocomplain x
cleanupTests
return






|
|
|












987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
    list [catch foo m] $m
} -cleanup {
    unset -nocomplain m
    interp delete slave
} -result {0 {}}

# Clean up after expand tests
catch {unset noComp l1 l2 constraints}
catch {rename l3 {}}
catch {rename run {}}

 #cleanup
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {namespace delete george}
catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
unset -nocomplain x
cleanupTests
return

Changes to tests/coroutine.test.

654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
...
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
...
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	set y ::yieldto
	lappend ::result a
................................................................................
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	lappend ::result a
	yield OUT
................................................................................
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	set y ::yieldto
	lappend ::result a
................................................................................
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.12 {coro floor above street level #3008307} -body {
    proc c {} {
	yield
    }
    proc cc {} {
	coroutine C c
    }






|


|







 







|


|







 







|


|







 







|


|







654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
...
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
...
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {a OUT b 123 c}
test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	set y ::yieldto
	lappend ::result a
................................................................................
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {a OUT b 123 c}
test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	lappend ::result a
	yield OUT
................................................................................
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {a OUT b 123 c}
test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	set y ::yieldto
	lappend ::result a
................................................................................
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {a OUT b 123 c}
test coroutine-7.12 {coro floor above street level #3008307} -body {
    proc c {} {
	yield
    }
    proc cc {} {
	coroutine C c
    }

Changes to tests/interp.test.

15
16
17
18
19
20
21


















22
23
24
25
26
27
28
...
878
879
880
881
882
883
884









885
886
887
888
889
890
891
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]



















set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp slaves] {
  interp delete $i
}
 
................................................................................
    list [catch {tst eval {suicide; set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}










# Test alias deletion

test interp-19.1 {alias deletion} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar






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







 







>
>
>
>
>
>
>
>
>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}
 

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp slaves] {
  interp delete $i
}
 
................................................................................
    list [catch {tst eval {suicide; set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}

test interp-10.11 {test for leaks in simple creation/deletion} -setup {
} -constraints memory -body {
    leaktest {
	interp create slave
	interp delete slave
    }
} -cleanup {
} -result 0

# Test alias deletion

test interp-19.1 {alias deletion} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar

Changes to tests/namespace.test.

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
204
205
206
207
208
209
210















































211
212
213
214
215
216
217
....
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
....
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
....
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
....
3278
3279
3280
3281
3282
3283
3284
3285





3286
3287
3288
3289
3290
3291
3292
3293




3294
3295
3296
3297
3298
3299
3300
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
    namespace eval test_ns_2 {
        proc p {} {
            return [namespace current]
        }
    }
    list [test_ns_2::p] [namespace delete test_ns_2]
................................................................................
    trace add command ns1 delete {
	namespace delete ns1
    }
} -body {
    # No segmentation fault given --enable-symbols=mem.
    namespace delete ns1
} -result {}
















































test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p
................................................................................
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} -result {::test_ns_1}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
    namespace eval test_ns_1 {
        proc q {} {
            return [namespace current]
        }
    }
    list [test_ns_1::q] \
................................................................................
	}
	proc bar {} {
	    namespace delete [namespace current]
	}
	namespace ensemble create
    }
    list [ns foo] [info exist ns::x]
} {1 0}
test namespace-46.9 {ensemble: configuring really configures things} {
    namespace eval ns {
	namespace ensemble create -map {a a} -prefixes 0
    }
    set result [list [catch {ns x} msg] $msg]
    namespace ensemble configure ns -map {b b}
    lappend result [catch {ns x} msg] $msg
................................................................................
    namespace eval ::test_ns_4 {
	namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1}
	proc bar {} {
	    list [foo] [namespace delete ::test_ns_2] [foo]
	}
	bar
    }
    # Should the result be "2 {} {2 3 2 1}" instead?
} -result {2 {} {2 3 1 1}} -cleanup {
    catch {namespace delete ::test_ns_1}
    catch {namespace delete ::test_ns_2}
    catch {namespace delete ::test_ns_3}
    catch {namespace delete ::test_ns_4}
}
test namespace-51.14 {name resolution path control} -setup {
    foreach cmd [info commands foo*] {
................................................................................
	proc abc {} {}
	proc def {} {}
	trace add command abc delete "rename ::testing::def {}; #"
	trace add command def delete "rename ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}
test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {





    namespace eval ::testing {
	namespace eval abc {proc xyz {} {}}
	namespace eval def {proc xyz {} {}}
	trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
	trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}




test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	variable gone {}
	oo::class create CB {
	    variable cmd
	    constructor other {set cmd $other}
	    destructor {rename $cmd {}; lappend ::testing::gone $cmd}






|







 







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







 







|







 







|







 







<
|







 







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







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
....
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
....
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
....
2786
2787
2788
2789
2790
2791
2792

2793
2794
2795
2796
2797
2798
2799
2800
....
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343

3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
} {:: 1 {invalid command name "test_ns_1::p"}}
test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
    namespace eval test_ns_2 {
        proc p {} {
            return [namespace current]
        }
    }
    list [test_ns_2::p] [namespace delete test_ns_2]
................................................................................
    trace add command ns1 delete {
	namespace delete ns1
    }
} -body {
    # No segmentation fault given --enable-symbols=mem.
    namespace delete ns1
} -result {}

test namespace-7.9 {
    Looking up a command when the current namespace is deleted
} -body {
    list [catch {
	namespace eval ns1 {
	    proc p1 {} {}
	    namespace delete [namespace current]
	    p1
	}
    } msg] $msg
} -result {1 {invalid command name "p1"}} 

test namespace-7.10 {
    A namespace can be looked up during the delete process.
} -body {
    variable res failure 
    namespace eval ns1 {
	namespace ensemble create
	trace add command [namespace current] delete [list ::apply [list args {
	    set [namespace parent]::res triggered
	} [namespace current]]]
	namespace delete [namespace current]
    }
    return $res
} -cleanup {
    unset res
} -result triggered 

test namespace-7.11 {
    Commands are deleted before variables.
} -body {
    variable res failure 
    namespace eval ns1 {
	namespace ensemble create
	namespace upvar [namespace parent] res res
	proc p1 {} {}
	trace add command p1 delete [list ::apply [list args {
	    variable res
	    set res triggered
	} [namespace current]]]
	namespace delete [namespace current]
    }
    return $res
} -cleanup {
    unset res
} -result triggered

test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p
................................................................................
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} -result {::}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
    namespace eval test_ns_1 {
        proc q {} {
            return [namespace current]
        }
    }
    list [test_ns_1::q] \
................................................................................
	}
	proc bar {} {
	    namespace delete [namespace current]
	}
	namespace ensemble create
    }
    list [ns foo] [info exist ns::x]
} {0 0}
test namespace-46.9 {ensemble: configuring really configures things} {
    namespace eval ns {
	namespace ensemble create -map {a a} -prefixes 0
    }
    set result [list [catch {ns x} msg] $msg]
    namespace ensemble configure ns -map {b b}
    lappend result [catch {ns x} msg] $msg
................................................................................
    namespace eval ::test_ns_4 {
	namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1}
	proc bar {} {
	    list [foo] [namespace delete ::test_ns_2] [foo]
	}
	bar
    }

} -result {2 {} {2 3 2 2 1}} -cleanup {
    catch {namespace delete ::test_ns_1}
    catch {namespace delete ::test_ns_2}
    catch {namespace delete ::test_ns_3}
    catch {namespace delete ::test_ns_4}
}
test namespace-51.14 {name resolution path control} -setup {
    foreach cmd [info commands foo*] {
................................................................................
	proc abc {} {}
	proc def {} {}
	trace add command abc delete "rename ::testing::def {}; #"
	trace add command def delete "rename ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}
test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} -setup {
    # Since this test deletes the global namespace, isolate the carnage in a
    # slave.
    interp create slave
} -body {
    slave eval {
	namespace eval ::testing {
	    namespace eval abc {proc xyz {} {}}
	    namespace eval def {proc xyz {} {}}
	    trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
	    trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
	}
	namespace delete ::testing

    }
} -cleanup {
    interp delete slave
} -result {}
test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	variable gone {}
	oo::class create CB {
	    variable cmd
	    constructor other {set cmd $other}
	    destructor {rename $cmd {}; lappend ::testing::gone $cmd}

Changes to tests/oo.test.

608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
	constructor {} {
	    proc localcmdexists {} {}
	    set state ok
	    my eval {upvar 0 ::result result}
	}
	method nuke {} {
	    namespace delete [namespace current]
	    return $result
	}
	destructor {
	    lappend result [self] $state [info commands localcmdexists]
	}
    }
    cls create obj
    namespace delete [info object namespace obj]
    [cls create obj2] nuke
} -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists}
test oo-3.6 {basic test of OO functionality: errors in destructor} -setup {






|


|







608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
	constructor {} {
	    proc localcmdexists {} {}
	    set state ok
	    my eval {upvar 0 ::result result}
	}
	method nuke {} {
	    namespace delete [namespace current]
	    return $::result
	}
	destructor {
	    lappend ::result [self] $state [info commands localcmdexists]
	}
    }
    cls create obj
    namespace delete [info object namespace obj]
    [cls create obj2] nuke
} -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists}
test oo-3.6 {basic test of OO functionality: errors in destructor} -setup {

Changes to tests/trace.test.

2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
    proc callback {old - -} {
        variable x "$old exists: [namespace which -command $old]"
    }
    namespace eval ::foo {proc bar {} {}}
    trace add command ::foo::bar delete [namespace code callback]
    namespace eval ::foo namespace delete ::foo
    set x
} {::foo::bar exists: }

test trace-34.6 {Bug 1458266} -setup {
    proc dummy {} {}
    proc stepTraceHandler {cmdString args} {
        variable log
        append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n"
        dummy






|







2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
    proc callback {old - -} {
        variable x "$old exists: [namespace which -command $old]"
    }
    namespace eval ::foo {proc bar {} {}}
    trace add command ::foo::bar delete [namespace code callback]
    namespace eval ::foo namespace delete ::foo
    set x
} {::foo::bar exists: ::foo::bar}

test trace-34.6 {Bug 1458266} -setup {
    proc dummy {} {}
    proc stepTraceHandler {cmdString args} {
        variable log
        append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n"
        dummy

Changes to tests/var.test.

150
151
152
153
154
155
156
157

158
159
160
161
162
163
164
165
166
167
168

169



170
171
172

173
174
175
176
177
178
179
180
181
182
183
184
185

186
187
188
189
190
191

192
193
194
195
196
197
198
199
200



201
202
203
204
205
206
207
....
1453
1454
1455
1456
1457
1458
1459
1460

































































1461
1462
1463
1464
1465
1466
1467
	lappend result [catch {set foo} msg] $msg
        namespace delete ::test_ns_var
	lappend result [catch {set foo 3} msg] $msg
	lappend result [catch {set foo(3) 3} msg] $msg
    }
    p
} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {

    namespace eval test_ns_var {
	variable result
        namespace eval subns {
	    variable foo 2
	}
	upvar 0 subns::foo foo
	lappend result [catch {set foo} msg] $msg
        namespace delete subns
	lappend result [catch {set foo 3} msg] $msg
	lappend result [catch {set foo(3) 3} msg] $msg
        namespace delete [namespace current]

	set result



    }
} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {

    namespace eval test_ns_var {
	variable result
	proc p {} {
	    array set x {1 2 3 4}
	    upvar 0 x(1) foo
	    lappend result [catch {set foo} msg] $msg
	    unset x
	    lappend result [catch {set foo 3} msg] $msg
	}
	set result [p]
        namespace delete [namespace current]
	set result
    }

} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
    unset -nocomplain test_ns_var::x
} -body {
    namespace eval test_ns_var {
	variable result {}

	variable x
	array set x {1 2 3 4}
	upvar 0 x(1) foo
	lappend result [catch {set foo} msg] $msg
	unset x
	lappend result [catch {set foo 3} msg] $msg
        namespace delete [namespace current]
	set result
    }



} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
    [format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}

test var-2.1 {Tcl_LappendObjCmd, create var if new} {
    catch {unset x}
................................................................................
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
 

































































catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}
catch {namespace delete test_ns_var}






|
>






|

|
|

>
|
>
>
>
|
<

>

<



|

|



<

>




<
|
>



|

|

<

>
>
>







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

176
177
178

179
180
181
182
183
184
185
186
187

188
189
190
191
192
193

194
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210
211
212
213
....
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
	lappend result [catch {set foo} msg] $msg
        namespace delete ::test_ns_var
	lappend result [catch {set foo 3} msg] $msg
	lappend result [catch {set foo(3) 3} msg] $msg
    }
    p
} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} -body {
    variable result
    namespace eval test_ns_var {
	variable result
        namespace eval subns {
	    variable foo 2
	}
	upvar 0 subns::foo foo
	lappend [namespace parent]::result [catch {set foo} msg] $msg
        namespace delete subns
	lappend [namespace parent]::result [catch {set foo 3} msg] $msg
	lappend [namespace parent]::result [catch {set foo(3) 3} msg] $msg
        namespace delete [namespace current]
    }
    set result
} -cleanup {
    unset result
} -result {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}


test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
    variable result {}
    namespace eval test_ns_var {

	proc p {} {
	    array set x {1 2 3 4}
	    upvar 0 x(1) foo
	    lappend [namespace parent]::result [catch {set foo} msg] $msg
	    unset x
	    lappend [namespace parent]::result [catch {set foo 3} msg] $msg
	}
	set result [p]
        namespace delete [namespace current]

    }
    set result
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
    unset -nocomplain test_ns_var::x
} -body {

    variable result {}
    namespace eval test_ns_var {
	variable x
	array set x {1 2 3 4}
	upvar 0 x(1) foo
	lappend [namespace parent]::result [catch {set foo} msg] $msg
	unset x
	lappend [namespace parent]::result [catch {set foo 3} msg] $msg
        namespace delete [namespace current]

    }
    set result
} -cleanup {
    unset result
} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
    [format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}

test var-2.1 {Tcl_LappendObjCmd, create var if new} {
    catch {unset x}
................................................................................
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob


test var-25.0 {Look up command from deleted namespace} -body {
    variable msg
    set result [namespace eval test_ns_var {
        namespace delete [namespace current]
	# Doesn't result in a panic with message called Tcl_FindHashEntry on
	# deleted table when Tcl_FindCommand is called to find resolve "catch"  
	catch {lindex success} [namespace parent]::msg
    }]
    list $result $msg
}  -result {0 success} 

test var-25.1 {set a variable after deleting current namespace} {
    variable msg {}
    set result [namespace eval test_ns_var {
	variable var1
        namespace delete [namespace current]
	set var1 one
	namespace which -variable var1
    }]
} {::var1}

test var-25.3 {The current namespace after deleting the current namespace} {
    variable msg {}
    namespace eval test_ns_var {
	variable var1
        namespace delete [namespace current]
	namespace current
    }
} :: 

test var-25.4 {
    declare a namespace variable after deleting the current namespace
} {
    variable msg {}
    namespace eval test_ns_var {
	variable var1
        namespace delete [namespace current]
	variable var1
	set var1 one
	namespace which -variable var1
    }
} {::var1}

test var-25.5 {
    create a procedure after deleting the current namespace
} {
    namespace eval test_ns_var {
        namespace delete [namespace current]
	proc p1 {} {return hello}
	list [namespace which p1] [p1]
    } $msg
} {::p1 hello}

test var-25.6 {
    create a namespace after deleting the current namespace
} {
    namespace eval test_ns_var {
        namespace delete [namespace current]
	namespace eval one {namespace current}
    }
} {::one}

 

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}
catch {namespace delete test_ns_var}

Changes to unix/Makefile.in.

782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
test-tcl: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @[email protected]=`pwd`:$${@[email protected]}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	@rm gdb.run

lldb-test: ${TCLTEST_EXE}
	@echo "settings set target.env-vars @[email protected]=`pwd`:$${@[email protected]}" > lldb.run
	@echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
	$(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl \






|







782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
test-tcl: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @[email protected]=`pwd`:$${@[email protected]}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $${TESTFLAGS} -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	@rm gdb.run

lldb-test: ${TCLTEST_EXE}
	@echo "settings set target.env-vars @[email protected]=`pwd`:$${@[email protected]}" > lldb.run
	@echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
	$(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl \