Tcl Source Code

	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	if (opnd < 2) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("operand should be >=2", -1));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
	    }
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

CheckNonNegative(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value < 0) {
	result = Tcl_NewStringObj("operand should be nonnegative", -1);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


CheckStrictlyPositive(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value <= 0) {
	result = Tcl_NewStringObj("operand should be positive", -1);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:
 */

static int		CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
			    int argc, Tcl_Obj *const argv[]);
static int		MemoryCmd(ClientData clientData, Tcl_Interp *interp,
			    int argc, Tcl_Obj *const argv[]);
static void		ValidateMemory(struct mem_header *memHeaderP,
			    const char *file, int line, int nukeGuards);

/*
 *----------------------------------------------------------------------
 *
 * TclInitDbCkalloc --

 */
	/* ARGSUSED */
static int
MemoryCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int argc,
    Tcl_Obj *const argv[])
{
    const char *fileName;
    FILE *fileP;
    Tcl_DString buffer;
    int result, idx;
    size_t len;
    static const char *subcommands[] = {
        "active", "display", "break_on_malloc", "info", "init", "objs",
        "onexit", "tag", "trace", "trace_on_at_malloc", "validate",
        NULL
    };
    enum MemSubcommands {
        OPT_ACTIVE, OPT_DISPLAY, OPT_BREAK, OPT_INFO, OPT_INIT, OPT_OBJS,
        OPT_ONEXIT, OPT_TAG, OPT_TRACE, OPT_TRACEON, OPT_VALIDATE
    };

    if (argc < 2) {
        Tcl_WrongNumArgs(interp, 1, argv, "option [args..]");

	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, argv[1], subcommands, "option", 0,
            &idx) != TCL_OK) {



        return TCL_ERROR;
    }

    switch ((enum MemSubcommands) idx) {
    case OPT_ACTIVE:
    case OPT_DISPLAY:
	if (argc != 3) {
            goto missingFile;
	}
	fileName = Tcl_TranslateFileName(interp, Tcl_GetString(argv[2]),
                &buffer);
	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",
                    Tcl_GetString(argv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;

    case OPT_BREAK:
	if (argc != 3) {
	    goto missingCount;
	}
	return Tcl_GetIntFromObj(interp, argv[2], &break_on_malloc);





    case OPT_INFO:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", (unsigned long)current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
	return TCL_OK;

    case OPT_INIT:
	if (argc != 3) {
	    goto missingBoolean;
	}
        return Tcl_GetBooleanFromObj(interp, argv[2], &init_malloced_bodies);



    case OPT_OBJS:
	if (argc != 3) {



            goto missingFile;
	}
	fileName = Tcl_TranslateFileName(interp, Tcl_GetString(argv[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;

    case OPT_ONEXIT:
	if (argc != 3) {
            goto missingFile;


	}
	fileName = Tcl_TranslateFileName(interp, Tcl_GetString(argv[2]),
                &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	onExitMemDumpFileName = dumpFile;
	strcpy(onExitMemDumpFileName,fileName);
	Tcl_DStringFree(&buffer);
	return TCL_OK;

    case OPT_TAG:
	if (argc != 3) {
            Tcl_WrongNumArgs(interp, 2, argv, "string");

	    return TCL_ERROR;
	}
	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
	    TclpFree((char *) curTagPtr);
	}
	len = strlen(Tcl_GetString(argv[2]));
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
	curTagPtr->refCount = 0;
	memcpy(curTagPtr->string, Tcl_GetString(argv[2]), len + 1);
	return TCL_OK;

    case OPT_TRACE:
	if (argc != 3) {
	    goto missingBoolean;
	}

        return Tcl_GetBooleanFromObj(interp, argv[2], &alloc_tracing);

    case OPT_TRACEON:

	if (argc != 3) {
	    goto missingCount;
	}
	return Tcl_GetIntFromObj(interp, argv[2], &trace_on_at_malloc);




    case OPT_VALIDATE:
	if (argc != 3) {
	    goto missingBoolean;
	}

        return Tcl_GetBooleanFromObj(interp, argv[2], &validate_memory);
    }

  missingCount:
    Tcl_WrongNumArgs(interp, 2, argv, "count");



    return TCL_ERROR;

  missingFile:
    Tcl_WrongNumArgs(interp, 2, argv, "file");

    return TCL_ERROR;


  missingBoolean:
    Tcl_WrongNumArgs(interp, 2, argv, "on|off");

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

 */

static int
CheckmemCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter for evaluation. */
    int argc,			/* Number of arguments. */
    Tcl_Obj *const argv[])	/* Values of arguments. */
{
    char *bytes;
    int len;

    if (argc != 2) {
        Tcl_WrongNumArgs(interp, 1, argv, "fileName");
	return TCL_ERROR;
    }
    bytes = Tcl_GetStringFromObj(argv[1], &len);
    if (len > 99) {
        Tcl_SetResult(interp, "string too long for internal buffer",
                TCL_STATIC);
        return TCL_ERROR;
    }
    tclMemDumpFileName = dumpFile;
    strcpy(tclMemDumpFileName, bytes);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitMemory --

void
Tcl_InitMemory(
    Tcl_Interp *interp)		/* Interpreter in which commands should be
				 * added */
{
    TclInitDbCkalloc();
    Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
}


#else	/* TCL_MEM_DEBUG */

/* This is the !TCL_MEM_DEBUG case */

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

char *
Tcl_Alloc(
    unsigned int size)
{
    char *result = (char *) TclpAlloc(size);



    /*
     * Most systems will not alloc(0), instead bumping it to one so that NULL
     * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
     * NULL, so we have to check that the NULL we get is not in response to
     * alloc(0).
     *

char *
Tcl_DbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{


    char *result = (char *) TclpAlloc(size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }
    return result;
}

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

char *
Tcl_AttemptAlloc(
    unsigned int size)
{


    return (char *) TclpAlloc(size);

}

char *
Tcl_AttemptDbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{


    return (char *) TclpAlloc(size);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Realloc(
    char *ptr,
    unsigned int size)
{
    char *result = (char *) TclpRealloc(ptr, size);



    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{


    char *result = (char *) TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
    }
    return result;
}

 */

char *
Tcl_AttemptRealloc(
    char *ptr,
    unsigned int size)
{


    return (char *) TclpRealloc(ptr, size);

}

char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{


    return (char *) TclpRealloc(ptr, size);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Free --
 *

	return TCL_ERROR;
    }
    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad count \"%d\": should be integer >= 0", elementCount));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.

		TclStackFree(interp, sortInfo.indexv);
	    }
	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option should be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Store the extracted indices for processing by sublist

	switch ((enum Lsort_Switches) index) {
	case LSORT_ASCII:
	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-command\" option should be followed "
			"by comparison command", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    sortInfo.sortMode = SORTMODE_COMMAND;
	    cmdPtr = objv[i+1];

	    break;
	case LSORT_INDEX: {
	    int indexc, dummy;
	    Tcl_Obj **indexv;

	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option should be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
		    &indexv) != TCL_OK) {

	    break;
	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option should be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (groupSize < 2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length should be at least 2", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADSTRIDE", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    group = 1;
	    i++;

     * Check for sanity when grouping elements of the overall list together
     * because of the -stride option. [TIP #326]
     */

    if (group) {
	if (length % groupSize) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list size should be a multiple of the stride length",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
		    NULL);
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	length = length / groupSize;
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = sortInfo.indexv[0];
	    if (groupOffset <= SORTIDX_END) {
		groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
	    }
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value should be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	static const char *opt[] = { "-nocase", NULL };
	int idx;

	if (Tcl_GetIndexFromObj(interp, objv[1], opt, "option",
		TCL_MULTIPLE_CHARS, &idx) == TCL_OK) {
	    nocase = 1;
	} else {




	    return TCL_ERROR;
	}
    }

    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20 for illustration why!)

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	static const char *opt[] = { "-nocase", NULL };
	int idx;


	if (Tcl_GetIndexFromObj(interp, objv[1], opt, "option",
		TCL_MULTIPLE_CHARS, &idx) == TCL_OK) {
	    nocase = TCL_MATCH_NOCASE;
	} else {




	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
    return TCL_OK;
}

     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string1, *string2;
    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
    strCmpFn_t strCmpFn;
    static const char *opts[] = { "-length", "-nocase", NULL };
    enum opts { OPT_LENGTH, OPT_NOCASE };

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	int idx;

	if (Tcl_GetIndexFromObj(interp, objv[i], opts, "option", 0,
		&idx) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum opts) idx) {
	case OPT_NOCASE:
	    nocase = 1;
	    break;
	case OPT_LENGTH:

	    if (i >= objc-3) {
		goto str_cmp_args;
	    }

	    if (TclGetIntFromObj(interp, objv[++i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }






	    break;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string1, *string2;
    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
    strCmpFn_t strCmpFn;
    static const char *opts[] = { "-length", "-nocase", NULL };
    enum opts { OPT_LENGTH, OPT_NOCASE };

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	int idx;

	if (Tcl_GetIndexFromObj(interp, objv[i], opts, "option", 0,
		&idx) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum opts) idx) {
	case OPT_NOCASE:
	    nocase = 1;
	    break;
	case OPT_LENGTH:

	    if (i >= objc-3) {
		goto str_cmp_args;
	    }

	    if (TclGetIntFromObj(interp, objv[++i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }






	    break;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

     * The type must be a list of at least length 1.
     */

    if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
	return TCL_ERROR;
    } else if (len < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"type should be non-empty list", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Now prepare the result options dictionary. We use the list API as it is

	    Tcl_DecrRefCount(handlersObj);
	    return TCL_ERROR;
	}
	switch ((enum Handlers) type) {
	case TryFinally:	/* finally script */
	    if (i < objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"finally clause should be last", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"NONTERMINAL", NULL);
		return TCL_ERROR;
	    } else if (i == objc-1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to finally clause: should be"
			" \"... finally script\"", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    finallyObj = objv[++i];
	    break;

	case TryOn:		/* on code variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to on clause: should be \"... on code"
			" variableList script\"", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    if (TclGetCompletionCodeFromObj(interp, objv[i+1],
		    &code) != TCL_OK) {
		Tcl_DecrRefCount(handlersObj);
		return TCL_ERROR;
	    }
	    info[2] = NULL;
	    goto commonHandler;

	case TryTrap:		/* trap pattern variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to trap clause: "
			"should be \"... trap pattern variableList script\"",
			-1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    code = 1;
	    if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad prefix '%s': should be a list",
			Tcl_GetString(objv[i+1])));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"EXNFORMAT", NULL);
		return TCL_ERROR;
	    }
	    info[2] = objv[i+1];

	OP4(			LIST, 2);
	OP44(			RETURN_IMM, TCL_ERROR, 0);
	TclAdjustStackDepth(2, envPtr);
	OP(			POP);
	OP(			POP);
	OP(			POP);
    issueErrorForEmptyCode:
	PUSH(			"type should be non-empty list");
	PUSH(			"-errorcode {TCL OPERATION THROW BADEXCEPTION}");
    }
    OP44(			RETURN_IMM, TCL_ERROR, 0);
    return TCL_OK;
}

/*

			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    if (len < 1) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"ensemble subcommand implementations "
				"should be non-empty lists", -1));
			Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				"EMPTY_TARGET", NULL);
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {

				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (len < 1) {
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "ensemble subcommand implementations "
				    "should be non-empty lists", -1));
			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				    "EMPTY_TARGET", NULL);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;

		" export any commands",
		TclGetString(objv[1+ensemblePtr->numParameters]),
		ensemblePtr->nsPtr->fullName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
		TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
	return TCL_ERROR;
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": should be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(objv[1+ensemblePtr->numParameters]));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	int i;

	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"\"-tails\" should be used with either "
		"\"-directory\" or \"-path\"", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
		"BADOPTIONCOMBINATION", NULL);
	return TCL_ERROR;
    }

    separators = NULL;		/* lint. */

 *	TCL_ERROR.
 *
 * Side effects:

 *	An error message is generated in interp's result object to indicate
 *	that a command was invoked with the a bad option. The message has the
 *	form:
 *		bad/ambiguous option "blah": should be one of
 *		<...generic options...>+<...specific options...>
 *	"blah" is the optionName argument and "<specific options>" is a space
 *	separated list of specific option words. The function takes good care
 *	of inserting minus signs before each option, commas after, and an "or"
 *	before the last option.
 *
 *----------------------------------------------------------------------

				 * standard generic options. Can be NULL for
				 * generic options only. */
{
    if (interp != NULL) {
	const char *genericopt =
		"blocking buffering buffersize encoding eofchar translation";
	const char **argv;
        char *problemType = "bad";
	int argc, i, len = strlen(optionName);
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, optionList, -1);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);
	for (i = 0; i < argc; i++) {
            if (optionName[0]=='-' && strncmp(argv[i], optionName, len)==0) {
                problemType = "ambiguous";
                break;
            }
        }
	errObj = Tcl_ObjPrintf("%s option \"%s\": should be one of ",
                problemType, optionName);
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);

	    SetFlag(statePtr, CHANNEL_LINEBUFFERED);
	} else if ((newValue[0] == 'n') &&
		(strncmp(newValue, "none", len) == 0)) {
	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
	} else if (interp) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "bad value for -buffering: should be one of"
                    " full, line, or none", -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERING", NULL);
            return TCL_ERROR;
	}
	return TCL_OK;
    } else if (HaveOpt(7, "-buffersize")) {
	int newBufferSize;

	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {

	    int outIndex = (argc - 1);
	    int inValue = (int) argv[0][0];
	    int outValue = (int) argv[outIndex][0];

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: should be non-NUL ASCII"
                            " character", -1));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "EOFCHAR", NULL);
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = inValue;
	    }
	    if (GotFlag(statePtr, TCL_WRITABLE)) {
		statePtr->outEofChar = outValue;
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "EOFCHAR", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    ckfree(argv);
	}

	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
	} else if (argc == 2) {
	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: should be a one or two"
			" element list", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "TRANSLATION", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

	    } else if (strcmp(readMode, "cr") == 0) {
		translation = TCL_TRANSLATE_CR;
	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {


		goto badTranslation;




	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data
	     * to see if the new translation mode allows us to complete the
	     * line.
	     */

	    } else if (strcmp(writeMode, "cr") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CR;
	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {


		goto badTranslation;




	    }
	}
	ckfree(argv);
	return TCL_OK;
    badTranslation:
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad value for -translation: should be one of "
		    "auto, binary, cr, lf, crlf, or platform", -1));
            Tcl_SetErrorCode(interp, "TCL", "VALUE", "TRANSLATION", NULL);
	}
	ckfree(argv);
	return TCL_ERROR;
    } else if (chanPtr->typePtr->setOptionProc != NULL) {
	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
		optionName, newValue);
    } else {
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }

	 * Check direction against channel mode. It is an error if we try to
	 * close a direction not supported by the channel (already closed, or
	 * never opened for that direction).
	 */

	if (!(dir & Tcl_GetChannelMode(chan))) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "half-close of %s-side not possible, side not opened"
		    " or already closed", dirOptions[index]));
	    return TCL_ERROR;
	}

	/*
	 * Special handling is needed if and only if the channel mode supports
	 * more than the direction to close. Because if the close the last

    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel inChan, outChan;
    int mode, i, index;
    Tcl_WideInt toRead;
    Tcl_Obj *cmdPtr;
    static const char *const switches[] = { "-command", "-size", NULL };
    enum { FcopyCommand, FcopySize };

    if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"input output ?-size size? ?-command callback?");
	return TCL_ERROR;
    }

	    mode |= O_TRUNC;
	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
	    *binaryPtr = 1;
	} else {

	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"invalid access mode \"%s\": should be RDONLY, "
			"WRONLY, RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, "
			"NONBLOCK, or TRUNC", flag));
	    }
	    ckfree(modeArgv);
	    return -1;
	}
    }

    ckfree(modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode should include either RDONLY, WRONLY, or RDWR",
		    -1));
	}
	return -1;
    }
    return mode;
}


 * Results:
 *	If the value of objPtr is identical to or a unique abbreviation for
 *	one of the entries in tablePtr, then the return value is TCL_OK and the
 *	index of the matching entry is stored at *indexPtr. If there isn't a
 *	proper match, then TCL_ERROR is returned and an error message is left
 *	in interp's result (unless interp is NULL). The msg argument is used
 *	in the error message; for example, if msg has the value "option" then
 *	the error message will say something flag 'bad option "foo": should be
 *	...'
 *
 * Side effects:
 *	The result of the lookup is cached as the internal rep of objPtr, so
 *	that repeated lookups can be done quickly.
 *
 *----------------------------------------------------------------------

	}
    }

    /*
     * Check if we were instructed to disallow abbreviations.
     */

    if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)
	    || ((flags & TCL_MULTIPLE_CHARS) && (p1 - key == 1))) {
	goto error;
    }

  done:
    /*
     * Cache the found representation. Note that we want to avoid allocating a
     * new internal-rep if at all possible since that is potentially a slow

	TclNewObj(resultPtr);
	entryPtr = tablePtr;
	while ((*entryPtr != NULL) && !**entryPtr) {
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	}
	Tcl_AppendStringsToObj(resultPtr,
		(numAbbrev>0 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
		msg, " \"", key, NULL);
	if (*entryPtr == NULL) {
	    Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
	} else {
	    Tcl_AppendStringsToObj(resultPtr, "\": should be ",
		    *entryPtr, NULL);
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	    while (*entryPtr != NULL) {
		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
			    " or ", *entryPtr, NULL);
		} else if (**entryPtr) {

 * Results:
 *	None.
 *
 * Side effects:
 *	An error message is generated in interp's result object to indicate
 *	that a command was invoked with the wrong number of arguments. The
 *	message has the form
 *		wrong # args: must be "foo bar additional stuff"
 *	where "foo" and "bar" are the initial objects in objv (objc determines
 *	how many of these are printed) and "additional stuff" is the contents
 *	of the message argument.
 *
 *	The message printed is modified somewhat if the command is wrapped
 *	inside an ensemble. In that case, the error message generated is
 *	rewritten in such a way that it appears to be generated from the

    /*
     * Value is not a legal completion code.
     */

    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad completion code \"%s\": should be"
		" ok, error, return, break, continue, or an integer",
		TclGetString(value)));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
    }
    return TCL_ERROR;
}


