Tcl Source Code

    set data [chan read $chan]
    chan puts "[string length $data] $data"
    if {[chan eof $chan]} {
        chan event $chan readable {}
    }
}

chan configure $chan -blocking 0 -translation binary
\fBchan event\fR $chan readable [list GetData $chan]
.CE
.PP
The next example is similar but uses \fBchan gets\fR to read
line-oriented data.
.PP
.CS

% set d
-code 1 -level 0
-errorstack {INNER {invokeStk1 gets file384b6a8}}
-errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}
-errorinfo {...} -errorline 1
% chan tell $f
0
% chan configure $f -translation binary
% chan gets $f
AÃB
.CE
.PP
The following example is similar to the above but demonstrates recovery after a
blocking read. The successfully decoded data "A" is returned in the error options
dictionary key \fB\-data\fR. The file position is advanced on the encoding error

% set d
-data A -code 1 -level 0
-errorstack {INNER {invokeStk1 read file35a65a0}}
-errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}
-errorinfo {...} -errorline 1
% chan tell $f
1
% chan configure $f -translation binary
% chan read $f
ÃB
% chan close $f
.CE
.PP
Finally the same example, but this time with a non-blocking channel.
.PP

.IP \fBdigit\fR 12
Any Unicode digit character.  Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
.IP \fBentier\fR 12
.
Synonym for \fBinteger\fR.


.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
.IP \fBgraph\fR 12
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for an integer value of arbitrary size
in Tcl, with optional surrounding whitespace. The formats accepted are
exactly those accepted by the C routine \fBTcl_GetBignumFromObj\fR.
.IP \fBlist\fR 12
Any proper list structure, with optional surrounding whitespace. In
case of improper list structure, 0 is returned and the \fIvarname\fR
will contain the index of the
.QW element
where the list parsing fails, or \-1 if this cannot be determined.
.IP \fBlower\fR 12

declare 656 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}

# TIP 656
declare 658 {
    int Tcl_ExternalToUtfDStringEx(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr,
	    Tcl_Size *errorLocationPtr)
}
declare 659 {
    int Tcl_UtfToExternalDStringEx(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr,
	    Tcl_Size *errorLocationPtr)
}

# TIP #511
declare 660 {
    int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber)
}

static inline void
TclBounceRefCount(
    Tcl_Obj* objPtr,
    const char* fn,
    int line)
{
    if (objPtr) {
	if ((objPtr)->refCount == 0) {
	    Tcl_DbDecrRefCount(objPtr, fn, line);
	}
    }
}
#else
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	((void)++(objPtr)->refCount)

    TclBounceRefCount(objPtr);

static inline void
TclBounceRefCount(
    Tcl_Obj* objPtr)
{
    if (objPtr) {
	if ((objPtr)->refCount == 0) {
	    Tcl_DecrRefCount(objPtr);
	}
    }
}

#endif

/*

	    TclNRAssembleObjCmd, NULL, NULL);
    cmdPtr->compileProc = &TclCompileAssembleCmd;

    /* Coroutine monkeybusiness */
    Tcl_CreateObjCommand2(interp, "::tcl::unsupported::corotype",
	    CoroTypeObjCmd, NULL, NULL);

    /* Load and intialize ICU */
    Tcl_CreateObjCommand2(interp, "::tcl::unsupported::loadIcu",
	    TclLoadIcuObjCmd, NULL, NULL);

    /* Export unsupported commands */
    nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
    if (nsPtr) {
	Tcl_Export(interp, nsPtr, "*", 1);
    }

#ifdef USE_DTRACE

				 * name. */
    void *clientData,		/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    Interp *iPtr = (Interp *)interp;
    Namespace *nsPtr;
    const char *tail;

    if (iPtr->flags & DELETED) {
	/*
	 * The interpreter is being deleted. Don't create any new commands;
	 * it's not safe to muck with the interpreter anymore.
	 */
	return NULL;
    }

    /*
     * Determine where the command should reside. If its name contains
     * namespace qualifiers, we put it in the specified namespace;
     * otherwise, we always put it in the global namespace.
     */

    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes))
#define BYTEARRAY_SIZE(len) \
	( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \
	? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \
	: (offsetof(ByteArray, bytes) + (len)) )
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)

int

 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    Tcl_Size numBytes)		/* Number of bytes in resized array
				 * Must be >= 0 */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep *irPtr;

    assert(numBytes >= 0);
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");

TclDumpMemoryInfo(
    void *clientData,
    int flags)
{
    char buf[1024];

    if (clientData == NULL) {
	return 0;
    }
    snprintf(buf, sizeof(buf),
	    "total mallocs             %10" TCL_Z_MODIFIER "u\n"
	    "total frees               %10" TCL_Z_MODIFIER "u\n"
	    "current packets allocated %10" TCL_Z_MODIFIER "u\n"
	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
	    "maximum packets allocated %10" TCL_Z_MODIFIER "u\n"

	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
		    TclGetString(objv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
	Tcl_WideInt value;
	if (objc != 3) {

	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot open output file: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }

	    goto bad_suboption;
	}
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad option \"%s\": should be active, break_on_malloc, info, "
	    "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
	    TclGetString(objv[1])));
    return TCL_ERROR;

  argError:
    Tcl_WrongNumArgs(interp, 2, objv, "count");
    return TCL_ERROR;

  bad_suboption:

    Tcl_Obj *field, *value, *result;
    unsigned short mode;

    if (varName == NULL) {
	TclNewObj(result);
	Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
	Tcl_DictObjPut(NULL, result,            \
	    Tcl_NewStringObj((key), -1),        \
	    (objValue));
	DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
	DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
	DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
	DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
	DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
	DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS

	    &localIndex, &isScalar, 1);

    /*
     * If the user specified an array element, we don't bother handling
     * that.
     */
    if (!isScalar) {
	return TCL_ERROR;
    }

    /*
     * We are doing an assignment to set the value of the constant. This will
     * need to be extended to push a value for each argument.
     */

TclLocalScalar(
    const char *bytes,
    size_t numBytes,
    CompileEnv *envPtr)
{
    Tcl_Token token[2] = {
	{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
	{TCL_TOKEN_TEXT, NULL, 0, 0}
    };

    token[1].start = bytes;
    token[1].size = numBytes;
    return TclLocalScalarFromToken(token, envPtr);
}


    UpdateStringOfDict,		/* updateStringProc */
    SetDictFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define DictSetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
	ir.twoPtrValue.ptr2 = NULL;                                     \
	Tcl_StoreInternalRep((objPtr), &tclDictType, &ir);		\
    } while (0)

#define DictGetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &tclDictType);		\
	(dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;	\
    } while (0)

/*
 * The type of the specially adapted version of the Tcl_Obj*-containing hash
 * table defined in the tclObj.c code. This version differs in that it
 * allocates a bit more space in each hash entry in order to hold the pointers
 * used to keep the hash entries in a linked list.

    Tcl_Obj *splitPtr;
    Tcl_Obj *resultPtr = NULL;

    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
    Tcl_IncrRefCount(splitPtr);

    if (objc != 0) {
	/*
	 * Return the last component, unless it is the only component, and it
	 * is the root of an absolute path.
	 */

	if (objc > 0) {
	    Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
	    if ((objc == 1) &&
		    (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {

    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    const char *path = TclGetString(pathPtr);

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX: {
	const char *origPath = path;

	/*
	 * Paths that begin with / are absolute.
	 */

	if (path[0] == '/') {
	    ++path;
	    /*
	     * Check for "//" network path prefix
	     */
	    if ((*path == '/') && path[1] && (path[1] != '/')) {
		path += 2;
		while (*path && *path != '/') {
		    ++path;
		}
	    }
	    if (driveNameLengthPtr != NULL) {
		/*
		 * We need this addition in case the "//" code was used.
		 */

		*driveNameLengthPtr = (path - origPath);
	    }
	} else {
	    type = TCL_PATH_RELATIVE;
	}
	break;
    }
    case TCL_PLATFORM_WINDOWS: {
	Tcl_DString ds;
	const char *rootEnd;

	Tcl_DStringInit(&ds);
	rootEnd = ExtractWinRoot(path, &ds, 0, &type);
	if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
	    *driveNameLengthPtr = rootEnd - path;
	    if (driveNameRef != NULL) {
		*driveNameRef = Tcl_DStringToObj(&ds);
		Tcl_IncrRefCount(*driveNameRef);
	    }
	}
	Tcl_DStringFree(&ds);
	break;
    }
    }
    return type;
}

/*
 *---------------------------------------------------------------------------

	elementStart = path;
	while ((*path != '\0') && (*path != '/')) {
	    path++;
	}
	length = path - elementStart;
	if (length > 0) {
	    Tcl_Obj *nextElt;
	    nextElt = Tcl_NewStringObj(elementStart, length);
	    Tcl_ListObjAppendElement(NULL, result, nextElt);
	}
	if (*path++ == '\0') {
	    break;
	}
    }
    return result;
}

    FreeChannelInternalRep,		/* freeIntRepProc */
    DupChannelInternalRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};




#define ChanSetInternalRep(objPtr, resPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(resPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (resPtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &chanObjType, &ir);			\

    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;
    statePtr->maxPerms = mask; /* Save max privileges for close callback */

    /*
     * Set the channel to system default encoding.






     */

    name = Tcl_GetEncodingName(NULL);
    statePtr->encoding = Tcl_GetEncoding(NULL, name);
    statePtr->inputEncodingState  = NULL;
    statePtr->inputEncodingFlags  = TCL_ENCODING_START;
    statePtr->outputEncodingState = NULL;

    /*
     * Verify the result.
     * - List, of method names. Convert to mask. Check for non-optionals
     *   through the mask. Compare open mode against optional r/w.
     */

    if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"chan handler \"%s initialize\" returned non-list: %s",
		TclGetString(cmdObj), TclGetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,

	methods |= FLAG(methIndex);
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"chan handler \"%s\" does not support all required methods",
		TclGetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inaccessible. Afterward the
     * mode tells us which methods are still required, and these methods will
     * also be supported by the handler, by design of the check.
     */

    if (!HAS(methods, METH_READ)) {
	mode &= ~TCL_READABLE;
    }
    if (!HAS(methods, METH_WRITE)) {
	mode &= ~TCL_WRITABLE;
    }

    if (!mode) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"chan handler \"%s\" makes the channel inaccessible",
		TclGetString(cmdObj)));
	goto error;
    }

    /*
     * The mode and support for it is ok, now check the internal constraints.
     */

    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"chan handler \"%s\" supports \"drain\" but not \"read\"",
		TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"chan handler \"%s\" supports \"flush\" but not \"write\"",
		TclGetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.

    if (result != 0) {
	*errorMsgPtr =
#ifdef EAI_SYSTEM	/* Doesn't exist on Windows */
		(result == EAI_SYSTEM) ? Tcl_PosixError(interp) :
#endif /* EAI_SYSTEM */
		gai_strerror(result);
	return 0;
    }

    /*
     * Put IPv4 addresses before IPv6 addresses to maximize backwards
     * compatibility of [fconfigure -sockname] output.
     *
     * There might be more elegant/efficient ways to do this.

/*
 * tclIcu.c --
 *
 * 	tclIcu.c implements various Tcl commands that make use of
 *	the ICU library if present on the system.
 *	(Adapted from tkIcu.c)
 *
 * Copyright © 2021 Jan Nijtmans
 * Copyright © 2024 Ashok P. Nadkarni
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Runtime linking of libicu.
 */
typedef enum UBreakIteratorTypex {
	  UBRK_CHARACTERX = 0,
	  UBRK_WORDX = 1
} UBreakIteratorTypex;

typedef enum UErrorCodex {
    U_AMBIGUOUS_ALIAS_WARNING = -122,
    U_ZERO_ERRORZ              =  0,     /**< No error, no warning. */
} UErrorCodex;

#define U_SUCCESS(x) ((x)<=U_ZERO_ERRORZ)
#define U_FAILURE(x) ((x)>U_ZERO_ERRORZ)

struct UEnumeration;
typedef struct UEnumeration UEnumeration;
struct UCharsetDetector;
typedef struct UCharsetDetector UCharsetDetector;
struct UCharsetMatch;
typedef struct UCharsetMatch UCharsetMatch;

/*
 * Prototypes for ICU functions sorted by category.
 */
typedef void        (*fn_u_cleanup)(void);
typedef const char *(*fn_u_errorName)(UErrorCodex);

typedef uint16_t    (*fn_ucnv_countAliases)(const char *, UErrorCodex *);
typedef int32_t     (*fn_ucnv_countAvailable)();
typedef const char *(*fn_ucnv_getAlias)(const char *, uint16_t, UErrorCodex *);
typedef const char *(*fn_ucnv_getAvailableName)(int32_t);

typedef void *(*fn_ubrk_open)(UBreakIteratorTypex, const char *,
	const uint16_t *, int32_t, UErrorCodex *);
typedef void	(*fn_ubrk_close)(void *);
typedef int32_t	(*fn_ubrk_preceding)(void *, int32_t);
typedef int32_t	(*fn_ubrk_following)(void *, int32_t);
typedef int32_t	(*fn_ubrk_previous)(void *);
typedef int32_t	(*fn_ubrk_next)(void *);
typedef void	(*fn_ubrk_setText)(void *, const void *, int32_t, UErrorCodex *);

typedef UCharsetDetector * (*fn_ucsdet_open)(UErrorCodex   *status);
typedef void               (*fn_ucsdet_close)(UCharsetDetector *ucsd);
typedef void               (*fn_ucsdet_setText)(UCharsetDetector *ucsd, const char *textIn, int32_t len, UErrorCodex *status);
typedef const char *       (*fn_ucsdet_getName)(const UCharsetMatch *ucsm, UErrorCodex *status);
typedef UEnumeration *     (*fn_ucsdet_getAllDetectableCharsets)(UCharsetDetector *ucsd, UErrorCodex *status);
typedef const UCharsetMatch *  (*fn_ucsdet_detect)(UCharsetDetector *ucsd, UErrorCodex *status);
typedef const UCharsetMatch ** (*fn_ucsdet_detectAll)(UCharsetDetector *ucsd, int32_t *matchesFound, UErrorCodex *status);

typedef void        (*fn_uenum_close)(UEnumeration *);
typedef int32_t     (*fn_uenum_count)(UEnumeration *, UErrorCodex *);
typedef const char *(*fn_uenum_next)(UEnumeration *, int32_t *, UErrorCodex *);

#define FIELD(name) fn_ ## name _ ## name
static struct {
    size_t              nopen; /* Total number of references to ALL libraries */
    /*
     * Depending on platform, ICU symbols may be distributed amongst
     * multiple libraries. For current functionality at most 2 needed.
     * Order of library loading is not guaranteed.
     */
    Tcl_LoadHandle      libs[2];

    FIELD(u_cleanup);
    FIELD(u_errorName);

    FIELD(ubrk_open);
    FIELD(ubrk_close);
    FIELD(ubrk_preceding);
    FIELD(ubrk_following);
    FIELD(ubrk_previous);
    FIELD(ubrk_next);
    FIELD(ubrk_setText);

    FIELD(ucnv_countAliases);
    FIELD(ucnv_countAvailable);
    FIELD(ucnv_getAlias);
    FIELD(ucnv_getAvailableName);

    FIELD(ucsdet_close);
    FIELD(ucsdet_detect);
    FIELD(ucsdet_detectAll);
    FIELD(ucsdet_getAllDetectableCharsets);
    FIELD(ucsdet_getName);
    FIELD(ucsdet_open);
    FIELD(ucsdet_setText);

    FIELD(uenum_close);
    FIELD(uenum_count);
    FIELD(uenum_next);

} icu_fns = {
    0, {NULL, NULL}, /* Reference count, library handles */
    NULL, NULL, /* u_* */
    NULL, NULL, NULL, NULL, NULL, NULL, NULL, /* ubrk* */
    NULL, NULL, NULL, NULL, /* ucnv_* */
    NULL, NULL, NULL, NULL, NULL, NULL, NULL, /* ucsdet* */
    NULL, NULL, NULL, /* uenum_* */
};

#define u_cleanup        icu_fns._u_cleanup
#define u_errorName      icu_fns._u_errorName

