Tcl Source Code

Changes On Branch bug-e593adf103-core-8
Login

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
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 all variables, procedures, and child namespaces
contained in the namespace are deleted.
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
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
namespace instead.
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

Changes to generic/tcl.h.

886
887
888
889
890
891
892

893
894
895
896
897
898
899
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
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871







-
+







    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)
#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;
890
891
892
893
894
895
896

897
898
899
900
901
902
903
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904







+








	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;
1072
1073
1074
1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086
1073
1074
1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086
1087







-
+







#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
#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.
     */

1712
1713
1714
1715
1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726
1713
1714
1715
1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726
1727







-
+







     *
     * 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);
    Tcl_DeleteNamespace((Tcl_Namespace *)iPtr->globalNsPtr);

    /*
     * Delete all the hidden commands.
     */

    hTablePtr = iPtr->hiddenCmdTablePtr;
    if (hTablePtr != NULL) {
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
1760
1761
1762
1763
1764
1765
1766





1767
1768
1769
1770
1771
1772

1773
1774
1775
1776
1777
1778
1779







-
-
-
-
-






-







	    }
	    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);
2425
2426
2427
2428
2429
2430
2431

2432
2433
2434
2435
2436
2437
2438
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434







+







	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;
2623
2624
2625
2626
2627
2628
2629

2630
2631
2632
2633
2634
2635
2636
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633







+







	/*
         * 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;
2670
2671
2672
2673
2674
2675
2676

2677
2678
2679
2680
2681
2682
2683
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681







+







	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;
2955
2956
2957
2958
2959
2960
2961

2962
2963



2964
2965
2966
2967
2968
2969
2970
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972







+


+
+
+







     * 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.
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3415
3416
3417
3418
3419
3420
3421


3422
3423
3424
3425
3426
3427
3428







-
-







    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.
	 */
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3442
3443
3444
3445
3446
3447
3448

3449
3450
3451
3452
3453
3454
3455







-







    /*
     * 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
3527
3528
3529
3530
3531
3532
3533

3534
3535
3536
3537
3538
3539
3540
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540







+







     * 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;
}

/*
 *----------------------------------------------------------------------
 *
4515
4516
4517
4518
4519
4520
4521
4522

4523
4524
4525
4526
4527
4528
4529
4530

4531
4532
4533
4534
4535
4536
4537
4515
4516
4517
4518
4519
4520
4521

4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538







-
+








+







    return TCL_OK;
}

static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
    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)) {
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
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







+











+







	 * 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.
     */

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







-
+
+





-
+
+













-
+












-
+

-
+







	    /*
	     * 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;
	    result = TCL_ERROR;
	    goto cleanup;
	}
    }
    if (cmdPtr == NULL) {
	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
	if (!cmdPtr) {
	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
	    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) {

	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
	    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 (code != TCL_OK) {
	    if (result != TCL_OK) {
		Tcl_DecrRefCount(commandPtr);
		return code;
		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.
	     */
4664
4665
4666
4667
4668
4669
4670







4671

4672
4673
4674
4675
4676
4677
4678
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682

4683
4684
4685
4686
4687
4688
4689
4690







+
+
+
+
+
+
+
-
+







	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 TCL_OK;
    return result;
}

static int
Dispatch(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
4769
4770
4771
4772
4773
4774
4775
4776

4777
4778
4779
4780
4781
4782
4783
4781
4782
4783
4784
4785
4786
4787

4788
4789
4790
4791
4792
4793
4794
4795







-
+







    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);
        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?
     */

5012
5013
5014
5015
5016
5017
5018


5019
5020
5021
5022
5023
5024
5025
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039







+
+







	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);
}

5033
5034
5035
5036
5037
5038
5039

5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061







+







    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.
     */

8611
8612
8613
8614
8615
8616
8617

8618


8619
8620
8621
8622
8623
8624
8625
8626
8627
8628
8629
8630
8631
8632
8633
8634
8635
8636



8637
8638
8639
8640
8641
8642
8643
8626
8627
8628
8629
8630
8631
8632
8633

8634
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663







+
-
+
+


