#define TCL_NUMBER_LONG		1
#define TCL_NUMBER_WIDE		2
#define TCL_NUMBER_BIG		3
#define TCL_NUMBER_DOUBLE	4
#define TCL_NUMBER_NAN		5

/*
 *----------------------------------------------------------------------
 * Non-public flags for Tcl_GetIndexFromObj
 *----------------------------------------------------------------------
 */

#define TCL_MULTIPLE_CHARS	2

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
 *----------------------------------------------------------------
 */

MODULE_SCOPE char *tclNativeExecutableName;

{
    if (objc) {
	int length;

	if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
		|| (length < 1)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cmdPrefix should be list of length >= 1", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "BGERRORFORMAT", NULL);
	    return TCL_ERROR;
	}
	TclSetBgErrorHandler(slaveInterp, objv[0]);
    }
    Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp));

	    return TCL_ERROR;
	}
	if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (limit <= 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "recursion limit should be > 0", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetRecursionLimit(slaveInterp, limit);
	iPtr = (Interp *) slaveInterp;
	if (interp == slaveInterp && iPtr->numLevels > limit) {

	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity should be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "command limit value should be at least 0", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    }
	}

	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity should be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "milliseconds should be at least 0", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = ((long) tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "seconds should be at least 0", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.sec = tmp;
		break;
	    }

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" has no %s", TclGetString(tmpBuf), piece));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[skip]), NULL);
	return TCL_ERROR;
    }

    errorMsg = Tcl_ObjPrintf("unknown method \"%s\": should be ",
	    TclGetString(objv[skip]));
    for (i=0 ; i<numMethodNames-1 ; i++) {
	if (i) {
	    Tcl_AppendToObj(errorMsg, ", ", -1);
	}
	Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    }

     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassInOuterContext(interp, objv[1],
	    "the class of an object should be a class");
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Apply semantic checks. In particular, classes and non-classes are not
     * interchangable (too complicated to do the conversion!) so we must

    Tcl_Obj *cmdObj;

    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix should be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);

    Tcl_Obj *cmdObj;

    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix should be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);

		}
		break;
	    }
	}
        Tcl_MutexUnlock(&asyncTestMutex);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be create, delete, int, mark, or marklater", NULL);
	return TCL_ERROR;
#else /* !TCL_THREADS */
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be create, delete, int, or mark", NULL);
	return TCL_ERROR;
#endif
    }
    return TCL_OK;
}

static int

	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be create, delete, get, or modify", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

	/*ARGSUSED*/
static int

	Tcl_AppendElement(interp,
		Tcl_GetCommandName(interp, (Tcl_Command) l));
	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
	Tcl_DecrRefCount(objPtr);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be create or name", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, t2);
	Tcl_DeleteTrace(interp, t1);
	Tcl_DStringFree(&buffer);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be tracetest, deletetest, doubletest or resulttest", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
CmdTraceProc(

    } else if (strcmp(argv[1], "create2") == 0) {
	Tcl_CreateCommand(interp, "value:at:",
		CreatedCommandProc2, NULL, NULL);
    } else if (strcmp(argv[1], "delete2") == 0) {
	Tcl_DeleteCommand(interp, "value:at:");
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be create, delete, create2, or delete2", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
CreatedCommandProc(

	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
	} else if (strcmp(argv[2], "special") == 0) {
	    char *s = (char*)ckalloc(100) + 16;
	    strcpy(s, "This is a specially-allocated string");
	    Tcl_SetResult(interp, s, SpecialFree);
	} else {
	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
		    "\": should be staticsmall, staticlarge, free, or special",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringGetResult(interp, &dstring);
    } else if (strcmp(argv[1], "length") == 0) {

	if (argc != 2) {

    } else if (strcmp(argv[1], "start") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringStartSublist(&dstring);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be append, element, end, free, get, length, "
		"result, trunc, or start", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

    const char *script;

    flags = 0;
    if (objc == 3) {
	const char *global = Tcl_GetStringFromObj(objv[2], &length);
	if (strcmp(global, "global") != 0) {
	    Tcl_AppendResult(interp, "bad value \"", global,
		    "\": should be global", NULL);
	    return TCL_ERROR;
	}
	flags = TCL_EVAL_GLOBAL;
    } else if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "script ?global?");
	return TCL_ERROR;
    }

	Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
		(ClientData) INT2PTR(value));
    } else if (strcmp(argv[1], "delete") == 0) {
	Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
		(ClientData) INT2PTR(value));
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be create or delete", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
ExitProcOdd(

	    mask = TCL_READABLE;
	} else if (strcmp(argv[3], "writable") == 0) {
	    mask = TCL_WRITABLE;
	} else if (strcmp(argv[3], "none") == 0) {
	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
		    "\": should be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}

	esPtr = ckalloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	    return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (index < 0) {
	    Tcl_AppendResult(interp, "bad event index: ", argv[3],
		    ": should be nonnegative", NULL);
	    return TCL_ERROR;
	}
	for (i = 0, esPtr = statePtr->scriptRecordPtr;
	     (i < index) && (esPtr != NULL);
	     i++, esPtr = esPtr->nextPtr) {
	    /* Empty loop body. */
	}

	    return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (index < 0) {
	    Tcl_AppendResult(interp, "bad event index: ", argv[3],
		    ": should be nonnegative", NULL);
	    return TCL_ERROR;
	}
	for (i = 0, esPtr = statePtr->scriptRecordPtr;
	     (i < index) && (esPtr != NULL);
	     i++, esPtr = esPtr->nextPtr) {
	    /* Empty loop body. */
	}

	    mask = TCL_READABLE;
	} else if (strcmp(argv[4], "writable") == 0) {
	    mask = TCL_WRITABLE;
	} else if (strcmp(argv[4], "none") == 0) {
	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[4],
		    "\": should be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}
	esPtr->mask = mask;
	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, (ClientData) esPtr);
	return TCL_OK;
    }
    Tcl_AppendResult(interp, "bad command ", cmd, ", should be one of "
	    "add, delete, list, set, or removeall", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": should be set, get, or not", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": should be set, get, mult10, or div10", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": should be set, get, get2, mult10, or div10", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------

	if (Tcl_AppendAllObjTypes(interp,
		Tcl_GetObjResult(interp)) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": should be assign, convert, duplicate, freeallvars, "
		"newobj, objcount, objtype, refcount, type, or types", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

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

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

    }
#endif /* TCL_REMOVE_OBSOLETE_TRACES */
    }
    return TCL_OK;

  badVarOps:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad operations \"%s\": should be one or more character of rwua",
	    flagOps));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": should be one or more of"
		    " enter, leave, enterstep, or leavestep", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": should be one or more of"
		    " delete or rename", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}

	for (i = 0; i < listLen; i++) {

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": should be one or more of"
		    " array, read, unset, or write", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	for (i = 0; i < listLen ; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,

     * Report a parse error.
     */

  parseError:
    if (interp != NULL) {
	bytes = Tcl_GetString(objPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad index \"%s\": should be integer?[+-]integer? or"
		" end?[+-]integer?", bytes));
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	TclCheckBadOctal(interp, bytes);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }

     */

    bytes = TclGetStringFromObj(objPtr, &length);
    if ((*bytes != 'e') || (strncmp(bytes, "end",
	    (size_t)((length > 3) ? 3 : length)) != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad index \"%s\": should be end?[+-]integer?", bytes));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Convert the string rep.

	/*
	 * Conversion failed. Report the error.
	 */

    badIndexFormat:
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad index \"%s\": should be end?[+-]integer?", bytes));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * The conversion succeeded. Free the old internal rep and set the new

					 *	-> channel */
	return ZlibPushSubcmd(interp, objc, objv);
    };

    return TCL_ERROR;

  badLevel:
    Tcl_SetObjResult(interp, Tcl_NewStringObj("level should be 0 to 9", -1));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
    if (extraInfoStr) {
	Tcl_AddErrorInfo(interp, extraInfoStr);
    }
    return TCL_ERROR;
  badBuffer:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "buffer size should be %d to %d",
	    MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

     */

    if (levelObj == NULL) {
	level = Z_DEFAULT_COMPRESSION;
    } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
	return TCL_ERROR;
    } else if (level < 0 || level > 9) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("level should be 0 to 9",-1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
	Tcl_AddErrorInfo(interp, "\n    (in -level option)");
	return TCL_ERROR;
    }

    /*
     * Construct the stream now we know its configuration.

	    break;
	case poLevel:
	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) {
		goto genericOptionError;
	    }
	    if (level < 0 || level > 9) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"level should be 0 to 9", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL",
			NULL);
		goto genericOptionError;
	    }
	    break;
	case poLimit:
	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) {
		goto genericOptionError;
	    }
	    if (limit < 1 || limit > MAX_BUFFER_SIZE) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read ahead limit should be 1 to %d",
			MAX_BUFFER_SIZE));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
		goto genericOptionError;
	    }
	    break;
	case poDictionary:
	    if (format == TCL_ZLIB_FORMAT_GZIP) {

	    } else {
		flush = Z_FINISH;
	    }
	    break;
	case ao_buffer: /* -buffer */
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-buffer\" option should be followed by integer "
			"decompression buffersize", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
		return TCL_ERROR;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"buffer size should be 1 to %d",
			MAX_BUFFER_SIZE));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
		return TCL_ERROR;
	    }
	    break;
	case ao_dictionary:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-dictionary\" option should be followed by"
			" compression dictionary bytes", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
		return TCL_ERROR;
	    }
	    compDictObj = objv[++i];
	    break;
	}

	    } else {
		flush = Z_FINISH;
	    }
	    break;
	case po_dictionary:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-dictionary\" option should be followed by"
			" compression dictionary bytes", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
		return TCL_ERROR;
	    }
	    compDictObj = objv[++i];
	    break;
	}

	    if (value[0] == 'f' && strcmp(value, "full") == 0) {
		flushType = Z_FULL_FLUSH;
	    } else if (value[0] == 's' && strcmp(value, "sync") == 0) {
		flushType = Z_SYNC_FLUSH;
	    } else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad -flush type \"%s\": should be full or sync",
			value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Try to actually do the flush now.

	if (optionName && strcmp(optionName, "-limit") == 0) {
	    int newLimit;

	    if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) {
		return TCL_ERROR;
	    } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"-limit should be between 1 and 65536", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL);
		return TCL_ERROR;
	    }
	}
    }

    if (setOptionProc == NULL) {

	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badOption $flag] \
		    "bad option \"$flag\",\
                     should be -base, -format, -gmt, -locale or -timezone"
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {

#
# Syntax:
#	clock add clockval ?count unit?... ?-option value?
#
# Parameters:
#	clockval -- Starting time value
#	count -- Amount of a unit of time to add
#	unit -- Unit of time to add, should be one of:
#			years year months month weeks week
#			days day hours hour minutes minute
#			seconds second
#
# Options:
#	-gmt BOOLEAN
#		(Deprecated) Flag synonymous with '-timezone :GMT'

		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set timezone $b
		}
		default {
		    throw [list CLOCK badOption $a] \
			"bad option \"$a\",\
                         should be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity

		}
		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    throw [list CLOCK badUnit $unit] \
			"unknown unit \"$unit\", should be \
                        years, months, weeks, days, hours, minutes or seconds"
		}
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error

	return $result
    }
    set options [string map {- ""} $options]
    set pat ^-(?:[join $options |])$
    if {[llength $args] == 1} {
	set flag [lindex $args 0]
	if {![regexp -- $pat $flag]} {
	    return -code error "unknown option $flag, should be: $usage"
	}
	return $http($flag)
    } else {
	foreach {flag value} $args {
	    if {![regexp -- $pat $flag]} {
		return -code error "unknown option $flag, should be: $usage"
	    }
	    set http($flag) $value
	}
    }
}