#define ubrk_open        icu_fns._ubrk_open
#define ubrk_close       icu_fns._ubrk_close
#define ubrk_preceding   icu_fns._ubrk_preceding
#define ubrk_following   icu_fns._ubrk_following
#define ubrk_previous    icu_fns._ubrk_previous
#define ubrk_next        icu_fns._ubrk_next
#define ubrk_setText     icu_fns._ubrk_setText

#define ucnv_countAliases     icu_fns._ucnv_countAliases
#define ucnv_countAvailable   icu_fns._ucnv_countAvailable
#define ucnv_getAlias         icu_fns._ucnv_getAlias
#define ucnv_getAvailableName icu_fns._ucnv_getAvailableName

#define ucsdet_close     icu_fns._ucsdet_close
#define ucsdet_detect    icu_fns._ucsdet_detect
#define ucsdet_detectAll icu_fns._ucsdet_detectAll
#define ucsdet_getAllDetectableCharsets icu_fns._ucsdet_getAllDetectableCharsets
#define ucsdet_getName   icu_fns._ucsdet_getName
#define ucsdet_open      icu_fns._ucsdet_open
#define ucsdet_setText   icu_fns._ucsdet_setText

#define uenum_next       icu_fns._uenum_next
#define uenum_close      icu_fns._uenum_close
#define uenum_count      icu_fns._uenum_count


TCL_DECLARE_MUTEX(icu_mutex);

static int FunctionNotAvailableError(Tcl_Interp *interp) {
    if (interp) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("ICU function not available", TCL_INDEX_NONE));
    }
    return TCL_ERROR;
}

static int IcuError(Tcl_Interp *interp, const char *message, UErrorCodex code)
{
    if (interp) {
	const char *codeMessage = NULL;
	if (u_errorName) {
	    codeMessage = u_errorName(code);
	}
	Tcl_SetObjResult(interp,
			 Tcl_ObjPrintf("%s. ICU error (%d): %s",
				       message,
				       code,
				       codeMessage ? codeMessage : ""));
    }
    return TCL_ERROR;
}

static int DetectEncoding(Tcl_Interp *interp, Tcl_Obj *objPtr, int all)
{
    Tcl_Size len;
    const char *bytes;
    const UCharsetMatch *match;
    const UCharsetMatch **matches;
    int nmatches;
    int ret;

    if (ucsdet_open == NULL || ucsdet_setText == NULL ||
	ucsdet_detect == NULL || ucsdet_detectAll == NULL ||
	ucsdet_getName == NULL || ucsdet_close == NULL) {
	return FunctionNotAvailableError(interp);
    }

    bytes = (char *) Tcl_GetBytesFromObj(interp, objPtr, &len);
    if (bytes == NULL) {
	return TCL_ERROR;
    }
    UErrorCodex status = U_ZERO_ERRORZ;

    UCharsetDetector* csd = ucsdet_open(&status);
    if (U_FAILURE(status)) {
	return IcuError(interp, "Could not open charset detector.", status);
    }

    ucsdet_setText(csd, bytes, len, &status);
    if (U_FAILURE(status)) {
	IcuError(interp, "Could not set detection text.", status);
	ucsdet_close(csd);
	return TCL_ERROR;
    }

    if (all) {
	matches = ucsdet_detectAll(csd, &nmatches, &status);
    }
    else {
	match = ucsdet_detect(csd, &status);
	matches = &match;
	nmatches = match ? 1 : 0;
    }

    if (U_FAILURE(status) || nmatches == 0) {
	ret = IcuError(interp, "Could not detect character set.", status);
    }
    else {
	int i;
	Tcl_Obj *resultObj = Tcl_NewListObj(nmatches, NULL);
	for (i = 0; i < nmatches; ++i) {
	    const char *name = ucsdet_getName(matches[i], &status);
	    if (U_FAILURE(status) || name == NULL) {
		name = "unknown";
		status = U_ZERO_ERRORZ; /* Reset on failure */
	    }
	    Tcl_ListObjAppendElement(
		NULL, resultObj, Tcl_NewStringObj(name, -1));
	}
	Tcl_SetObjResult(interp, resultObj);
	ret = TCL_OK;
    }

    ucsdet_close(csd);
    return ret;
}

static int DetectableEncodings(Tcl_Interp *interp)
{
    if (ucsdet_open == NULL || ucsdet_getAllDetectableCharsets == NULL ||
	ucsdet_close == NULL || uenum_next == NULL || uenum_count == NULL ||
	uenum_close == NULL) {
	return FunctionNotAvailableError(interp);
    }
    UErrorCodex status = U_ZERO_ERRORZ;

    UCharsetDetector* csd = ucsdet_open(&status);
    if (U_FAILURE(status)) {
	return IcuError(interp, "Could not open charset detector.", status);
    }

    int ret;
    UEnumeration *enumerator = ucsdet_getAllDetectableCharsets(csd, &status);
    if (U_FAILURE(status) || enumerator == NULL) {
	IcuError(interp, "Could not get list of detectable encodings.", status);
	ret = TCL_ERROR;
    } else {
	int32_t count;
	count = uenum_count(enumerator, &status);
	if (U_FAILURE(status)) {
	    IcuError(interp, "Could not get charset enumerator count.", status);
	    ret = TCL_ERROR;
	} else {
	    int i;
	    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < count; ++i) {
		const char *name;
		int32_t len;
		name = uenum_next(enumerator, &len, &status);
		if (name == NULL || U_FAILURE(status)) {
		    name = "unknown";
		    len = 7;
		    status = U_ZERO_ERRORZ; /* Reset on error */
		}
		Tcl_ListObjAppendElement(
		    interp, resultObj, Tcl_NewStringObj(name, len));
	    }
	    Tcl_SetObjResult(interp, resultObj);
	    ret = TCL_OK;
	}
	uenum_close(enumerator);
    }

    ucsdet_close(csd);
    return ret;
}

/*
 *------------------------------------------------------------------------
 *
 * EncodingDetectObjCmd --
 *
 *    Implements the Tcl command EncodingDetect.
 *       encdetect - returns names of all detectable encodings
 *       encdetect BYTES ?-all? - return detected encoding(s)
 *
 * Results:
 *    TCL_OK    - Success.
 *    TCL_ERROR - Error.
 *
 * Side effects:
 *    Interpreter result holds result or error message.
 *
 *------------------------------------------------------------------------
 */
static int
IcuDetectObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1 , objv, "?bytes ?-all??");
	return TCL_ERROR;
    }

    if (objc == 1) {
	return DetectableEncodings(interp);
    }

    int all = 0;
    if (objc == 3) {
	if (strcmp("-all", Tcl_GetString(objv[2]))) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("Invalid option %s, must be \"-all\"",
			      Tcl_GetString(objv[2])));
	    return TCL_ERROR;
	}
	all = 1;
    }

    return DetectEncoding(interp, objv[1], all);
}

/*
 *------------------------------------------------------------------------
 *
 * IcuConverterNamesObjCmd --
 *
 *    Sets interp result to list of available ICU converters.
 *
 * Results:
 *    TCL_OK    - Success.
 *    TCL_ERROR - Error.
 *
 * Side effects:
 *    Interpreter result holds list of converter names.
 *
 *------------------------------------------------------------------------
 */
static int
IcuConverterNamesObjCmd (
    TCL_UNUSED(void *),
    Tcl_Interp *interp,    /* Current interpreter. */
    Tcl_Size objc,              /* Number of arguments. */
    Tcl_Obj *const objv[]) /* Argument objects. */
{

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1 , objv, "");
	return TCL_ERROR;
    }
    if (ucnv_countAvailable == NULL || ucnv_getAvailableName == NULL) {
	return FunctionNotAvailableError(interp);
    }

    int32_t count = ucnv_countAvailable();
    if (count <= 0) {
	return TCL_OK;
    }
    Tcl_Obj *resultObj = Tcl_NewListObj(count, NULL);
    int32_t i;
    for (i = 0; i < count; ++i) {
	const char *name = ucnv_getAvailableName(i);
	if (name) {
	    Tcl_ListObjAppendElement(
		NULL, resultObj, Tcl_NewStringObj(name, -1));
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * IcuConverterAliasesObjCmd --
 *
 *    Sets interp result to list of available ICU converters.
 *
 * Results:
 *    TCL_OK    - Success.
 *    TCL_ERROR - Error.
 *
 * Side effects:
 *    Interpreter result holds list of converter names.
 *
 *------------------------------------------------------------------------
 */
static int
IcuConverterAliasesObjCmd (
    TCL_UNUSED(void *),
    Tcl_Interp *interp,    /* Current interpreter. */
    Tcl_Size objc,              /* Number of arguments. */
    Tcl_Obj *const objv[]) /* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1 , objv, "convertername");
	return TCL_ERROR;
    }
    if (ucnv_countAliases == NULL || ucnv_getAlias == NULL) {
	return FunctionNotAvailableError(interp);
    }

    const char *name = Tcl_GetString(objv[1]);
    UErrorCodex status = U_ZERO_ERRORZ;
    uint16_t count = ucnv_countAliases(name, &status);
    if (status != U_AMBIGUOUS_ALIAS_WARNING && U_FAILURE(status)) {
	return IcuError(interp, "Could not get aliases.", status);
    }
    if (count <= 0) {
	return TCL_OK;
    }
    Tcl_Obj *resultObj = Tcl_NewListObj(count, NULL);
    uint16_t i;
    for (i = 0; i < count; ++i) {
	status = U_ZERO_ERRORZ; /* Reset in case U_AMBIGUOUS_ALIAS_WARNING */
	const char *aliasName = ucnv_getAlias(name, i, &status);
	if (status != U_AMBIGUOUS_ALIAS_WARNING && U_FAILURE(status)) {
	    status = U_ZERO_ERRORZ; /* Reset error for next iteration */
	    continue;
	}
	if (aliasName) {
	    Tcl_ListObjAppendElement(
		NULL, resultObj, Tcl_NewStringObj(aliasName, -1));
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static void
TclIcuCleanup(
    TCL_UNUSED(void *))
{
    Tcl_MutexLock(&icu_mutex);
    if (icu_fns.nopen-- <= 1) {
	int i;
	if (u_cleanup != NULL) {
	    u_cleanup();
	}
	for (i = 0; i < (int)(sizeof(icu_fns.libs) / sizeof(icu_fns.libs[0]));
	     ++i) {
	    if (icu_fns.libs[i] != NULL) {
		Tcl_FSUnloadFile(NULL, icu_fns.libs[i]);
	    }
	}
	memset(&icu_fns, 0, sizeof(icu_fns));
    }
    Tcl_MutexUnlock(&icu_mutex);
}

static void
TclIcuInit(
    Tcl_Interp *interp)
{
    Tcl_MutexLock(&icu_mutex);
    char symbol[256];
    char icuversion[4] = "_80"; /* Highest ICU version + 1 */

    /*
     * The initialization below clones the existing one from Tk. May need
     * revisiting.
     * ICU shared library names as well as function names *may* be versioned.
     * See https://unicode-org.github.io/icu/userguide/icu4c/packaging.html
     * for the gory details.
     */
    if (icu_fns.nopen == 0) {
	int i = 0;
	Tcl_Obj *nameobj;
	static const char *iculibs[] = {
#if defined(_WIN32)
#  define DLLNAME "icu%s%s.dll"
	    "icuuc??.dll", /* Windows, user-provided */
	    NULL,
	    "cygicuuc??.dll", /* When running under Cygwin */
#elif defined(__CYGWIN__)
#  define DLLNAME "cygicu%s%s.dll"
	    "cygicuuc??.dll",
#elif defined(MAC_OSX_TCL)
#  define DLLNAME "libicu%s.%s.dylib"
	    "libicuuc.??.dylib",
#else
#  define DLLNAME "libicu%s.so.%s"
	    "libicuuc.so.??",
#endif
	    NULL
	};

	/* Going back down to ICU version 60 */
	while ((icu_fns.libs[0] == NULL) && (icuversion[1] >= '6')) {
	    if (--icuversion[2] < '0') {
		icuversion[1]--; icuversion[2] = '9';
	    }
#if defined(__CYGWIN__)
	    i = 2;
#else
	    i = 0;
#endif
	    while (iculibs[i] != NULL) {
		Tcl_ResetResult(interp);
		nameobj = Tcl_NewStringObj(iculibs[i], TCL_INDEX_NONE);
		char *nameStr = Tcl_GetString(nameobj);
		char *p = strchr(nameStr, '?');
		if (p != NULL) {
		    memcpy(p, icuversion+1, 2);
		}
		Tcl_IncrRefCount(nameobj);
		if (Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.libs[0])
			== TCL_OK) {
		    if (p == NULL) {
			icuversion[0] = '\0';
		    }
		    Tcl_DecrRefCount(nameobj);
		    break;
		}
		Tcl_DecrRefCount(nameobj);
		++i;
	    }
	}
	if (icu_fns.libs[0] != NULL) {
	    /* Loaded icuuc, load others with the same version */
	    nameobj = Tcl_ObjPrintf(DLLNAME, "i18n", icuversion+1);
	    Tcl_IncrRefCount(nameobj);
	    /* Ignore errors. Calls to contained functions will fail. */
	    (void) Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.libs[1]);
	    Tcl_DecrRefCount(nameobj);
	}
#if defined(_WIN32)
	/*
	 * On Windows, if no ICU install found, look for the system's
	 * (Win10 1703 or later). There are two cases. Newer systems
	 * have icu.dll containing all functions. Older systems have
	 * icucc.dll and icuin.dll
	 */
	if (icu_fns.libs[0] == NULL) {
	    Tcl_ResetResult(interp);
		nameobj = Tcl_NewStringObj("icu.dll", TCL_INDEX_NONE);
		Tcl_IncrRefCount(nameobj);
		if (Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.libs[0])
			== TCL_OK) {
		    /* Reload same for second set of functions. */
		    (void) Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.libs[1]);
		    /* Functions do NOT have version suffixes */
		    icuversion[0] = '\0';
		}
		Tcl_DecrRefCount(nameobj);
	}
	if (icu_fns.libs[0] == NULL) {
	    /* No icu.dll. Try last fallback */
	    Tcl_ResetResult(interp);
	    nameobj = Tcl_NewStringObj("icuuc.dll", TCL_INDEX_NONE);
	    Tcl_IncrRefCount(nameobj);
	    if (Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.libs[0])
		== TCL_OK) {
		Tcl_DecrRefCount(nameobj);
		nameobj = Tcl_NewStringObj("icuin.dll", TCL_INDEX_NONE);
		Tcl_IncrRefCount(nameobj);
		(void) Tcl_LoadFile(interp, nameobj, NULL, 0, NULL, &icu_fns.libs[1]);
		/* Functions do NOT have version suffixes */
		icuversion[0] = '\0';
	    }
	    Tcl_DecrRefCount(nameobj);
	}
#endif

