static int ThreadEventProc(Tcl_Event *event, int mask)
{
int code;
ThreadEvent *data = (ThreadEvent *)event; /* event is really a ThreadEvent */
Tcl_Preserve(data->interpreter);
code = Tcl_EvalEx(data->interpreter, data->script, -1, TCL_EVAL_GLOBAL);
Tcl_Free(data->script);
if (code != TCL_OK) {
ThreadErrorProc(data->interpreter);
}
Tcl_Release(data->interpreter);
return 1;
}
Tcl_ThreadCreateType
NewTestThread(
ClientData clientData)
{
ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int result;
char *threadEvalScript;
/*
* Initialize the interpreter. This should be more general.
*/
tsdPtr->interp = Tcl_CreateInterp();
result = Tcl_Init(tsdPtr->interp);
result = TclThread_Init(tsdPtr->interp);
/*
* This is part of the test facility. Initialize _ALL_ test commands for
* use by the new thread.
*/
result = Tcltest_Init(tsdPtr->interp);
/*
* Update the list of threads.
*/
Tcl_MutexLock(&threadMutex);
ListUpdateInner(tsdPtr);
/*
* We need to keep a pointer to the alloc'ed mem of the script we are
* eval'ing, for the case that we exit during evaluation
*/
threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
strcpy(threadEvalScript, ctrlPtr->script);
Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
/*
* Notify the parent we are alive.
*/
Tcl_ConditionNotify(&ctrlPtr->condWait);
Tcl_MutexUnlock(&threadMutex);
/*
* Run the script.
*/
Tcl_Preserve((ClientData) tsdPtr->interp);
result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
}
/*
* Clean up.
*/
ListRemove(tsdPtr);
Tcl_Release((ClientData) tsdPtr->interp);
Tcl_DeleteInterp(tsdPtr->interp);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
}