# http::Finish --

	body		{}
	status		""
	http		""
	connection	close
    }
    set state(-keepalive) $defaultKeepalive
    set state(-strict) $strict
    set state(accepttypes) $http(-accept)
    # These flags have their types verified [Bug 811170]
    array set type {
	-binary		boolean
	-blocksize	integer
	-queryblocksize integer
	-strict		boolean
	-timeout	integer

	    # Validate numbers
	    if {
		[info exists type($flag)] &&
		![string is $type($flag) -strict $value]
	    } {
		unset $token
		return -code error \
		    "bad value for $flag ($value), should be $type($flag)"
	    }
	    set state($flag) $value
	} else {
	    unset $token
	    return -code error "unknown option $flag, should be: $usage"
	}
    }

    # Make sure -query and -querychannel aren't both specified

    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    if {$isQuery && $isQueryChannel} {
	unset $token
	return -code error "can't combine -query and -querychannel options!"
    }

    # Validate URL, determine the server host and port, and check proxy case
    # Recognize user:pass@host URLs also, although we do not do anything with
    # that info yet.

    # URLs have basically four parts.

	(?: \# (.*) )?			# <fragment>
	$
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	unset $token
	return -code error "unsupported URL: $url"
    }
    # Phase two: validate
    set host [string trim $host {[]}]; # strip square brackets from IPv6 address
    if {$host eq ""} {
	# Caller has to provide a host name; we do not have a "default host"
	# that would enable us to handle relative URLs.
	unset $token
	return -code error "missing host part: $url"
	# Note that we don't check the hostname for validity here; if it's
	# invalid, we'll simply fail to resolve it later on.
    }
    if {$port ne "" && $port > 65535} {
	unset $token
	return -code error "invalid port number: $port"
    }
    # The user identification and resource identification parts of the URL can
    # have encoded characters in them; take care!
    if {$user ne ""} {
	# Check for validity according to RFC 3986, Appendix A
	set validityRE {(?xi)
	    ^
	    (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+
	    $
	}
	if {$state(-strict) && ![regexp -- $validityRE $user]} {
	    unset $token
	    # Provide a better error message in this error case
	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} {
		return -code error \
			"illegal encoding character usage \"$bad\" in URL user"
	    }
	    return -code error "illegal characters in URL user"
	}
    }
    if {$srvurl ne ""} {
	# RFC 3986 allows empty paths (not even a /), but servers
	# return 400 if the path in the HTTP request doesn't start
	# with / , so add it here if needed.
	if {[string index $srvurl 0] ne "/"} {

	    $
	}
	if {$state(-strict) && ![regexp -- $validityRE $srvurl]} {
	    unset $token
	    # Provide a better error message in this error case
	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
		return -code error \
		    "illegal encoding character usage \"$bad\" in URL path"
	    }
	    return -code error "illegal characters in URL path"
	}
    } else {
	set srvurl /
    }
    if {$proto eq ""} {
	set proto http
    }
    set lower [string tolower $proto]
    if {![info exists urlTypes($lower)]} {
	unset $token
	return -code error "unsupported URL type \"$proto\""
    }
    set defport [lindex $urlTypes($lower) 0]
    set defcmd [lindex $urlTypes($lower) 1]

    if {$port eq ""} {
	set port $defport
    }

    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
    # until we can manage this.
    if {[info exists state(-handler)]} {
	set state(-protocol) 1.0
    }
    if {[catch {
	puts $sock "$how $srvurl HTTP/$state(-protocol)"
	puts $sock "Accept: $state(accepttypes)"
	array set hdrs $state(-headers)
	if {[info exists hdrs(Host)]} {
	    # Allow Host spoofing. [Bug 928154]
	    puts $sock "Host: $hdrs(Host)"
	} elseif {$port == $defport} {
	    # Don't add port in this case, to handle broken servers. [Bug
	    # #504508]

proc http::make-transformation-chunked {chan command} {
    set lambda {{chan command} {
        set data ""
        set size -1
        yield
        while {1} {
            chan configure $chan -translation {crlf binary}
            while {[gets $chan line] < 1} {
		yield
	    }
            chan configure $chan -translation {binary binary}
            if {[scan $line %x size] != 1} {
		return -code error "invalid size: \"$line\""
	    }
            set chunk ""
            while {$size && ![chan eof $chan]} {
                set part [chan read $chan $size]
                incr size -[string length $part]
                append chunk $part
            }
            if {[catch {

    # flag used to detect that we just have a single (flags set) subprogram.
    set empty 1

    foreach item $desc {
	if {$state == "args"} {
	    # more items after 'args'...
	    return -code error "'args' special argument should be the last one"
	}
        set res [OptNormalizeOne $item]
        set state [lindex $res 0]
        if {$inflags} {
            if {$state == "flags"} {
		# add to 'subprogram'
                lappend flagsprg $res

    # Error messages front ends

    proc OptAmbigous {desc arg} {
        OptError "ambigous option \"$arg\", choose from:" [OptSelection $desc]
    }
    proc OptFlagUsage {desc arg} {
        OptError "bad flag \"$arg\", should be one of" $desc
    }
    proc OptTooManyArgs {desc arguments} {
        OptError "too many arguments (unexpected argument(s): $arguments),\
		usage:"\
		$desc 1
    }
    proc OptParamType {item} {

    append err(usage) "-name packageName -version packageVersion"
    append err(usage) "?-load {filename ?{procs}?}? ... "
    append err(usage) "?-source {filename ?{procs}?}? ..."

    set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
    set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
    set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""
    set err(noLoadOrSource) "at least one of -load and -source should be given"

    # process arguments
    set len [llength $args]
    if {$len < 6} {
	error $err(wrongNumArgs)
    }

    variable ConstraintInitializer
    DebugPuts 3 "entering ConstraintInitializer $constraint $script"
    if {[llength [info level 0]] == 2} {
	return $ConstraintInitializer($constraint)
    }
    # Check for boolean values
    if {![info complete $script]} {
	return -code error "ConstraintInitializer should be complete script"
    }
    set ConstraintInitializer($constraint) $script
}

# tcltest::InitConstraints --
#
# Call all registered constraint initializers to force initialization

	foreach flag [array names testAttributes] {
	    if {$flag ni $validFlags} {
		incr testLevel -1
		set sorted [lsort $validFlags]
		set options [join [lrange $sorted 0 end-1] ", "]
		append options ", or [lindex $sorted end]"
		return -code error "bad option \"$flag\": should be $options"
	    }
	}

	# store whatever the user gave us
	foreach item [array names testAttributes] {
	    set [string trimleft $item "-"] $testAttributes($item)
	}

	# Check the values supplied for -match
	variable CustomMatch
	if {$match ni [array names CustomMatch]} {
	    incr testLevel -1
	    set sorted [lsort [array names CustomMatch]]
	    set values [join [lrange $sorted 0 end-1] ", "]
	    append values ", or [lindex $sorted end]"
	    return -code error "bad -match value \"$match\":\
		    should be $values"
	}

	# Replace symbolic valies supplied for -returnCodes
	foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} {
	    set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes]
	}
    } else {

    }
    -result hello
}
test assemble-9.7 {concat} {
    -body {
	list [catch {assemble {concat 0}} result] $result $::errorCode
    }
    -result {1 {operand should be positive} {TCL ASSEM POSITIVE}}
    -cleanup {unset result}
}

# assemble-10 -- eval and expr

test assemble-10.1 {eval - wrong # args} {
    -body {

test assemble-16.4 {invokeStk - no operands} {
    -body {
	proc x {} {
	    assemble {invokeStk 0}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-16.5 {invokeStk1} {
    -body {
	tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3}
    }
    -result {1 2}

test assemble-18.5 {lindexMulti - bad operand count} {
    -body {
	proc x {} {
	    assemble {lindexMulti 0}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-18.6 {lindexMulti} {
    -body {
	assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1}
    }
    -result {{a b c} {d e f} {g h j}}

test assemble-19.5 {list - negative operand count} {
    -body {
	proc x {} {
	    assemble {list -1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be nonnegative} {TCL ASSEM NONNEGATIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-19.6 {list - no args} {
    -body {
	assemble {list 0}
    }
    -result {}

test assemble-20.5 {lsetFlat - negative operand count} {
    -body {
	proc x {} {
	    assemble {lsetFlat 1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be >=2} {TCL ASSEM OPERAND>=2}}
    -cleanup {rename x {}; unset result}
}
test assemble-20.6 {lsetFlat} {
    -body {
	assemble {push b; push a; lsetFlat 2}
    } 
    -result b

test assemble-21.5 {over - negative operand count} {
    -body {
	proc x {} {
	    assemble {over -1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be nonnegative} {TCL ASSEM NONNEGATIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-21.6 {over} {
    -body {
	proc x {} {
	    assemble {
		push 1

test assemble-22.5 {reverse - negative operand count} {
    -body {
	proc x {} {
	    assemble {reverse -1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be nonnegative} {TCL ASSEM NONNEGATIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-22.6 {reverse - zero operand count} {
    -body {
	proc x {} {
	    assemble {push 1; reverse 0}
	}

test assemble-25.5 {dictGet - negative operand count} {
    -body {
	proc x {} {
	    assemble {dictGet 0}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-25.6 {dictGet - 1 index} {
    -body {
	assemble {push {a 1 b 2}; push a; dictGet 1}
    }
    -result 1

test assemble-26.5 {dictSet - zero operand count} {
    -body {
	proc x {} {
	    assemble {dictSet 0 foo}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-26.6 {dictSet - bad local} {
    -body {
	proc x {} {
	    assemble {dictSet 1 ::foo::bar}
	}

test assemble-27.5 {dictUnset - zero operand count} {
    -body {
	proc x {} {
	    assemble {dictUnset 0 foo}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand should be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-27.6 {dictUnset - bad local} {
    -body {
	proc x {} {
	    assemble {dictUnset 1 ::foo::bar}
	}

}
test binary-74.9 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0\0
} -result {$``````
}
test binary-74.10 {binary encode uuencode} -returnCodes error -body {
    binary encode uuencode -foo 30 abcabcabc
} -result {bad option "-foo": should be -maxlen or -wrapchar}
test binary-74.11 {binary encode uuencode} -returnCodes error -body {
    binary encode uuencode -maxlen 1 abcabcabc
} -result {line length out of range}
test binary-74.12 {binary encode uuencode} -body {
    binary encode uuencode -maxlen 3 -wrapchar | abcabcabc
} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|}

#

test chan-1.1 {chan command general syntax} -body {
    chan
} -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\""
test chan-1.2 {chan command general syntax} -body {
    chan FOOBAR
} -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": should be *"

test chan-2.1 {chan command: blocked subcommand} -body {
    chan blocked foo bar
} -returnCodes error -result "wrong # args: should be \"chan blocked channelId\""
test chan-3.1 {chan command: close subcommand} -body {
    chan close foo bar zet
} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\""
test chan-3.2 {chan command: close subcommand} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan bar
} -cleanup {
    close $chan
} -returnCodes error -result "bad direction \"bar\": should be read or write"
test chan-3.3 {chan command: close subcommand} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan write
} -cleanup {
    close $chan
} -returnCodes error -result "half-close of write-side not possible, side not opened or already closed"
test chan-4.1 {chan command: configure subcommand} -body {
    chan configure
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\""
test chan-4.2 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar \u0100
} -returnCodes error -match glob -result {bad value*}
test chan-4.3 {chan command: [Bug 800753]} -body {

    chan pending stdin
} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
test chan-16.3 {chan command: pending subcommand} -body {
    chan pending stdin stdout stderr
} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
test chan-16.4 {chan command: pending subcommand} -body {
    chan pending {input output} stdout
} -returnCodes error -result "bad mode \"input output\": should be input or output"
test chan-16.5 {chan command: pending input subcommand} -body {
    chan pending input stdout 
} -result -1
test chan-16.6 {chan command: pending input subcommand} -body {
    chan pending input stdin
} -result 0
test chan-16.7 {chan command: pending input subcommand} -body {

} -body {
    set f1 [open $path(test1) w]
    lappend l [chan configure $f1 -buffering]
    lappend l [list [catch {chan configure $f1 -buffering green} msg] $msg]
    lappend l [chan configure $f1 -buffering]
} -cleanup {
    chan close $f1
} -result {full {1 {bad value for -buffering: should be one of full, line, or none}} full}
test chan-io-39.6 {Tcl_SetChannelOption, multiple options} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -buffering line
    chan puts $f1 hello
    chan puts $f1 bye

    chan event gorp readable
} -returnCodes error -result {can not find channel named "gorp"}
test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event gorp writable
} -returnCodes error -result {can not find channel named "gorp"}
test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event gorp who-knows
} -returnCodes error -result {bad event name "who-knows": should be readable or writable}

#
# Test chan event on a file
#

set path(foo) [makeFile {} foo]
set f [open $path(foo) w+]

} {}

test clock-1.4 "clock format - bad flag" {*}{
    -body {
    list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
    } 
    -match glob
    -result {1 {bad option "-oops": should be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
}

test clock-1.5 "clock format - bad timezone" {
    list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
} {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}}

test clock-1.6 "clock format - gmt + timezone" {

    set start [clock clicks]
    after 10
    set end [clock clicks]
    expr "$end > $start"
} {1}
test clock-33.3 {clock clicks tests} {
    list [catch {clock clicks foo} msg] $msg
} {1 {bad option "foo": should be -milliseconds or -microseconds}}
test clock-33.4 {clock clicks tests} {
    expr [clock clicks -milliseconds]+1
    concat {}
} {}
test clock-33.4a {clock milliseconds} {
    expr { [clock milliseconds] + 1 }
    concat {}

    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" : 
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks ? } msg] $msg
} {1 {bad option "?": should be -milliseconds or -microseconds}}
test clock-33.7 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks - } msg] $msg
} {1 {ambiguous option "-": should be -milliseconds or -microseconds}}

test clock-33.8 {clock clicks test, microsecond timing test} {
    # This test can fail on a system that is so heavily loaded that
    # the test takes >60 ms to run.
    set start [clock clicks -micro]
    after 10
    set end [clock clicks -micro]

} {Oct 23,1992 15:00 GMT}
test clock-34.8 {clock scan tests} {
    set time [clock scan "Oct 23,1992 15:00" -gmt true]
    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Oct 23,1992 15:00 GMT}
test clock-34.9 {clock scan tests} {
    list [catch {clock scan "Jan 12" -bad arg} msg] $msg
} {1 {bad option "-bad", should be -base, -format, -gmt, -locale or -timezone}}
# The following two two tests test the two year date policy
test clock-34.10 {clock scan tests} {
    set time [clock scan "1/1/71" -gmt true]
    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,1971 00:00 GMT}
test clock-34.11 {clock scan tests} {
    set time [clock scan "1/1/37" -gmt true]

} {4 {}}

test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding
} -result {wrong # args: should be "encoding option ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {bad option "foo": should be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto
} -result {wrong # args: should be "encoding convertto ?encoding? data"}
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {

} -result identity

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": should be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
    file exists
} -result {wrong # args: should be "file exists name"}
test cmdAH-5.4 {Tcl_FileObjCmd} {
    file exists ""
} 0

test cmdAH-29.5 {Tcl_FileObjCmd: type} {
    list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}

# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file gorp x
} -result {unknown or ambiguous subcommand "gorp": should be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file ex x
} -match glob -result {unknown or ambiguous subcommand "ex": should be *}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file is x
} -match glob -result {unknown or ambiguous subcommand "is": should be *}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file z x
} -match glob -result {unknown or ambiguous subcommand "z": should be *}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file read x
} -match glob -result {unknown or ambiguous subcommand "read": should be *}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file s x
} -match glob -result {unknown or ambiguous subcommand "s": should be *}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file t x
} -match glob -result {unknown or ambiguous subcommand "t": should be *}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file dirname ~woohgy
} -result {user "woohgy" doesn't exist}

# channels
# In testing 'file channels', we need to make sure that a channel created in
# one interp isn't visible in another.

testConstraint testobj [llength [info commands testobj]]

test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
    lsort
} -result {wrong # args: should be "lsort ?-option value ...? list"}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
    lsort -foo {1 3 2 5}
} -result {bad option "-foo": should be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique}
test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
    lsort {d e c b a \{ d35 d300}
} {a b c d d300 d35 e \{}
test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} {
    lsort -integer -ascii {d e c b a d35 d300}
} {a b c d d300 d35 e}
test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} -body {
    lsort -command {1 3 2 5}
} -returnCodes error -result {"-command" option should be followed by comparison command}
test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} -setup {
    proc cmp {a b} {
	expr {[string match x* $b] - [string match x* $a]}
    }
} -body {
    lsort -command cmp {x1 abc x2 def x3 x4}
} -result {x1 x2 x3 x4 abc def} -cleanup {

    lsort -dictionary {1k 0k 10k}
} {0k 1k 10k}
test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
    lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
    lsort -index {1 3 2 5}
} -returnCodes error -result {"-index" option should be followed by list index}
test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
    lsort -index foo {1 3 2 5}
} -returnCodes error -result {bad index "foo": should be integer?[+-]integer? or end?[+-]integer?}
test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
    lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
    lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}}
} {{3 16 42} {10 20 50} {1 25 100}}
test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {

    lsort -stride 3 {f e d c b a}
} {c b a f e d}
test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body {
    lsort -stride foo bar
} -result {expected integer but got "foo"}
test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 1 bar
} -result {stride length should be at least 2}
test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 2 {a b c}
} -result {list size should be a multiple of the stride length}
test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 2 -index 3 {a b c d}
} -result {when used with "-stride", the leading "-index" value should be within the group}
test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
    lsort -stride 2 -index {0 1} {
	{{c o d e} 54321} {{b l a h} 94729}
	{{b i g} 12345} {{d e m o} 34512}
    }
} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}

# Some tests for Tcl_ReturnObjCmd are in proc-old.test

test cmdMZ-return-1.0 {return checks for bad option values} -body {
    return -options foo
} -returnCodes error -match glob -result {bad -options value:*}
test cmdMZ-return-1.1 {return checks for bad option values} -body {
    return -code err
} -returnCodes error -match glob -result {bad completion code "err": should be ok, error, return, break, continue*, or an integer}
test cmdMZ-return-1.2 {return checks for bad option values} -body {
    return -code 0x100000000
} -returnCodes error -match glob -result {bad completion code "0x100000000": should be ok, error, return, break, continue*, or an integer}
test cmdMZ-return-1.3 {return checks for bad option values} -body {
    return -level foo
} -returnCodes error -match glob -result {bad -level value: *}
test cmdMZ-return-1.4 {return checks for bad option values} -body {
    return -level -1
} -returnCodes error -match glob -result {bad -level value: *}
test cmdMZ-return-1.5 {return checks for bad option values} -body {

    list [catch {return -level 0 -code break} -> foo] [dictSort $foo]
} {3 {-code 3 -level 0}}
test cmdMZ-return-2.12 {return option handling} -body {
    return -level 0 -code error -options {-code ok}
} -returnCodes ok -result {}
test cmdMZ-return-2.13 {return option handling} -body {
    return -level 0 -code error -options {-code err}
} -returnCodes error -match glob -result {bad completion code "err": should be ok, error, return, break, continue*, or an integer}
test cmdMZ-return-2.14 {return option handling} -body {
    return -level 0 -code error -options {-code foo -options {-code break}}
} -returnCodes break -result {}
test cmdMZ-return-2.15 {return opton handling} {
    list [catch {
	apply {{} {
	    return -code error -errorcode {a b} c

test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} {
	# shared object - Interp result && Var 'r'
	set r [list foobar]
	# command that will add error to result
	lindex a bogus
    }}
} -returnCodes error -result {bad index "bogus": should be integer?[+-]integer? or end?[+-]integer?}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a bogus }}
} -returnCodes error -result {bad index "bogus": should be integer?[+-]integer? or end?[+-]integer?}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a 0o9 }}
} -returnCodes error -match glob -result {*invalid octal number*}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; array set var {one two many} }}
} -returnCodes error -result {list must have an even number of elements}
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {

# change without warning.

test compile-18.1 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble
} -match glob -result {wrong # args: should be "*"}
test compile-18.2 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble ?
} -match glob -result {bad type "?": should be *}
test compile-18.3 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble lambda
} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
test compile-18.4 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble lambda \{
} -result "can't interpret \"\{\" as a lambda expression"
test compile-18.5 {disassembler - basics} -body {

test pkgconfig-2.0 {error: missing subcommand} {
    catch {::tcl::pkgconfig} msg
    set msg
} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
test pkgconfig-2.1 {error: illegal subcommand} {
    catch {::tcl::pkgconfig foo} msg
    set msg
} {bad subcommand "foo": should be get or list}
test pkgconfig-2.2 {error: list with arguments} {
    catch {::tcl::pkgconfig list foo} msg
    set msg
} {wrong # args: should be "::tcl::pkgconfig list"}
test pkgconfig-2.3 {error: get without arguments} {
    catch {::tcl::pkgconfig get} msg
    set msg

}

test dict-1.1 {dict command basic syntax} -returnCodes error -body {
    dict
} -result {wrong # args: should be "dict subcommand ?arg ...?"}
test dict-1.2 {dict command basic syntax} -returnCodes error -body {
    dict ?
} -match glob -result {unknown or ambiguous subcommand "?": should be *}

test dict-2.1 {dict create command} {
    dict create
} {}
test dict-2.2 {dict create command} {
    dict create a b
} {a b}

    dict filter {a b} script "\{k v" {continue}
} -result {unmatched open brace in list}
test dict-17.21 {dict filter command} -returnCodes error -body {
    dict filter {a b}
} -result {wrong # args: should be "dict filter dictionary filterType ?arg ...?"}
test dict-17.22 {dict filter command} -returnCodes error -body {
    dict filter {a b} JUNK
} -result {bad filterType "JUNK": should be key, script, or value}
test dict-17.23 {dict filter command} -returnCodes error -body {
    dict filter a key *
} -result {missing value to go with key}

test dict-18.1 {dict-list relationship} -body {
    # Test that any internal conversion between list and dict does not change
    # the object

    throw a b c
} -result {wrong # args: should be "throw type message"}
test error-8.8 {throw syntax checks} -returnCodes error -body {
    throw "not a \{ list" foo
} -result {unmatched open brace in list}
test error-8.9 {throw syntax checks} -returnCodes error -body {
    throw {} foo
} -result {type should be non-empty list}
test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body {
    apply {code {throw $code foo}} {}
} -result {type should be non-empty list}
test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error  -body {
    throw {not {}a list} x[]y
} -result {list element in braces followed by "a" instead of space}

# simple try tests: body completes with code ok

test error-9.1 {try (ok, empty result) with no handlers} {

# It would seem appropriate to set at least those for the matching handler and
# the executed body; possibly for each handler we fall through as well?

# negative case try tests - bad "on" handler

test error-20.1 {bad code name in on handler} -body {
    try { list a b c } on err {} {}
} -returnCodes error -match glob -result {bad completion code "err": should be ok, error, return, break, continue*, or an integer}
test error-20.2 {bad code value in on handler} -body {
    try { list a b c } on 34985723094872345 {} {}
} -returnCodes error -match glob -result {bad completion code "34985723094872345": should be ok, error, return, break, continue*, or an integer}

test error-21.1 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {string repeat x 10} on ok {} {}
    }
} 0
test error-21.2 {memory leaks in try: Bug 2910044} memory {

} {3 3 done}

test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
    update a b
} -result {wrong # args: should be "update ?idletasks?"}
test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body {
    update bogus
} -result {bad option "bogus": should be idletasks}
test event-12.3 {Tcl_UpdateCmd procedure} -setup {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    after 500 {set x after}
    after idle {set y after}

    exec -keepnewline [interpreter] $path(echo) foo
} "foo\n"
test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
    exec -keepnewline
} -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"}
test exec-14.3 {unknown switch} -constraints {exec} -body {
    exec -gorp
} -returnCodes error -result {bad option "-gorp": should be -ignorestderr, -keepnewline, or --}
test exec-14.4 {-- switch} -constraints {exec} -body {
    exec -- -gorp
} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
test exec-14.5 {-ignorestderr switch} {exec} {
    # Alas, the use of -ignorestderr is buried here :-(
    exec [interpreter] $path(sh2) -c [list $path(echo2) foo bar] 2>@1
} "foo bar\nbar"

    createfile tf1
    file copy tf1 tf2
    lsort [glob tf*]
} -result {tf1 tf2}

test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
    file rename -xyz
} -returnCodes error -result {bad option "-xyz": should be -force or --}
test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
    file rename xyz
} -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"}
test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
    file rename xyz ~_totally_bogus_user
} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup {

} -constraints {notRoot} -body {
    file mkdir tf1
    file exists tf1
} -result {1}

test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
    file delete -xyz
} -returnCodes error -result {bad option "-xyz": should be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
    file delete -force -force
} -result {}
test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup {
    cleanup
} -body {
    createfile tf1

} -result {}
test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
    createfile -tf1
} -body {
    file delete -tf1
} -returnCodes error -cleanup {
    file delete -- -tf1
} -result {bad option "-tf1": should be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile --
    createfile -force
    file delete -force -force -- -- -force
    glob -- -- -force

    file link
} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
test fCmd-28.2 {file link} -returnCodes error -body {
    file link a b c d
} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
test fCmd-28.3 {file link} -returnCodes error -body {
    file link abc b c
} -result {bad option "abc": should be -symbolic or -hard}
test fCmd-28.4 {file link} -returnCodes error -body {
    file link -abc b c
} -result {bad option "-abc": should be -symbolic or -hard}
cd [workingDirectory]
makeDirectory abc.dir
makeDirectory abc2.dir
makeFile contents abc.file
makeFile contents abc2.file
cd [temporaryDirectory]
test fCmd-28.5 {file link: source already exists} -setup {

} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}

test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body {
    glob
} -result {no files matched glob patterns ""}
test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
    glob -gorp
} -result {bad option "-gorp": should be -directory, -join, -nocomplain, -path, -tails, -types, or --}
test filename-11.3 {Tcl_GlobCmd} -body {
    glob -nocomplai
} -result {}
test filename-11.4 {Tcl_GlobCmd} -body {
    glob -nocomplain
} -result {}
test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body {

    glob -path
} -result {missing argument to "-path"}
test filename-11.34 {Tcl_GlobCmd} -returnCodes error -body {
    glob -direct
} -result {missing argument to "-directory"}
test filename-11.35 {Tcl_GlobCmd} -returnCodes error -body {
    glob -paths *
} -result {bad option "-paths": should be -directory, -join, -nocomplain, -path, -tails, -types, or --}
# Test '-tails' flag to glob.
test filename-11.36 {Tcl_GlobCmd} -returnCodes error -body {
    glob -tails *
} -result {"-tails" should be used with either "-directory" or "-path"}
test filename-11.37 {Tcl_GlobCmd} {
    glob -type d -tails -path $globname *
} [list $globname]
test filename-11.38 {Tcl_GlobCmd} {
    glob -tails -path $globname *
} [list $globname]
test filename-11.39 {Tcl_GlobCmd} {

    foreach f [glob -dir [pwd] *] {
	lappend res [file tail $f]
    }
    list $res [glob *]
} -match compareWords -result equal
test filename-11.43 {Tcl_GlobCmd} -returnCodes error -body {
    glob -t *
} -result {ambiguous option "-t": should be -directory, -join, -nocomplain, -path, -tails, -types, or --}
test filename-11.44 {Tcl_GlobCmd} -returnCodes error -body {
    glob -tails -path hello -directory hello *
} -result {"-directory" cannot be used with "-path"}
test filename-11.45 {Tcl_GlobCmd on root volume} -setup {
    set res1 ""
    set res2 ""
    set tmpd [pwd]

# miscellaneous

test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} history {
    catch {history gorp} msg
    set msg
} {unknown or ambiguous subcommand "gorp": should be add, change, clear, event, info, keep, nextid, or redo}

# cleanup
::tcltest::cleanupTests
return

	-urlencoding iso8859-1
    set x [http::config]
    http::config {*}$savedconf
    set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
test http-1.5 {http::config} -returnCodes error -body {
    http::config -proxyhost {} -junk 8080
} -result {unknown option -junk, should be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
test http-1.6 {http::config} -setup {
    set oldenc [http::config -urlencoding]
} -body {
    set enc [list [http::config -urlencoding]]
    http::config -urlencoding iso8859-1
    lappend enc [http::config -urlencoding]
} -cleanup {
    http::config -urlencoding $oldenc
} -result {utf-8 iso8859-1}

test http-2.1 {http::reset} {
    catch {http::reset http#1}
} 0

test http-3.1 {http::geturl} -returnCodes error -body {
    http::geturl -bogus flag
} -result {unknown option flag, should be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
test http-3.2 {http::geturl} -returnCodes error -body {
    http::geturl http:junk
} -result {unsupported URL: http:junk}
set url //[info hostname]:$port
set badurl //[info hostname]:[expr $port+1]
test http-3.3 {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token

    set token [http::geturl $fullurl -validate 1]
    http::code $token
} -cleanup {
    http::cleanup $token
} -result "HTTP/1.0 200 OK"
test http-3.15 {http::geturl parse failures} -body {
    http::geturl "{invalid}:url"
} -returnCodes error -result {unsupported URL: {invalid}:url}
test http-3.16 {http::geturl parse failures} -body {
    http::geturl http:relative/url
} -returnCodes error -result {unsupported URL: http:relative/url}
test http-3.17 {http::geturl parse failures} -body {
    http::geturl /absolute/url
} -returnCodes error -result {missing host part: /absolute/url}
test http-3.18 {http::geturl parse failures} -body {
    http::geturl http://somewhere:123456789/
} -returnCodes error -result {invalid port number: 123456789}
test http-3.19 {http::geturl parse failures} -body {
    http::geturl http://{user}@somewhere
} -returnCodes error -result {illegal characters in URL user}
test http-3.20 {http::geturl parse failures} -body {
    http::geturl http://%user@somewhere
} -returnCodes error -result {illegal encoding character usage "%us" in URL user}
test http-3.21 {http::geturl parse failures} -body {
    http::geturl http://somewhere/{path}
} -returnCodes error -result {illegal characters in URL path}
test http-3.22 {http::geturl parse failures} -body {
    http::geturl http://somewhere/%path
} -returnCodes error -result {illegal encoding character usage "%pa" in URL path}
test http-3.23 {http::geturl parse failures} -body {
    http::geturl http://somewhere/path?{query}?
} -returnCodes error -result {illegal characters in URL path}
test http-3.24 {http::geturl parse failures} -body {
    http::geturl http://somewhere/path?%query
} -returnCodes error -result {illegal encoding character usage "%qu" in URL path}
test http-3.25 {http::meta} -setup {
    unset -nocomplain m token
} -body {
    set token [http::geturl $url -timeout 2000]
    array set m [http::meta $token]
    lsort [array names m]
} -cleanup {

} 3
test indexObj-1.9 {exact match of empty values} testindexobj {
    testindexobj 1 0 {} a aa aaa {} b bb bbb
} 3

test indexObj-2.1 {no match} testindexobj {
    list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg
} {1 {bad token "dddd": should be abc, def, xalb, xyz, alm, or x}}
test indexObj-2.2 {no match} testindexobj {
    list [catch {testindexobj 1 1 dddd abc} msg] $msg
} {1 {bad token "dddd": should be abc}}
test indexObj-2.3 {no match: no abbreviations} testindexobj {
    list [catch {testindexobj 1 0 xy abc def xalb xyz alm} msg] $msg
} {1 {bad token "xy": should be abc, def, xalb, xyz, or alm}}
test indexObj-2.4 {ambiguous value} testindexobj {
    list [catch {testindexobj 1 1 d dumb daughter a c} msg] $msg
} {1 {ambiguous token "d": should be dumb, daughter, a, or c}}
test indexObj-2.5 {omit error message} testindexobj {
    list [catch {testindexobj 0 1 d x} msg] $msg
} {1 {}}
test indexObj-2.6 {TCL_EXACT => no "ambiguous" error message} testindexobj {
    list [catch {testindexobj 1 0 d dumb daughter a c} msg] $msg
} {1 {bad token "d": should be dumb, daughter, a, or c}}
test indexObj-2.7 {exact match of empty values} testindexobj {
    list [catch {testindexobj 1 1 {} a b c} msg] $msg
} {1 {ambiguous token "": should be a, b, or c}}
test indexObj-2.8 {exact match of empty values: singleton case} testindexobj {
    list [catch {testindexobj 1 0 {} a} msg] $msg
} {1 {bad token "": should be a}}
test indexObj-2.9 {non-exact match of empty values: singleton case} testindexobj {
    # NOTE this is a special case.  Although the empty string is a
    # unique prefix, we have an established history of rejecting
    # empty lookup keys, requiring any unique prefix match to have
    # at least one character.
    list [catch {testindexobj 1 1 {} a} msg] $msg
} {1 {ambiguous token "": should be a}}

test indexObj-3.1 {cache result to skip next lookup} testindexobj {
    testindexobj check 42
} {42}

test indexObj-4.1 {free old internal representation} testindexobj {
    set x {a b}

unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": should be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": should be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": should be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": should be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path


# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {
    interp
} -result {wrong # args: should be "interp cmd ?arg ...?"}
test interp-1.2 {options for interp command} -returnCodes error -body {
    interp frobox
} -result {bad option "frobox": should be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.3 {options for interp command} {
    interp delete
} ""
test interp-1.4 {options for interp command} -returnCodes error -body {
    interp delete foo bar
} -result {could not find interpreter "foo"}
test interp-1.5 {options for interp command} -returnCodes error -body {
    interp exists foo bar
} -result {wrong # args: should be "interp exists ?path?"}
#
# test interp-0.6 was removed
#
test interp-1.6 {options for interp command} -returnCodes error -body {
    interp slaves foo bar zop
} -result {wrong # args: should be "interp slaves ?path?"}
test interp-1.7 {options for interp command} -returnCodes error -body {
    interp hello
} -result {bad option "hello": should be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
    interp -froboz
} -result {bad option "-froboz": should be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
    interp -froboz -safe
} -result {bad option "-froboz": should be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} 
test interp-1.10 {options for interp command} -returnCodes error -body {
    interp target
} -result {wrong # args: should be "interp target path alias"}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a

    interp create b -safe
} b
test interp-2.6 {basic interpreter creation} {
    interp create d -safe
} d
test interp-2.7 {basic interpreter creation} {
    list [catch {interp create -froboz} msg] $msg
} {1 {bad option "-froboz": should be -safe or --}}
test interp-2.8 {basic interpreter creation} {
    interp create -- -froboz
} -froboz
test interp-2.9 {basic interpreter creation} {
    interp create -safe -- -froboz1
} -froboz1
test interp-2.10 {basic interpreter creation} {

    list $result $msg
} {1 {expected integer but got "bar"}}
test interp-29.1.5 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo 0} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit should be > 0}}
test interp-29.1.6 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo -1} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit should be > 0}}
test interp-29.1.7 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.1.8 {slave recursionlimit argument checking} {

    list $result $msg
} {1 {expected integer but got "foo"}}
test interp-29.1.10 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit 0} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit should be > 0}}
test interp-29.1.11 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit -1} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit should be > 0}}
test interp-29.1.12 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.2.1 {query recursion limit} {

    interp limit
} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
test interp-35.2 {interp limit syntax} -body {
    interp limit {}
} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
test interp-35.3 {interp limit syntax} -body {
    interp limit {} foo
} -returnCodes error -result {bad limit type "foo": should be commands or time}
test interp-35.4 {interp limit syntax} -body {
    set i [interp create]
    set dict [interp limit $i commands]
    set result {}
    foreach key [lsort [dict keys $dict]] {
	lappend result $key [dict get $dict $key]
    }

    interp delete $i
} -result {}
test interp-35.7 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i commands -foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {bad option "-foobar": should be -command, -granularity, or -value}
test interp-35.8 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i commands -granularity foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {expected integer but got "foobar"}
test interp-35.9 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i commands -granularity 0
} -cleanup {
    interp delete $i
} -returnCodes error -result {granularity should be at least 1}
test interp-35.10 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i commands -value foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {expected integer but got "foobar"}
test interp-35.11 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i commands -value -1
} -cleanup {
    interp delete $i
} -returnCodes error -result {command limit value should be at least 0}
test interp-35.12 {interp limit syntax} -body {
    set i [interp create]
    set dict [interp limit $i time]
    set result {}
    foreach key [lsort [dict keys $dict]] {
	lappend result $key [dict get $dict $key]
    }

    interp delete $i
} -result {}
test interp-35.15 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {bad option "-foobar": should be -command, -granularity, -milliseconds, or -seconds}
test interp-35.16 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -granularity foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {expected integer but got "foobar"}
test interp-35.17 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -granularity 0
} -cleanup {
    interp delete $i
} -returnCodes error -result {granularity should be at least 1}
test interp-35.18 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -seconds foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {expected integer but got "foobar"}
test interp-35.19 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -seconds -1
} -cleanup {
    interp delete $i
} -returnCodes error -result {seconds should be at least 0}
test interp-35.20 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -millis foobar
} -cleanup {
    interp delete $i
} -returnCodes error -result {expected integer but got "foobar"}
test interp-35.21 {interp limit syntax} -body {
    set i [interp create]
    interp limit $i time -millis -1
} -cleanup {
    interp delete $i
} -returnCodes error -result {milliseconds should be at least 0}
test interp-35.22 {interp time limits normalize milliseconds} -body {
    set i [interp create]
    interp limit $i time -seconds 1 -millis 1500
    list [$i limit time -seconds] [$i limit time -millis]
} -cleanup {
    interp delete $i
} -result {2 500}

} -returnCodes error -result {wrong # args: should be "slave bgerror ?cmdPrefix?"}
test interp-36.4 {SlaveBgerror syntax} -setup {
    interp create slave
} -body {
    slave bgerror \{
} -cleanup {
    interp delete slave
} -returnCodes error -result {cmdPrefix should be list of length >= 1}
test interp-36.5 {SlaveBgerror syntax} -setup {
    interp create slave
} -body {
    slave bgerror {}
} -cleanup {
    interp delete slave
} -returnCodes error -result {cmdPrefix should be list of length >= 1}
test interp-36.6 {SlaveBgerror returns handler} -setup {
    interp create slave
} -body {
    slave bgerror {foo bar soom}
} -cleanup {
    interp delete slave
} -result {foo bar soom}

    interp debug {} -f
} -result {0}
test interp-38.6 {interp debug basic setup} -body {
    interp debug -frames
} -returnCodes error -result {could not find interpreter "-frames"}
test interp-38.7 {interp debug basic setup} -body {
    interp debug {} -frames
} -returnCodes error -result {bad debug option "-frames": should be -frame}
test interp-38.8 {interp debug basic setup} -body {
    interp debug {} -frame 0 bogus
} -returnCodes {
    error
} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}