#define ICUUC_SYM(name)                                         \
	strcpy(symbol, #name );                                 \
	strcat(symbol, icuversion);                             \
	icu_fns._##name = (fn_ ## name)                         \
	    Tcl_FindSymbol(NULL, icu_fns.libs[0], symbol)
	if (icu_fns.libs[0] != NULL) {
	    ICUUC_SYM(u_cleanup);
	    ICUUC_SYM(u_errorName);

	    ICUUC_SYM(ucnv_countAliases);
	    ICUUC_SYM(ucnv_countAvailable);
	    ICUUC_SYM(ucnv_getAlias);
	    ICUUC_SYM(ucnv_getAvailableName);

	    ICUUC_SYM(ubrk_open);
	    ICUUC_SYM(ubrk_close);
	    ICUUC_SYM(ubrk_preceding);
	    ICUUC_SYM(ubrk_following);
	    ICUUC_SYM(ubrk_previous);
	    ICUUC_SYM(ubrk_next);
	    ICUUC_SYM(ubrk_setText);

	    ICUUC_SYM(uenum_close);
	    ICUUC_SYM(uenum_count);
	    ICUUC_SYM(uenum_next);

#undef ICUUC_SYM
	}

#define ICUIN_SYM(name)                                         \
	strcpy(symbol, #name );                                 \
	strcat(symbol, icuversion);                             \
	icu_fns._##name = (fn_ ## name)                         \
	    Tcl_FindSymbol(NULL, icu_fns.libs[1], symbol)
	if (icu_fns.libs[1] != NULL) {
	    ICUIN_SYM(ucsdet_close);
	    ICUIN_SYM(ucsdet_detect);
	    ICUIN_SYM(ucsdet_detectAll);
	    ICUIN_SYM(ucsdet_getName);
	    ICUIN_SYM(ucsdet_getAllDetectableCharsets);
	    ICUIN_SYM(ucsdet_open);
	    ICUIN_SYM(ucsdet_setText);
#undef ICUIN_SYM
	}

    }
#undef ICU_SYM

    Tcl_MutexUnlock(&icu_mutex);

    if (icu_fns.libs[0] != NULL) {
	/*
	 * Note refcounts updated BEFORE command definition to protect
	 * against self redefinition.
	 */
	if (icu_fns.libs[1] != NULL) {
	    /* Commands needing both libraries */

	    /* Ref count number of commands */
	    icu_fns.nopen += 1;
	    Tcl_CreateObjCommand2(interp,
				 "::tcl::unsupported::icu::detect",
				 IcuDetectObjCmd,
				 0,
				 TclIcuCleanup);
	}
	/* Commands needing only libs[0] (icuuc) */

	/* Ref count number of commands */
	icu_fns.nopen += 2;
	Tcl_CreateObjCommand2(interp,
			     "::tcl::unsupported::icu::converters",
			     IcuConverterNamesObjCmd,
			     0,
			     TclIcuCleanup);
	Tcl_CreateObjCommand2(interp,
			     "::tcl::unsupported::icu::aliases",
			     IcuConverterAliasesObjCmd,
			     0,
			     TclIcuCleanup);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * TclLoadIcuObjCmd --
 *
 *    Loads and initializes ICU
 *
 * Results:
 *    TCL_OK    - Success.
 *    TCL_ERROR - Error.
 *
 * Side effects:
 *    Interpreter result holds result or error message.
 *
 *------------------------------------------------------------------------
 */
int
TclLoadIcuObjCmd (
    TCL_UNUSED(void *),
    Tcl_Interp *interp,    /* Current interpreter. */
    Tcl_Size objc,              /* Number of arguments. */
    Tcl_Obj *const objv[]) /* Argument objects. */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1 , objv, "");
	return TCL_ERROR;
    }
    TclIcuInit(interp);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * coding: utf-8
 * End:
 */

	    const char *procName)
}
declare 93 {
    void TclProcDeleteProc(void *clientData)
}
declare 96 {
    int TclRenameCommand(Tcl_Interp *interp, const char *oldName,
	    const char *newName)
}
declare 97 {
    void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
}
declare 98 {
    int TclServiceIdle(void)
}

    void *TclStackAlloc(Tcl_Interp *interp, size_t numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
	    Tcl_Namespace *namespacePtr, int isProcCallFrame)
}
declare 218 {
    void TclPopStackFrame(Tcl_Interp *interp)
}
# TIP 431: temporary directory creation function
declare 219 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,

	    Tcl_Size keyc, Tcl_Obj *const keyv[], int flags)
}
declare 226 {
    int TclObjBeingDeleted(Tcl_Obj *objPtr)
}
declare 227 {
    void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength,
	    Tcl_Namespace *pathAry[])
}
declare 229 {
    int	TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
	    const char *myName, int myFlags, int index)
}
declare 230 {
    Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,

declare 233 {
    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
}

# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
	    int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}

# TIP #285: Script cancellation support.
declare 237 {

MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    Tcl_Size pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_DisassembleObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclLoadIcuObjCmd;

/* Assemble command function */
MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_AssembleObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclNRAssembleObjCmd;
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_EofObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ErrorObjCmd;

	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;

	/*
	 * Special case 0-length lists. The Tcl indexing function treat
	 * will return any value beyond length as TCL_SIZE_MAX for this
	 * case.
	 */
	if ((index == TCL_SIZE_MAX) && (elemCount == 0)) {
	    index = 0;
	}
	if (index < 0 || index > elemCount
		|| (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {

    tracePtr->nextPtr = NULL;
    tracePtr->refCount = 1;

    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
	    TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
    oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
	    oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
	    MyClassDeleted);
    return oPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * SquelchCachedName --

MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE Class *	TclOOAllocClass(Tcl_Interp *interp,
			    Object *useThisObj);
MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp,
			    Tcl_Object object, Tcl_Obj *nameObj,
			    int flags, const Tcl_MethodType2 *typePtr,
			    void *clientData);
MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls,
			    Tcl_Obj *nameObj, int flags,
			    const Tcl_MethodType2 *typePtr,
			    void *clientData);
MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, Tcl_Size objc,
			    Tcl_Obj *const *objv, Tcl_Size skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,

void
TclContinuationsCopy(
    Tcl_Obj *objPtr,
    Tcl_Obj *originObjPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);

    if (hPtr) {
	ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr);

	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
    }
}

ContLineLoc *
TclContinuationsGet(
    Tcl_Obj *objPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);

    if (!hPtr) {
	return NULL;
    }
    return (ContLineLoc *)Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 *

     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an uninitialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
	    hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}

     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an uninitialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
	    hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}

{
    do {
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	    if (isnan(objPtr->internalRep.doubleValue)) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "floating point value is Not a Number", -1));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
			    (char *)NULL);
		}
		return TCL_ERROR;
	    }
	    *dblPtr = (double) objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclIntType)) {

		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	    /*
	     * Must check for those bignum values that can fit in a long, even

    do {
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	    /*
	     * Must check for those bignum values that can fit in a

    do {
	if (TclHasInternalRep(objPtr, &tclIntType)) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
	if (TclHasInternalRep(objPtr, &tclBignumType)) {
	    mp_int big;
	    mp_err err;

		    objPtr->internalRep.wideValue) != MP_OKAY) {
		return TCL_ERROR;
	    }
	    return TCL_OK;
	}
	if (TclHasInternalRep(objPtr, &tclDoubleType)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer but got \"%s\"",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;

	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
		    "incr ref count");
	}
    }
# endif /* TCL_THREADS */
    ++(objPtr)->refCount;
}
#else /* !TCL_MEM_DEBUG */
void

	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
		    "decr ref count");
	}
    }
# endif /* TCL_THREADS */

    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }

	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
		    "check shared status");
	}
    }
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);

    size_t l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller

       if (objPtr1 == objPtr2) {
	   return 1;
       }
    */

    /*
     * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
     * in a register.
     */

     *
     * If any check fails, then force another conversion to the command type,
     * to discard the old rep and create a new one.
     */

    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    if (TclHasInternalRep(objPtr, &tclCmdNameType)) {
	Command *cmdPtr = resPtr->cmdPtr;

	if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
		&& (interp == cmdPtr->nsPtr->interp)
		&& !(cmdPtr->nsPtr->flags & NS_DYING)) {
	    Namespace *refNsPtr = (Namespace *)
		    TclGetCurrentNamespace(interp);

	    if ((resPtr->refNsPtr == NULL)
		    || ((refNsPtr == resPtr->refNsPtr)
		    && (resPtr->refNsId == refNsPtr->nsId)
		    && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
		return (Tcl_Command) cmdPtr;
	    }
	}
    }

    /*
     * OK, must create a new internal representation (or fail) as any cache we
     * had is invalid one way or another.
     */

    /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
	return NULL;
    }
    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}

/*
 *----------------------------------------------------------------------

	    Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
		    (void *) objv[1]->internalRep.twoPtrValue.ptr1,
		    (void *) objv[1]->internalRep.twoPtrValue.ptr2);
	}
    }

    if (objv[1]->bytes) {
	Tcl_AppendToObj(descObj, ", string representation \"", -1);
	Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
		16, "...");
	Tcl_AppendToObj(descObj, "\"", -1);
    } else {
	Tcl_AppendToObj(descObj, ", no string representation", -1);
    }

    Tcl_SetObjResult(interp, descObj);
    return TCL_OK;

    if (code == TCL_ERROR) {
	if (iPtr->errorInfo) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
		&valuePtr);
	if (valuePtr != NULL) {
	    Tcl_Size length;

	    (void)TclGetStringFromObj(valuePtr, &length);
	    if (length) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
		&valuePtr);
	if (valuePtr != NULL) {
	    Tcl_Size len, valueObjc;
	    Tcl_Obj **valueObjv;

	    if (Tcl_IsShared(iPtr->errorStack)) {
		Tcl_Obj *newObj;

		newObj = Tcl_DuplicateObj(iPtr->errorStack);
		Tcl_DecrRefCount(iPtr->errorStack);
		Tcl_IncrRefCount(newObj);
		iPtr->errorStack = newObj;
	    }

	    /*
	     * List extraction done after duplication to avoid moving the rug
	     * if someone does [return -errorstack [info errorstack]]
	     */

	    if (TclListObjGetElements(interp, valuePtr, &valueObjc,
		    &valueObjv) == TCL_ERROR) {
		return TCL_ERROR;
	    }
	    iPtr->resetErrorStack = 0;
	    TclListObjLength(interp, iPtr->errorStack, &len);

	    /*
	     * Reset while keeping the list internalrep as much as possible.
	     */

	    Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
		    valueObjv);
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
		&valuePtr);
	if (valuePtr != NULL) {
	    Tcl_SetObjErrorCode(interp, valuePtr);
	} else {
	    Tcl_SetErrorCode(interp, "NONE", (void *)NULL);
	}

	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE],
		&valuePtr);
	if (valuePtr != NULL) {
	    TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
	}
    }
    if (level != 0) {
	iPtr->returnLevel = level;
	iPtr->returnCode = code;

	    if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict, &search,
		    &keyPtr, &valuePtr, &done)) {
		/*
		 * Value is not a legal dictionary.
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad %s value: expected dictionary but got \"%s\"",
			compare, TclGetString(objv[1])));
		Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
			(void *)NULL);
		goto error;
	    }

	    while (!done) {
		Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr);

    /*
     * Check for bogus -code value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
    if (valuePtr != NULL) {
	if (TclGetCompletionCodeFromObj(interp, valuePtr,
		&code) == TCL_ERROR) {
	    goto error;
	}
	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
    }

    /*
     * Check for bogus -level value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_LEVEL], &valuePtr);
    if (valuePtr != NULL) {
	if ((TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &level))
		|| (level < 0)) {
	    /*
	     * Value is not a legal level.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad -level value: expected non-negative integer but got"
		    " \"%s\"", TclGetString(valuePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (void *)NULL);
	    goto error;
	}
	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
    }

    /*
     * Check for bogus -errorcode value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
    if (valuePtr != NULL) {
	Tcl_Size length;

	if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
	    /*
	     * Value is not a list, which is illegal for -errorcode.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad -errorcode value: expected a list but got \"%s\"",
		    TclGetString(valuePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
		    (void *)NULL);
	    goto error;
	}
    }

    /*
     * Check for bogus -errorstack value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
    if (valuePtr != NULL) {
	Tcl_Size length;

	if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length)) {
	    /*
	     * Value is not a list, which is illegal for -errorstack.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad -errorstack value: expected a list but got \"%s\"",
		    TclGetString(valuePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
		    (void *)NULL);
	    goto error;
	}
	if (length % 2) {
	    /*
	     * Errorstack must always be an even-sized list
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "forbidden odd-sized list for -errorstack: \"%s\"",
		    TclGetString(valuePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "RESULT",
		    "ODDSIZEDLIST_ERRORSTACK", (void *)NULL);
	    goto error;
	}
    }

    /*
     * Convert [return -code return -level X] to [return -code ok -level X+1]
     */

    if (code == TCL_RETURN) {

		Tcl_NewWideIntObj(result));
	Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL],
		Tcl_NewWideIntObj(0));
    }

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "");
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
    }
    if (iPtr->errorCode) {
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
    }
    if (iPtr->errorInfo) {
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo);
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORLINE],

    int level, code;
    Tcl_Obj **objv, *mergedOpts;

    Tcl_IncrRefCount(options);
    if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
	    || (objc % 2)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"expected dict but got \"%s\"", TclGetString(options)));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL);
	code = TCL_ERROR;
    } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
	    &mergedOpts, &code, &level)) {
	code = TCL_ERROR;
    } else {
	code = TclProcessReturn(interp, code, level, mergedOpts);

			    size_t length, int *cflagsPtr, int *eflagsPtr);
static Tcl_CmdProc	TestsetassocdataCmd;
static Tcl_CmdProc	TestsetCmd;
static Tcl_CmdProc	Testset2Cmd;
static Tcl_CmdProc	TestseterrorcodeCmd;
static Tcl_ObjCmdProc2	TestsetobjerrorcodeCmd;
static Tcl_CmdProc	TestsetplatformCmd;
static Tcl_ObjCmdProc2	TestSizeCmd;
static Tcl_CmdProc	TeststaticlibraryCmd;
static Tcl_CmdProc	TesttranslatefilenameCmd;
static Tcl_CmdProc	TestupvarCmd;
static Tcl_ObjCmdProc2	TestWrongNumArgsObjCmd;
static Tcl_ObjCmdProc2	TestGetIndexFromObjStructObjCmd;
static Tcl_CmdProc	TestChannelCmd;
static Tcl_CmdProc	TestChannelEventCmd;

	    TestFindFirstCmd, NULL, NULL);
    Tcl_CreateObjCommand2(interp, "testfindlast",
	    TestFindLastCmd, NULL, NULL);
    Tcl_CreateObjCommand2(interp, "testgetintforindex",
	    TestGetIntForIndexCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand2(interp, "testsize", TestSizeCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testtranslatefilename",
	    TesttranslatefilenameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);

    return TCL_OK;
}

static int
TestSizeCmd(
    TCL_UNUSED(void *),	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_Size objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    if (objc != 2) {
	goto syntax;
    }
    if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
	Tcl_StatBuf *statPtr;

	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
	},
    {/*1*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    NULL,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*2*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    NULL,                  /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*3*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    NULL,                  /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*4*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    NULL,                  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*5*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    NULL,                  /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*6*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    NULL,                  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*7*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    NULL,                  /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*8*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*9*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    },
    {/*10*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace,     /* Replace */
	    NULL)                  /* "in" operator */
    }
};


/*
 *----------------------------------------------------------------------
 *

    if (llen <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/* We know numElems <= LIST_MAX, so this is safe. */
	flagPtr = (int *) Tcl_Alloc(llen*sizeof(int));
    }
    for (bytesNeeded = 0, i = 0; i < llen; i++) {
	Tcl_Obj *elemObj;
	const char *elemStr;
	Tcl_Size elemLen;
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
	/* Note TclScanElement updates flagPtr[i] */
	bytesNeeded += Tcl_ScanCountedElement(elemStr, elemLen, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
	Tcl_DecrRefCount(elemObj);
    }
    if (bytesNeeded > INT_MAX - llen + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += llen; /* Separating spaces and terminating nul */

    /*
     * Pass 2: generate the string repr.
     */
    objPtr->bytes = (char *) Tcl_Alloc(bytesNeeded);
    p = objPtr->bytes;
    for (i = 0; i < llen; i++) {
	Tcl_Obj *elemObj;
	const char *elemStr;
	Tcl_Size elemLen;
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
	p += Tcl_ConvertCountedElement(elemStr, elemLen, p, flagPtr[i]);
	*p++ = ' ';
	Tcl_DecrRefCount(elemObj);

	// EVAL DIRECT to avoid interfering with bytecode compile which may be
	// active on the stack
	int flags = TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT;
	int status = Tcl_EvalObjEx(intrp, genCmd, flags);
	elemObj = Tcl_GetObjResult(intrp);
	if (status != TCL_OK) {
	    Tcl_SetObjResult(intrp, Tcl_ObjPrintf(
		"Error: %s\nwhile executing %s\n",
		elemObj ? Tcl_GetString(elemObj) : "NULL", Tcl_GetString(genCmd)));
	    return NULL;
	}
    }
    return elemObj;
}

    NULL, /* SetFromAnyProc */
    TCL_OBJTYPE_V2(
	lgenSeriesObjLength,
	lgenSeriesObjIndex,
	NULL, /* slice */
	NULL, /* reverse */
	NULL, /* get elements */
	NULL, /* set element */
	NULL, /* replace */
	NULL) /* "in" operator */
};

/*
 *  ObjType Duplicate Internal Rep Function
 */
