Tcl Source Code

2013-02-25  Don Porter  <[email protected]>

	* tests/assocd.test:	[Bugs 3605719,3605720] Test independence.
	* tests/basic.test:	Thanks Rolf Ade for patches.

2013-02-23  Jan Nijtmans  <[email protected]>

	    NOERRN();
	    moveins(v->nfa, right, lp);
	}
	seencontent = 1;

	/* NB, recursion in parseqatom() may swallow rest of branch */
	parseqatom(v, stopper, type, lp, right, t);

    }

    if (!seencontent) {		/* empty branch */
	if (!partial) {
	    NOTE(REG_UUNSPEC);
	}
	assert(lp == left);

    t = top->right;
    if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
	t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
    } else {
	EMPTYARC(atom->end, rp);
	t->right = subre(v, '=', 0, atom->end, rp);
    }

    assert(SEE('|') || SEE(stopper) || SEE(EOS));
    t->flags |= COMBINE(t->flags, t->right->flags);
    top->flags |= COMBINE(top->flags, t->flags);
}

/*
 - nonword - generate arcs for non-word-character ahead or behind

/*
 * table of function pointers for generic manipulation functions. A regex_t's
 * re_fns points to one of these.
 */

struct fns {
    VOID FUNCPTR(free, (regex_t *));
};

/*
 * the insides of a regex_t, hidden behind a void *
 */

struct guts {

    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    ClientData clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}

declare 258 {
    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
	    const char *varName, const char *localName, int flags)
}

declare 259 {
    int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
	    const char *part2, const char *localName, int flags)
}
# Removed in 9.0
#declare 260 {
#    int Tcl_VarEval(Tcl_Interp *interp, ...)
#}

declare 261 {
    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
}

declare 262 {
    ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    ClientData prevClientData)
}
declare 263 {
    int Tcl_Write(Tcl_Channel chan, const char *s, int slen)

TCLAPI void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 257 */
TCLAPI void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* 258 */
TCLAPI int		Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
				const char *varName, const char *localName,
				int flags);
/* 259 */
TCLAPI int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
/* Slot 260 is reserved */
/* 261 */
TCLAPI ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 262 */
TCLAPI ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 263 */
TCLAPI int		Tcl_Write(Tcl_Channel chan, const char *s, int slen);

    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
    void (*reserved253)(void);
    int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
    void (*reserved255)(void);
    void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
    int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
    int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
    void (*reserved260)(void);
    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
    int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
    void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
    void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */

#define Tcl_UnsetVar2 \
	(tclStubsPtr->tcl_UnsetVar2) /* 254 */
/* Slot 255 is reserved */
#define Tcl_UntraceVar2 \
	(tclStubsPtr->tcl_UntraceVar2) /* 256 */