# cleanup

    set f1 [open $path(test1) w]
    set l ""
    lappend l [fconfigure $f1 -buffering]
    lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg]
    lappend l [fconfigure $f1 -buffering]
    close $f1
    set l
} {full {1 {bad value for -buffering: should be one of full, line, or none}} full}
test io-39.6 {Tcl_SetChannelOption, multiple options} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line
    puts $f1 hello
    puts $f1 bye
    set x [file size $path(test1)]

    list [catch {fileevent gorp readable} msg] $msg
} {1 {can not find channel named "gorp"}}
test io-41.4 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {fileevent gorp writable} msg] $msg
} {1 {can not find channel named "gorp"}}
test io-41.5 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {fileevent gorp who-knows} msg] $msg
} {1 {bad event name "who-knows": should be readable or writable}}

#
# Test fileevent on a file
#

set path(foo) [makeFile {} foo]
set f [open $path(foo) w+]

    seek a b c d e f g
} -result {wrong # args: should be "seek channelId offset ?origin?"}
test iocmd-5.3 {seek command} -returnCodes error -body {
    seek stdin gugu
} -result {expected integer but got "gugu"}
test iocmd-5.4 {seek command} -returnCodes error -body {
    seek stdin 100 gugu
} -result {bad origin "gugu": should be start, current, or end}
test iocmd-5.5 {seek command} -returnCodes error -body {
    seek stdin 100 ""
} -result {ambiguous origin "": should be start, current, or end}

test iocmd-6.1 {tell command} {
    list [catch {tell} msg] $msg
} {1 {wrong # args: should be "tell channelId"}}
test iocmd-6.2 {tell command} {
    list [catch {tell a b c d e} msg] $msg
} {1 {wrong # args: should be "tell channelId"}}

} {1 {can not find channel named "aaa"}}
test iocmd-7.4 {close command} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan bar
} -cleanup {
    close $chan
} -returnCodes error -result "bad direction \"bar\": should be read or write"
test iocmd-7.4a {close command} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan ""
} -cleanup {
    close $chan
} -returnCodes error -result "ambiguous direction \"\": should be read or write"
test iocmd-7.5 {close command} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan write
} -cleanup {
    close $chan
} -returnCodes error -result "half-close of write-side not possible, side not opened or already closed"

test iocmd-8.1 {fconfigure command} {
    list [catch {fconfigure} msg] $msg
} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}}
test iocmd-8.2 {fconfigure command} {
    list [catch {fconfigure a b c d e f} msg] $msg
} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}}
test iocmd-8.3 {fconfigure command} {
    list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
test iocmd-8.4 {fconfigure command} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    set x [list [catch {fconfigure $f1 froboz} msg] $msg]
    close $f1
    set x
} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.5 {fconfigure command} {
    list [catch {fconfigure stdin -buffering froboz} msg] $msg
} {1 {bad value for -buffering: should be one of full, line, or none}}
test iocmd-8.6 {fconfigure command} {
    list [catch {fconfigure stdin -translation froboz} msg] $msg
} {1 {bad value for -translation: should be one of auto, binary, cr, lf, crlf, or platform}}
test iocmd-8.7 {fconfigure command} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding unicode
    set x [fconfigure $f1]
    close $f1
    set x

    # might fail if /dev/ttya is unavailable
    set tty [open /dev/ttya]
    fconfigure $tty -blah blih
} -cleanup {
    if {$tty ne ""} {
	close $tty
    }
} -returnCodes error -result {unknown or ambiguous option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}
test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup {
    set tty ""
} -body {
    # might fail early if com1 is unavailable
    set tty [open com1]
    fconfigure $tty -blah blih
} -cleanup {
    if {$tty ne ""} {
	close $tty
    }
} -returnCodes error -result {unknown or ambiguous option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar}
# TODO: Test parsing of serial channel options (nonportable, since requires an
# open channel to work with).