static void
DupLgenSeriesRep(

    cachePtr = (Cache*)TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = (Cache*)TclpSysAlloc(sizeof(Cache));
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
	memset(cachePtr, 0, sizeof(Cache));
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
	Tcl_MutexUnlock(listLockPtr);
	cachePtr->owner = Tcl_GetCurrentThread();
	TclpSetAllocCache(cachePtr);
    }

    if (TclGetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
	if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
		!= TCL_OK) {
	    const char *arg = TclGetString(objv[1]);

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad argument \"%s\": must be"
		    " cancel, idle, info, or an integer", arg));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
		    arg, (void *)NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * At this point, either index = -1 and ms contains the number of ms
     * to wait, or else index is the index of a subcommand.

	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
		    afterPtr = afterPtr->nextPtr) {
		if (assocPtr->interp == interp) {
		    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
			    "after#%d", afterPtr->id));
		}
	    }
	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	}
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
	    return TCL_ERROR;
	}
	afterPtr = GetAfterEvent(assocPtr, objv[2]);
	if (afterPtr == NULL) {
	    const char *eventStr = TclGetString(objv[2]);

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "event \"%s\" doesn't exist", eventStr));
	    Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL);
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultListPtr;

	    TclNewObj(resultListPtr);
	    Tcl_ListObjAppendElement(interp, resultListPtr,
		    afterPtr->commandPtr);
	    Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (afterPtr->token == NULL) ? "idle" : "timer", -1));
	    Tcl_SetObjResult(interp, resultListPtr);
	}
	break;
    default:
	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
    }
    return TCL_OK;
}

	}
	if (iPtr->limit.timeEvent == NULL
		|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
	    diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
		diff = TCL_TIME_MAXIMUM_SLICE;
	    }
	    if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
		diff = 1;
	    }
	    if (diff > 0) {
		Tcl_Sleep((int) diff);
		if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
		    break;
		}
	    } else {
		break;
	    }
	} else {
	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
		diff = TCL_TIME_MAXIMUM_SLICE;
	    }
	    if (diff > 0) {
		Tcl_Sleep((int) diff);

	/*
	 * None of the remaining traces on this command are execution traces.
	 * We therefore remove this flag:
	 */

	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;

	/*
	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
	 */

	if (cmdPtr->compileProc != NULL) {
	    iPtr->compileEpoch++;
	}
    }

	    }
	}
    }

    /* Keep the original pointer for possible use in an error message */
    element = part2;
    if (part2 == NULL) {
	if (TclIsVarArrayElement(varPtr)) {
	    Tcl_Obj *keyObj = VarHashGetKey(varPtr);
	    part2 = Tcl_GetString(keyObj);
	}
    } else if ((flags & VAR_TRACED_UNSET) && !(flags & VAR_ARRAY_ELEMENT)) {
	/* On unset traces, part2 has already been set by the caller, and
	 * the VAR_ARRAY_ELEMENT flag indicates whether the accessed
	 * variable actually has a second part, or is a scalar */
	element = NULL;
    }

    /*
     * Invoke traces on the array containing the variable, if relevant.
     */

    result = NULL;

     *	Reconsider this if we ever start treating non-ASCII Unicode
     *	characters as meaningful list syntax, expanded Unicode spaces as
     *	element separators, for example.)
     *

    end = Tcl_UtfPrev(end, start);
    while (*end == '{') {
	if (end == start) {
	    return 0;
	}
	end = Tcl_UtfPrev(end, start);
    }

     *
     */

    while ((--end >= start) && (*end == '{')) {
    }
    if (end < start) {
	return 0;
    }

    /*
     * (c) the trailing character of the string is already a list-element
     *	   separator, Use the same testing routine as TclFindElement to
     *	   enforce consistency.
     */

GetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    Tcl_WideInt endValue,       /* The value to be stored at *widePtr if
				 * objPtr holds "end".
				 * NOTE: this value may be TCL_INDEX_NONE. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
				 * representing an index. */
{
    int numType;
    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;
	    if ((*widePtr < 0)) {
		*widePtr = (endValue == -1) ? WIDE_MIN : -1;
	    }
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */

    if (indexPtr != NULL) {
	/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
	if (wide >= 0 && wide <= TCL_SIZE_MAX) {
	    *indexPtr = (Tcl_Size)wide; /* A valid index */
	} else if (wide > TCL_SIZE_MAX) {
	    *indexPtr = TCL_SIZE_MAX;   /* Beyond max possible index */
	} else if (wide < -1-TCL_SIZE_MAX) {
	    *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */
	} else if ((wide < 0) && (endValue >= 0)) {
	    *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */
	} else {
	    *indexPtr = (Tcl_Size) wide;
	}
    }
    return TCL_OK;
}

/*

 */

static int
GetEndOffsetFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    Tcl_WideInt endValue,       /* The value to be stored at "widePtr" if
				 * "objPtr" holds "end". */
    Tcl_WideInt *widePtr)       /* Location filled in with an integer
				 * representing an index. */
{
    Tcl_ObjInternalRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    void *cd;

    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
	Tcl_ObjInternalRep ir;

	    /*
	     * Quick scan to see if multi-value list is even possible.
	     * This relies on TclGetString() returning a NUL-terminated string.
	     */
	    if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1)
		    /* If it's possible, do the full list parse. */
		    && (TCL_OK == TclListObjLength(NULL, objPtr, &length))
		    && (length > 1)) {
		goto parseError;
	    }

	    /* Passed the list screen, so parse for index arithmetic expression */
	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE, &opPtr,
		    TCL_PARSE_INTEGER_ONLY)) {
		Tcl_WideInt w1=0, w2=0;

		/* value starts with valid integer... */

		if ((*opPtr == '-') || (*opPtr == '+')) {
		    /* ... value continues with [-+] ... */

    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	/*
	 * Encodes end+1. This is distinguished from end+n as noted
	 * in function header.
	 * NOTE: this may wrap around if the caller passes (as lset does)
	 * listLen-1 as endValue and and listLen is 0. The -1 will be
	 * interpreted as FF...FF and adding 1 will result in 0 which
	 * is what we want. Callers like lset which pass in listLen-1 == -1
	 * as endValue will have to adjust accordingly.
	 */
	*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
    } else if (offset == WIDE_MIN) {
	*widePtr = (endValue == -1) ? WIDE_MIN : -1;
    } else if (offset < 0) {
	/* end-(n-1) - Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;
    } else {
	/* 0:WIDE_MAX - plain old index. */
	*widePtr = offset;
    }
    return TCL_OK;

    /* Report a parse error. */
  parseError:
    if (interp != NULL) {
	char * bytes = TclGetString(objPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad index \"%s\": must be integer?[+-]integer? or"
		" end?[+-]integer?", bytes));
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL);
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

    /*
     * It's an error to unset an undefined variable.
     */

    if (result != TCL_OK) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
	      ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL);
	}
    }

    /*
     * Finally, if the variable is truly not in use then free up its Var
     * structure and remove it from its hash table, if any. The ref count of

		Tcl_SetHashValue(tPtr, tracePtr);
	    }
	}

	if ((dummyVar.flags & VAR_TRACED_UNSET)
		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {

	    /*
	     * Pass the array element name to TclObjCallVarTraces(), because
	     * it cannot be determined from dummyVar. Alternatively, indicate
	     * via flags whether the variable involved in the code that caused
	     * the trace to be triggered was an array element, for the correct
	     * formatting of error messages.
	     */
	    if (part2Ptr) {
		flags |= VAR_ARRAY_ELEMENT;
	    } else if (TclIsVarArrayElement(varPtr)) {
		part2Ptr = VarHashGetKey(varPtr);
	    }

	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
	      (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT))
			    | TCL_TRACE_UNSETS,
		    /* leaveErrMsg */ 0, index);

	    /*
	     * The traces that we just called may have triggered a change in
	     * the set of traces. If so, reload the traces to manipulate.
	     */

     *
     *      array default set v 1
     *      lappend v(a) 2; # returns a new object {1 2}
     *      set v(b); # returns the original default object "1"
     */

    if (tablePtr->defaultObj) {
	Tcl_DecrRefCount(tablePtr->defaultObj);
	Tcl_DecrRefCount(tablePtr->defaultObj);
    }
    tablePtr->defaultObj = defaultObj;
    if (tablePtr->defaultObj) {
	Tcl_IncrRefCount(tablePtr->defaultObj);
	Tcl_IncrRefCount(tablePtr->defaultObj);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	 */

	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if (zf->length == (size_t) TCL_INDEX_NONE) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	/* What's the magic about 64 * 1024 * 1024 ? */
	if ((zf->length <= ZIP_CENTRAL_END_LEN) ||
		(zf->length - ZIP_CENTRAL_END_LEN) >
			(64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
	    goto error;
	}

#----------------------------------------------------------------------
#
# icu.tcl --
#
#	This file implements the portions of the [tcl::unsupported::icu]
#       ensemble that are coded in Tcl.
#
#----------------------------------------------------------------------
#
# Copyright © 2024 Ashok P. Nadkarni
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#----------------------------------------------------------------------

::tcl::unsupported::loadIcu

namespace eval ::tcl::unsupported::icu {
    # Map Tcl encoding names to ICU and back. Note ICU has multiple aliases
    # for the same encoding.
    variable tclToIcu
    variable icuToTcl

    proc LogError {message} {
	puts stderr $message
    }

    proc Init {} {
	variable tclToIcu
	variable icuToTcl
	# There are some special cases where names do not line up
	# at all. Map Tcl -> ICU
	array set specialCases {
	    ebcdic ebcdic-cp-us
	    macCentEuro maccentraleurope
	    utf16 UTF16_PlatformEndian
	    utf-16be UnicodeBig
	    utf-16le UnicodeLittle
	    utf32 UTF32_PlatformEndian
	}
	# Ignore all errors. Do not want to hold up Tcl
	# if ICU not available
	if {[catch {
	    foreach tclName [encoding names] {
		if {[catch {
		    set icuNames [aliases $tclName]
		} erMsg]} {
		    LogError "Could not get aliases for $tclName: $erMsg"
		    continue
		}
		if {[llength $icuNames] == 0} {
		    # E.g. macGreek -> x-MacGreek
		    set icuNames [aliases x-$tclName]
		    if {[llength $icuNames] == 0} {
			# Still no joy, check for special cases
			if {[info exists specialCases($tclName)]} {
			    set icuNames [aliases $specialCases($tclName)]
			}
		    }
		}
		# If the Tcl name is also an ICU name use it else use
		# the first name which is the canonical ICU name
		set pos [lsearch -exact -nocase $icuNames $tclName]
		if {$pos >= 0} {
		    lappend tclToIcu($tclName) [lindex $icuNames $pos] {*}[lreplace $icuNames $pos $pos]
		} else {
		    set tclToIcu($tclName) $icuNames
		}
		foreach icuName $icuNames {
		    lappend icuToTcl($icuName) $tclName
		}
	    }
	} errMsg]} {
	    LogError $errMsg
	}
	array default set tclToIcu ""
	array default set icuToTcl ""

	# Redefine ourselves to no-op.
	proc Init {} {}
    }
    # Primarily used during development
    proc MappedIcuNames {{pat *}} {
	Init
	variable icuToTcl
	return [array names icuToTcl $pat]
    }
    # Primarily used during development
    proc UnmappedIcuNames {{pat *}} {
	Init
	variable icuToTcl
	set unmappedNames {}
	foreach icuName [converters] {
	    if {[llength [icuToTcl $icuName]] == 0} {
		lappend unmappedNames $icuName
	    }
	    foreach alias [aliases $icuName] {
		if {[llength [icuToTcl $alias]] == 0} {
		    lappend unmappedNames $alias
		}
	    }
	}
	# Aliases can be duplicates. Remove
	return [lsort -unique [lsearch -inline -all $unmappedNames $pat]]
    }
    # Primarily used during development
    proc UnmappedTclNames {{pat *}} {
	Init
	variable tclToIcu
	set unmappedNames {}
	foreach tclName [encoding names] {
	    # Note entry will always exist. Check if empty
	    if {[llength [tclToIcu $tclName]] == 0} {
		lappend unmappedNames $tclName
	    }
	}
	return [lsearch -inline -all $unmappedNames $pat]
    }

    # Returns the Tcl equivalent of an ICU encoding name or
    # the empty string in case not found.
    proc icuToTcl {icuName} {
	Init
	proc icuToTcl {icuName} {
	    variable icuToTcl
	    return [lindex $icuToTcl($icuName) 0]
	}
	icuToTcl $icuName
    }

    # Returns the ICU equivalent of an Tcl encoding name or
    # the empty string in case not found.
    proc tclToIcu {tclName} {
	Init
	proc tclToIcu {tclName} {
	    variable tclToIcu
	    return [lindex $tclToIcu($tclName) 0]
	}
	tclToIcu $tclName
    }


    namespace export {[a-z]*}
    namespace ensemble create
}

#
# (Ticket 41c9857bdd) In a safe interpreter, this file does not set
# ::auto_path (other than to {} if it is undefined). The caller, typically
# a Safe Base command, is responsible for setting ::auto_path.

if {![info exists auto_path]} {
    if {[info exists env(TCLLIBPATH)] && (![interp issafe])} {
	set auto_path [apply {{} {
	    lmap path $::env(TCLLIBPATH) {
		# Paths relative to unresolvable home dirs are ignored
		if {[catch {file tildeexpand $path} expanded_path]} {
		    continue
		}
		set expanded_path
	    }
	}}]
    } else {
	set auto_path ""
    }
}

namespace eval tcl {
    if {![interp issafe]} {

set auto_index(::tcl::UpdateWordBreakREs) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(writeFile) [list ::tcl::Pkg::source [file join $dir writefile.tcl]]
set auto_index(::tcl::unsupported::icu) [list ::tcl::Pkg::source [file join $dir icu.tcl]]

namespace eval ::tclTestPerf-Chan {

namespace path {::tclTestPerf}

proc _get_test_chan {{bufSize 4096}} {
  lassign [chan pipe] ch wch;
  fconfigure $ch -translation lf -encoding utf-8 -buffersize $bufSize -buffering full
  fconfigure $wch -translation lf -encoding utf-8 -buffersize $bufSize -buffering full

  exec [info nameofexecutable] -- $bufSize >@$wch << {
    set bufSize [lindex $::argv end]
    fconfigure stdout -translation lf -encoding utf-8 -buffersize $bufSize -buffering full
    set buf [string repeat test 1000]; # 4K
    # write ~ 10*1M + 10*2M + 10*10M + 1*20M:
    set i 0; while {$i < int((10*1e6 + 10*2e6 + 10*10e6 + 1*20e6)/4e3)} {
      #puts -nonewline stdout $i\t
      puts stdout $buf
      #flush stdout; # don't flush to use full buffer
      incr i

    chan configure stdout -eofchar [list \x27 {}]
} -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
    chan configure stdout -eofchar [list \x27 \x80]
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}
test chan-4.6 {chan command: check no inValue, valid outValue} -body {
    chan configure stdout -eofchar [list {} \x27]
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}

test chan-5.1 {chan command: copy subcommand} -body {
    chan copy foo
} -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\""

test chan-6.1 {chan command: eof subcommand} -body {
    chan eof foo bar

    testConstraint makeFileInHome [expr {![file exists $::env(HOME)/_test_] && [file writable $::env(HOME)]}]

    # set up a long data file for some of the following tests

    set path(longfile) [makeFile {} longfile]
    set f [open $path(longfile) w]
    chan configure $f -translation lf
    for { set i 0 } { $i < 100 } { incr i} {
	chan puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
\#123456789abcdef01
\#"
    }
    chan close $f

    set path(cat) [makeFile {
	set f stdin
	if {$argv != ""} {
	    set f [open [lindex $argv 0]]
	}
	chan configure $f -translation binary -blocking 0 -eofchar \x1A
	chan configure stdout -translation binary -buffering none
	chan event $f readable "foo $f"
	proc foo {f} {
	    set x [chan read $f]
	    catch {chan puts -nonewline $x}
	    if {[chan eof $f]} {
		chan close $f
		exit 0


test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts -nonewline $f "a\x4D\x00"
    chan close $f
    contents $path(test1)
} aM\x00
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis

    chan close           $f
    lappend sizes [file size $path(test2)]
} {19 19 19 19 19}

test chan-io-2.1 {WriteBytes} {
    # loop until all bytes are written
    set f [open $path(test1) w]
    chan configure $f  -translation binary -buffersize 16 -translation crlf
    chan puts $f "abcdefghijklmnopqrstuvwxyz"
    chan close $f
    contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test chan-io-2.2 {WriteBytes: savedLF > 0} {
    # After flushing buffer, there was a \n left over from the last
    # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.
    set f [open $path(test1) w]
    chan configure $f -translation binary -buffersize 16 -translation crlf
    chan puts -nonewline $f "123456789012345\n12"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test chan-io-2.3 {WriteBytes: flush on line} -body {
    # Tcl "line" buffering has weird behavior: if current buffer contains a
    # \n, entire buffer gets flushed.  Logical behavior would be to flush only
    # up to the \n.
    set f [open $path(test1) w]
    chan configure $f -translation binary -buffering line -translation crlf
    chan puts -nonewline $f "\n12"
    contents $path(test1)
} -cleanup {
    chan close $f
} -result "\r\n12"
test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} {
    set f [open $path(test1) w]
     chan configure $f -translation binary -buffering line -buffersize 16

    chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

test chan-io-3.1 {WriteChars: compatibility with WriteBytes} {

    chan puts -nonewline $f "12345678901\n456789012345678901234"
    chan close $f
    set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"

test chan-io-5.1 {CheckFlush: not full} {
    set f [open $path(test1) w]

    chan puts -nonewline $f "12345678901234567890"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test chan-io-5.2 {CheckFlush: full} {
    set f [open $path(test1) w]

    chan gets $f
} -cleanup {
    chan close $f
} -result "1234567890123０１２３４"
test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
    # (bufPtr->nextAdded < bufPtr->bufLength)
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis
    list [chan gets $f line] $line [chan eof $f]
} -cleanup {
    chan close $f
} -result {10 1234567890 0}
test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
    set x ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis -profile tcl8
    lappend x [chan gets $f line] $line
    lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 16 "1234567890123０１\x82" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
    variable x ""
} -constraints {stdio fileevent} -body {
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation binary -buffering none
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan configure $f -encoding shiftjis -blocking 0
    chan event $f read [namespace code {
	lappend x [chan gets $f line] $line [chan blocked $f]
    }]
    vwait [namespace which -variable x]
    chan configure $f -translation binary -blocking 1
    chan puts $f "\x51\x82\x52"
    chan configure $f -encoding shiftjis
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
} -result [list -1 "" 1 17 "1234567890123０１２３" 0]

test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
    # not (bytesLeft == 0)
    set f [open $path(test1) w+]
    chan configure $f -translation binary
    chan puts $f "${a}\r\nabcdef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation binary -translation auto
    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE is
    # 30). To check if "\n" follows, calls PeekAhead and determines that
    # cached data is available in buffer w/o having to call driver.
    chan gets $f
} -cleanup {
    chan close $f
} -result $a

test chan-io-11.1 {ReadBytes: want to read a lot} -body {
    # ((unsigned) toRead > (unsigned) srcLen)
    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation binary
    # here
    chan read $f 1000
} -cleanup {
    chan close $f
} -result {abcdefghijkl}
test chan-io-11.2 {ReadBytes: want to read all} -body {
    # ((unsigned) toRead > (unsigned) srcLen)
    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation binary
    # here
    chan read $f
} -cleanup {
    chan close $f
} -result {abcdefghijkl}
test chan-io-11.3 {ReadBytes: allocate more space} -body {
    # (toRead > length - offset - 1)
    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
    chan close $f
    set f [open $path(test1)]
    chan configure $f -buffersize 16 -translation binary
    # here
    chan read $f
} -cleanup {
    chan close $f
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-11.4 {ReadBytes: EOF char found} -body {
    # (TranslateInputEOL() != 0)
    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnopqrstuvwxyz
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation binary -eofchar m
    # here
    list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]
} -cleanup {
    chan close $f
} -result {abcdefghijkl 1 {} 1}

test chan-io-12.1 {ReadChars: want to read a lot} -body {

    chan close $f
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-12.4 {ReadChars: split-up char} -setup {
    variable x {}
} -constraints {stdio testchannel fileevent} -body {
    # (srcRead == 0)
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation binary -buffering none -buffersize 16
    chan puts -nonewline $f "123456789012345\x96"
    chan configure $f -encoding shiftjis -blocking 0
    chan event $f read [namespace code {
	lappend x [chan read $f] [testchannel inputbuffered $f]
    }]
    chan configure $f -encoding shiftjis
    vwait [namespace which -variable x]
    chan configure $f -translation binary -blocking 1
    chan puts -nonewline $f \x7B
    after 500			;# Give the cat process time to catch up
    chan configure $f -encoding shiftjis -blocking 0
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
} -result [list "123456789012345" 1 本 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
    variable x {}
} -constraints {stdio fileevent} -body {
    set path(test1) [makeFile {
	chan configure stdout -translation binary -buffering none
	chan gets stdin; chan puts -nonewline \xE7
	chan gets stdin; chan puts -nonewline \x89
	chan gets stdin; chan puts -nonewline \xA6
    } test1]
    set f [openpipe r+ $path(test1)]
    chan event $f readable [namespace code {
	lappend x [chan read $f]

    chan close $f
} -result "file"

test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup {
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f "1234567890\n098765432"
    chan close $f
    set f [open $path(test1) r]
    chan gets $f
    lappend l [testchannel inputbuffered $f]
    lappend l [chan tell $f]
} -cleanup {

    chan close $f
} -result 0
test chan-io-27.2 {FlushChannel, some output buffered} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [file size $path(test1)]
    chan close $f
    lappend l [file size $path(test1)]
} -result {0 6 6}
test chan-io-27.3 {FlushChannel, implicit flush on chan close} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello
    lappend l [file size $path(test1)]
    chan close $f
    lappend l [file size $path(test1)]
} -result {0 6}
test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan configure $f -buffersize 60
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	chan puts $f hello
    }
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
} -result {0 60 72}
test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup {
    file delete $path(test1)
    set l ""
} -constraints {unixOrWin} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffersize 60
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	chan puts $f hello
    }
    lappend l [file size $path(test1)]
    chan close $f
    lappend l [file size $path(test1)]
} -result {0 60 72}
set path(pipe)   [makeFile {} pipe]
set path(output) [makeFile {} output]
test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup {
    file delete $path(pipe)
    file delete $path(output)
} -constraints {stdio asyncPipeChan Close} -body {
    set f [open $path(pipe) w]
    chan puts $f "set f \[[list open $path(output) w]]"
    chan puts $f {
	chan configure $f -translation lf -buffering none
	while {![chan eof stdin]} {
	    after 20
	    chan puts -nonewline $f [chan read stdin 1024]
	}
	chan close $f
    }
    chan close $f

} -result abcdef
test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup {
    file delete $path(pipe)
    file delete $path(output)
} -constraints {stdio asyncPipeChan Close nonPortable} -body {
    set f [open $path(pipe) w]
    chan puts $f {





	set f [open $path(output) w]
	chan configure $f -translation lf -buffering none
	for {set x 0} {$x < 20} {incr x} {
	    after 20
	    chan puts -nonewline $f [chan read stdin 1024]
	}
	chan close $f
    }
    chan close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open $path(output) w]
    chan close $f
    set f [openpipe r+ $path(pipe)]
    chan configure $f -blocking off
    chan puts -nonewline $f $x
    chan close $f
    set counter 0
    while {([file size $path(output)] < 20480) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }

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 {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]

    chan puts -nonewline $f ""
    chan close $f
    file size $path(test1)
} -result 0
test chan-io-29.3 {Tcl_WriteChars, nonempty string} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]

    chan puts -nonewline $f hello
    chan close $f
    file size $path(test1)
} -result 5
test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} -setup {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering full
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
} -result {6 0 0 6}
test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} -setup {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering line
    chan puts -nonewline $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
} -result {5 0 0 11}
test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} -setup {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering none
    chan puts -nonewline $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
} -result {0 5 0 11}
test chan-io-29.7 {Tcl_Flush, full buffering} -setup {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering full
    chan puts -nonewline $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan flush $f

test chan-io-29.9 {Tcl_Flush, channel not writable} -body {
    chan flush stdin
} -returnCodes error -result {channel "stdin" wasn't opened for writing}
test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    set f2 [open $path(longfile) r]
    for {set x 0} {$x < 10} {incr x} {
	chan puts $f1 [chan gets $f2]
    }
    chan close $f2
    chan close $f1
    file size $path(test1)
} -result 387
test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]

    set f2 [open $path(longfile) r]
    for {set x 0} {$x < 10} {incr x} {
	chan puts -nonewline $f1 [chan gets $f2]
    }
    chan close $f1
    chan close $f2
    file size $path(test1)

} -cleanup {
    chan close $f1
} -result {18 24 30}
test chan-io-29.19 {Explicit and implicit flushes} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    set x ""
    chan puts $f1 hello
    chan puts $f1 hello
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
    chan puts $f1 hello
    chan close $f1
    lappend x [file size $path(test1)]
} -result {18 24 30}
test chan-io-29.20 {Implicit flush when buffer is full} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    for {set x 0} {$x < 100} {incr x} {
      chan puts $f1 $line
    }
    set z ""
    lappend z [file size $path(test1)]
    for {set x 0} {$x < 100} {incr x} {

    }
    string tolower $x
} -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}}
test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan flush $f
    file size $path(test1)
} -cleanup {
    chan close $f
} -result 21
test chan-io-29.29 {Tcl_WriteChars, cr mode} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    file size $path(test1)
} -result 21
test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    file size $path(test1)
} -result 25
test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
    file delete $path(pipe)
    file delete $path(output)

    chan close $f
} -result {abc def 0 {} 1 {} 1}
test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1Aghi 0 qrs 0 {} 1"
test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    set x [chan gets $f]
    lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {1 1 {} 1}