#define Tcl_UpdateLinkedVar \
	(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
#define Tcl_UpVar \
	(tclStubsPtr->tcl_UpVar) /* 258 */
#define Tcl_UpVar2 \
	(tclStubsPtr->tcl_UpVar2) /* 259 */
/* Slot 260 is reserved */
#define Tcl_VarTraceInfo \
	(tclStubsPtr->tcl_VarTraceInfo) /* 261 */
#define Tcl_VarTraceInfo2 \
	(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
#define Tcl_Write \
	(tclStubsPtr->tcl_Write) /* 263 */
#define Tcl_WrongNumArgs \
	(tclStubsPtr->tcl_WrongNumArgs) /* 264 */
#define Tcl_DumpActiveMemory \

	Tcl_UnsetVar2(interp, varName, NULL, flags)
#define Tcl_GetVar(interp, varName, flags) \
	Tcl_GetVar2(interp, varName, NULL, flags)
#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
	Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
	Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)





/*
 * Deprecated Tcl procedures:
 */

#ifndef TCL_NO_DEPRECATED
#   define Tcl_EvalObj(interp,objPtr) \
	    Tcl_EvalObjEx((interp),(objPtr),0)
#   define Tcl_GlobalEvalObj(interp,objPtr) \
	    Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#endif /* !TCL_NO_DEPRECATED */

#endif /* _TCLDECLS */

    const char *nameString;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    nameString = Tcl_GetString(objv[1]);
    if (Tcl_TraceVar(interp, nameString,
	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, &done) != TCL_OK) {
	return TCL_ERROR;
    };
    done = 0;
    foundEvent = 1;
    while (!done && foundEvent) {

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>







































































































/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.

    Tcl_Channel stderrChannel;	/* Static variable for the stderr channel. */
    int stderrInitialized;
    Tcl_Encoding binaryEncoding;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;













/*
 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer(int length);
static void		ChannelTimerProc(ClientData clientData);
static int		CheckChannelErrors(ChannelState *statePtr,

    CloseCallback *cbPtr, *cbPrevPtr;

    for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
	    if (cbPrevPtr == NULL) {
		statePtr->closeCbPtr = cbPtr->nextPtr;


	    }
	    ckfree(cbPtr);
	    break;
	}
	cbPrevPtr = cbPtr;
    }
}

#if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
#   define EAGAIN EWOULDBLOCK
#endif
#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
#error one of EWOULDBLOCK or EAGAIN must be defined
#endif

/*
 * The following structure encapsulates the state for a background channel
 * copy. Note that the data buffer for the copy will be appended to this
 * structure.
 */

typedef struct CopyState {
    struct Channel *readPtr;	/* Pointer to input channel. */
    struct Channel *writePtr;	/* Pointer to output channel. */
    int readFlags;		/* Original read channel flags. */
    int writeFlags;		/* Original write channel flags. */
    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
    Tcl_WideInt total;		/* Total bytes transferred (written). */
    Tcl_Interp *interp;		/* Interp that started the copy. */
    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
    int bufSize;		/* Size of appended buffer. */
    char buffer[1];		/* Copy buffer, this must be the last
				 * field. */
} CopyState;

/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {

/*
 * The following defines the *default* buffer size for channels.
 */

#define CHANNELBUFFER_DEFAULT_SIZE	(1024 * 4)

/*
 * Structure to record a close callback. One such record exists for each close
 * callback registered for a channel.
 */

typedef struct CloseCallback {
    Tcl_CloseProc *proc;	/* The procedure to call. */
    ClientData clientData;	/* Arbitrary one-word data to pass to the
				 * callback. */
    struct CloseCallback *nextPtr;
				/* For chaining close callbacks. */
} CloseCallback;

/*
 * The following structure describes the information saved from a call to
 * "fileevent". This is used later when the event being waited for to invoke
 * the saved script in the interpreter designed in this record.
 */

typedef struct EventScriptRecord {

    int outEofChar;		/* If nonzero, append this to the channel when
				 * it is closed if it is open for writing. */
    int unreportedError;	/* Non-zero if an error report was deferred
				 * because it happened in the background. The
				 * value is the POSIX error code. */
    int refCount;		/* How many interpreters hold references to
				 * this IO channel? */

    CloseCallback *closeCbPtr;	/* Callbacks registered to be called when the
				 * channel is closed. */
    char *outputStage;		/* Temporary staging buffer used when
				 * translating EOL before converting from
				 * UTF-8 to external form. */
    ChannelBuffer *curOutPtr;	/* Current output buffer being filled. */
    ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
    ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */

    int interestMask;		/* Mask of all events this channel has
				 * handlers for. */
    EventScriptRecord *scriptRecordPtr;
				/* Chain of all scripts registered for event
				 * handlers ("fileevent") on this channel. */
    int bufSize;		/* What size buffers to allocate? */
    Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */
    CopyState *csPtrR;		/* State of background copy for which channel is input, or NULL. */

    CopyState *csPtrW;		/* State of background copy for which channel is output, or NULL. */

    Channel *topChanPtr;	/* Refers to topmost channel in a stack. Never
				 * NULL. */
    Channel *bottomChanPtr;	/* Refers to bottommost channel in a stack.
				 * This channel can be relied on to live as
				 * long as the channel state. Never NULL. */
    struct ChannelState *nextCSPtr;
				/* Next in list of channels currently open. */

					 * Used by Channel Tcl_Obj type to
					 * determine if we have to revalidate
					 * the channel. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on
					 * the channel is allowed. */

/*
 * For each channel handler registered in a call to Tcl_CreateChannelHandler,
 * there is one record of the following type. All of records for a specific
 * channel are chained together in a singly linked list which is stored in the
 * channel structure.
 */

typedef struct ChannelHandler {
    Channel *chanPtr;		/* The channel structure for this channel. */
    int mask;			/* Mask of desired events. */
    Tcl_ChannelProc *proc;	/* Procedure to call in the type of
				 * Tcl_CreateChannelHandler. */
    ClientData clientData;	/* Argument to pass to procedure. */
    struct ChannelHandler *nextPtr;
    				/* Next one in list of registered handlers. */
} ChannelHandler;

/*
 * This structure keeps track of the current ChannelHandler being invoked in
 * the current invocation of ChannelHandlerEventProc. There is a potential
 * problem if a ChannelHandler is deleted while it is the current one, since
 * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
 * problem, structures of the type below indicate the next handler to be
 * processed for any (recursively nested) dispatches in progress. The
 * nextHandlerPtr field is updated if the handler being pointed to is deleted.
 * The nextPtr field is used to chain together all recursive invocations, so
 * that Tcl_DeleteChannelHandler can find all the recursively nested
 * invocations of ChannelHandlerEventProc and compare the handler being
 * deleted against the NEXT handler to be invoked in that invocation; when it
 * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
 * field of the structure to the next handler.
 */

typedef struct NextChannelHandler {
    ChannelHandler *nextHandlerPtr;
				/* The next handler to be invoked in this
				 * invocation. */
    struct NextChannelHandler *nestedHandlerPtr;
				/* Next nested invocation of
				 * ChannelHandlerEventProc. */
} NextChannelHandler;

/*
 * The following structure describes the event that is added to the Tcl event
 * queue by the channel handler check procedure.
 */

typedef struct ChannelHandlerEvent {
    Tcl_Event header;		/* Standard header for all events. */
    Channel *chanPtr;		/* The channel that is ready. */
    int readyMask;		/* Events that have occurred. */
} ChannelHandlerEvent;

/*
 * The following structure is used by Tcl_GetsObj() to encapsulates the state
 * for a "gets" operation.
 */

typedef struct GetsState {
    Tcl_Obj *objPtr;		/* The object to which UTF-8 characters will
				 * be appended. */
    char **dstPtr;		/* Pointer into objPtr's string rep where next
				 * character should be stored. */
    Tcl_Encoding encoding;	/* The encoding to use to convert raw bytes to
				 * UTF-8. */
    ChannelBuffer *bufPtr;	/* The current buffer of raw bytes being
				 * emptied. */
    Tcl_EncodingState state;	/* The encoding state just before the last
				 * external to UTF-8 conversion in
				 * FilterInputBytes(). */
    int rawRead;		/* The number of bytes removed from bufPtr in
				 * the last call to FilterInputBytes(). */
    int bytesWrote;		/* The number of bytes of UTF-8 data appended
				 * to objPtr during the last call to
				 * FilterInputBytes(). */
    int charsWrote;		/* The corresponding number of UTF-8
				 * characters appended to objPtr during the
				 * last call to FilterInputBytes(). */
    int totalChars;		/* The total number of UTF-8 characters
				 * appended to objPtr so far, just before the
				 * last call to FilterInputBytes(). */
} GetsState;

/*
 * The length of time to wait between synthetic timer events. Must be zero or
 * bad things tend to happen.
 */

#define SYNTHETIC_EVENT_TIME	0


/*
 * Maximum number of levels of nesting permitted in Tcl commands (used to
 * catch infinite recursion).
 */

#define MAX_NESTING_DEPTH	1000

/*
 * TIP#143 limit handler internal representation.
 */

struct LimitHandler {
    int flags;			/* The state of this particular handler. */
    Tcl_LimitHandlerProc *handlerProc;
				/* The handler callback. */
    ClientData clientData;	/* Opaque argument to the handler callback. */
    Tcl_LimitHandlerDeleteProc *deleteProc;
				/* How to delete the clientData. */
    LimitHandler *prevPtr;	/* Previous item in linked list of
				 * handlers. */
    LimitHandler *nextPtr;	/* Next item in linked list of handlers. */
};

/*
 * Values for the LimitHandler flags field.
 *	LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
 *		processed; handlers are never to be entered reentrantly.
 *	LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
 *		should not normally be observed because when a handler is
 *		deleted it is also spliced out of the list of handlers, but
 *		even so we will be careful.
 */

#define LIMIT_HANDLER_ACTIVE	0x01
#define LIMIT_HANDLER_DELETED	0x02

/*
 * The macro below is used to modify a "char" value (e.g. by casting it to an
 * unsigned character) so that it can be used safely with macros such as
 * isspace.
 */

#define UCHAR(c) ((unsigned char) (c))

typedef struct {
    Tcl_Interp *interp;		/* The interpreter that the limit callback was
				 * attached to. This is not the interpreter
				 * that the callback runs in! */
    long type;			/* The type of callback that this is. */
} ScriptLimitCallbackKey;
































/*
 * Prototypes for local static functions:
 */

static int		AliasCreate(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,

    int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    int code;

    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
	    LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));

    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	ckfree(linkPtr);
	return TCL_ERROR;
    }

    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	ckfree(linkPtr);
    }
    return code;
}


 */