test iocmd-9.1 {eof command} {
    list [catch {eof} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.2 {eof command} {

} "1 unmatched open brace in list
unmatched open brace in list
    while processing open access modes \"FOO {BAR BAZ\"
    invoked from within
\"open \$path(test3) \"FOO \\{BAR BAZ\"\""
test iocmd-12.7 {POSIX open access modes: errors} {
  list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg
} {1 {invalid access mode "FOO": should be RDONLY, WRONLY, RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC}}
test iocmd-12.8 {POSIX open access modes: errors} {
    list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg
} {1 {access mode should include either RDONLY, WRONLY, or RDWR}}
close [open $path(test3) w]
test iocmd-12.9 {POSIX open access modes: BINARY} {
    list [catch {open $path(test1) BINARY} msg] $msg
} {1 {access mode should include either RDONLY, WRONLY, or RDWR}}
test iocmd-12.10 {POSIX open access modes: BINARY} {
    set f [open $path(test1) {WRONLY BINARY TRUNC}]
    puts $f a
    puts $f b
    puts -nonewline $f c	;# contents are now 5 bytes: a\nb\nc
    close $f
    set f [open $path(test1) r]

    list [catch {fcopy $wfile $wfile} msg] $msg
} "1 {channel \"$wfile\" wasn't opened for reading}"
test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $rfile} msg] $msg
} "1 {channel \"$rfile\" wasn't opened for writing}"
test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile foo bar} msg] $msg
} {1 {bad option "foo": should be -command or -size}}
test iocmd-15.10a {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile - bar} msg] $msg
} {1 {ambiguous option "-": should be -command or -size}}
test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
} {1 {expected integer but got "foo"}}

close $rfile
close $wfile

# ### ### ### ######### ######### #########
## Testing the reflected channel.

test iocmd-20.0 {chan, wrong#args} {
    catch {chan} msg
    set msg
} {wrong # args: should be "chan subcommand ?arg ...?"}
test iocmd-20.1 {chan, unknown method} -body {
    chan foo
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": should be *}

# --- --- --- --------- --------- ---------
# chan create, and method "initalize"

test iocmd-21.0 {chan create, wrong#args, not enough} {
    catch {chan create} msg
    set msg

    set msg
} {bad mode list: is empty}
test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
    proc foo {} {}
    catch {chan create {c} foo} msg
    rename foo {}
    set msg
} {bad mode "c": should be read or write}
test iocmd-21.4 {chan create, bad handler, not a list} {
    catch {chan create {r w} "foo \{"} msg
    set msg
} {unmatched open brace in list}
test iocmd-21.5 {chan create, bad handler, not a command} {
    catch {chan create {r w} foo} msg
    set msg

    set msg
} -match glob -result {*all required methods*}
test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return 1}
    catch {chan create {r w} foo} msg
    rename foo {}
    set msg
} -match glob -result {*bad method "1": should be *}
test iocmd-21.12 {chan create, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return {a b c}}
    catch {chan create {r w} foo} msg
    rename foo {}
    set msg
} -match glob -result {*bad method "c": should be *}
test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} -body {
    proc foo {args} {return {initialize finalize}}
    catch {chan create {r w} foo} msg
    rename foo {}
    set msg
} -match glob -result {*all required methods*}
test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} -body {

    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    catch {chan postevent $c goo} msg; note $msg
    close $c
    rename foo {}
    set res
} -result {{bad event "goo": should be read or write}}
test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    catch {chan postevent $c "\{"} msg; note $msg
    close $c
    rename foo {}