test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    set x [chan gets $f]
    lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f

    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]

    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1A
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1A
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1A
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1A
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]

    set x 24
    chan gets $f x(0)
} -returnCodes error -cleanup {
    chan close $f
} -result {can't set "x(0)": variable isn't array}
test chan-io-33.8 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 100} {incr y} {chan puts $f $x}
    chan close $f
    set f [open $path(test3) r]
    chan configure $f -translation lf
    for {set y 0} {$y < 100} {incr y} {chan gets $f}
    chan close $f
    set y
} 100
test chan-io-33.9 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 200} {incr y} {chan puts $f $x}
    chan close $f
    set f [open $path(test3) r]
    chan configure $f -translation lf
    for {set y 0} {$y < 200} {incr y} {chan gets $f}
    chan close $f
    set y
} 200
test chan-io-33.10 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 300} {incr y} {chan puts $f $x}
    chan close $f
    set f [open $path(test3) r]
    chan configure $f -translation lf
    for {set y 0} {$y < 300} {incr y} {chan gets $f}

} -cleanup {
    chan close $f1
} -result 0
test chan-io-34.2 {Tcl_Seek to offset from start} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 10 start
    chan tell $f1
} -cleanup {
    chan close $f1
} -result 10
test chan-io-34.3 {Tcl_Seek to end of file} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 0 end
    chan tell $f1
} -cleanup {
    chan close $f1
} -result 54
test chan-io-34.4 {Tcl_Seek to offset from end of file} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 -10 end
    chan tell $f1
} -cleanup {
    chan close $f1
} -result 44
test chan-io-34.5 {Tcl_Seek to offset from current position} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 10 current
    chan seek $f1 10 current
    chan tell $f1
} -cleanup {
    chan close $f1
} -result 20
test chan-io-34.6 {Tcl_Seek to offset from end of file} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 -10 end
    list [chan tell $f1] [chan read $f1]
} -cleanup {
    chan close $f1
} -result {44 {rstuvwxyz
}}
test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 -10 end
    set c1 [chan tell $f1]
    set r1 [chan read $f1 5]

} -returnCodes error -cleanup {
    chan close $pipe
} -match glob -result {error during seek on "*": invalid argument}
test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]

    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan close $f
    set f [open $path(test3) RDWR]
    set x [chan read $f 1]
    chan seek $f 3
    lappend x [chan read $f 1]
    chan seek $f 0 start

    chan seek $f 2
    set x [chan gets $f]
    chan close $f
    list $x [viewFile test3]
} "zzy xyzzy"
test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    chan puts $f xyz\n123
    chan close $f
    set f [open $path(test3) a+]
    chan configure $f -translation lf
    chan puts $f xyzzy
    chan flush $f
    set x [chan tell $f]
    chan seek $f -4 cur
    set y [chan gets $f]
    chan close $f
    list $x [viewFile test3] $y

} -cleanup {
    chan close $f1
} -result 0
test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 0 end
    chan tell $f1
} -cleanup {
    chan close $f1
} -result 54
test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 10 start
    set c1 [chan tell $f1]
    chan seek $f1 10 current

    chan close $f1
    set c
} -1
test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup {
    file delete $path(test2)
} -body {
    set f [open $path(test2) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
    chan close $f
    set f [open $path(test2)]
    chan configure $f -translation lf
    set x [chan tell $f]
    chan read $f 3
    lappend x [chan tell $f]
    chan seek $f 2
    lappend x [chan tell $f]
    chan seek $f 10 current
    lappend x [chan tell $f]
    chan seek $f 0 end
    lappend x [chan tell $f]
} -cleanup {
    chan close $f
} -result {0 3 2 12 30}
test chan-io-34.19 {Tcl_Tell combined with opening in append mode} -body {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    chan puts $f "abcdefghijklmnopqrstuvwxyz"
    chan puts $f "abcdefghijklmnopqrstuvwxyz"
    chan close $f
    set f [open $path(test3) a]
    chan tell $f
} -cleanup {
    chan close $f

    chan close $f
} -result {29 39 40 447}
test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} -setup {
    file delete $path(test3)
    set l ""
} -constraints {largefileSupport extensive} -body {
    set f [open $path(test3) w]
    chan configure $f -translation binary
    lappend l [chan tell $f]
    chan puts -nonewline $f abcdef
    lappend l [chan tell $f]
    chan flush $f
    lappend l [chan tell $f]
    # 4GB offset!
    chan seek $f 0x100000000

} -cleanup {
    chan close $f
} -result {10 8 1}
test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1A
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {17 8 1}
test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1A
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {17 8 1}
test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1A
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {17 8 1}
test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1A
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {17 8 1}
test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1A
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {21 8 1}
test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1A
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {

    chan close $f1
} -result {0 21}
test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -buffering none
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    chan configure $f1 -buffering full
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]

} -cleanup {
    chan close $f
} -result 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts -nonewline $f \xE7\x89\xA6
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -encoding utf-8
    chan read $f
} -cleanup {
    chan close $f
} -result 牦
test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts -nonewline $f \xE7\x89\xA6
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -encoding utf-8
    chan read $f
} -cleanup {
    chan close $f
} -result 牦
test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
    file delete $path(test1)
    set f [open $path(test1) w]
} -body {
    chan configure $f -encoding foobar
} -returnCodes error -cleanup {
    chan close $f
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
    variable x {}
} -constraints {stdio fileevent} -body {
    set f [openpipe r+ $path(cat)]
    chan configure $f -encoding iso8859-1
    chan puts -nonewline $f \xE7
    chan flush $f
    chan configure $f -encoding utf-8 -blocking 0
    chan event $f readable [namespace code { lappend x [chan read $f] }]
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan configure $f -encoding utf-8
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan configure $f -encoding iso8859-1
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
} -result "{} timeout {} timeout \xE7 timeout"

    file stat $path(test3) stats
    format 0o%03o [expr {$stats(mode) & 0o777}]
} -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]

    chan puts $f xyzzy
    chan close $f
    set f [open $path(test3) {WRONLY CREAT}]

    chan puts -nonewline $f "ab"
    chan close $f
    set f [open $path(test3) r]
    chan gets $f
} -cleanup {
    chan close $f
} -result abzzy
test chan-io-40.5 {POSIX open access modes: APPEND} -setup {
    file delete $path(test3)
    set x ""
} -body {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    chan puts $f xyzzy
    chan close $f
    set f [open $path(test3) {WRONLY APPEND}]
    chan configure $f -translation lf
    chan puts $f "new line"
    chan seek $f 0
    chan puts $f "abc"

    chan close $f
    open $path(test3) {WRONLY CREAT EXCL}
} -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists}
test chan-io-40.7 {POSIX open access modes: EXCL} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) {WRONLY CREAT EXCL}]

    chan puts $f "A test line"
    chan close $f
    viewFile test3
} -result {A test line}
test chan-io-40.8 {POSIX open access modes: TRUNC} -setup {
    file delete $path(test3)
} -body {

test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body {
    file delete $path(test3)
    open $path(test3) WRONLY
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test chan-io-40.13 {POSIX open access modes: WRONLY} -body {
    makeFile xyzzy test3
    set f [open $path(test3) WRONLY]

    chan puts -nonewline $f "ab"
    chan seek $f 0 current
    set x [list [catch {chan gets $f} msg] $msg]
    chan close $f
    lappend x [viewFile test3]
} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {

    lappend result [file size $path(test1)]
} -result {0 0 40}
test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation binary -blocking 0
    chan configure $f2 -translation binary -blocking 0
    chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation binary -blocking 0
    chan configure $f2 -translation binary -blocking 0
    chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation binary -blocking 0
    chan configure $f2 -translation binary -blocking 0
    chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] ==  [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.6 {TclCopyChannel} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation binary -blocking 0
    chan configure $f2 -translation binary -blocking 0
    set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation binary -blocking 0
    chan configure $f2 -translation binary -blocking 0
    chan copy $f1 $f2
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -cleanup {

	    [file size $path(utf8-fcopy.txt)] \
	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body {
    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]
    chan configure $in  -encoding koi8-r -translation lf

    chan configure $out -translation binary
    chan copy $in $out
    file size $path(utf8-fcopy.txt)
} -cleanup {
    chan close $in
    chan close $out
    unset in out
} -returnCodes 1 -match glob -result {error writing "*":\
	invalid or incomplete multibyte or wide character}
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
    set f [open $path(utf8-fcopy.txt) w]
    fconfigure $f -encoding utf-8 -translation lf
    puts $f АА
    close $f
} -constraints {fcopy} -body {
    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    chan configure $in  -translation binary
    chan configure $out -encoding koi8-r -translation lf -profile strict
    catch {chan copy $in $out} cres copts
    return $cres
} -cleanup {
    if {$in in [chan names]} {
	close $in

# size
test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body {
    file size a b
} -result {wrong # args: should be "file size name"}
test cmdAH-27.2 {Tcl_FileObjCmd: size} {
    set oldsize [file size $gorpfile]
    set f [open $gorpfile a]
    fconfigure $f -translation lf
    puts $f "More text"
    close $f
    expr {[file size $gorpfile] - $oldsize}
} {10}
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
    list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}

    append a $a
    set x [encoding convertfrom jis0208 $a]
    list [string length $x] [string index $x 0]
} "512 乎"

test encoding-8.1 {Tcl_ExternalToUtf} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary
    puts -nonewline $f "ab\x8C\xC1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation lf -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} ab乎g

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {

    append a $a
    set x [encoding convertto jis0208 $a]
    list [string length $x] [string range $x 0 1]
} "1024 8C"

test encoding-10.1 {Tcl_UtfToExternal} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation lf -encoding shiftjis
    puts -nonewline $f ab乎g
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\x8C\xC1g"

test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {

小切手送付先として使用しております。恐れ入りますが、正しい住所をご登録しなお
お願いいたします。また、大変恐縮ですが、住所変更のあと、日本語サービス部（
casino_japanese@___.com ）までご住所変更済の連絡をいただけないで
しょうか？"

cd [temporaryDirectory]
set fid [open iso2022.txt w]
fconfigure $fid -translation binary
puts -nonewline $fid $iso2022encData
close $fid

test encoding-23.1 {iso2022-jp escape encoding test} {
    string equal $iso2022uniData $iso2022uniData2
} 1
test encoding-23.2 {iso2022-jp escape encoding test} {

    return $diff
}

# Create char tables.
cd [temporaryDirectory]
foreach enc {cp932 euc-jp iso2022-jp} {
    set f [open $enc.chars w]
    fconfigure $f -encoding iso8859-1
    foreach-jisx0208 code {
	puts $f [format "%04X %s" $code [gen-jisx0208-$enc $code]]
    }
    close $f
}
# shiftjis == cp932 for jisx0208.
file copy -force cp932.chars shiftjis.chars

# Tests for tcl::unsupported::icu

if {"::tcltest" ni [namespace children]} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Force late loading of ICU if present
catch {::tcl::unsupported::icu}
testConstraint icu [expr {[info commands ::tcl::unsupported::icu::detect] ne ""}]

namespace eval icu {
    test icu-detect-0 {Return list of ICU encodings} -constraints icu -body {
	set encoders [::tcl::unsupported::icu detect]
	list [::tcl::mathop::in UTF-8 $encoders] [::tcl::mathop::in ISO-8859-1 $encoders]
    } -result {1 1}

    test icu-detect-1 {Guess encoding} -constraints icu -body {
	::tcl::unsupported::icu detect [readFile [info script]]
    } -result ISO-8859-1

    test icu-detect-2 {Get all possible encodings} -constraints icu -body {
	set encodings [::tcl::unsupported::icu detect [readFile [info script]] -all]
	list [::tcl::mathop::in UTF-8 $encodings] [::tcl::mathop::in ISO-8859-1 $encodings]
    } -result {1 1}

    test icu-tclToIcu-0 {Map Tcl encoding} -constraints icu -body {
	# tis-620 because it is ambiguous in ICU on some platforms
	# but should return the preferred encoding
	list [::tcl::unsupported::icu tclToIcu utf-8] [::tcl::unsupported::icu tclToIcu tis-620] [::tcl::unsupported::icu tclToIcu shiftjis]
    } -result {UTF-8 TIS-620 ibm-943_P15A-2003}

    test icu-tclToIcu-1 {Map Tcl encoding - no map} -constraints icu -body {
	# Should not raise an error
	::tcl::unsupported::icu tclToIcu dummy
    } -result {}

    test icu-icuToTcl-0 {Map ICU encoding} -constraints icu -body {
       list [::tcl::unsupported::icu icuToTcl UTF-8] [::tcl::unsupported::icu icuToTcl TIS-620] [::tcl::unsupported::icu icuToTcl ibm-943_P15A-2003]
    } -result {utf-8 tis-620 cp932}

    test icu-icuToTcl-1 {Map ICU encoding - no map} -constraints icu -body {
	# Should not raise an error
	::tcl::unsupported::icu icuToTcl dummy
    } -result {}

}


namespace delete icu
::tcltest::cleanupTests

testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]

# set up a long data file for some of the following tests

set path(longfile) [makeFile {} longfile]
set f [open $path(longfile) w]
fconfigure $f -translation lf
for { set i 0 } { $i < 100 } { incr i} {
    puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
\#123456789abcdef01
\#"
    }
close $f

set path(cat) [makeFile {
    set f stdin
    if {$argv != ""} {
	set f [open [lindex $argv 0]]
    }
    fconfigure $f -translation binary -blocking 0 -eofchar \x1A
    fconfigure stdout -translation binary -buffering none
    fileevent $f readable "foo $f"
    proc foo {f} {
	set x [read $f]
	catch {puts -nonewline $x}
	if {[eof $f]} {
	    close $f
	    exit 0

test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f "a\x4D\x00"
    close $f
    contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    fconfigure $f -encoding shiftjis

    testreadwrite 0xffffffff
} -result 1

test io-2.1 {WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f  -translation binary -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-2.2 {WriteBytes: savedLF > 0} {
    # After flushing buffer, there was a \n left over from the last
    # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.

    set f [open $path(test1) w]
    fconfigure $f -translation binary -buffersize 16 -translation crlf
    puts -nonewline $f "123456789012345\n12"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-2.3 {WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.

    set f [open $path(test1) w]
    fconfigure $f -translation binary -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents $path(test1)]
    close $f
    set x
} "\r\n12"
test io-2.4 {WriteBytes: reset sawLF after each buffer} {
    set f [open $path(test1) w]
     fconfigure $f -translation binary -buffering line -buffersize 16

    puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
test io-2.5 {WriteBytes: large file (> INT_MAX). Bug 3d01d51bc4} -constraints {
    pointerIs64bit perf

    puts -nonewline $f "12345678901\n456789012345678901234"
    close $f
    set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"

test io-5.1 {CheckFlush: not full} {
    set f [open $path(test1) w]

    puts -nonewline $f "12345678901234567890"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test io-5.2 {CheckFlush: full} {
    set f [open $path(test1) w]

    close $f
    set x
} "1234567890123０１２３４"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
    # (bufPtr->nextAdded < bufPtr->bufLength)

    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -profile tcl8
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 10 "1234567890" 0]
test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -profile tcl8
    set x [list [gets $f line] $line]
    lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list 16 "1234567890123０１\x82" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation binary -buffering none
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    fconfigure $f -encoding shiftjis -blocking 0
    fileevent $f read [namespace code "ready $f"]
    variable x {}
    proc ready {f} {
	variable x
	lappend x [gets $f line] $line [fblocked $f]
    }
    vwait [namespace which -variable x]
    fconfigure $f -translation binary -blocking 1
    puts $f "\x51\x82\x52"
    fconfigure $f -encoding shiftjis
    vwait [namespace which -variable x]
    close $f
    set x
} [list -1 "" 1 17 "1234567890123０１２３" 0]

    # not (bytesLeft == 0)

    set f [open $path(test1) w+]
    fconfigure $f -translation binary
    puts $f "${a}\r\nabcdef"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation binary -translation auto

    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE
    # is 30).  To check if "\n" follows, calls PeekAhead and determines
    # that cached data is available in buffer w/o having to call driver.

    set x [gets $f]
    close $f

test io-11.1 {ReadBytes: want to read a lot} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open $path(test1) w]
    puts -nonewline $f abcdefghijkl
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation binary
    # here
    set x [read $f 1000]
    close $f
    set x
} {abcdefghijkl}
test io-11.2 {ReadBytes: want to read all} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open $path(test1) w]
    puts -nonewline $f abcdefghijkl
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation binary
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijkl}
test io-11.3 {ReadBytes: allocate more space} {
    # (toRead > length - offset - 1)

    set f [open $path(test1) w]
    puts -nonewline $f abcdefghijklmnopqrstuvwxyz
    close $f
    set f [open $path(test1)]
    fconfigure $f -buffersize 16 -translation binary
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyz}
test io-11.4 {ReadBytes: EOF char found} {
    # (TranslateInputEOL() != 0)

    set f [open $path(test1) w]
    puts $f abcdefghijklmnopqrstuvwxyz
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation binary -eofchar m
    # here
    set x [list [read $f] [eof $f] [read $f] [eof $f]]
    close $f
    set x
} [list "abcdefghijkl" 1 "" 1]

test io-12.1 {ReadChars: want to read a lot} {

    close $f
    set x
} {abcdefghijklmnopqrstuvwxyz}
test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
    # (srcRead == 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation binary -buffering none -buffersize 16
    puts -nonewline $f "123456789012345\x96"
    fconfigure $f -encoding shiftjis -blocking 0

    fileevent $f read [namespace code "ready $f"]
    proc ready {f} {
	variable x
	lappend x [read $f] [testchannel inputbuffered $f]
    }
    variable x {}

    fconfigure $f -encoding shiftjis
    vwait [namespace which -variable x]
    fconfigure $f -translation binary -blocking 1
    puts -nonewline $f "\x7B"
    after 500			;# Give the cat process time to catch up
    fconfigure $f -encoding shiftjis -blocking 0
    vwait [namespace which -variable x]
    close $f
    set x
} [list "123456789012345" 1 "本" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
    set path(test1) [makeFile {
	fconfigure stdout -translation binary -buffering none
	gets stdin; puts -nonewline "\xE7"
	gets stdin; puts -nonewline "\x89"
	gets stdin; puts -nonewline "\xA6"
    } test1]
    set f [open "|[list [interpreter] $path(test1)]" r+]
    fileevent $f readable [namespace code {
	lappend x [read $f]

    set t [testchannel type $f]
    close $f
    string compare $t file
} 0

test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f "1234567890\n098765432"
    close $f
    set f [open $path(test1) r]
    gets $f
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [tell $f]

    set s [file size $path(test1)]
    close $f
    set s
} 0
test io-27.2 {FlushChannel, some output buffered} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set l ""
    puts $f hello
    lappend l [file size $path(test1)]
    flush $f
    lappend l [file size $path(test1)]
    close $f
    lappend l [file size $path(test1)]
    set l
} {0 6 6}
test io-27.3 {FlushChannel, implicit flush on close} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set l ""
    puts $f hello
    lappend l [file size $path(test1)]
    close $f
    lappend l [file size $path(test1)]
    set l
} {0 6}
test io-27.4 {FlushChannel, implicit flush when buffer fills} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    fconfigure $f -buffersize 60
    set l ""
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }
    lappend l [file size $path(test1)]
    flush $f
    lappend l [file size $path(test1)]
    close $f
    set l
} {0 60 72}
test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
	{unixOrWin} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -buffersize 60
    set l ""
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }
    lappend l [file size $path(test1)]
    close $f

    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
    file delete $path(pipe)
    file delete $path(output)
    set f [open $path(pipe) w]
    puts $f "set f \[[list open $path(output) w]]"
    puts $f {
	fconfigure $f -translation lf -buffering none
	while {![eof stdin]} {
	    after 20
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f

test io-28.3 {CloseChannel, not called before output queue is empty} \
	{stdio asyncPipeClose nonPortable} {
    file delete $path(pipe)
    file delete $path(output)
    set f [open $path(pipe) w]
    puts $f {








	set f [open $path(output) w]
	fconfigure $f -translation lf -buffering none
	for {set x 0} {$x < 20} {incr x} {
	    after 20
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open $path(output) w]
    close $f
    set f [open "|[list [interpreter] pipe]" r+]
    fconfigure $f -blocking off

    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size $path(output)] < 20480) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]

test io-29.1 {Tcl_WriteChars, channel not writable} {
    list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
    file delete $path(test1)
    set f [open $path(test1) w]

    puts -nonewline $f ""
    close $f
    file size $path(test1)
} 0
test io-29.3 {Tcl_WriteChars, nonempty string} {
    file delete $path(test1)
    set f [open $path(test1) w]

    puts -nonewline $f hello
    close $f
    file size $path(test1)
} 5
test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -buffering full
    puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    close $f
    set l
} {6 0 0 6}
test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -buffering line
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    close $f
    set l
} {5 0 0 11}
test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -buffering none
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    close $f
    set l
} {0 5 0 11}
test io-29.7 {Tcl_Flush, full buffering} {testchannel} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -buffering full
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]

} {5 0 0 5 0 11 0 11}
test io-29.9 {Tcl_Flush, channel not writable} {
    list [catch {flush stdin} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.10 {Tcl_WriteChars, looping and buffering} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    set f2 [open $path(longfile) r]
    for {set x 0} {$x < 10} {incr x} {
	puts $f1 [gets $f2]
    }
    close $f2
    close $f1
    file size $path(test1)
} 387
test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
    file delete $path(test1)
    set f1 [open $path(test1) w]

    set f2 [open $path(longfile) r]
    for {set x 0} {$x < 10} {incr x} {
	puts -nonewline $f1 [gets $f2]
    }
    close $f1
    close $f2
    file size $path(test1)

    lappend x [file size $path(test1)]
    close $f1
    set x
} {18 24 30}
test io-29.19 {Explicit and implicit flushes} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    set x ""
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    lappend x [file size $path(test1)]
    puts $f1 hello
    flush $f1
    lappend x [file size $path(test1)]
    puts $f1 hello
    close $f1
    lappend x [file size $path(test1)]
    set x
} {18 24 30}
test io-29.20 {Implicit flush when buffer is full} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    for {set x 0} {$x < 100} {incr x} {
      puts $f1 $line
    }
    set z ""
    lappend z [file size $path(test1)]
    for {set x 0} {$x < 100} {incr x} {

    }
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
test io-29.28 {Tcl_WriteChars, lf mode} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    flush $f
    set s [file size $path(test1)]
    close $f
    set s
} 21
test io-29.29 {Tcl_WriteChars, cr mode} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    file size $path(test1)
} 21
test io-29.30 {Tcl_WriteChars, crlf mode} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    file size $path(test1)
} 25
test io-29.31 {Tcl_WriteChars, background flush} stdio {
    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.

    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1 {} 1}