void
Tcl_UnlinkVar(
    Tcl_Interp *interp,		/* Interpreter containing variable to unlink */
    const char *varName)	/* Global variable in interp to unlink. */
{
    Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);

    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,

 */

void
Tcl_UpdateLinkedVar(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *varName)	/* Name of global variable that is linked. */
{
    Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
    int savedFlag;

    if (linkPtr == NULL) {
	return;
    }
    savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
    linkPtr->flags |= LINK_BEING_UPDATED;
    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
	    TCL_GLOBAL_ONLY);
    /*
     * Callback may have unlinked the variable. [Bug 1740631]
     */
    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
	    LinkTraceProc, NULL);
    if (linkPtr != NULL) {
	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
    }
}

/*
 *----------------------------------------------------------------------

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    ckfree(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}
	return NULL;
    }

    /*

EstablishErrorCodeTraces(
    ClientData clientData,
    Tcl_Interp *interp,
    const char *name1,
    const char *name2,
    int flags)
{
    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
	    ErrorCodeRead, NULL);
    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
	    EstablishErrorCodeTraces, NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *

EstablishErrorInfoTraces(
    ClientData clientData,
    Tcl_Interp *interp,
    const char *name1,
    const char *name2,
    int flags)
{
    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
	    ErrorInfoRead, NULL);
    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
	    EstablishErrorInfoTraces, NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
     * as appropriate for the target type. This frees the old internal
     * representation.
     */

    if (typePtr->setFromAnyProc == NULL) {


	Tcl_Panic("may not convert object to type %s", typePtr->name);



    }

    return typePtr->setFromAnyProc(interp, objPtr);
}