# ### ### ### ######### ######### #########

test iortrans-1.0 {chan, wrong#args} -returnCodes error -body {
    chan
} -result {wrong # args: should be "chan subcommand ?arg ...?"}
test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
    chan foo
} -match glob -result {unknown or ambiguous subcommand "foo": should be*}

# --- --- --- --------- --------- ---------
# chan push, and method "initalize"

test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
    chan push
} -result {wrong # args: should be "chan push channel cmdprefix"}

} -match glob -result {*all required methods*}
test iortrans-2.10 {chan push, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return 1}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*bad method "1": should be *}
test iortrans-2.11 {chan push, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return {a b c}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*bad method "c": should be *}
test iortrans-2.12 {chan push, initialize failed, bad result, required methods missing} -body {
    # Required: initialize, and finalize.
    proc foo {args} {return {initialize}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*all required methods*}
test iortrans-2.13 {chan push, initialize failed, bad result, illegal method name} -body {
    proc foo {args} {return {initialize finalize BOGUS}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*returned bad method "BOGUS": should be clear, drain, finalize, flush, initialize, limit?, read, or write}
test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body {
    proc foo {args} {return {initialize finalize}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*makes the channel inaccessible}

    set x {1 2}
    list [testevalex {lindex {{a b c} {d e f}} $x}] \
	[testevalex {lindex {{a b c} {d e f}} $x}]
} {f f}
test lindex-2.4 {malformed index list} testevalex {
    set x \{
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 bad\ index\ \"\{\":\ should\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}

# Indices that are integers or convertible to integers

test lindex-3.1 {integer -1} testevalex {
    set x ${minus}1
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}

test lindex-4.7 {bad octal} -constraints testevalex -body {
    set x end--0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
    set x end-0a2
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-0a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lindex-4.9 {obsolete test} testevalex {
    set x end
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
test lindex-4.10 {incomplete end-} testevalex {
    set x end-
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-": should be integer?[+-]integer? or end?[+-]integer?}}

test lindex-5.1 {bad second index} testevalex {
    list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result
} {1 {bad index "0a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lindex-5.2 {good second index} testevalex {
    testevalex {lindex {{a b c} {d e f} {g h i}} 1 2}
} f
test lindex-5.3 {three indices} testevalex {
    testevalex {lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1}
} f

	list [lindex {{a b c} {d e f}} $x] [lindex {{a b c} {d e f}} $x]
    } result
    set result
} {f f}
test lindex-10.4 {malformed index list} {
    set x \{
    list [catch { lindex {a b c} $x } result] $result
} {1 bad\ index\ \"\{\":\ should\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}

# Indices that are integers or convertible to integers

test lindex-11.1 {integer -1} {
    set x ${minus}1
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]

test lindex-12.7 {bad octal} -body {
    set x end--0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
    set x end-0a2
    list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-0a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lindex-12.9 {obsolete test} {
    set x end
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {c c}
test lindex-12.10 {incomplete end-} {
    set x end-
    list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-": should be integer?[+-]integer? or end?[+-]integer?}}

test lindex-13.1 {bad second index} {
    list [catch { lindex {a b c} 0 0a2 } result] $result
} {1 {bad index "0a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lindex-13.2 {good second index} {
    catch {
	lindex {{a b c} {d e f} {g h i}} 1 2
    } result
    set result
} f
test lindex-13.3 {three indices} {

} {a b e f c d}

test linsert-2.1 {linsert errors} {
    list [catch linsert msg] $msg
} {1 {wrong # args: should be "linsert list index ?element ...?"}}
test linsert-2.2 {linsert errors} {
    list [catch {linsert a b} msg] $msg
} {1 {bad index "b": should be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.3 {linsert errors} {
    list [catch {linsert a 12x 2} msg] $msg
} {1 {bad index "12x": should be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.4 {linsert errors} {
    list [catch {linsert \{ 12 2} msg] $msg
} {1 {unmatched open brace in list}}
test linsert-2.5 {syntax (TIP 323)} {
    linsert {a b c} 0
} [list a b c]
test linsert-2.6 {syntax (TIP 323)} {

    list [catch {load -lazy {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
test load-1.7 {basic errors} {} {
    list [catch {load -abc foo} msg] $msg
} "1 {bad option \"-abc\": should be -global, -lazy, or --}"
test load-1.8 {basic errors} {} {
    list [catch {load -global} msg] $msg
} "1 {couldn't figure out package name for -global}"

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]

    list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.2 {error conditions} {
    list [catch {lrange a b 6 7} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.3 {error conditions} {
    list [catch {lrange a b 6} msg] $msg
} {1 {bad index "b": should be integer?[+-]integer? or end?[+-]integer?}}
test lrange-2.4 {error conditions} {
    list [catch {lrange a 0 enigma} msg] $msg
} {1 {bad index "enigma": should be integer?[+-]integer? or end?[+-]integer?}}
test lrange-2.5 {error conditions} {
    list [catch {lrange "a \{b c" 3 4} msg] $msg
} {1 {unmatched open brace in list}}
test lrange-2.6 {error conditions} {
    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}

    -result {expected integer but got "a"}
}
test lrepeat-1.4 {error cases} {
    -body {
	lrepeat -3 1
    }
    -returnCodes 1
    -result {bad count "-3": should be integer >= 0} 
}
test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0
    }
    -result {}
}

    list [catch lreplace msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} {
    list [catch {lreplace a b} msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.3 {lreplace errors} {
    list [catch {lreplace x a 10} msg] $msg
} {1 {bad index "a": should be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.4 {lreplace errors} {
    list [catch {lreplace x 10 x} msg] $msg
} {1 {bad index "x": should be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} {1 {bad index "1x": should be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 1 1} msg] $msg
} {1 {list doesn't contain element 1}}

    lsearch -glob {xyz bbcc *bc*} *bc*
} 1
test lsearch-2.9 {search modes} {
    lsearch -glob {b.x ^bc xy bcx} ^bc
} 1
test lsearch-2.10 {search modes} -returnCodes error -body {
    lsearch -glib {b.x bx xy bcx} b.x
} -result {bad option "-glib": should be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
test lsearch-2.11 {search modes with -nocase} {
    lsearch -exact -nocase {a b c A B C} A
} 0
test lsearch-2.12 {search modes with -nocase} {
    lsearch -glob -nocase {a b c A B C} A*
} 0
test lsearch-2.13 {search modes with -nocase} {

    lsearch
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.2 {lsearch errors} -returnCodes error -body {
    lsearch a
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.3 {lsearch errors} -returnCodes error -body {
    lsearch a b c
} -result {bad option "a": should be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
test lsearch-3.4 {lsearch errors} -returnCodes error -body {
    lsearch a b c d
} -result {bad option "a": should be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
test lsearch-3.5 {lsearch errors} -returnCodes error -body {
    lsearch "\{" b
} -result {unmatched open brace in list}
test lsearch-3.6 {lsearch errors} -returnCodes error -body {
    lsearch -index a b
} -result {"-index" option should be followed by list index}
test lsearch-3.7 {lsearch errors} -returnCodes error -body {
    lsearch -subindices -exact a b
} -result {-subindices cannot be used without -index option}

test lsearch-4.1 {binary data} {
    lsearch -exact [list foo one\000two bar] bar
} 2

    lsearch -start 2 {a b c d e f} a
} -1
test lsearch-10.3 {offset searching} {
    lsearch -start end-4 {a b c a b c} a
} 3
test lsearch-10.4 {offset searching} -returnCodes error -body {
    lsearch -start foobar {a b c a b c} a
} -result {bad index "foobar": should be integer?[+-]integer? or end?[+-]integer?}
test lsearch-10.5 {offset searching} -returnCodes error -body {
    lsearch -start 1 2
} -result {missing starting index}
test lsearch-10.6 {binary search with offset} {
    set res {}
    for {set i 0} {$i < 100} {incr i} {
	lappend res [lsearch -integer -start 2 -sorted $increasingIntegers $i]

} {{0 0 0} {1 0 0}}

test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
    lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}
test lsearch-20.2 {lsearch -index option, malformed index} -body {
    lsearch -index foo {{a c} {a b} {a a}} a
} -returnCodes error -result {bad index "foo": should be integer?[+-]integer? or end?[+-]integer?}
test lsearch-20.3 {lsearch -index option, malformed index} -body {
    lsearch -index \{ {{a c} {a b} {a a}} a
} -returnCodes error -result {unmatched open brace in list}

test lsearch-21.1 {lsearch shimmering crash} {
    set x 0
    lsearch -exact -integer $x $x

    list [testevalex {lset x 0 3}] $x
} {{3 1 2} {3 1 2}}
test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
    set x {0 1 2}
    list [catch {
	testevalex {lset x {{bad}1} 3}
    } msg] $msg
} {1 {bad index "{bad}1": should be integer?[+-]integer? or end?[+-]integer?}}

test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1 2}
    list [testevalex {lset x 0 $x}] $x
} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1}

    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list 2a2] w}
    } msg] $msg
} {1 {bad index "2a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list -1] w}
    } msg] $msg
} {1 {list index out of range}}
test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {

    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 2a2 w}
    } msg] $msg
} {1 {bad index "2a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a -1 w}
    } msg] $msg
} {1 {list index out of range}}
test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {

test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
    set a [list "a \{" b]
    list [catch {testevalex {lset a {0 1} c}} msg] $msg
} {1 {unmatched open brace in list}}
test lset-8.3 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
} {1 {bad index "2a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lset-8.4 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
} {1 {bad index "2a2": should be integer?[+-]integer? or end?[+-]integer?}}
test lset-8.5 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 -1 h}} msg] $msg
} {1 {list index out of range}}
test lset-8.6 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 -1} h}} msg] $msg

test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
    namespace wombat {}
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": should be *}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
    namespace ch :: test_ns_*
} {}

test namespace-21.1 {NamespaceChildrenCmd, no args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}

test namespace-25.1 {NamespaceEvalCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
test namespace-25.2 {NamespaceEvalCmd, bad args} -body {
    namespace test_ns_1
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": should be *}
catch {unset v}
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
    set v 123
    namespace eval test_ns_1 {
        variable v 314159
        proc p {} {
            variable v

    }
    set result [list [ns x1] [ns x2]]
    lappend result [catch {ns x} msg] $msg
    rename ns {}
    lappend result [info command ns::x1]
    namespace delete ns
    lappend result [info command ns::x1]
} {1 2 1 {unknown or ambiguous subcommand "x": should be x1, or x2} ::ns::x1 {}}
test namespace-42.4 {ensembles: basic} -body {
    namespace eval ns {
	namespace export y*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create
    }

	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [catch {ns x} msg] $msg
} -cleanup {
    namespace delete ns
} -result {1 {unknown or ambiguous subcommand "x": should be x1, x2, or x3}}
test namespace-42.6 {ensembles: nested} -body {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {} {format 0}
	    namespace export z
	    namespace ensemble create

	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create -map {a x1 b x2}
    }
    set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]]
    rename ns {}
    lappend result [namespace ensemble exists ns]
} {1 {unknown or ambiguous subcommand "c": should be a, or b} 1 0}
test namespace-43.2 {ensembles: dict-driven} -body {
    namespace eval ns {
	namespace export x*
	proc x1 {args} {list 1 $args}
	proc x2 {args} {list 2 [llength $args]}
	namespace ensemble create -map {
	    a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .}

    }
}
test namespace-43.3 {ensembles: list-driven} -setup $SETUP -body {
    namespace delete ns
} -result {}
test namespace-43.4 {ensembles: list-driven} -setup $SETUP -body {
    ns a foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": should be b, or c}
test namespace-43.5 {ensembles: list-driven} -setup $SETUP -body {
    ns b foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 2,5
test namespace-43.6 {ensembles: list-driven} -setup $SETUP -body {
    ns c foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 3,5
test namespace-43.7 {ensembles: list-driven} -setup $SETUP -body {
    ns d foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": should be b, or c}
set SETUP {
    namespace eval ns {
	namespace export a b
	proc a args {format 1,[llength $args]}
	proc b args {format 2,[llength $args]}
	proc c args {format 3,[llength $args]}
	proc d args {format 4,[llength $args]}
	namespace ensemble create -subcommands {b c} -map {c ::ns::d}
    }
}
test namespace-43.8 {ensembles: list-and-map-driven} -setup $SETUP -body {
    namespace delete ns
} -result {}
test namespace-43.9 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns a foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": should be b, or c}
test namespace-43.10 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns b foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 2,5
test namespace-43.11 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns c foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 4,5
test namespace-43.12 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns d foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": should be b, or c}
set SETUP {
    namespace eval ns {
	namespace export *
	proc foo args {format bar}
	proc spong args {format wibble}
	namespace ensemble create -prefixes off
    }
}
test namespace-43.13 {ensembles: turn off prefixes} -setup $SETUP -body {
    namespace delete ns
} -result {}
test namespace-43.14 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns fo
} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "fo": should be foo, or spong}
test namespace-43.15 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns foo
} -cleanup {namespace delete ns} -result bar
test namespace-43.16 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns s
} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "s": should be foo, or spong}
test namespace-43.17 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns spong
} -cleanup {namespace delete ns} -result wibble

test namespace-44.1 {ensemble: errors} {
    list [catch {namespace ensemble} msg] $msg
} {1 {wrong # args: should be "namespace ensemble subcommand ?arg ...?"}}
test namespace-44.2 {ensemble: errors} {
    list [catch {namespace ensemble ?} msg] $msg
} {1 {bad subcommand "?": should be configure, create, or exists}}
test namespace-44.3 {ensemble: errors} {
    namespace eval ns {
	list [catch {namespace ensemble create -map x} msg] $msg
    }
} {1 {missing value to go with key}}
test namespace-44.4 {ensemble: errors} {
    namespace eval ns {
	list [catch {namespace ensemble create -map {x {}}} msg] $msg
    }
} {1 {ensemble subcommand implementations should be non-empty lists}}
test namespace-44.5 {ensemble: errors} -setup {
    namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure}
} -body {
    foobar foobarcon
} -cleanup {
    rename foobar {}
} -returnCodes error -result {invalid command name "::foobarconfigure"}

    catch {ns ?} msg; set result [list $msg]
    namespace eval ns {namespace export x*}
    catch {ns ?} msg; lappend result $msg
    rename ns::x1 {}
    catch {ns ?} msg; lappend result $msg
    namespace delete ns
    set result
} {{unknown or ambiguous subcommand "?": should be x1} {unknown or ambiguous subcommand "?": should be x1, or x2} {unknown or ambiguous subcommand "?": should be x2}}
test namespace-46.3 {ensemble: implementation errors} {
    namespace eval ns {
	variable count 0
	namespace ensemble create -map {
	    a {::lappend ::result}
	    b {::incr ::ns::count}
	}

	namespace ensemble create -map {a a} -prefixes 0
    }
    set result [list [catch {ns x} msg] $msg]
    namespace ensemble configure ns -map {b b}
    lappend result [catch {ns x} msg] $msg
    namespace delete ns
    set result
} {1 {unknown subcommand "x": should be a} 1 {unknown subcommand "x": should be b}}

test namespace-47.1 {ensemble: unknown handler} {
    set log {}
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    global log

	    variable count
	    incr count
	    proc b {} {}
	}
	namespace ensemble create -unknown ::ns::Magic
    }
    list [catch {ns spong} msg] $msg $ns::count [namespace delete ns]
} {1 {unknown or ambiguous subcommand "spong": should be a, b, or c} 1 {}}
test namespace-47.4 {ensemble: unknown handler} {
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    return -code break
	}
	namespace ensemble create -unknown ::ns::Magic

    rename ns {}
    lappend result [info command ns::x1]
    namespace delete ns
    lappend result [info command ns::x1]
} -result\
   {{1 x2} {2 x1}\
    1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\
    1 {unknown or ambiguous subcommand "x": should be x1, or x2}\
    ::ns::x1 {}}
test namespace-53.4 {ensembles: parameters} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {a1 a2} {list 1 $a1 $a2}
	proc x2 {a1 a2} {list 2 $a1 $a2}
	proc x3 {a1 a2} {list 3 $a1 $a2}

    lappend result [catch {ns x1 x} msg] $msg
    namespace ensemble configure ns -parameters p1
    lappend result [catch {ns x1 x} msg] $msg
    lappend result [catch {ns x x1} msg] $msg
} -cleanup {
    namespace delete ns
} -result\
   {1 {unknown or ambiguous subcommand "x": should be x1, x2, or x3}\
    0 {1 x}\
    1 {unknown or ambiguous subcommand "x": should be x1, x2, or x3}\
    0 {1 x}}
test namespace-53.6 {ensembles: nested} -setup {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {args} {list 0 $args}
	    namespace export z

    lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
    lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters]
} -cleanup {
    namespace delete ns
} -result\
   {0 {1 x2} {}\
    0 {1 x2} p1\
    1 {unknown or ambiguous subcommand "x2": should be x1} {}}