test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation lf
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1Aghi 0 qrs 0 {} 1"
test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation cr
    set l ""
    set x [gets $f]
    lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {0 1 {} 1}
test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set l ""
    set x [gets $f]
    lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f

    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation lf
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation cr
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]

    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1A
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar \x1A
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1A
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1A
    set l ""
    lappend l [gets $f]

    set f [open $path(test3) r]
    set result [list [catch {gets $f x(0)} msg] $msg]
    close $f
    set result
} {1 {can't set "x(0)": variable isn't array}}
test io-33.8 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    fconfigure $f -translation lf
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 100} {incr y} {puts $f $x}
    close $f
    set f [open $path(test3) r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 100} {incr y} {gets $f}
    close $f
    set y
} 100
test io-33.9 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    fconfigure $f -translation lf
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 200} {incr y} {puts $f $x}
    close $f
    set f [open $path(test3) r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 200} {incr y} {gets $f}
    close $f
    set y
} 200
test io-33.10 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    fconfigure $f -translation lf
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 300} {incr y} {puts $f $x}
    close $f
    set f [open $path(test3) r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 300} {incr y} {gets $f}

    set c [tell $f1]
    close $f1
    set c
} 0
test io-34.2 {Tcl_Seek to offset from start} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 10 start
    set c [tell $f1]
    close $f1
    set c
} 10
test io-34.3 {Tcl_Seek to end of file} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 0 end
    set c [tell $f1]
    close $f1
    set c
} 54
test io-34.4 {Tcl_Seek to offset from end of file} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 -10 end
    set c [tell $f1]
    close $f1
    set c
} 44
test io-34.5 {Tcl_Seek to offset from current position} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 10 current
    seek $f1 10 current
    set c [tell $f1]
    close $f1
    set c
} 20
test io-34.6 {Tcl_Seek to offset from end of file} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 -10 end
    set c [tell $f1]
    set r [read $f1]
    close $f1
    list $c $r
} {44 {rstuvwxyz
}}
test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 -10 end
    set c1 [tell $f1]
    set r1 [read $f1 5]

    close $f1
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error during seek on "": invalid argument}}
test io-34.9 {Tcl_Seek, testing buffered input flushing} {
    file delete $path(test3)
    set f [open $path(test3) w]

    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
    set f [open $path(test3) RDWR]
    set x [read $f 1]
    seek $f 3
    lappend x [read $f 1]
    seek $f 0 start

    seek $f 2
    set x [gets $f]
    close $f
    list $x [viewFile test3]
} "zzy xyzzy"
test io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
    set f [open $path(test3) w]
    fconfigure $f -translation lf
    puts $f xyz\n123
    close $f
    set f [open $path(test3) a+]
    fconfigure $f -translation lf
    puts $f xyzzy
    flush $f
    set x [tell $f]
    seek $f -4 cur
    set y [gets $f]
    close $f
    list $x [viewFile test3] $y
} {14 {xyz
123
xyzzy} zzy}
test io-34.13 {Tcl_Tell at start of file} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    set p [tell $f1]
    close $f1
    set p
} 0
test io-34.14 {Tcl_Tell after seek to end of file} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 0 end
    set c1 [tell $f1]
    close $f1
    set c1
} 54
test io-34.15 {Tcl_Tell combined with seeking} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    puts $f1 "abcdefghijklmnopqrstuvwxyz"
    close $f1
    set f1 [open $path(test1) r]
    seek $f1 10 start
    set c1 [tell $f1]
    seek $f1 10 current

    gets $f1
    close $f1
    set c
} -1
test io-34.18 {Tcl_Tell combined with seeking and reading} {
    file delete $path(test2)
    set f [open $path(test2) w]
    fconfigure $f -translation lf
    puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
    close $f
    set f [open $path(test2)]
    fconfigure $f -translation lf
    set x [tell $f]
    read $f 3
    lappend x [tell $f]
    seek $f 2
    lappend x [tell $f]
    seek $f 10 current
    lappend x [tell $f]
    seek $f 0 end
    lappend x [tell $f]
    close $f
    set x
} {0 3 2 12 30}
test io-34.19 {Tcl_Tell combined with opening in append mode} {
    set f [open $path(test3) w]
    fconfigure $f -translation lf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    set f [open $path(test3) a]
    set c [tell $f]
    close $f
    set c

    lappend l [tell $f]
    close $f
    set l
} {29 39 40 447}
test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport extensive} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -translation binary
    set l ""
    lappend l [tell $f]
    puts -nonewline $f abcdef
    lappend l [tell $f]
    flush $f
    lappend l [tell $f]
    # 4GB offset!

    set e [eof $f]
    close $f
    list $s $l $e
} {10 8 1}
test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1A
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation lf -eofchar \x1A
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1A
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar \x1A
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1A
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {21 8 1}
test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1A
    set l [string length [read $f]]

    set e [eof $f]
    close $f
    list $s $l $e [scan [string index $in end] %c]
} -result {1 1 1 13}
test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1A
    set l [string length [set in [read $f]]]
    set e [eof $f]
    close $f
    list $c $l $e [scan [string index $in end] %c]
} -result {17 8 1 13}
test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set i [format \n%cqrsuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1A
    set l [string length [set in [read $f]]]

    lappend x [gets $f1]
    lappend x [fblocked $f1]
    close $f1
    set x
} {{} 1 hello 0 {} 1}
test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio {
    set f1 [open "|[list [interpreter]]" r+]
    chan configure $f1 -translation binary
    puts $f1 {
	chan configure stdout -translation binary
	puts hello_from_pipe
    }
    flush $f1
    gets $f1
    fconfigure $f1 -blocking off -buffering full
    puts $f1 {puts hello}
    set x ""

    close $f1
    set x
} {0 21}
test io-39.8 {Tcl_SetChannelOption, different buffering options} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    set l ""
    fconfigure $f1 -translation lf -buffering none
    puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    fconfigure $f1 -buffering full
    puts -nonewline $f1 hello
    lappend l [file size $path(test1)]

    set x [fconfigure $f -buffersize]
    close $f
    set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f \xE7\x89\xA6
    close $f
    set f [open $path(test1) r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x
} 牦
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f \xE7\x89\xA6
    close $f
    set f [open $path(test1) r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x

    set f [open $path(test1) w]
    fconfigure $f -e foobar
} -cleanup {
    close $f
} -returnCodes 1 -match glob -result {bad option "-e": should be one of *}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" r+]
    fconfigure $f -encoding iso8859-1
    puts -nonewline $f "\xE7"
    flush $f
    fconfigure $f -encoding utf-8 -blocking 0
    variable x {}
    fileevent $f readable [namespace code { lappend x [read $f] }]
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    fconfigure $f -encoding utf-8
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    fconfigure $f -translation binary
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    close $f
    set x
} "{} timeout {} timeout \xE7 timeout"
test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \

    close $f
    file stat $path(test3) stats
    format 0o%03o [expr {$stats(mode)&0o777}]
} [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
    set f [open $path(test3) w]

    puts $f xyzzy
    close $f
    set f [open $path(test3) {WRONLY CREAT}]

    puts -nonewline $f "ab"
    close $f
    set f [open $path(test3) r]
    set x [gets $f]
    close $f
    set x
} abzzy
test io-40.5 {POSIX open access modes: APPEND} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -translation lf
    puts $f xyzzy
    close $f
    set f [open $path(test3) {WRONLY APPEND}]
    fconfigure $f -translation lf
    puts $f "new line"
    seek $f 0
    puts $f "abc"

    puts $f xyzzy
    close $f
    open $path(test3) {WRONLY CREAT EXCL}
} -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists}
test io-40.7 {POSIX open access modes: EXCL} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT EXCL}]

    puts $f "A test line"
    close $f
    viewFile test3
} {A test line}
test io-40.8 {POSIX open access modes: TRUNC} {
    file delete $path(test3)
    set f [open $path(test3) w]

test io-40.12 {POSIX open access modes: WRONLY} -match regexp -body {
    file delete $path(test3)
    open $path(test3) WRONLY
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test io-40.13 {POSIX open access modes: WRONLY} {
    makeFile xyzzy test3
    set f [open $path(test3) WRONLY]

    puts -nonewline $f "ab"
    seek $f 0 current
    set x [list [catch {gets $f} msg] $msg]
    close $f
    lappend x [viewFile test3]
    string compare [string tolower $x] \
	[list 1 "channel \"$f\" wasn't opened for reading" abzzy]

	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test io-52.10 {TclCopyChannel & encodings} -constraints fcopy -body {
    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]

    fconfigure $in  -encoding koi8-r -translation lf

    fconfigure $out -translation binary

    fcopy $in $out

    file size $path(utf8-fcopy.txt)
} -cleanup {
    close $in
    close $out
} -returnCodes 1 -match glob -result {error writing "*":\
    invalid or incomplete multibyte or wide character}
test io-52.11 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf -profile strict
    puts $out АА
    close $out
} -constraints {fcopy} -body {
    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    fconfigure $in  -translation binary
    fconfigure $out -encoding koi8-r -translation lf -profile strict
    catch {fcopy $in $out} cres copts
	return $cres
} -cleanup {
	if {$in in [chan names]} {
		close $in

    testobj freeallvars
    removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}

test io-75.1 {multibyte encoding error read results in raw bytes (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.1]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed
    # by a byte > 0x7F. This is violated to get an invalid sequence.
    puts -nonewline $f A\xC0\x40
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -profile tcl8 -buffering none
} -body {

# Incomplete sequence test.
# This error may IMHO only be detected with the close.
# But the read already returns the incomplete sequence.
test io-75.3 {incomplete multibyte encoding read is ignored (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.3]
    set f [open $fn w+]
    fconfigure $f -translation binary
    puts -nonewline $f "A\xC0"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -profile tcl8
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.3
} -result 41c0

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.4]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f A\x81\xFFA
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.4
} -result 4181ff41

test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.5]
    set f [open $fn w+]
    fconfigure $f -translation binary
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.5
} -result 4181