/*
 *--------------------------------------------------------------

    Tcl_UnlinkVar, /* 251 */
    Tcl_UnregisterChannel, /* 252 */
    0, /* 253 */
    Tcl_UnsetVar2, /* 254 */
    0, /* 255 */
    Tcl_UntraceVar2, /* 256 */
    Tcl_UpdateLinkedVar, /* 257 */
    Tcl_UpVar, /* 258 */
    Tcl_UpVar2, /* 259 */
    0, /* 260 */
    Tcl_VarTraceInfo, /* 261 */
    Tcl_VarTraceInfo2, /* 262 */
    Tcl_Write, /* 263 */
    Tcl_WrongNumArgs, /* 264 */
    Tcl_DumpActiveMemory, /* 265 */
    Tcl_ValidateAllMemory, /* 266 */
    Tcl_AppendResultVA, /* 267 */
    Tcl_AppendStringsToObjVA, /* 268 */

/*
 * Convenience macros for iterating over the list of traces. Note that each of
 * these *must* be treated as a command, and *must* have a block following it.
 */

#define FOREACH_VAR_TRACE(interp, name, clientData) \
    (clientData) = NULL; \
    while (((clientData) = Tcl_VarTraceInfo((interp), (name), 0, \
	    TraceVarProc, (clientData))) != NULL)

#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
    (clientData) = NULL; \
    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
	    TraceCommandProc, clientData)) != NULL)