+
+
+







 *
 *----------------------------------------------------------------------
 */

void
TclSetTailcall(
    Tcl_Interp *interp,
    Namespace *nsPtr,
    Tcl_Obj *listPtr)
    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).
     */

    NRE_callback *runPtr;

    for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
        if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
            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 --
 *
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
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







-
-
-
+
+
+
+
+




-
+




-
-
-
+
-
-
-
+
-
-
-
-
-
+







    }

    /*
     * 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;
    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 PopCallFrame can use it
     * command, then set it in the varFrame so that Tcl_PopCallFrame can use it
     * at the proper time.
     */

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

        iPtr->varFramePtr->tailcallNsPtr = iPtr->varFramePtr->nsPtr;
        /* The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled. */

	iPtr->varFramePtr->tailcallNsPtr->refCount++;
        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
        iPtr->varFramePtr->tailcallCmdPtr = Tcl_NewListObj(objc-1, objv+1);
    }
    return TCL_RETURN;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







+
+

+
-
+







int
TclNRTailcallEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    Tcl_Obj *listPtr = data[0];
    Tcl_Namespace *nsPtr = data[1];
    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);

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

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

int
TclNRReleaseValues(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
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
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







+

-
-
+













-
-
-
-
-
-
-
-





-
-
+
-
-






-
+







int
TclNRYieldToObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *listPtr;
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    Tcl_Obj *listPtr, *nsObjPtr;
    Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
    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;
    }

    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);
    listPtr = Tcl_NewListObj(objc-1, objv+1);
    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);
    TclSetTailcall(interp, nsPtr, listPtr);
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}

static int
RewindCoroutineCallback(
8999
9000
9001
9002
9003
9004
9005


9006
9007
9008
9009
9010
9011
9012
8990
8991
8992
8993
8994
8995
8996
8997
8998
8999
9000
9001
9002
9003
9004
9005







+
+







    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;
9373
9374
9375
9376
9377
9378
9379

9380
9381
9382
9383
9384
9385
9386
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380







+







    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
2614
2615
2616
2617
2618
2619
2620



2621
2622
2623
2624

2625
2626
2627
2628
2629
2630
2631
2632







-
-
-




-
+







    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);
    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords - 1,	envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileThrowCmd --
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945

3946
3947
3948
3949
3950
3951
3952
3930
3931
3932
3933
3934
3935
3936

3937
3938
3939
3940

3941
3942
3943
3944
3945
3946
3947
3948







-




-
+







    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);
    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
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147







+







    }

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

    TclHandleRelease(codePtr->interpHandle);
    TclNsDecrRefCount(codePtr->nsPtr);
    ckfree(codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
2802
2803
2804
2805
2806
2807
2808

2809
2810
2811
2812
2813
2814
2815
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817







+







    }

    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
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160







-
+







	    *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 (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;
1711
1712
1713
1714
1715
1716
1717
1718

1719
1720
1721
1722
1723
1724
1725
1711
1712
1713
1714
1715
1716
1717

1718
1719
1720
1721
1722
1723
1724
1725







-
+







	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DYING) {
    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));
1907
1908
1909
1910
1911
1912
1913

1914
1915
1916
1917
1918
1919
1920
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921







+







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







-
+
+










-
-
-
-
-
-
-
-
-
-
-







	    fflush(stdout);
	}
#endif
	yieldParameter = 0;
	Tcl_SetObjResult(interp, OBJ_AT_TOS);
	goto doYield;

    case INST_YIELD_TO_INVOKE:
    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;
	}
	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) {
2439
2440
2441
2442
2443
2444
2445
2446

2447
2448
2449

2450
2451
2452
2453
2454
2455
2456
2429
2430
2431
2432
2433
2434
2435

2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447







-
+



+







	 * 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);
	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;
2464
2465
2466
2467
2468
2469
2470
2471

2472
2473
2474
2475
2476
2477
2478
2455
2456
2457
2458
2459
2460
2461

2462
2463
2464
2465
2466
2467
2468
2469







-
+







	TEBC_YIELD();
	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
		INT2PTR(yieldParameter), NULL, NULL);
	return TCL_OK;
    }

    case INST_TAILCALL: {
	Tcl_Obj *listPtr, *nsObjPtr;
	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));
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510