test io-75.6 {incomplete utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is an incomplete byte sequence in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none \
	    -translation lf -profile strict
} -body {
    gets $f
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.6.1 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6.1]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered
    puts -nonewline $f A\xC3B
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none \
	    -translation lf -profile strict
} -body {
    gets $f
} -cleanup {
    close $f
    removeFile io-75.6.1
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.6.2 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict), recover functionality} -setup {
    set fn [makeFile {} io-75.6.2]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered
    puts -nonewline $f A\xC3B
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none \
	    -translation lf -profile strict
} -body {
    set l {}
    lappend l [catch {gets $f}]
    lappend l [tell $f]
    fconfigure $f -translation binary
    lappend l [expr {[gets $f] eq "A\xC3B"}]
} -cleanup {
    close $f
    removeFile io-75.6.2
} -match glob -returnCodes 0 -result {1 0 1}

# TCL ticket c4eb46a196: non blocking case had endless loop, so test it
test io-75.6.3 {invalid utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6.3]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered
    puts -nonewline $f A\xC3B
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none \
	    -translation lf -profile strict -blocking 0
} -body {
    gets $f
} -cleanup {
    close $f
    removeFile io-75.6.3
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.6.4 {incomplete utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6.4]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is an incomplete byte sequence in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none \
	    -translation lf -profile strict -blocking 0
} -body {
    gets $f
	# only the 2nd gets returns the error
	gets $f
} -cleanup {
    close $f
    removeFile io-75.6.4
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.7 {
    invalid utf-8 encoding read is not ignored (-profile strict)
} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -translation lf \
	    -profile strict
} -body {
    list [catch {read $f} msg data] $msg [dict get $data -data]
} -cleanup {
    close $f
    removeFile io-75.7
    unset msg data f fn
} -match glob -result {1 {error reading "file*":\
    invalid or incomplete multibyte or wide character} A}

test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes
    # precedence.
    puts -nonewline $f A\x1A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict

    unset f d hd
} -result {41 1 {}}

test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    # This also configures the channel encoding profile as strict.
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\x81\x81\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {

test io-strict-multibyte-eof {
    incomplete utf-8 sequence immediately prior to eof character

    See issue 25cdcb7e8fb381fb
} -setup {
    set chan [file tempfile];
    fconfigure $chan -translation binary
    puts -nonewline $chan \x81\x1A
    flush $chan
    seek $chan 0
    chan configure $chan -encoding utf-8 -profile strict
} -body {
    list [catch {read $chan 1} msg data] $msg [dict get $data -data]
} -cleanup {

test io-75.10 {
    incomplete multibyte encoding read is not ignored because "binary" sets
    profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.10]
    set f [open $fn w+]
    fconfigure $f -translation binary
    puts -nonewline $f A\xC0
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none
} -body {
    catch {read $f} errmsg
    lappend res $errmsg

# This may be expected due to special utf-8 handling.

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.11 {shiftjis encoding error read results in error (strict profile)} -setup {
    set fn [makeFile {} io-75.11]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f A\x81\xFFA
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -blocking 0 -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data]
} -cleanup {
    close $f
    removeFile io-75.11
    unset d hd msg data f
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character} 0}

test io-75.12 {
    invalid utf-8 encoding read is not ignored because setting the encoding to
    "binary" also set the profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.12]
    set f [open $fn w+]
    fconfigure $f -translation binary
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -translation lf
} -body {
    catch {read $f} errmsg
    lappend res $errmsg
    chan configure $f -profile tcl8
    seek $f 0
    set d [read $f]
    binary scan $d H* hd

test io-75.13 {
    In nonblocking mode when there is an encoding error the data that has been
    successfully read so far is returned first and then the error is returned
    on the next call to [read].
} -setup {
    set fn [makeFile {} io-75.13]
    set f [open $fn w+]
    fconfigure $f -translation binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -blocking 0 -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {read $f} msg data] $msg [dict exists $data -data]
} -cleanup {
    close $f
    removeFile io-75.13
    unset d hd msg data f fn
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character} 0}

test io-75.14 {
	[gets] succesfully returns lines prior to error

	invalid utf-8 encoding [gets] continues in non-strict mode after error
} -setup {
    set chan [file tempfile]
    fconfigure $chan -translation binary
    # \xC0\n is an invalid utf-8 sequence
    puts -nonewline $chan a\nb\nc\xC0\nd\n
    flush $chan
    seek $chan 0
    fconfigure $chan -encoding utf-8 -buffering none \
	-translation auto -profile strict
} -body {
    set res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
    chan configure $chan -profile tcl8
    lappend res [gets $chan]

test io-75.15 {
    invalid utf-8 encoding strict
    gets does not hang
    gets succeeds for the first two lines
} -setup {
    set res {}
    set chan [file tempfile]
    fconfigure $chan -translation binary
    # \xC0\x40 is an invalid utf-8 sequence
    puts $chan hello\nAB\nCD\xC0\x40EF\nGHI
	seek $chan 0
} -body {
    #Now try to read it with [gets]
    fconfigure $chan -encoding utf-8 -profile strict
    lappend res [gets $chan]

   list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}

set path(test1) [makeFile {} test1]

test iocmd-1.6 {puts command} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f foobar
    close $f
    file size $path(test1)
} 6
test iocmd-1.7 {puts command} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f foobar
    close $f
    file size $path(test1)
} 7
test iocmd-1.8 {puts command} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [binary format a4a5 foo bar]
    close $f
    file size $path(test1)
} 9

test iocmd-2.1 {flush command} {
   list [catch {flush} msg] $msg

test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding utf-16
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile strict -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-encoding utf-16 -profile tcl8
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040

    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}

} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
#
# Test 13.4 relies on assigning the same channel name twice.
#
test iocmd-12.4 {POSIX open access modes: WRONLY} {unix} {
    file delete $path(test3)
    set f [open $path(test3) w]

    puts $f xyzzy
    close $f
    set f [open $path(test3) WRONLY]

    puts -nonewline $f "ab"
    seek $f 0 current
    set x [list [catch {gets $f} msg] $msg]
    close $f
    set f [open $path(test3) r]

    lappend x [gets $f]
    close $f
    set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy]
    string compare $x $y
} 0
test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body {
    file delete $path(test3)

    set res {}
    proc foo args {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo args {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo args {
	oninit cget cgetall; onfinal; track
	return {-bar foo -snarf x}
    }
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *} -bar foo -snarf x}}
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]

	note [fconfigure $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
    -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * * -translation {auto *}}}
