Posted to tcl by patthoyts at Tue May 20 14:05:17 GMT 2008view pretty
/* * Test the calling of the cleanup procedures that are registered * with Tcl_SetAssocData. * * It seems that these cleanup procedures are only called when a child * interpreter is deleted. When the main interpreter is closed in tclsh * they are not called. * * Using the code below I tested this extension with tcl 8.4.15 looking for * PkgFree to be printed out. * * C:\opt\tcl\src>tclsh * % load demo.dll * PkgInit * % exit * * C:\opt\tcl\src>tclsh * % interp create test * test * % test eval {load demo.dll} * PkgInit * % interp delete test * PkgFree * * It seems that to check for this kind of major interp cleanup you must * have scripts of the following style: * load demo.dll * puts "done" * rename exit ::tcl::exit * with this it works correctly in the primary interpreter. * * compile this with: * cl -W3 -MD -I/opt/tcl/include demo.c -link \ * -dll \opt\tcl\lib\tclstub84.lib -out:demo.dll */ #define USE_TCL_STUBS #include "tcl.h" typedef struct Package { unsigned long magic; } Package; static void PkgFree(ClientData clientData, Tcl_Interp *interp) { printf("PkgFree\n"); fflush(stdout); ckfree((char *)clientData); } int DLLEXPORT Demo_Init(Tcl_Interp *interp) { Package *pkgPtr = NULL; Tcl_InitStubs(interp, TCL_VERSION, 0); pkgPtr = (Package *)ckalloc(sizeof(Package)); pkgPtr->magic = 0xCAFEBABE; printf("PkgInit\n"); Tcl_SetAssocData(interp, "DemoPackage", PkgFree, (ClientData)pkgPtr); Tcl_PkgProvide(interp, "Demo", "1.0"); return TCL_OK; }