static inline void
InitCallChain(
    CallChain *callPtr,
    Object *oPtr,
    int flags)
{
    /*
     * Note that it's possible to end up with a NULL oPtr->selfCls here if
     * there is a call into stereotypical object after it has finished running
     * its destructor phase. Such things can't be cached for a long time so the
     * epoch can be bogus. [Bug 7842f33a5c]
     */

    callPtr->flags = flags &
	    (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
    if (oPtr->flags & USE_CLASS_CACHE) {
	oPtr = (oPtr->selfCls ? oPtr->selfCls->thisPtr : NULL);
	callPtr->flags |= USE_CLASS_CACHE;
    }
    if (oPtr) {
	callPtr->epoch = oPtr->fPtr->epoch;
	callPtr->objectCreationEpoch = oPtr->creationEpoch;
	callPtr->objectEpoch = oPtr->epoch;
    } else {
	callPtr->epoch = 0;
	callPtr->objectCreationEpoch = 0;
	callPtr->objectEpoch = 0;
    }
    callPtr->refCount = 1;
    callPtr->numChain = 0;
    callPtr->chain = callPtr->staticChain;
}

/*
 * ----------------------------------------------------------------------

IsStillValid(
    CallChain *callPtr,
    Object *oPtr,
    int flags,
    int mask)
{
    if ((oPtr->flags & USE_CLASS_CACHE)) {
	/*
	 * If the object is in a weird state (due to stereotype tricks) then
	 * just declare the cache invalid. [Bug 7842f33a5c]
	 */
	if (!oPtr->selfCls) {
	    return 0;
	}
	oPtr = oPtr->selfCls->thisPtr;
	flags |= USE_CLASS_CACHE;
    }
    return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
	    && (callPtr->epoch == oPtr->fPtr->epoch)
	    && (callPtr->objectEpoch == oPtr->epoch)
	    && ((callPtr->flags & mask) == (flags & mask)));

	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	    Tcl_StoreInternalRep(cacheInThisObj, &methodNameType, NULL);
	}

	/*
	 * Note that it's possible to end up with a NULL oPtr->selfCls here if
	 * there is a call into stereotypical object after it has finished
	 * running its destructor phase. It's quite a tangle, but at that
	 * point, we simply can't get stereotypes from the cache.
	 * [Bug 7842f33a5c]
	 */

	if (oPtr->flags & USE_CLASS_CACHE && oPtr->selfCls) {
	    if (oPtr->selfCls->classChainCache) {
		hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
			methodNameObj);
	    } else {
		hPtr = NULL;
	    }
	} else {
	    if (oPtr->chainCache != NULL) {

    CallChain *callPtr;
    struct ChainBuilder cb;
    Tcl_Size count;
    Foundation *fPtr = clsPtr->thisPtr->fPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;
    Object obj;

    /*
     * Note that it's possible to end up with a NULL clsPtr here if there is
     * a call into stereotypical object after it has finished running its
     * destructor phase. It's quite a tangle, but at that point, we simply
     * can't get stereotypes. [Bug 7842f33a5c]
     */

    if (clsPtr == NULL) {
	return NULL;
    }

    /*
     * Synthesize a temporary stereotypical object so that we can use existing
     * machinery to produce the stereotypical call chain.
     */

    memset(&obj, 0, sizeof(Object));

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     *
     * Note also that it's possible to end up with a null classPtr here if
     * there is a call into stereotypical object after it has finished running
     * its destructor phase. [Bug 7842f33a5c]
     */

  tailRecurse:
    if (classPtr == NULL) {
	return;
    }
    FOREACH(superPtr, classPtr->mixins) {
	if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
		filterDecl)) {
	    return 1;
	}
    }

	    for {set n 1} {$n <= $nworkers} {incr n} {
		lappend workers [set worker [[self] new]]
		$worker schedule {*}$args
	    }
	    return [uplevel 1 $script]
	} finally {
	    foreach worker $workers {$worker destroy}
	}
    }
    method run {nworkers} {
	set result {}
	set stopvar [my varname stop]
	set stop false
	my WithWorkers $nworkers [list my Work [my varname result]] {
	    after idle [namespace code {set stop true}]

    rename obj2 {}
    rename obj1 {}
    # doesn't crash
    return done
} -cleanup {
    rename obj {}
} -result done
test oo-35.7.1 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
    oo::class create base
    oo::class create RpcClient {
	superclass base
	method write name {
	    lappend ::result "RpcClient -> $name"
	}
	method create_bug {} {
	    MkObjectRpc create cfg [self] 111
	}
    }
    oo::class create MkObjectRpc {
	superclass base
	variable hdl
	constructor {rpcHdl mqHdl} {
	    set hdl $mqHdl
	    oo::objdefine [self] forward rpc $rpcHdl
	}
	destructor {
	    my rpc write otto-$hdl
	}
    }
    set ::result {}
} -body {
    set FH [RpcClient new]
    $FH create_bug
    $FH destroy
    join $result \n
} -cleanup {
    base destroy
} -result {}
test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
    oo::class create base
    oo::class create RpcClient {
	superclass base
	method write name {
	    lappend ::result "RpcClient -> $name"
	}
	method create_bug {} {
	    MkObjectRpc create cfg [self] 111
	}
	destructor {
	    lappend ::result "Destroyed"
	}
    }
    oo::class create MkObjectRpc {
	superclass base
	variable hdl
	constructor {rpcHdl mqHdl} {
	    set hdl $mqHdl
	    oo::objdefine [self] forward rpc $rpcHdl
	}
	destructor {
	    my rpc write otto-$hdl
	}
    }
    set ::result {}
} -body {
    set FH [RpcClient new]
    $FH create_bug
    $FH destroy
    join $result \n
} -cleanup {
    base destroy
} -result {Destroyed}
test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
    oo::class create base
    oo::class create RpcClient {
	superclass base
	variable interiorObjects
	method write name {
	    lappend ::result "RpcClient -> $name"
	}
	method create_bug {} {
	    set obj [MkObjectRpc create cfg [self] 111]
	    lappend interiorObjects $obj
	    return $obj
	}
	destructor {
	    lappend ::result "Destroyed"
	    # Explicit destroy of interior objects
	    foreach obj $interiorObjects {
		$obj destroy
	    }
	}
    }
    oo::class create MkObjectRpc {
	superclass base
	variable hdl
	constructor {rpcHdl mqHdl} {
	    set hdl $mqHdl
	    oo::objdefine [self] forward rpc $rpcHdl
	}
	destructor {
	    my rpc write otto-$hdl
	}
    }
    set ::result {}
} -body {
    set FH [RpcClient new]
    $FH create_bug
    $FH destroy
    join $result \n
} -cleanup {
    base destroy
} -result "Destroyed\nRpcClient -> otto-111"
test oo-36.1 {TIP #470: introspection within oo::define} {
    oo::define oo::object self
} ::oo::object
test oo-36.2 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
} -body {
    oo::define Cls self

TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE}];\
			  package ifneeded registry 1.3.7 [list load ${REG_DLL_FILE}]
TEST_LOAD_FACILITIES	= package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE} Tcltest];\
			  $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE	= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

TCLSH			= tclsh$(VER)${EXESUFFIX}
WINE			= @WINE@
CAT32			= cat32$(EXEEXT)

RMDIR		= rm -rf
MKDIR		= mkdir -p
SHELL		= @SHELL@
RM		= rm -f
COPY		= cp
LN		= ln
GDB		= gdb

###
# Tip 430 - ZipFS Modifications
###

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library

shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	$(GDB) ./$(TCLSH) --command=gdb.run
	rm gdb.run

shquotequote = $(subst ',\",$(subst ",\",$(1)))
gdb-test: tcltest
	@printf '%s ' 'set env TCL_LIBRARY=$(LIBRARY_DIR)' > gdb.run
	@printf '\n' >>gdb.run
	@printf '%s ' set args $(ROOT_DIR_NATIVE)/tests/all.tcl \
		$(call shquotequote,$(TESTFLAGS)) -singleproc 1 >> gdb.run
	$(GDB) ${TEST_EXE_FILE} --command=gdb.run
	rm gdb.run

depend:

Makefile: $(SRC_DIR)/Makefile.in
	./config.status