test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * * -translation {auto *}}}
test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar foo -snarf x"
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * * -translation {auto *} -bar foo -snarf x}}
test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]

	    [file delete -force -- foo.test]
} {0 {} 0 1 {}}
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    catch {
	set f [open foo.test/..namedfork/rsrc w]
	fconfigure $f -translation lf
	puts -nonewline $f "foo"
	close $f
    }
    list [catch {file attributes foo.test -rsrclength} msg] $msg \
	    [catch {file attributes foo.test -rsrclength 0} msg] $msg \
	    [catch {file attributes foo.test -rsrclength} msg] $msg \
	    [file delete -force -- foo.test]
} {0 3 0 {} 0 0 {}}

test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
    catch {file delete -force -- foo.test}
    catch {file delete -force -- bar.test}
    close [open foo.test w]
    catch {
	file attributes foo.test -creator FOOC -type FOOT -hidden 1
	set f [open foo.test/..namedfork/rsrc w]
	fconfigure $f -translation lf
	puts -nonewline $f "foo"
	close $f
	file copy foo.test bar.test
    }
    list [catch {file attributes bar.test -creator} msg] $msg \
	    [catch {file attributes bar.test -type} msg] $msg \
	    [catch {file attributes bar.test -hidden} msg] $msg \

# ucm2tests.tcl
#
# Parses given ucm files (from ICU) to generate test data
# for encodings.
#
#  tclsh ucm2tests.tcl PATH_TO_ICU_UCM_DIRECTORY ?OUTPUTPATH?
#

namespace eval ucm {
    # No means to change these currently but ...
    variable outputPath
    variable outputChan
    variable errorChan stderr
    variable verbose 0

    # Map Tcl encoding name to ICU UCM file name
    variable encNameMap
    array set encNameMap {
	cp1250    glibc-CP1250-2.1.2
	cp1251    glibc-CP1251-2.1.2
	cp1252    glibc-CP1252-2.1.2
	cp1253    glibc-CP1253-2.1.2
	cp1254    glibc-CP1254-2.1.2
	cp1255    glibc-CP1255-2.1.2
	cp1256    glibc-CP1256-2.1.2
	cp1257    glibc-CP1257-2.1.2
	cp1258    glibc-CP1258-2.1.2
	gb1988    glibc-GB_1988_80-2.3.3
	iso8859-1 glibc-ISO_8859_1-2.1.2
	iso8859-2 glibc-ISO_8859_2-2.1.2
	iso8859-3 glibc-ISO_8859_3-2.1.2
	iso8859-4 glibc-ISO_8859_4-2.1.2
	iso8859-5 glibc-ISO_8859_5-2.1.2
	iso8859-6 glibc-ISO_8859_6-2.1.2
	iso8859-7 glibc-ISO_8859_7-2.3.3
	iso8859-8 glibc-ISO_8859_8-2.3.3
	iso8859-9 glibc-ISO_8859_9-2.1.2
	iso8859-10 glibc-ISO_8859_10-2.1.2
	iso8859-11 glibc-ISO_8859_11-2.1.2
	iso8859-13 glibc-ISO_8859_13-2.3.3
	iso8859-14 glibc-ISO_8859_14-2.1.2
	iso8859-15 glibc-ISO_8859_15-2.1.2
	iso8859-16 glibc-ISO_8859_16-2.3.3
    }

    # Array keyed by Tcl encoding name. Each element contains mapping of
    # Unicode code point -> byte sequence for that encoding as a flat list
    # (or dictionary). Both are stored as hex strings
    variable charMap

    # Array keyed by Tcl encoding name. List of invalid code sequences
    # each being a hex string.
    variable invalidCodeSequences

    # Array keyed by Tcl encoding name. List of unicode code points that are
    # not mapped, each being a hex string.
    variable unmappedCodePoints

    # The fallback character per encoding
    variable encSubchar
}

proc ucm::abort {msg} {
    variable errorChan
    puts $errorChan $msg
    exit 1
}
proc ucm::warn {msg} {
    variable errorChan
    puts $errorChan $msg
}
proc ucm::log {msg} {
    variable verbose
    if {$verbose} {
	variable errorChan
	puts $errorChan $msg
    }
}
proc ucm::print {s} {
    variable outputChan
    puts $outputChan $s
}

proc ucm::parse_SBCS {encName fd} {
    variable charMap
    variable invalidCodeSequences
    variable unmappedCodePoints

    set result {}
    while {[gets $fd line] >= 0} {
	if {[string match #* $line]} {
	    continue
	}
	if {[string equal "END CHARMAP" [string trim $line]]} {
	    break
	}
	if {![regexp {^\s*<U([[:xdigit:]]{4})>\s*((\\x[[:xdigit:]]{2})+)\s*(\|(0|1|2|3|4))} $line -> unichar bytes - - precision]} {
	    error "Unexpected line parsing SBCS: $line"
	}
	set bytes [string map {\\x {}} $bytes]; # \xNN -> NN
	if {$precision eq "" || $precision eq "0"} {
	    lappend result $unichar $bytes
	} else {
	    # It is a fallback mapping - ignore
	}
    }
    set charMap($encName) $result

    # Find out invalid code sequences and unicode code points that are not mapped
    set valid {}
    set mapped {}
    foreach {unich bytes} $result {
	lappend mapped $unich
	lappend valid $bytes
    }
    set invalidCodeSequences($encName) {}
    for {set i 0} {$i <= 255} {incr i} {
	set hex [format %.2X $i]
	if {[lsearch -exact $valid $hex] < 0} {
	    lappend invalidCodeSequences($encName) $hex
	}
    }

    set unmappedCodePoints($encName) {}
    for {set i 0} {$i <= 65535} {incr i} {
	set hex [format %.4X $i]
	if {[lsearch -exact $mapped $hex] < 0} {
	    lappend unmappedCodePoints($encName) $hex
	    # Only look for (at most) one below 256 and one above 1024
	    if {$i < 255} {
		# Found one so jump past 8 bits
		set i 255
	    } else {
		break
	    }
	}
	if {$i == 255} {
	    set i 1023
	}
    }
    lappend unmappedCodePoints($encName) D800 DC00 10000 10FFFF
}

proc ucm::generate_boilerplate {} {
    # Common procedures
    print {
# This file is automatically generated by ucm2tests.tcl.
# Edits will be overwritten on next generation.
#
# Generates tests comparing Tcl encodings to ICU.
# The generated file is NOT standalone. It should be sourced into a test script.

proc ucmConvertfromMismatches {enc map} {
    set mismatches {}
    foreach {unihex hex} $map {
	set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits
	set unich [subst "\\U$unihex"]
	if {[encoding convertfrom -profile strict $enc [binary decode hex $hex]] ne $unich} {
	    lappend mismatches "<[printable $unich],$hex>"
	}
    }
    return $mismatches
}
proc ucmConverttoMismatches {enc map} {
    set mismatches {}
    foreach {unihex hex} $map {
	set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits
	set unich [subst "\\U$unihex"]
	if {[encoding convertto -profile strict $enc $unich] ne [binary decode hex $hex]} {
	    lappend mismatches "<[printable $unich],$hex>"
	}
    }
    return $mismatches
}
if {[info commands printable] eq ""} {
    proc printable {s} {
	set print ""
	foreach c [split $s ""] {
	    set i [scan $c %c]
	    if {[string is print $c] && ($i <= 127)} {
		append print $c
	    } elseif {$i <= 0xff} {
		append print \\x[format %02X $i]
	    } elseif {$i <= 0xffff} {
		append print \\u[format %04X $i]
	    } else {
		append print \\U[format %08X $i]
	    }
	}
	return $print
    }
}
    }
} ; # generate_boilerplate

proc ucm::generate_tests {} {
    variable encNameMap
    variable charMap
    variable invalidCodeSequences
    variable unmappedCodePoints
    variable outputPath
    variable outputChan
    variable encSubchar

    if {[info exists outputPath]} {
	set outputChan [open $outputPath w]
	fconfigure $outputChan -translation lf
    } else {
	set outputChan stdout
    }

    array set tclNames {}
    foreach encName [encoding names] {
	set tclNames($encName) ""
    }

    generate_boilerplate
    foreach encName [lsort -dictionary [array names encNameMap]] {
	if {![info exists charMap($encName)]} {
	    warn "No character map read for $encName"
	    continue
	}
	unset tclNames($encName)

	# Print the valid tests
	print "\n#\n# $encName (generated from $encNameMap($encName))"
	print "\ntest encoding-convertfrom-ucmCompare-$encName {Compare against ICU UCM} -body \{"
	print "    ucmConvertfromMismatches $encName {$charMap($encName)}"
	print "\} -result {}"
	print "\ntest encoding-convertto-ucmCompare-$encName {Compare against ICU UCM} -body \{"
	print "    ucmConverttoMismatches $encName {$charMap($encName)}"
	print "\} -result {}"
	if {0} {
	    # This will generate individual tests for every char
	    # and test in lead, tail, middle, solo configurations
	    # but takes considerable time
	    print "lappend encValidStrings \{*\}\{"
	    foreach {unich hex} $charMap($encName) {
		print "    $encName \\u$unich $hex {} {}"
	    }
	    print "\}; # $encName"
	}

	# Generate the invalidity checks
	print "\n# $encName - invalid byte sequences"
	print "lappend encInvalidBytes \{*\}\{"
	foreach hex $invalidCodeSequences($encName) {
	    # Map XXXX... to \xXX\xXX...
	    set uhex [regsub -all .. $hex {\\x\0}]
	    set uhex \\U[string range 00000000$hex end-7 end]
	    print "    $encName $hex tcl8    $uhex -1 {} {}"
	    print "    $encName $hex replace \\uFFFD -1 {} {}"
	    print "    $encName $hex strict  {}       0 {} {}"
	}
	print "\}; # $encName"

	print "\n# $encName - invalid byte sequences"
	print "lappend encUnencodableStrings \{*\}\{"
	if {[info exists encSubchar($encName)]} {
	    set subchar $encSubchar($encName)
	} else {
	    set subchar "3F"; # Tcl uses ? by default
	}
	foreach hex $unmappedCodePoints($encName) {
	    set uhex \\U[string range 00000000$hex end-7 end]
	    print "    $encName $uhex tcl8    $subchar -1 {} {}"
	    print "    $encName $uhex replace $subchar -1 {} {}"
	    print "    $encName $uhex strict  {}                      0 {} {}"
	}
	print "\}; # $encName"
    }

    if {[array size tclNames]} {
	warn "Missing encoding: [lsort [array names tclNames]]"
    }
    if {[info exists outputPath]} {
	close $outputChan
	unset outputChan
    }
}

proc ucm::parse_file {encName ucmPath} {
    variable charMap
    variable encSubchar

    set fd [open $ucmPath]
    try {
	# Parse the metadata
	unset -nocomplain state
	while {[gets $fd line] >= 0} {
	    if {[regexp {<(code_set_name|mb_cur_max|mb_cur_min|uconv_class|subchar)>\s+(\S+)} $line -> key val]} {
		set state($key) $val
	    } elseif {[regexp {^\s*CHARMAP\s*$} $line]} {
		set state(charmap) ""
		break
	    } else {
		# Skip all else
	    }
	}
	if {![info exists state(charmap)]} {
	    abort "Error: $ucmPath has No CHARMAP line."
	}
	foreach key {code_set_name uconv_class} {
	    if {[info exists state($key)]} {
		set state($key) [string trim $state($key) {"}]
	    }
	}
	if {[info exists charMap($encName)]} {
	    abort "Duplicate file for $encName ($path)"
	}
	if {![info exists state(uconv_class)]} {
	    abort "Error: $ucmPath has no uconv_class definition."
	}
	if {[info exists state(subchar)]} {
	    # \xNN\xNN.. -> NNNN..
	    set encSubchar($encName) [string map {\\x {}} $state(subchar)]
	}
	switch -exact -- $state(uconv_class) {
	    SBCS {
		if {[catch {
		    parse_SBCS $encName $fd
		} result]} {
		    abort "Could not process $ucmPath. $result"
		}
	    }
	    default {
		log "Skipping $ucmPath -- not SBCS encoding."
		return
	    }
	}
    } finally {
	close $fd
    }
}

proc ucm::run {} {
    variable encNameMap
    variable outputPath
    switch [llength $::argv] {
	2 {set outputPath [lindex $::argv 1]}
	1 {}
	default {
	    abort "Usage: [info nameofexecutable] $::argv0 path/to/icu/ucm/data ?outputfile?"
	}
    }
    foreach {encName fname} [array get encNameMap] {
	ucm::parse_file $encName [file join [lindex $::argv 0] ${fname}.ucm]
    }
    generate_tests
}

ucm::run

GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
	tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
	tclCkalloc.o tclClock.o tclClockFmt.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
	tclEncoding.o tclEnsemble.o \
	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o \
	tclIcu.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \
	tclLink.o tclListObj.o \
	tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o tclStrIdxTree.o \

	$(GENERIC_DIR)/tclEvent.c \
	$(GENERIC_DIR)/tclExecute.c \
	$(GENERIC_DIR)/tclFCmd.c \
	$(GENERIC_DIR)/tclFileName.c \
	$(GENERIC_DIR)/tclGet.c \
	$(GENERIC_DIR)/tclHash.c \
	$(GENERIC_DIR)/tclHistory.c \
	$(GENERIC_DIR)/tclIcu.c \
	$(GENERIC_DIR)/tclIndexObj.c \
	$(GENERIC_DIR)/tclInterp.c \
	$(GENERIC_DIR)/tclIO.c \
	$(GENERIC_DIR)/tclIOCmd.c \
	$(GENERIC_DIR)/tclIOGT.c \
	$(GENERIC_DIR)/tclIOSock.c \
	$(GENERIC_DIR)/tclIOUtil.c \

	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"
	@for i in $(TOP_DIR)/library/encoding/*.enc; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \
	done
	@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \
	    echo "Customizing tcl module path"; \
	    echo "if {![interp issafe]} { ::tcl::tm::roots [list $(TCL_MODULE_PATH)] }" >> \
	        "$(SCRIPT_INSTALL_DIR)/tm.tcl"; \
	fi

install-tzdata:
	@for i in tzdata; do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \

tclHash.o: $(GENERIC_DIR)/tclHash.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHash.c

tclHistory.o: $(GENERIC_DIR)/tclHistory.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHistory.c

tclIcu.o: $(GENERIC_DIR)/tclIcu.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIcu.c

tclIndexObj.o: $(GENERIC_DIR)/tclIndexObj.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIndexObj.c

tclInterp.o: $(GENERIC_DIR)/tclInterp.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclInterp.c

tclIO.o: $(GENERIC_DIR)/tclIO.c $(IOHDR)

	tclEvent.$(OBJEXT) \
	tclExecute.$(OBJEXT) \
	tclFCmd.$(OBJEXT) \
	tclFileName.$(OBJEXT) \
	tclGet.$(OBJEXT) \
	tclHash.$(OBJEXT) \
	tclHistory.$(OBJEXT) \
	tclIcu.$(OBJEXT) \
	tclIndexObj.$(OBJEXT) \
	tclInterp.$(OBJEXT) \
	tclIO.$(OBJEXT) \
	tclIOCmd.$(OBJEXT) \
	tclIOGT.$(OBJEXT) \
	tclIORChan.$(OBJEXT) \
	tclIORTrans.$(OBJEXT) \

	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}
	$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest

# use prebuilt zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
	@if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \
		$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.aset" ; then \

	$(TMP_DIR)\tclEvent.obj \
	$(TMP_DIR)\tclExecute.obj \
	$(TMP_DIR)\tclFCmd.obj \
	$(TMP_DIR)\tclFileName.obj \
	$(TMP_DIR)\tclGet.obj \
	$(TMP_DIR)\tclHash.obj \
	$(TMP_DIR)\tclHistory.obj \
	$(TMP_DIR)\tclIcu.obj \
	$(TMP_DIR)\tclIndexObj.obj \
	$(TMP_DIR)\tclInterp.obj \
	$(TMP_DIR)\tclIO.obj \
	$(TMP_DIR)\tclIOCmd.obj \
	$(TMP_DIR)\tclIOGT.obj \
	$(TMP_DIR)\tclIOSock.obj \
	$(TMP_DIR)\tclIOUtil.obj \