diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 2 | ||||
| -rw-r--r-- | generic/tclBasic.c | 8 | ||||
| -rw-r--r-- | generic/tclInt.h | 1 | ||||
| -rw-r--r-- | generic/tclTest.c | 16 | ||||
| -rw-r--r-- | generic/tclThreadTest.c | 8 |
5 files changed, 27 insertions, 8 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index de314fa..b44b9c3 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2396,7 +2396,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)())) + (((Tcl_SetPanicProc)(Tcl_ConsolePanic), Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9c2736c..81e1927 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8500,18 +8500,12 @@ TclNRTailcallObjCmd( if (objc > 1) { Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - Tcl_Namespace *ns1Ptr; /* The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ - listPtr = Tcl_NewListObj(objc, objv); - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) - || (nsPtr != ns1Ptr)) { - Tcl_Panic("Tailcall failed to find the proper namespace"); - } + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); iPtr->varFramePtr->tailcallPtr = listPtr; diff --git a/generic/tclInt.h b/generic/tclInt.h index 64e7c67..9cd4578 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4634,6 +4634,7 @@ MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init; MODULE_SCOPE Tcl_PackageInitProc TclThread_Init; MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init; MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; +MODULE_SCOPE void TclThreadTestFinalize(); /* *---------------------------------------------------------------- diff --git a/generic/tclTest.c b/generic/tclTest.c index ac01ecf..814d734 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -44,6 +44,7 @@ DLLEXPORT int Tcltest_Init(Tcl_Interp *interp); DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); +EXTERN TCL_NORETURN void Tcltest_Exit(ClientData clientData); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect @@ -570,6 +571,10 @@ Tcltest_Init( return TCL_ERROR; } + + /* Finalizer */ + Tcl_SetExitProc(Tcltest_Exit); + /* * Create additional commands and math functions for testing Tcl. */ @@ -797,6 +802,17 @@ Tcltest_SafeInit( return Procbodytest_SafeInit(interp); } +TCL_NORETURN void Tcltest_Exit( + ClientData clientData +) { + int status = PTR2INT(clientData); + Tcl_Finalize(); + TclThreadTestFinalize(); + TclpExit(status); + Tcl_Panic("OS exit failed!"); +} + + /* *---------------------------------------------------------------------- * diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 3a6fc43..6da26db 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -176,6 +176,14 @@ TclThread_Init( } +void TclThreadTestFinalize() { + if (errorProcString != NULL) { + ckfree(errorProcString); + errorProcString= NULL; + } + return; +} + /* *---------------------------------------------------------------------- * |