#include #define FN "testfile" /* This script will work in all Tcl versions, and the file will be deleted. */ #define SCRIPT "after 1000 {puts a;close a;puts aa;set t t}; vwait t; after 1000 {puts b;exit}; vwait t" /* This script will work in Tcl 8.5.11, and the file will be deleted. */ /* This script will cause a segfault in Tcl 8.5.12 and 8.6, and the file won't be deleted. */ /*#define SCRIPT "after 1000 {puts b;exit}; vwait t"*/ static int XCloseProc (ClientData instanceData, Tcl_Interp *interp) { Tcl_Obj *o = Tcl_NewStringObj(FN, -1); Tcl_IncrRefCount(o); Tcl_FSDeleteFile(o); Tcl_DecrRefCount(o); return 0; } static int XInputProc (ClientData instanceData, char *buf, int toRead, int *errorCode) { return 0; } static int XOutputProc (ClientData instanceData, const char *buf, int toWrite, int *errorCode) { return toWrite; } static void XWatchProc (ClientData instanceData, int mask) {} static int XGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr) { return 0; } static Tcl_ChannelType xChannelType = { (char *) "x", TCL_CHANNEL_VERSION_2, XCloseProc, XInputProc, XOutputProc, NULL, NULL, NULL, XWatchProc, XGetHandleProc, NULL, NULL, NULL, NULL }; int main (int argc, char *argv[]) { Tcl_Interp *in; Tcl_Channel chan; Tcl_FindExecutable(argv[0]); Tcl_Init(in = Tcl_CreateInterp()); chan = Tcl_CreateChannel(&xChannelType, "a", NULL, TCL_READABLE|TCL_WRITABLE); Tcl_RegisterChannel(in, chan); Tcl_Eval(in, SCRIPT); return 0; }