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;
}