test namespace-53.9 {ensemble: unknown handler changing -parameters,\
  thereby eating all args} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {args} {list 1 $args}
	proc Magic {ensemble subcmd args} {
	    namespace ensemble configure $ensemble\

    lappend result [testobj refcount 1]
} {{} 12 12 bytearray 3}

test obj-3.1 {Tcl_ConvertToType error} testobj {
    list [testdoubleobj set 1 12.34] \
	[catch {testobj convert 1 end-offset} msg] \
	 $msg
} {12.34 1 {bad index "12.34": should be end?[+-]integer?}}
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
    list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
} {{} 1 {bad index "": should be end?[+-]integer?}}

test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]

    while executing
\"oo::define oo::object method missingArgs\""
test oo-1.4 {basic test of OO functionality} -body {
    oo::object create {}
} -returnCodes 1 -result {object name must not be empty}
test oo-1.5 {basic test of OO functionality} -body {
    oo::object doesnotexist
} -returnCodes 1 -result {unknown method "doesnotexist": should be create, destroy or new}
test oo-1.5.1 {basic test of OO functionality} -setup {
    oo::object create aninstance
} -returnCodes error -body {
    aninstance
} -cleanup {
    rename aninstance {}
} -result {wrong # args: should be "aninstance method ?arg ...?"}

test oo-4.1 {basic test of OO functionality: export} {
    set o [oo::object new]
    set result {}
    oo::objdefine $o method Foo {} {lappend ::result Foo; return}
    lappend result [catch {$o Foo} msg] $msg
    oo::objdefine $o export Foo
    lappend result [$o Foo] [$o destroy]
} {1 {unknown method "Foo": should be destroy} Foo {} {}}
test oo-4.2 {basic test of OO functionality: unexport} {
    set o [oo::object new]
    set result {}
    oo::objdefine $o method foo {} {lappend ::result foo; return}
    lappend result [$o foo]
    oo::objdefine $o unexport foo
    lappend result [catch {$o foo} msg] $msg [$o destroy]
} {foo {} 1 {unknown method "foo": should be destroy} {}}
test oo-4.3 {exporting and error messages, Bug 1824958} -setup {
    oo::class create testClass
} -cleanup {
    testClass destroy
} -body {
    oo::define testClass self export Bad
    testClass Bad
} -returnCodes 1 -result {unknown method "Bad": should be create, destroy or new}
test oo-4.4 {exporting a class method from an object} -setup {
    oo::class create testClass
    testClass create testObject
} -cleanup {
    testClass destroy
} -body {
    oo::define testClass method Good {} { return ok }

} -body {
    oo::objdefine oo::object method foo {} { return "in object" }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": should be destroy} {in object}}
test oo-5.2 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::define oo::object self method foo {} { return "in object" }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": should be destroy} {in object}}
test oo-5.3 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::objdefine oo::object {
	method foo {} { return "in object" }
    }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": should be destroy} {in object}}
test oo-5.4 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::define oo::object {
	self method foo {} { return "in object" }
    }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": should be destroy} {in object}}
test oo-5.5 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::define oo::object {
	self {
	    method foo {} { return "in object" }
	}
    }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": should be destroy} {in object}}

test oo-6.1 {OO: forward} {
    oo::object create foo
    oo::objdefine foo {
	forward a lappend
	forward b lappend result
    }

    oo::define subClass superclass superClass
    set result [list [catch {subClass doit bad} msg] $msg]
    instance doit ok
    return $result
} -cleanup {
    subClass destroy
    superClass destroy
} -result {1 {unknown method "doit": should be create, destroy or new} ok}
test oo-7.2 {OO: inheritance 101} -setup {
    oo::class create superClass
    oo::class create subClass
    subClass create instance
} -body {
    oo::define superClass method doit x {
	lappend ::result |$x|

    lappend result [meta make classinstance {
	lappend ::result "in definition script in [namespace current]"
    }]
    lappend result [classinstance create instance]
} -cleanup {
    catch {classinstance destroy}
    catch {meta destroy}
} -result {1 {unknown method "create": should be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body {
    oo::class create other
    oo::class create meta {
	superclass other oo::class
	self {
	    unexport create new
	    method make {x {definitions {}}} {

	lappend ::result "in definition script in [namespace current]"
    }]
    lappend result [classinstance create instance]
} -cleanup {
    catch {classinstance destroy}
    catch {meta destroy}
    catch {other destroy}
} -result {1 {unknown method "create": should be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup {
    oo::class create Aclass
    oo::class create Bclass
    Bclass create Binstance
} -body {
    oo::define Aclass {
	method incr {var step} {

    oo::objdefine c method foo {} { next }
    catch {c ?} msg
    set result [list $msg]
    catch {c foo} msg
    lappend result $msg $errorInfo
} -cleanup {
    A destroy
} -result {{unknown method "?": should be destroy or foo} foo! {foo!
    while executing
"error foo!"
    (class "::A" method "foo" line 1)
    invoked from within
"next "
    (class "::B" method "foo" line 1)
    invoked from within

    set result [list [catch {fooTest ?} msg] $msg]
    fooTest bar
    fooTest boo
    fooTest2 bar
    fooTest2 boo
    oo::objdefine fooTest2 mixin
    lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy]
} {1 {unknown method "?": should be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}}
test oo-14.2 {OO: mixins} {
    oo::class create Aclass {
	method bar {} {return "[self object] in bar"}
    }
    oo::class create Bclass {
	method boo {} {return "[self object] in boo"}
    }
    oo::define Aclass mixin Bclass
    Aclass create fooTest
    set result [list [catch {fooTest ?} msg] $msg]
    lappend result [catch {fooTest bar} msg] $msg
    lappend result [catch {fooTest boo} msg] $msg
    lappend result [Bclass destroy] [info commands Aclass]
} {1 {unknown method "?": should be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}}
test oo-14.3 {OO and mixins and filters - advanced case} -setup {
    oo::class create mix
    oo::class create c {
	mixin mix
    }
    c create i
} -body {

    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
    info object gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": should be call, class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list [list [info object class oo::object] \
	      [info object class oo::class] \
	      [info object class meta] \

} -body {
    info class superclass foo
} -returnCodes 1 -cleanup {
    foo destroy
} -result {"foo" is not a class}
test oo-17.4 {OO: class introspection} -body {
    info class gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": should be call, constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
test oo-17.5 {OO: class introspection} -setup {
    oo::class create testClass
} -body {
    testClass create foo
    testClass create bar
    testClass create spong
    lsort [info class instances testClass]

    cls destroy
} -returnCodes error -body {
    oo::define cls {
	method dummy {} {}
	method unknown args {next {*}$args}
    }
    [cls new] foo bar
} -result {unknown method "foo": should be destroy, dummy or unknown}
test oo-24.2 {unknown method method - Bug 1965063} -setup {
    oo::class create cls
} -cleanup {
    cls destroy
} -returnCodes error -body {
    oo::define cls {
	method dummy {} {}
	method unknown args {next {*}$args}
    }
    cls create obj
    oo::objdefine obj {
	method dummy2 {} {}
	method unknown args {next {*}$args}
    }
    obj foo bar
} -result {unknown method "foo": should be destroy, dummy, dummy2 or unknown}
test oo-24.3 {unknown method method - absent method name} -setup {
    set o [oo::object new]
} -cleanup {
    $o destroy
} -body {
    oo::objdefine $o method unknown args {
	return "unknown: >>$args<<"

	variable -? y
	method boo {} {
	    return [incr x],[incr y]
	}
    }
    foo create bar
    list [bar boo] [bar boo]
} -returnCodes error -match glob -result {unknown method "-?": should be *}
test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup {
    oo::class create Foo
    set result {}
} -body {
    # This is really a test of problems to do with Tcl's introspection when a
    # variable resolver is present...
    oo::define Foo {

test oo-33.4 {TIP 380: slots - errors} -setup {
    set s [SampleSlot new]
} -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup {
    rename $s {}
} -result {unknown method "-grill": should be -append, -clear, -set, contents or ops}

SampleSlot destroy

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {

    ::pkg::create -version 1.0 -source test.tcl -load foo.so
} -returnCodes error -match glob -result {value for "-name" missing: *}
test package-1.5 {pkg::create gives error on no version given} -body {
    ::pkg::create -name foo -source test.tcl -load foo.so
} -returnCodes error -match glob -result {value for "-version" missing: *}
test package-1.6 {pkg::create gives error on no source or load options} -body {
    ::pkg::create -name foo -version 1.0 -version 2.0
} -returnCodes error -result {at least one of -load and -source should be given}
test package-1.7 {pkg::create gives correct output for 1 direct source} {
    ::pkg::create -name foo -version 1.0 -source test.tcl
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]}
test package-1.8 {pkg::create gives correct output for 2 direct sources} {
    ::pkg::create -name foo -version 1.0 -source test.tcl -source test2.tcl
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list source [file join $dir test2.tcl]]}
test package-1.9 {pkg::create gives correct output for 1 direct load} {

    package vs 2.3 2.1
} {1}
test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 1.2
} {0}
test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body {
    package foo
} -returnCodes error -result {bad option "foo": should be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies 2.1 2.1-3.2-4.5
} -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"}
test package-4.55 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies 2.1 3.2-x.y
} -returnCodes error -result {expected version number but got "x.y"}
test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {

} -result latest

test package-14.0 {wrong\#args} -returnCodes error -body {
    package prefer foo bar
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": should be latest or stable}

test package-15.0 {set, keep} {package prefer stable} stable
test package-15.1 {set stable, keep} {prefer stable} {stable stable}
test package-15.2 {set latest, change} {prefer latest} {stable latest}
test package-15.3 {set latest, keep} {
    prefer latest latest
} {stable latest latest}

    list [catch {tproc continue} msg] $msg
} {4 abc}
test proc-old-7.6 {return with special completion code} {
    list [catch {tproc -14} msg] $msg
} {-14 abc}
test proc-old-7.7 {return with special completion code} -body {
    tproc err
} -returnCodes error -match glob -result {bad completion code "err": should be ok, error, return, break, continue*, or an integer}
test proc-old-7.8 {return with special completion code} -body {
    tproc 10b
} -returnCodes error -match glob -result {bad completion code "10b": should be ok, error, return, break, continue*, or an integer}
test proc-old-7.9 {return with special completion code} {
    proc tproc2 {} {
	tproc return
    }
    list [catch tproc2 msg] $msg
} {0 abc}
test proc-old-7.10 {return with special completion code} {

    list [catch {regexp a} msg] $msg
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
test regexp-6.2 {regexp errors} {
    list [catch {regexp -nocase a} msg] $msg
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
test regexp-6.3 {regexp errors} {
    list [catch {regexp -gorp a} msg] $msg
} {1 {bad option "-gorp": should be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexp-6.4 {regexp errors} {
    list [catch {regexp a( b} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.5 {regexp errors} {
    list [catch {regexp a( b} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.6 {regexp errors} {
    list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
} {0 1}
test regexp-6.7 {regexp errors} {
    list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
} {0 0}
test regexp-6.8 {regexp errors} -setup {
    unset -nocomplain f1
} -body {
    set f1 44
    regexp abc abc f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-6.9 {regexp errors, -start bad int check} {
    list [catch {regexp -start bogus {^$} {}} msg] $msg
} {1 {bad index "bogus": should be integer?[+-]integer? or end?[+-]integer?}}
test regexp-6.10 {regexp errors} {
    list [catch {regexp {a[} b} msg] $msg
} {1 {couldn't compile regular expression pattern: brackets [] not balanced}}

test regexp-7.1 {basic regsub operation} {
    list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
} {1 xax111aaa222xaa}

    list [catch {regsub -nocase -all a b} msg] $msg
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
test regexp-11.4 {regsub errors} {
    list [catch {regsub a b c d e f} msg] $msg
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
test regexp-11.5 {regsub errors} {
    list [catch {regsub -gorp a b c} msg] $msg
} {1 {bad option "-gorp": should be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
test regexp-11.6 {regsub errors} {
    list [catch {regsub -nocase a( b c d} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-11.7 {regsub errors} -setup {
    unset -nocomplain f1
} -body {
    set f1 44
    regsub -nocase aaa aaa xxx f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-11.8 {regsub errors, -start bad int check} {
    list [catch {regsub -start bogus pattern string rep var} msg] $msg
} {1 {bad index "bogus": should be integer?[+-]integer? or end?[+-]integer?}}
test regexp-11.9 {regsub without final variable name returns value} {
    regsub b abaca X
} {aXaca}
test regexp-11.10 {regsub without final variable name returns value} {
    regsub -all a abaca X
} {XbXcX}
test regexp-11.11 {regsub without final variable name returns value} {

	list [catch {regexp -nocase a} msg] $msg
    }
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
test regexpComp-6.3 {regexp errors} {
    evalInProc {
	list [catch {regexp -gorp a} msg] $msg
    }
} {1 {bad option "-gorp": should be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexpComp-6.4 {regexp errors} {
    evalInProc {
	list [catch {regexp a( b} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-6.5 {regexp errors} {
    evalInProc {

	list [catch {regexp abc abc f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-6.9 {regexp errors, -start bad int check} {
    evalInProc {
	list [catch {regexp -start bogus {^$} {}} msg] $msg
    }
} {1 {bad index "bogus": should be integer?[+-]integer? or end?[+-]integer?}}

test regexpComp-7.1 {basic regsub operation} {
    evalInProc {
	list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
    }
} {1 xax111aaa222xaa}
test regexpComp-7.2 {basic regsub operation} {

	list [catch {regsub a b c d e f} msg] $msg
    }
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
test regexpComp-11.5 {regsub errors} {
    evalInProc {
	list [catch {regsub -gorp a b c} msg] $msg
    }
} {1 {bad option "-gorp": should be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
test regexpComp-11.6 {regsub errors} {
    evalInProc {
	list [catch {regsub -nocase a( b c d} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-11.7 {regsub errors} {
    evalInProc {
	unset -nocomplain f1
	set f1 44
	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-11.8 {regsub errors, -start bad int check} {
    evalInProc {
	list [catch {regsub -start bogus pattern string rep var} msg] $msg
    }
} {1 {bad index "bogus": should be integer?[+-]integer? or end?[+-]integer?}}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want... 
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    evalInProc {

    list [catch {registry -32bit} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1b {argument parsing for registry command} {win reg} {
    list [catch {registry -64bit} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.2 {argument parsing for registry command} {win reg} {
    list [catch {registry foo} msg] $msg
} {1 {bad option "foo": should be broadcast, delete, get, keys, set, type, or values}}
test registry-1.2a {argument parsing for registry command} {win reg} {
    list [catch {registry -33bit foo} msg] $msg
} {1 {bad mode "-33bit": should be -32bit or -64bit}}

test registry-1.3 {argument parsing for registry command} {win reg} {
    list [catch {registry d} msg] $msg
} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
test registry-1.3a {argument parsing for registry command} {win reg} {
    list [catch {registry -32bit d} msg] $msg
} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}}

} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
test registry-1.23 {argument parsing for registry command} {win reg} {
    list [catch {registry values foo bar baz} msg] $msg
} {1 {wrong # args: should be "registry values keyName ?pattern?"}}

test registry-2.1 {DeleteKey: bad key} {win reg} {
    list [catch {registry delete foo} msg] $msg
} {1 {bad root name "foo": should be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
test registry-2.2 {DeleteKey: bad key} {win reg} {
    list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg
} {1 {bad key: cannot delete root keys}}
test registry-2.3 {DeleteKey: bad key} {win reg} {
    list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
} {1 {bad key: cannot delete root keys}}
test registry-2.4 {DeleteKey: subkey at root level} {win reg} {

    registry values \\
} -returnCodes error -result "bad key \"\\\": must start with a valid root"
test registry-9.2 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\foobar
} -returnCodes error -result {bad key "\foobar": must start with a valid root}
test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\
} -returnCodes error -result {bad root name "": should be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\\\
} -returnCodes error -result {bad root name "": should be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english nt} -body {
    registry values \\\\\\HKEY_CLASSES_ROOT
} -returnCodes error -result {unable to open key: The network address is invalid.}
test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\gaspode
} -returnCodes error -result {bad root name "": should be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values foobar
} -returnCodes error -result {bad root name "foobar": should be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.8 {ParseKeyName: null keys} -constraints {win reg} -body {
    registry delete HKEY_CLASSES_ROOT\\
} -returnCodes error -result {bad key: cannot delete root keys}
test registry-9.9 {ParseKeyName: null keys} \
    -constraints {win reg english} \
    -body {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} \
    -returnCodes error \

} -result {wrong # args: should be "encoding option ?arg ...?"}
test safe-11.1a {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding foobar
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -match glob -result {bad option "foobar": should be *}
test safe-11.2 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding system cp775
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding system"}

    }
    foo
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": should be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {

    }
    list [catch {foo 1} msg] $msg
} {0 {}}
test set-old-8.22 {array command, names option} {
    catch {unset a}
    set a(22) 3
    list [catch {array names a 4 5} msg] $msg
} {1 {bad option "4": should be -exact, -glob, or -regexp}}
test set-old-8.23 {array command, names option} {
    catch {unset a}
    array names a
} {}
test set-old-8.24 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx

    socket -myport xxxx
} -returnCodes error -result {expected integer but got "xxxx"}
test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport 2522
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -froboz
} -returnCodes error -result {bad option "-froboz": should be -async, -myaddr, -myport, or -server}
test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}
test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket host 2528 -junk
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {

testConstraint testindexobj [expr {[info commands testindexobj] != {}}]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]

test string-1.1 {error conditions} {
    list [catch {string gorp a b} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": should be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2 {error conditions} {
    list [catch {string} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}

test string-2.1 {string compare, too few args} {
    list [catch {string compare a} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.2 {string compare, bad args} {
    list [catch {string compare a b c} msg] $msg
} {1 {bad option "a": should be -length or -nocase}}
test string-2.3 {string compare, bad args} {
    list [catch {string compare -length -nocase str1 str2} msg] $msg
} {1 {expected integer but got "-nocase"}}
test string-2.4 {string compare, too many args} {
    list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.5 {string compare with length unspecified} {

} 1

test string-4.1 {string first, too few args} {
    list [catch {string first a} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2 {string first, bad args} {
    list [catch {string first a b c} msg] $msg
} {1 {bad index "c": should be integer?[+-]integer? or end?[+-]integer?}}
test string-4.3 {string first, too many args} {
    list [catch {string first a b 5 d} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.4 {string first} {
    string first bq abcdefgbcefgbqrs
} 12
test string-4.5 {string first} {

    string index abcde 5
} {}
test string-5.6 {string index} {
    list [catch {string index abcde -10} msg] $msg
} {0 {}}
test string-5.7 {string index} {
    list [catch {string index a xyz} msg] $msg
} {1 {bad index "xyz": should be integer?[+-]integer? or end?[+-]integer?}}
test string-5.8 {string index} {
    string index abc end
} c
test string-5.9 {string index} {
    string index abc end-1
} b
test string-5.10 {string index, unicode} {

    list [catch {string is alpha -failin str} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4 {string is, too many args} {
    list [catch {string is alpha -failin var -strict str more} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5 {string is, class check} {
    list [catch {string is bogus str} msg] $msg
} {1 {bad class "bogus": should be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6 {string is, ambiguous class} {
    list [catch {string is al str} msg] $msg
} {1 {ambiguous class "al": should be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7 {string is alpha, all ok} {
    string is alpha -strict -failindex var abc
} 1
test string-6.8 {string is, error in var} {
    list [string is alpha -failindex var abc5def] $var
} {0 3}
test string-6.9 {string is, var shouldn't get set} {

catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.2 {string last, bad args} {
    list [catch {string last a b c} msg] $msg
} {1 {bad index "c": should be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3 {string last, too many args} {
    list [catch {string last a b c d} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.4 {string last} {
    string la xxx xxxx123xx345x678
} 1
test string-7.5 {string last} {

} 8

test string-10.1 {string map, too few args} {
    list [catch {string map} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
test string-10.2 {string map, bad args} {
    list [catch {string map {a b} abba oops} msg] $msg
} {1 {bad option "a b": should be -nocase}}
test string-10.3 {string map, too many args} {
    list [catch {string map -nocase {a b} str1 str2} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
test string-10.4 {string map} {
    string map {a b} abba
} {bbbb}
test string-10.5 {string map} {

    string match "" ""
} 1
test string-11.29 {string match} {
    string match \[a a
} 1
test string-11.30 {string match, bad args} {
    list [catch {string match - b c} msg] $msg
} {1 {ambiguous option "-": should be -nocase}}
test string-11.31 {string match case} {
    string match a A
} 0
test string-11.32 {string match nocase} {
    string match -n a A
} 1
test string-11.33 {string match nocase} {

    string range abcdefghijklmnop 1000 1010
} {}
test string-12.11 {string range} {
    string range abcdefghijklmnop -100 end
} {abcdefghijklmnop}
test string-12.12 {string range} {
    list [catch {string range abc abc 1} msg] $msg
} {1 {bad index "abc": should be integer?[+-]integer? or end?[+-]integer?}}
test string-12.13 {string range} {
    list [catch {string range abc 1 eof} msg] $msg
} {1 {bad index "eof": should be integer?[+-]integer? or end?[+-]integer?}}
test string-12.14 {string range} {
    string range abcdefghijklmnop end-1 end
} {op}
test string-12.15 {string range} {
    string range abcdefghijklmnop end 1000
} {p}
test string-12.16 {string range} {

    string replace abcdefghijklmnop 1000 1010
} {abcdefghijklmnop}
test string-14.12 {string replace} {
    string replace abcdefghijklmnop -100 end
} {}
test string-14.13 {string replace} {
    list [catch {string replace abc abc 1} msg] $msg
} {1 {bad index "abc": should be integer?[+-]integer? or end?[+-]integer?}}
test string-14.14 {string replace} {
    list [catch {string replace abc 1 eof} msg] $msg
} {1 {bad index "eof": should be integer?[+-]integer? or end?[+-]integer?}}
test string-14.15 {string replace} {
    string replace abcdefghijklmnop end-10 end-2 NEW
} {abcdeNEWop}
test string-14.16 {string replace} {
    string replace abcdefghijklmnop 0 end foo
} {foo}
test string-14.17 {string replace} {
    string replace abcdefghijklmnop end end-1
} {abcdefghijklmnop}

test string-15.1 {string tolower too few args} {
    list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2 {string tolower bad args} {
    list [catch {string tolower a b} msg] $msg
} {1 {bad index "b": should be integer?[+-]integer? or end?[+-]integer?}}
test string-15.3 {string tolower too many args} {
    list [catch {string tolower ABC 1 end oops} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.4 {string tolower} {
    string tolower ABCDeF
} {abcdef}
test string-15.5 {string tolower} {

} b

test string-16.1 {string toupper} {
    list [catch {string toupper} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.2 {string toupper} {
    list [catch {string toupper a b} msg] $msg
} {1 {bad index "b": should be integer?[+-]integer? or end?[+-]integer?}}
test string-16.3 {string toupper} {
    list [catch {string toupper a 1 end oops} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.4 {string toupper} {
    string toupper abCDEf
} {ABCDEF}
test string-16.5 {string toupper} {

} B

test string-17.1 {string totitle} {
    list [catch {string totitle} msg] $msg
} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
test string-17.2 {string totitle} {
    list [catch {string totitle a b} msg] $msg
} {1 {bad index "b": should be integer?[+-]integer? or end?[+-]integer?}}
test string-17.3 {string totitle} {
    string totitle abCDEf
} {Abcdef}
test string-17.4 {string totitle} {
    string totitle "abc xYz"
} {Abc xyz}
test string-17.5 {string totitle} {

} \u1361ABC

test string-20.1 {string trimright errors} {
    list [catch {string trimright} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2 {string trimright errors} {
    list [catch {string trimg a} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": should be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3 {string trimright} {
    string trimright "    XYZ      "
} {    XYZ}
test string-20.4 {string trimright} {
    string trimright "   "
} {}
test string-20.5 {string trimright} {

    list [catch {string wordend a} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
test string-21.2 {string wordend} {
    list [catch {string wordend a b c} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
test string-21.3 {string wordend} {
    list [catch {string wordend a gorp} msg] $msg
} {1 {bad index "gorp": should be integer?[+-]integer? or end?[+-]integer?}}
test string-21.4 {string wordend} {
    string wordend abc. -1
} 3
test string-21.5 {string wordend} {
    string wordend abc. 100
} 4
test string-21.6 {string wordend} {

} 3
test string-21.14 {string wordend, unicode} {
    string wordend "\uc700\uc700 abc" 8
} 6

test string-22.1 {string wordstart} {
    list [catch {string word a} msg] $msg
} {1 {unknown or ambiguous subcommand "word": should be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2 {string wordstart} {
    list [catch {string wordstart a} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3 {string wordstart} {
    list [catch {string wordstart a b c} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4 {string wordstart} {
    list [catch {string wordstart a gorp} msg] $msg
} {1 {bad index "gorp": should be integer?[+-]integer? or end?[+-]integer?}}
test string-22.5 {string wordstart} {
    string wordstart "one two three_words" 400
} 8
test string-22.6 {string wordstart} {
    string wordstart "one two three_words" 2
} 0
test string-22.7 {string wordstart} {

} {0 2}

test string-26.1 {tcl::prefix, too few args} -body {
    tcl::prefix match a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"}
test string-26.2 {tcl::prefix, bad args} -body {
    tcl::prefix match a b c
} -returnCodes 1 -result {bad option "a": should be -error, -exact, or -message}
test string-26.2.1 {tcl::prefix, empty table} -body {
    tcl::prefix match {} foo
} -returnCodes 1 -result {bad option "foo": no valid options}
test string-26.3 {tcl::prefix, bad args} -body {
    tcl::prefix match -error "{}x" -exact str1 str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-26.3.1 {tcl::prefix, bad args} -body {

    tcl::prefix match {apa bepa cepa depa} cepa
} cepa
test string-26.6 {tcl::prefix} {
    tcl::prefix match {apa bepa cepa depa} be
} bepa
test string-26.7 {tcl::prefix} -body {
    tcl::prefix match -exact {apa bepa cepa depa} be
} -returnCodes 1 -result {bad option "be": should be apa, bepa, cepa, or depa}
test string-26.8 {tcl::prefix} -body {
    tcl::prefix match -message wombat {apa bepa bear depa} be
} -returnCodes 1 -result {ambiguous wombat "be": should be apa, bepa, bear, or depa}
test string-26.9 {tcl::prefix} -body {
    tcl::prefix match -error {} {apa bepa bear depa} be
} -returnCodes 0 -result {}
test string-26.10 {tcl::prefix} -body {
    tcl::prefix match -error {-level 1} {apa bepa bear depa} be
} -returnCodes 2 -result {ambiguous option "be": should be apa, bepa, bear, or depa}
test string-26.10.1 {tcl::prefix} -setup {
    proc _testprefix {args} {
        array set opts {-a x -b y -c y}
        foreach {opt val} $args {
            set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt]
            set opts($opt) $val
        }
        array get opts
    }
} -body {
    set a [catch {_testprefix -x u} result options]
    dict get $options -errorinfo
} -cleanup {
    rename _testprefix {}
} -result {bad option "-x": should be -a, -b, or -c
    while executing
"_testprefix -x u"}

# Helper for memory stress tests
# Repeat each body in a local space checking that memory does not increase
proc MemStress {args} {
    set res {}

	return [expr {$end - $tmp}]
    }
}

test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": should be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3 {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.

set i 0
foreach {tname tbody tresult tcode} {
    {too few args} {
	string compare a
    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
    {bad args} {
	string compare a b c
    } {bad option "a": should be -length or -nocase} {error}
    {bad args} {
	string compare -length -nocase str1 str2
    } {expected integer but got "-nocase"} {error}
    {too many args} {
	string compare -length 10 -nocase str1 str2 str3
    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
    {compare with length unspecified} {