/*

	 * If this is the last trace on the variable, and the variable is
	 * unset and unused, then free up the variable.
	 */

	TclCleanupVar(varPtr, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarTraceInfo --
 *
 *	Return the clientData value associated with a trace on a variable.
 *	This function can also be used to step through all of the traces on a
 *	particular variable that have the same trace function.
 *
 * Results:
 *	The return value is the clientData value associated with a trace on
 *	the given variable. Information will only be returned for a trace with
 *	proc as trace function. If the clientData argument is NULL then the
 *	first such trace is returned; otherwise, the next relevant one after
 *	the one given by clientData will be returned. If the variable doesn't
 *	exist, or if there are no (more) traces for it, then NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_VarTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *varName,	/* Name of variable; may end with "(index)" to
				 * signify an array reference. */
    int flags,			/* OR-ed combo or TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY (can be 0). */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
	    prevClientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarTraceInfo2 --
 *
 *	Same as Tcl_VarTraceInfo, except takes name in two pieces instead of

    TclSetVarLink(varPtr);
    varPtr->value.linkPtr = otherPtr;
    if (TclIsVarInHash(otherPtr)) {
	VarHashRefCount(otherPtr)++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpVar --
 *
 *	This function links one variable to another, just like the "upvar"
 *	command.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error
 *	message is left in the interp's result.
 *
 * Side effects:
 *	The variable in frameName whose name is given by varName becomes
 *	accessible under the name localNameStr, so that references to
 *	localNameStr are redirected to the other variable like a symbolic
 *	link.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UpVar(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    const char *frameName,	/* Name of the frame containing the source
				 * variable, such as "1" or "#0". */
    const char *varName,	/* Name of a variable in interp to link to.
				 * May be either a scalar name or an element
				 * in an array. */
    const char *localNameStr,	/* Name of link variable. */
    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of localNameStr. */
{
    int result;
    CallFrame *framePtr;
    Tcl_Obj *varNamePtr, *localNamePtr;

    if (TclGetFrame(interp, frameName, &framePtr) == -1) {
	return TCL_ERROR;
    }

    varNamePtr = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(varNamePtr);
    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
    Tcl_IncrRefCount(localNamePtr);

    result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0,
	    localNamePtr, flags, -1);
    Tcl_DecrRefCount(varNamePtr);
    Tcl_DecrRefCount(localNamePtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpVar2 --
 *
 *	This function links one variable to another, just like the "upvar"

    list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
} -match glob -result {1 -NaN*}
test binary-40.4 {ScanNumber: NaN} -body {
    unset -nocomplain arg1
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
} -match glob -result {1 -NaN*}

test binary-41.1 {ScanNumber: word alignment} {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.2 {ScanNumber: word alignment} {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.3 {ScanNumber: word alignment} {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.4 {ScanNumber: word alignment} {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.5 {ScanNumber: word alignment} bigEndian {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.600000023841858}
test binary-41.6 {ScanNumber: word alignment} littleEndian {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.600000023841858}
test binary-41.7 {ScanNumber: word alignment} bigEndian {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
test binary-41.8 {ScanNumber: word alignment} littleEndian {
    unset -nocomplain arg1; unset arg2

    list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}

test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body {
    binary ?
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *}

# Wide int (guaranteed at least 64-bit) handling
test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {

	flush stdout
	vwait ::sok
	fconfigure $sok -buffering line
	while {[gets $sok line]>=0} {puts $sok $line}
	puts $sok DONE
	exit 0
    } echo.tcl]

} -body {


    set ff [openpipe r $echo]
    gets $ff port

    set s [socket 127.0.0.1 $port]
    puts $s Hey
    close $s w
    set timer [after 1000 [namespace code {set ::done Failed}]]
    set acc {}
    fileevent $s readable [namespace code {
	if {[gets $s line]<0} {
	    set done Succeeded
	} else {
	    lappend acc $line
	}
    }]
    vwait [namespace which -variable done]
    after cancel $timer
    close $s r
    close $ff
    list $done $acc
} -cleanup {



    removeFile echo.tcl
} -result {Succeeded {Hey DONE}}

test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body {
    chan puts stdin hello
} -returnCodes error -result {channel "stdin" wasn't opened for writing}
test chan-io-29.2 {Tcl_WriteChars, empty string} -setup {