2511


2512

2513
2514
2515
2516
2517
2518
2519
2491
2492
2493
2494
2495
2496
2497




2498
2499
2500
2501
2502
2503
2504
2505

2506
2507
2508
2509
2510
2511
2512
2513







-
-
-
-
+
+
+
+
+

+
+
-
+








	/*
	 * 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);
	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->tailcallPtr = listPtr;
	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
290
291
292
293
294
295
296




297
298
299
300
301
302
303







-
-
-
-







				 * 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
413
414
415
416
417
418
419
420
421
422
423
424





425
426
427
428
429
430
431
409
410
411
412
413
414
415





416
417
418
419
420
421
422
423
424
425
426
427







-
-
-
-
-
+
+
+
+
+







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

1152
1153
1154
1155
1156
1157
1158

1159

1160
1161
1162
1163
1164
1165
1166
1148
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162
1163







+
-
+







				 * 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    *tailcallPtr;
    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
2825
2826
2827
2828
2829
2830
2831
2832


2833
2834
2835
2836
2837
2838
2839
2822
2823
2824
2825
2826
2827
2828

2829
2830
2831
2832
2833
2834
2835
2836
2837







-
+
+







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

/*
4829
4830
4831
4832
4833
4834
4835
4836



4837
4838
4839
4840
4841
4842
4843
4827
4828
4829
4830
4831
4832
4833

4834
4835
4836
4837
4838
4839
4840
4841
4842
4843







-
+
+
+








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

#define TclGetCurrentNamespace(interp) \
    (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr
    (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
333
334
335
336
337
338
339
340
341
342
343


344
345
346
347
348
349
350
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
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350
351







-
-
+
+












-
+

















-
+
+








    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
	 * 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->activationCount++;
    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->level = (iPtr->varFramePtr->level + 1);
    } else {
	framePtr->level = 0;
    }
    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;
    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;
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
375
376
377
378
379
380
381

382
383
384
385
386
387
388







-








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.
     */

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







-
+
-
-


+
-
+
-
-
-
-
-


