Tcl Source Code

Artifact e0ce9a1e419ae54df0241781ba91f9c6b6917cfa:

#include <tcl.h>
#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;
}