Posted to tcl by patthoyts at Tue May 20 14:05:17 GMT 2008view raw
- /*
- * 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;
- }