-
-
+
+
+
+
+







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

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

    /* Corresponds to refCount++ in Tcl_PushCallFrame */
    nsPtr = framePtr->nsPtr;
    TclNsDecrRefCount(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);
    if (framePtr->tailcallNsPtr) {
	TclSetTailcall(interp, framePtr->tailcallNsPtr,
	    framePtr->tailcallCmdPtr);
	TclNsDecrRefCount(framePtr->tailcallNsPtr);
	framePtr->tailcallNsPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPushStackFrame --
780
781
782
783
784
785
786
787
788


789
790
791
792
793
794
795
777
778
779
780
781
782
783


784
785
786
787
788
789
790
791
792







-
-
+
+







    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;
    /* 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;
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
927
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
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
926
927
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







+
-
+


-
-
+
+



-
-
-
-
+
+
+
+
+
















-

+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
-
-
-
+
+
+
+
+
+
+
+













-
+
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+

+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+

+
-
+
+
+
+
+
+
+
+


-
+

-
-
-
-
+
+
+
+

-
-
+
-
-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+
-
-







 *----------------------------------------------------------------------
 */

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

    /*
     * Ensure that this namespace doesn't get deallocated in the meantime.
     */
    nsPtr->refCount++;
    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]
     *
     * Note that setting this field requires access to the internal definition
     * of namespaces, so it should only be accessed by code that knows about
     * being careful with reentrancy.
     */

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

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

    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.
     */
	/*
	 * 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);
	}
    }
	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
	/*
	 * 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.
     * linked ensemble commands, of course). Note that this code is actually
     * reentrant so command delete traces won't purturb things badly.
     */
	 *
	 * 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->ensembles != NULL) {
	EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;

	    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.
	 */
	 * Splice out and link to indicate that we've already been killed.

	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
	nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
	ensemblePtr->next = ensemblePtr;
	Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
	|| 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;
    }

    /*
     * If the namespace is on the call frame stack, it is marked as "dying"
     * Remove the namespace from its parent's child hashtable.
     * (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
    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.
	 * 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.
	 */
     */

    if (nsPtr->commandPathLength != 0) {
	UnlinkNsPath(nsPtr);
	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
	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
	     * "errorInfo" and "errorCode" variables for errors that occurred
	     * while it was being torn down. Try to clear the variable list
	     * one last time.
	     */
     * interpreted as valid by, e.g., the cache validation code for cached
     * command references in Tcl_GetCommandFromObj.
     */

    nsPtr->nsId = 0;
	    TclDeleteNamespaceVars(nsPtr);

    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);
	Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		ckfree(nsPtr->childTablePtr);
	    }
	if (nsPtr->childTablePtr != NULL) {
	    Tcl_DeleteHashTable(nsPtr->childTablePtr);
	    ckfree(nsPtr->childTablePtr);
	}
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	TclNsDecrRefCount(nsPtr);
	    nsPtr ->flags |= NS_DEAD;
	} else {
	    /*
	     * Restore the ::errorInfo and ::errorCode traces.
	     */
    } else {
	/*
	 * Restore the ::errorInfo and ::errorCode traces.
	 */

	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
	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.
	     */
	/*
	 * 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);
	}
	nsPtr->flags &= ~(NS_DYING|NS_DEAD);
    }
    }
    TclNsDecrRefCount(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
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
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







-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-







 */

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.
     */

    NamespaceFree(nsPtr);
    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 --
 *
1317
1318
1319
1320
1321
1322
1323
1324
1325


1326
1327
1328
1329
1330
1331
1332
1281
1282
1283
1284
1285
1286
1287


1288
1289
1290
1291
1292
1293
1294
1295
1296







-
-
+
+







 *----------------------------------------------------------------------
 */

void
TclNsDecrRefCount(
    Namespace *nsPtr)
{
    if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
	NamespaceFree(nsPtr);
    if (nsPtr->refCount-- == 1) {
	TclTeardownNamespace(nsPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Export --
2217
2218
2219
2220
2221
2222
2223
2224

2225
2226
2227
2228
2229
2230
2231
2181
2182
2183
2184
2185
2186
2187

2188
2189
2190
2191
2192
2193
2194
2195







-
+







     * 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;
	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 == ':') {
2435
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2399
2400
2401
2402
2403
2404
2405

2406
2407
2408
2409
2410
2411
2412
2413







-
+







 */
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DYING)) {
    if (!(nsPtr->flags & NS_DEAD)) {
	    return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
2608
2609
2610
2611
2612
2613
2614
2615

2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
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
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682












2683
2684
2685
2686
2687
2688
2689
2572
2573
2574
2575
2576
2577
2578

2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599

2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617

2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
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







-
+




















-
+

















-
+



















-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+







	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)) {
		    || !(realNsPtr->flags & NS_DEAD)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * Next, check along the path.
	 */

	for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
	    pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
	    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)) {
		    && !(realNsPtr->flags & NS_DEAD)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * If we've still not found the command, look in the global namespace
	 * as a last resort.
	 */

	if (cmdPtr == NULL) {
	    (void) TclGetNamespaceForQualName(interp, name, NULL,
		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		    && !(realNsPtr->flags & NS_DEAD)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    } else {
	Namespace *nsPtr[2];
	register int search;

	TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

	/*
	 * 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);
		}
	    }
	}
	    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;
    }

2905
2906
2907
2908
2909
2910
2911
2912

2913
2914
2915
2916
2917
2918
2919
2872
2873
2874
2875
2876
2877
2878

2879
2880
2881
2882
2883
2884
2885
2886







-
+







	 * 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)
	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) {
3264
3265
3266
3267
3268
3269
3270
3271

3272
3273
3274
3275
3276
3277
3278
3231
3232
3233
3234
3235
3236
3237

3238
3239
3240
3241
3242
3243
3244
3245







-
+







     * 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)) {
		|| (((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;
	}
4698
4699
4700
4701
4702
4703
4704



4705
4706
4707
4708
4709
4710
4711
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681







+
+
+







	/*
	 * 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;
}

/*
 *----------------------------------------------------------------------
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
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







-
+












-


+




+







	     &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)) {
    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;
    }

    nsPtr->refCount++;
    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
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 || ((
    if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
	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
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879







+
+







     * 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;
    }
1486
1487
1488
1489
1490
1491
1492


1493
1494
1495
1496
1497
1498
1499
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503







+
+







    /*
     * 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
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)) {
                && !(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
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
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)) {
	    && !(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
987
988
989
990
991
992
993



994
995
996
997
998
999
1000
1001
1002
1003







-
-
-
+
+
+







    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 {}
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 ""}

Changes to tests/coroutine.test.

654
655
656
657
658
659
660
661

662
663
664

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

685
686
687

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704

705
706
707

708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725

726
727
728

729
730
731
732
733
734
735
654
655
656
657
658
659
660

661
662
663

664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683

684
685
686

687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703

704
705
706

707
708
709
710
711
712
713
714
715
716
717
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 {
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
} -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
	yield OUT
	lappend ::result b
	$y ::return -level 0 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
} -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 b
	yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
} -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
	yield OUT
	lappend ::result b
	$y ::return -level 0 -cotest [namespace delete ::cotest] 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
} -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
} -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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    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
}

878
879
880
881
882
883
884









885
886
887
888
889
890
891
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918







+
+
+
+
+
+
+
+
+







    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
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147







-
+







    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"}}
} {:: 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]
204
205
206
207
208
209
210















































211
212
213
214
215
216
217
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    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
1585
1586
1587
1588
1589
1590
1591
1592

1593
1594
1595
1596
1597
1598
1599
1632
1633
1634
1635
1636
1637
1638

1639
1640
1641
1642
1643
1644
1645
1646







-
+







    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} -result {::test_ns_1}
} -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] \
2084
2085
2086
2087
2088
2089
2090
2091

2092
2093
2094
2095
2096
2097
2098
2131
2132
2133
2134
2135
2136
2137

2138
2139
2140
2141
2142
2143
2144
2145







-
+







	}
	proc bar {} {
	    namespace delete [namespace current]
	}
	namespace ensemble create
    }
    list [ns foo] [info exist ns::x]
} {1 0}
} {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
2739
2740
2741
2742
2743
2744
2745
2746
2747

2748
2749
2750
2751
2752
2753
2754
2786
2787
2788
2789
2790
2791
2792


2793
2794
2795
2796
2797
2798
2799
2800







-
-
+







    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 {
} -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*] {
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293

















3294
3295
3296
3297
3298
3299
3300
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







-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	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.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
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
	    return $::result
	}
	destructor {
	    lappend result [self] $state [info commands localcmdexists]
	    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
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 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
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







-
+
+






-
+

-
-
+
+

+
-
-
-
+
+
+
+
+

+

-



-
+

-
+



-

+




-
-
+
+



-
+

-
+

+
-
-
+
+
+







	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} {
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 result [catch {set foo} msg] $msg
	lappend [namespace parent]::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
	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
    }
} {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}}
    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 {
	variable result
	proc p {} {
	    array set x {1 2 3 4}
	    upvar 0 x(1) foo
	    lappend result [catch {set foo} msg] $msg
	    lappend [namespace parent]::result [catch {set foo} msg] $msg
	    unset x
	    lappend result [catch {set foo 3} msg] $msg
	    lappend [namespace parent]::result [catch {set foo 3} msg] $msg
	}
	set result [p]
        namespace delete [namespace current]
	set result
    }
    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 result {}
    namespace eval test_ns_var {
	variable x
	array set x {1 2 3 4}
	upvar 0 x(1) foo
	lappend result [catch {set foo} msg] $msg
	lappend [namespace parent]::result [catch {set foo} msg] $msg
	unset x
	lappend result [catch {set foo 3} msg] $msg
	lappend [namespace parent]::result [catch {set foo 3} msg] $msg
        namespace delete [namespace current]
    }
	set result
    }
    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}
1453
1454
1455
1456
1457
1458
1459
1460


































































1461
1462
1463
1464
1465
1466
1467
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







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







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
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 @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > 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
	@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 @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > 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 \