Tcl Source Code

	}
    }

    /*
     * Nobody's old enough?!? -- something's really wrong.
     */

    FDEBUG(("cannot find victim to replace!\n"));
    assert(NOTREACHED);
    ERR(REG_ASSERT);
    return d->ssets;
}

/*
 * Local Variables:

	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

    default:
	Tcl_Panic("Instruction \"%s\" could not be found, cannot happen\n",
		TclGetString(instNameObj));
    }

    status = TCL_OK;
 cleanup:
    Tcl_DecrRefCount(instNameObj);
    if (operand1Obj) {

    case INST_EVAL_STK:
	TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
	break;
    case INST_EXPR_STK:
	TclCompileExpr(interp, tokenPtr->start, tokenPtr->size, envPtr, 1);
	break;
    default:
	Tcl_Panic("no ASSEM_EVAL case for %s (%d), cannot happen",
		instPtr->name, instPtr->tclInstCode);
    }

    /*
     * Roll up the stack usage of the embedded block into the assembler
     * environment.
     */

	prevPtr = bbPtr;
    }

    /* Make sure that all catches are closed */

    if (catchDepth != 0) {
	Tcl_Panic("unclosed catch at end of code in "
		"tclAssembly.c:BuildExceptionRanges, cannot happen");
    }

    /* Free temp storage */

    Tcl_Free(catchIndices);
    Tcl_Free(catches);

		    TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
	    range->codeOffset = bbPtr->startOffset;

	    entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		    TclGetString(block->jumpTarget));
	    if (entryPtr == NULL) {
		Tcl_Panic("undefined label in tclAssembly.c:"
			"BuildExceptionRanges, cannot happen");
	    }

	    errorExit = (BasicBlock*)Tcl_GetHashValue(entryPtr);
	    range->catchOffset = errorExit->startOffset;
	}
    }
}

    Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS);

    iPtr->globalNsPtr = NULL;	/* Force creation of global ns below. */
    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
	    NULL, NULL);
    if (iPtr->globalNsPtr == NULL) {
	Tcl_Panic("Tcl_CreateInterp: cannot create global namespace");
    }

    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /*
     * Register the mathematical "operator" commands. [TIP #174]
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("cannot create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData));

     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot %s \"%s\": command doesn't exist",
		((newName == NULL) || (*newName == '\0')) ? "delete" : "rename",
		oldName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL);
	return TCL_ERROR;
    }

    /*

     */

    TclGetNamespaceForQualName(interp, newName, NULL,
	    TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);

    if ((newNsPtr == NULL) || (newTail == NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot rename to \"%s\": bad command name", newName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }
    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot rename to \"%s\": command already exists", newName));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
		"TARGET_EXISTS", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*

    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create procedure \"%s\": unknown namespace",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create procedure \"%s\": bad procedure name",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding

	    }
	}

	Tcl_SetObjResult(interp, listPtr);
	return TCL_OK;

    default:
	Tcl_Panic("QueryConfigObjCmd: Unknown subcommand to 'pkgconfig'. This cannot happen");
	break;
    }
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------

	}
    }

  endOfOptionLoop:
    if ((mask & (TCL_FILE_EVENTS | TCL_IDLE_EVENTS |
	    TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot wait: would block forever", -1));
	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }

    if ((timeout > 0) && ((mask & TCL_TIMER_EVENTS) == 0)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(

	    goto done;
	}
    }

    if (!foundEvent) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_NewStringObj((numItems == 0) ?
		"cannot wait: would wait forever" :
		"cannot wait for variable(s)/channel(s): would wait forever",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }

    if (!done && !timedOut) {

	Tcl_DecrRefCount(split);
	split = NULL;
    }

  done:
    if (errfile != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create directory \"%s\": %s",
		TclGetString(errfile), Tcl_PosixError(interp)));
	result = TCL_ERROR;
    }
    if (split != NULL) {
	Tcl_DecrRefCount(split);
    }
    if (target != NULL) {

	 * this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
		&& !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot overwrite file \"%s\" with directory \"%s\"",
		    TclGetString(target), TclGetString(source)));
	    goto done;
	}
	if (!S_ISDIR(sourceStatBuf.st_mode)
		&& S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot overwrite directory \"%s\" with file \"%s\"",
		    TclGetString(target), TclGetString(source)));
	    goto done;
	}

	/*
	 * The destination exists, but appears to be ok to over-write, and
	 * -force is given. We now try to adjust permissions to ensure the

	} else {
	    result = Tcl_FSDeleteFile(source);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("cannot unlink \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));
	    errfile = NULL;
	}
    }

  done:
    if (errfile != NULL) {

     */

    if (chan == NULL) {
	if (nameVarObj) {
	    TclDecrRefCount(nameObj);
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create temporary file: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    if (nameVarObj != NULL) {
	if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_UnregisterChannel(interp, chan);

    /*
     * Deal with results.
     */

    if (dirNameObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create temporary directory: %s",
		Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirNameObj);
    return TCL_OK;
}


     * Invoke the library's initialization function (either the normal one or
     * the safe one, depending on whether or not the interpreter is safe).
     */

    if (Tcl_IsSafe(target)) {
	if (libraryPtr->safeInitProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot use library in a safe interpreter: no"
		    " %s_SafeInit procedure", libraryPtr->prefix));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
		    (char *)NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = libraryPtr->safeInitProc(target);
    } else {
	if (libraryPtr->initProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot attach library to interpreter: no %s_Init procedure",
		    libraryPtr->prefix));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
		    (char *)NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = libraryPtr->initProc(target);

    /*
     * If we've ended up with an empty string now, we're attempting to create
     * the global namespace despite the global namespace existing. That's
     * naughty!
     */

    if (*name == '\0') {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot create namespace"
		" \"\": only global namespace can have empty name", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
		"CREATEGLOBAL", (char *)NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;
    }

	Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
#else
	parentPtr->childTablePtr != NULL &&
	Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
#endif
    ) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create namespace \"%s\": already exists", name));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
		"CREATEEXISTING", (char *)NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;
    }

    /*

     */

    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
		" \"%s\": pattern cannot specify a namespace", pattern));
	Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Make sure that we don't already have the pattern in the array
     */

		 * Repeated import of same command is acceptable.
		 */

		return TCL_OK;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot import command \"%s\": already exists", cmdName));
	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", (char *)NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

	/*
	 * Disallow creation of an object over an existing command.
	 */

	hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName);
	if (hPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot create object \"%s\": command already exists with"
		    " that name", nameStr));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", (char *)NULL);
	    return NULL;
	}
    }

    /*

     * as appropriate for the target type. This frees the old internal
     * representation.
     */

    if (typePtr->setFromAnyProc == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot convert value to type %s", typePtr->name));
	    Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", (char *)NULL);
	}
	return TCL_ERROR;
    }

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

    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    TclParseInit(interp, start, numBytes, parsePtr);
    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot parse a NULL pointer", -1));
	}
	return TCL_ERROR;
    }
    parsePtr->commentStart = NULL;
    parsePtr->commentSize = 0;
    parsePtr->commandStart = NULL;
    parsePtr->commandSize = 0;

	}
	*closePtr = 1;
    }
    return file;

  badLastArg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot specify \"%s\" as last word in command", arg));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", (char *)NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *

		inputFile = NULL;
		inputLiteral = p + 1;
		skip = 1;
		if (*inputLiteral == '\0') {
		    inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
		    if (inputLiteral == NULL) {
			Tcl_SetObjResult(interp, Tcl_ObjPrintf(
				"cannot specify \"%s\" as last word in command",
				argv[i]));
			Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
				"PIPESYNTAX", (char *)NULL);
			goto error;
		    }
		    skip = 2;
		}

     * Verify that the pipes that were created satisfy the readable/writable
     * constraints.
     */

    if (flags & TCL_ENFORCE_MODE) {
	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot read output from command:"
		    " standard output was redirected", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
		    "BADREDIRECT", (char *)NULL);
	    goto error;
	}
	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot write input to command:"
		    " standard input was redirected", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
		    "BADREDIRECT", (char *)NULL);
	    goto error;
	}
    }

    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    char *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name; /* Name of desired package. */

    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find package %s", name));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", (void *)NULL);
	AddRequirementsToResult(interp, reqc, reqv);
	return TCL_ERROR;
    }

    /*
     * Ensure that the provided version meets the current requirements.

    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create procedure \"%s\": unknown namespace",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (void *)NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot create procedure \"%s\": bad procedure name",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (void *)NULL);
	return TCL_ERROR;
    }

    /*
     * Create the data structure to represent the procedure.

     * Convert objPtr to list type first; if it cannot be converted, or if its
     * length is not 2, then it cannot be converted to lambdaType.
     */

    result = TclListObjLength(NULL, objPtr, &objc);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot interpret \"%s\" as a lambda expression",
		Tcl_GetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL);
	return TCL_ERROR;
    }
    result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot interpret \"%s\" as a lambda expression",
		TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL);
	return TCL_ERROR;
    }

    argsPtr = objv[0];
    bodyPtr = objv[1];

	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning. */
	    Tcl_Panic("TclParseNumber: state INITIAL cannot happen here");
	}
    }

    /*
     * Format an error message when an invalid number is encountered.
     */

	for (asyncPtr = firstHandler; asyncPtr != NULL;
		asyncPtr = asyncPtr->nextPtr) {
	    if (asyncPtr->id == id) {
		Tcl_ThreadId threadID;
		if (Tcl_CreateThread(&threadID, AsyncThreadProc,
			INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
			TCL_THREAD_NOFLAGS) != TCL_OK) {
		    Tcl_AppendResult(interp, "cannot create thread", (char *)NULL);
		    Tcl_MutexUnlock(&asyncTestMutex);
		    return TCL_ERROR;
		}
		break;
	    }
	}
	Tcl_MutexUnlock(&asyncTestMutex);

    joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;

    Tcl_MutexLock(&threadMutex);
    if (Tcl_CreateThread(&id, NewTestThread, &ctrl,
	    TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
	Tcl_MutexUnlock(&threadMutex);
	Tcl_AppendResult(interp, "cannot create a new thread", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Wait for the thread to start because it is using something on our stack!
     */

		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
			|| (varFramePtr == NULL)
			|| !HasLocalVars(varFramePtr)
			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		    "bad variable name \"%s\": cannot create namespace "
		    "variable that refers to procedure variable",
		    TclGetString(myNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL);
	    return TCL_ERROR;
	}
    }

	    p += strlen(p)-1;
	    if (*p == ')') {
		/*
		 * myName looks like an array reference.
		 */

		Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
			"bad variable name \"%s\": cannot create a scalar "
			"variable that looks like an array element", myName));
		Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
			(char *)NULL);
		return TCL_ERROR;
	    }
	}

		    TclGetString(myNamePtr), (char *)NULL);
	    return TCL_ERROR;
	}
    }

    if (varPtr == otherPtr) {
	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
		"cannot upvar from variable to itself", -1));
	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", (char *)NULL);
	return TCL_ERROR;
    }

    if (TclIsVarTraced(varPtr)) {
	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		"variable \"%s\" has traces: cannot use for upvar", myName));
	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", (char *)NULL);
	return TCL_ERROR;
    } else if (!TclIsVarUndefined(varPtr)) {
	Var *linkPtr;

	/*
	 * The variable already existed. Make sure this variable "varPtr"

{
    if (!part1Ptr) {
	if (index == -1) {
	    Tcl_Panic("invalid part1Ptr and invalid index together");
	}
	part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("cannot %s \"%s%s%s%s\": %s",
	    operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
	    (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
	    reason));
}

/*
 *----------------------------------------------------------------------

    # Source init.tcl and tm.tcl into the child, to get auto_load and
    # other procedures defined:

    if {[catch {::interp eval $child {
	source [file join $tcl_library init.tcl]
    }} msg opt]} {
	Log $child "cannot source init.tcl ($msg)"
	return -options $opt "cannot source init.tcl into child $child ($msg)"
    }

    if {[catch {::interp eval $child {
	source [file join $tcl_library tm.tcl]
    }} msg opt]} {
	Log $child "cannot source tm.tcl ($msg)"
	return -options $opt "cannot source tm.tcl into child $child ($msg)"
    }

    # Sync the paths used to search for Tcl modules. This can be done only
    # now, after tm.tcl was loaded.
    namespace upvar ::safe [VarName $child] state
    if {[llength $state(tm_path_child)] > 0} {
	::interp eval $child [list \

# Side effects:
#	Sets the variable tcltest::CustomMatch

proc tcltest::customMatch {mode script} {
    variable CustomMatch
    if {![info complete $script]} {
	return -code error \
		"invalid customMatch script; cannot evaluate after completion"
    }
    set CustomMatch($mode) $script
}

# tcltest::SubstArguments list
#
# This helper function takes in a list of words, then perform a

#ifndef _DARWIN_C_SOURCE
    /*
     * Sanity check fd.
     */

    if (fd >= FD_SETSIZE) {
	Tcl_Panic("TclUnixWaitForFile cannot handle file id %d", fd);
	/* must never get here, or select masks overrun will occur below */
    }
#endif

    /*
     * If there is a non-zero finite timeout, compute the time when we give
     * up.

test append-3.1 {append errors} -returnCodes error -body {
    append
} -result {wrong # args: should be "append varName ?value ...?"}
test append-3.2 {append errors} -returnCodes error -body {
    set x ""
    append x(0) 44
} -result {cannot set "x(0)": variable isn't array}
test append-3.3 {append errors} -returnCodes error -body {
    unset -nocomplain x
    append x
} -result {cannot read "x": no such variable}
test append-3.4 {append surrogates} -body {
    set x \uD83D
    append x \uDE02
} -result \uD83D\uDE02
test append-3.5 {append surrogates} -body {
    set x \uD83D
    set x $x\uDE02

test append-6.1 {lappend errors} -returnCodes error -body {
    lappend
} -result {wrong # args: should be "lappend varName ?value ...?"}
test append-6.2 {lappend errors} -returnCodes error -body {
    set x ""
    lappend x(0) 44
} -result {cannot set "x(0)": variable isn't array}

test append-7.1 {lappend-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    trace add variable x write foo
    proc foo {} {global x; unset x}
    catch {lappend x 1}
    proc foo {args} {global x; unset x}
    info exists x
    set x
    lappend x 1
    list [info exists x] [catch {set x} msg] $msg
} -result {0 1 {cannot read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace add variable myvar read foo
    proc foo {args} {append ::result $args}
    lappend myvar a

} -result {wrong # args: should be "append varName ?value ...?"}
test appendComp-3.2 {append errors} -returnCodes error -body {
    proc foo {} {
	set x ""
	append x(0) 44
    }
    foo
} -result {cannot set "x(0)": variable isn't array}
test appendComp-3.3 {append errors} -returnCodes error -body {
    proc foo {} {
	unset -nocomplain x
	append x
    }
    foo
} -result {cannot read "x": no such variable}

test appendComp-4.1 {lappend command} {
    proc foo {} {
	global x
	unset -nocomplain x
	lappend x 1 2 abc "long string"
    }

} -result {wrong # args: should be "lappend varName ?value ...?"}
test appendComp-6.2 {lappend errors} -returnCodes error -body {
    proc foo {} {
	set x ""
	lappend x(0) 44
    }
    foo
} -result {cannot set "x(0)": variable isn't array}

test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    proc bar {} {
	global x
	trace add variable x write foo
	proc foo {} {global x; unset x}
	catch {lappend x 1}
	proc foo {args} {global x; unset x}
	info exists x
	set x
	lappend x 1
	list [info exists x] [catch {set x} msg] $msg
    }
    bar
} -result {0 1 {cannot read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace add variable myvar read foo
	proc foo {args} {append ::result $args}
	lappend myvar a

} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"}

# Tests for malformed lambda

test apply-2.0 {malformed lambda} -returnCodes error -body {
    set lambda a
    apply $lambda
} -result {cannot interpret "a" as a lambda expression}
test apply-2.1 {malformed lambda} -returnCodes error -body {
    set lambda [list a b c d]
    apply $lambda
} -result {cannot interpret "a b c d" as a lambda expression}
test apply-2.2 {malformed lambda} {
    set lambda [list {{}} boo]
    list [catch {apply $lambda} msg] $msg $::errorInfo
} {1 {argument with no name} {argument with no name
    (parsing lambda expression "{{}} boo")
    invoked from within
"apply $lambda"}}

	proc x {} {
	    assemble {push a; unsetStk true}
	    info exists a
	}
	x
    }
    -returnCodes error
    -result {cannot unset "a": no such variable}
    -cleanup {rename x {}}
}
test assemble-23.9 {unsetArrayStk} {
    -body {
	proc x {} {
	    set a(b) {}
	    assemble {push a; push b; unsetArrayStk false}

	proc x {} {
	    assemble {push a; push b; unsetArrayStk true}
	    info exists a(b)
	}
	x
    }
    -returnCodes error
    -result {cannot unset "a(b)": no such variable}
    -cleanup {rename x {}}
}

# assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray)

test assemble-24.1 {unset - wrong # args} {
    -body {

	proc x {} {
	    assemble {unset true a}
	    info exists a
	}
	x
    }
    -returnCodes error
    -result {cannot unset "a": no such variable}
    -cleanup {rename x {}}
}
test assemble-24.10 {unsetArray} {
    -body {
	proc x {} {
	    set a(b) {}
	    assemble {push b; unsetArray false a}

	proc x {} {
	    assemble {push b; unsetArray true a}
	    info exists a(b)
	}
	x
    }
    -returnCodes error
    -result {cannot unset "a(b)": no such variable}
    -cleanup {rename x {}}
}

# assemble-25 - dict get

test assemble-25.1 {dict get - wrong # args} {
    -body {

    list [test_ns_basic::p] \
         [rename test_ns_basic::p test_ns_basic::q] \
         [test_ns_basic::q]
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
test basic-18.2 {TclRenameCommand, existing cmd must be found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
} {1 {cannot rename "test_ns_basic::p": command doesn't exist}}
test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_basic {
        proc p {} {
            return "p in [namespace current]"
        }
    }

} -body {
    namespace eval test_ns_basic {
        proc q {} {
            return 42
        }
    }
    list [catch {rename test_ns_basic::q :::george::martha} msg] $msg
} -result {1 {cannot rename to ":::george::martha": command already exists}}
test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
    catch {rename q ""}
    proc p {} {
        return "p in [namespace current]"
    }

    binary scan abc a
} -result {not enough arguments for all format specifiers}
test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan abc a arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    set arg1 abc
    list [binary scan abc a0 arg1] $arg1
} -result {1 {}}
test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup {

    binary scan abc A
} -result {not enough arguments for all format specifiers}
test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan abc A arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    set arg1 abc
    list [binary scan abc A0 arg1] $arg1
} -result {1 {}}
test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup {

    list [binary scan \x52 b14 arg1] $arg1
} {0 foo}
test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 b1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1 arg2
} -body {
    set arg1 foo
    set arg2 bar
    list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
} -result {2 11100 1110000110100000}

    list [binary scan \x52 B14 arg1] $arg1
} {0 foo}
test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 B1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1 arg2
} -body {
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
} -result {2 01110 1000011100000101}

    list [binary scan \x52 h3 arg1] $arg1
} {0 foo}
test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 h1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1 arg2
} -body {
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
} -result {2 07 7850}

    list [binary scan \x52 H3 arg1] $arg1
} {0 foo}
test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 H1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-25.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
} {2 70 8705}

    list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 c1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-26.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
} {2 {112 -121} 5}
test binary-26.11 {Tcl_BinaryObjCmd: scan} {

    list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 s1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-27.10 {Tcl_BinaryObjCmd: scan} {

    list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 S1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-28.10 {Tcl_BinaryObjCmd: scan} {

    list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 i1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-29.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-29.10 {Tcl_BinaryObjCmd: scan} {

    list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 I1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-30.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-30.10 {Tcl_BinaryObjCmd: scan} {

    list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3F\xCC\xCC\xCD f1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {

    list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A d1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {

    list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 t1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {

    list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 t1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {

    list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 n1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {

    list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 n1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xA3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {

    list [binary scan \x52 q1 arg1] $arg1
} {0 foo}
test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A q1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3F\xF9\x99\x99\x99\x99\x99\x9A\x40\x0B\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {

    list [binary scan \x52 r1 arg1] $arg1
} {0 foo}
test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3F\xCC\xCC\xCD r1 arg1(a)
} -result {cannot set "arg1(a)": variable isn't array}
test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3F\xCC\xCC\xCD\x40\x59\x99\x9A\x05 R2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {

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

	$errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
    unset -nocomplain x
} -body {
    set x 44
    list [catch {file lstat $gorpfile x} msg] $msg $errorCode
} -result {1 {cannot set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}}
unset -nocomplain stat
# mkdir
set dirA [file join [temporaryDirectory] a]
set dirB [file join [temporaryDirectory] a]
test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup {
    catch {file delete -force $dirA}
} -body {

    list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain x
} -returnCodes error -body {
    set x 44
    file stat $gorpfile x
} -result {cannot set "x(dev)": variable isn't array}
test cmdAH-28.8 {Tcl_FileObjCmd: stat} -setup {
    set filename [makeFile "" foo.text]
} -body {
    # Sign extension of purported unsigned short to int.
    file stat $filename stat
    expr {$stat(mode) > 0}
} -cleanup {

test cmdAH-33.6 {file tempdir: missing parent dir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -returnCodes error -body {
    file tempdir $base/quux/
} -cleanup {
    catch {file delete -force $base}
} -result {cannot create temporary directory: no such file or directory}
test cmdAH-33.7 {file tempdir: missing parent dir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -returnCodes error -body {
    file tempdir $base/quux/foobar
} -cleanup {
    catch {file delete -force $base}
} -result {cannot create temporary directory: no such file or directory}

# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}

interp delete safeInterp
interp delete simpleInterp

    }}
} -result {b a}
test cmdIL-6.10 {lassign command - variable update error} -body {
    apply {{} {
	set x(x) {}
	lassign a x
    }}
} -returnCodes error -result {cannot set "x": variable is array}
test cmdIL-6.11 {lassign command - variable update error} -body {
    apply {{} {
	set x(x) {}
	set y FAIL
	list [catch {lassign a y x} msg] $msg $y
    }}
} -result {1 {cannot set "x": variable is array} a}
test cmdIL-6.12 {lassign command - memory leak testing} -setup {
    unset -nocomplain x y
    set x(x) {}
    set y FAIL
    proc getbytes {} {
        set lines [split [memory info] "\n"]
        lindex [lindex $lines 3] 3

} -result {b a}
test cmdIL-6.22 {lassign command - variable update error} -body {
    apply {{} {
	set lassign lassign
	set x(x) {}
	$lassign a x
    }}
} -returnCodes 1 -result {cannot set "x": variable is array}
test cmdIL-6.23 {lassign command - variable update error} -body {
    apply {{} {
	set lassign lassign
	set x(x) {}
	set y FAIL
	list [catch {$lassign a y x} msg] $msg $y
    }}
} -result {1 {cannot set "x": variable is array} a}
test cmdIL-6.24 {lassign command - memory leak testing} -setup {
    set x(x) {}
    set y FAIL
    proc getbytes {} {
        set lines [split [memory info] "\n"]
        lindex [lindex $lines 3] 3
    }

    set a(george) martha
    set b geo
    expr {$a(${b}rge)}
} -result martha
test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body {
    unset -nocomplain a
    expr {$a + 17}
} -returnCodes error -result {cannot read "a": no such variable}
test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} {
    expr {27||3? 3<<(1+4) : 4&&9}
} 96
test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
    unset -nocomplain a
} -body {
    set a 15

		} result2 options2]
		incr count
	    }
	    list $count $result2
	}
	catchtest::x
    }
    -result {10 {cannot set "result1": trace on result1 fails by request}}
    -cleanup {namespace delete catchtest}
}

test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
     -setup {
	 namespace eval catchtest {
	     variable options1 {}

		} result2 options2]
		incr count
	    }
	    list $count $result2
	}
	catchtest::x
    }
    -result {10 {cannot set "options1": trace on options1 fails by request}}
    -cleanup {namespace delete catchtest}
}

test compile-4.1 {TclCompileForCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"

rename _ti_gencode {}

# Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342]
test compile-14.1 {testing errors in element name; segfault?} {} {
     catch {set a([error])} msg1
     catch {set bubba([join $abba $jubba]) $vol} msg2
     list $msg1 $msg2
} {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {cannot read "abba": no such variable}}

test compile-14.2 {testing element name "$"} -body {
    unset -nocomplain a
    set a() 1
    set a(1) 2
    set a($) 3
    list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]

    tcl::unsupported::disassemble ?
} -result "bad type \"?\": must be $disassemblables"
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 "cannot interpret \"\{\" as a lambda expression"
test compile-18.5 {disassembler - basics} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble lambda {{} {}}
} -match glob -result *
test compile-18.6 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble proc
} -match glob -result {wrong # args: should be "* proc procName"}

    tcl::unsupported::getbytecode ?
} -result "bad type \"?\": must be $disassemblables"
test compile-18.23 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode lambda
} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
test compile-18.24 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode lambda \{
} -result "cannot interpret \"\{\" as a lambda expression"
test compile-18.25 {disassembler - basics} -body {
    dict keys [tcl::unsupported::getbytecode lambda {{} {}}]
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.26 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode proc
} -match glob -result {wrong # args: should be "* proc procName"}
test compile-18.27 {disassembler - basics} -returnCodes error -body {

    proc f x {
	coroutine D eval {yield X$x;yield Y}
    }
} -body {
    f 12
} -cleanup {
    rename f {}
} -returnCodes error -match glob -result {cannot read *}

test coroutine-4.7 {compile context, bug #3282869} -setup {
    proc f x {
	coroutine D eval {yield X$x;yield Y$x}
    }
} -body {
    set ::x 15

test dict-11.15 {dict incr command: write failure} -setup {
    unset -nocomplain dictVar
} -body {
    set dictVar(block) {}
    dict incr dictVar a
} -returnCodes error -cleanup {
    unset dictVar
} -result {cannot set "dictVar": variable is array}
test dict-11.16 {dict incr command: compilation} {
    apply {{} {
	set v {a 0 b 0 c 0}
	dict incr v a
	dict incr v b 1
	dict incr v c 2
	dict incr v d 3

test dict-12.10 {dict lappend command: write failure} -setup {
    unset -nocomplain dictVar
} -body {
    set dictVar(block) {}
    dict lappend dictVar a x
} -returnCodes error -cleanup {
    unset dictVar
} -result {cannot set "dictVar": variable is array}
test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} {
    apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}}
} {a 1 b {2 22} c 3}

test dict-13.1 {dict append command} -body {
    set dictv {a a}
    dict append dictv a

test dict-13.9 {dict append command: write failure} -setup {
    unset -nocomplain dictVar
} -body {
    set dictVar(block) {}
    dict append dictVar a x
} -returnCodes error -cleanup {
    unset dictVar
} -result {cannot set "dictVar": variable is array}
test dict-13.10 {compiled dict append: crash case} {
    apply {{} {dict append dictVar a o k}}
} {a ok}
test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
    apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}}
} {a 1 b 222 c 3}

test dict-15.9 {dict set command: write failure} -setup {
    unset -nocomplain dictVar
} -body {
    set dictVar(block) {}
    dict set dictVar a x
} -returnCodes error -cleanup {
    unset dictVar
} -result {cannot set "dictVar": variable is array}
test dict-15.10 {dict set command: syntax} -returnCodes error -body {
    dict set
} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
test dict-15.11 {dict set command: syntax} -returnCodes error -body {
    dict set a
} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
test dict-15.12 {dict set command: syntax} -returnCodes error -body {

test dict-16.9 {dict unset command: write failure} -setup {
    unset -nocomplain dictVar
} -body {
    set dictVar(block) {}
    dict unset dictVar a
} -returnCodes error -cleanup {
    unset dictVar
} -result {cannot set "dictVar": variable is array}
# Now test with an LVT present (i.e., the bytecoded version).
test dict-16.10 {dict unset command} -body {
    apply {{} {
	set dictVar {a b c d}
	dict unset dictVar a
    }}
} -result {c d}

    apply {{} {dict unset dictVar}}
} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
test dict-16.18 {dict unset command: write failure} -body {
    apply {{} {
	set dictVar(block) {}
	dict unset dictVar a
    }}
} -returnCodes error -result {cannot set "dictVar": variable is array}

test dict-17.1 {dict filter command: key} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict filter $dictVar key a2
} -cleanup {
    unset dictVar
} -result {a2 b}

} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
test dict-22.2 {dict with command} -body {
    dict with v
} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
test dict-22.3 {dict with command} -body {
    unset -nocomplain v
    dict with v {error "in body"}
} -returnCodes 1 -result {cannot read "v": no such variable}
test dict-22.4 {dict with command} -body {
    set a {b c d e}
    unset -nocomplain b d
    set result [list [info exist b] [info exist d]]
    dict with a {
	lappend result [info exist b] [info exist d] $b $d
    }

test error-3.2 {errors in catch command} {
    list [catch {catch a b c} msg] $msg
} {0 1}
test error-3.3 {errors in catch command} {
    catch {unset a}
    set a(0) 22
    list [catch {catch {format 44} a} msg] $msg
} {1 {cannot set "a": variable is array}}
catch {unset a}

# More tests related to errorInfo and errorCode

test error-4.1 {errorInfo and errorCode variables} {
    list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 msg3}

		addmsg finally,$bar
	    }
	} msg
	addmsg $msg
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {body finally,a {cannot set "foo": variable is array}}
test error-19.12 {interpreted try and errors on variable write} -setup {
    set RES {}
} -body {
    apply {try {
	array set foo {bar boo}
	set bar unset
	catch {

		addmsg finally,$bar
	    }
	} msg
	addmsg $msg
    } ::tcl::test::error} try
} -cleanup {
    unset RES
} -result {body finally,a {cannot set "foo": variable is array}}
test error-19.13 {compiled try and errors on variable write} -setup {
    set RES {}
} -body {
    apply {{} {
	array set foo {bar boo}
	set bar unset
	catch {

		addmsg finally,$bar
	    }
	} msg
	addmsg $msg
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {body finally,a {cannot set "foo": variable is array}}
rename addmsg {}

# FIXME test what vars get set on fallthough ... what is the correct behavior?
# 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

    vwait
} -result {}
test event-11.3 {Tcl_VwaitCmd procedure} -setup {
    catch {unset x}
} -body {
    set x 1
    vwait x(1)
} -returnCodes error -result {cannot trace "x(1)": variable isn't array}
test event-11.4 {Tcl_VwaitCmd procedure} -setup {
    foreach i [after info] {
	after cancel $i
    }
    after 10; update; # On Mac make sure update won't take long
} -body {
    after 100 {set x x-done}

    exec cat | |& cat
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.6 {errors in exec invocation} -constraints {exec} -body {
    exec cat |&
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.7 {errors in exec invocation} -constraints {exec} -body {
    exec cat <
} -returnCodes error -result {cannot specify "<" as last word in command}
test exec-10.8 {errors in exec invocation} -constraints {exec} -body {
    exec cat >
} -returnCodes error -result {cannot specify ">" as last word in command}
test exec-10.9 {errors in exec invocation} -constraints {exec} -body {
    exec cat <<
} -returnCodes error -result {cannot specify "<<" as last word in command}
test exec-10.10 {errors in exec invocation} -constraints {exec} -body {
    exec cat >>
} -returnCodes error -result {cannot specify ">>" as last word in command}
test exec-10.11 {errors in exec invocation} -constraints {exec} -body {
    exec cat >&
} -returnCodes error -result {cannot specify ">&" as last word in command}
test exec-10.12 {errors in exec invocation} -constraints {exec} -body {
    exec cat >>&
} -returnCodes error -result {cannot specify ">>&" as last word in command}
test exec-10.13 {errors in exec invocation} -constraints {exec} -body {
    exec cat >@
} -returnCodes error -result {cannot specify ">@" as last word in command}
test exec-10.14 {errors in exec invocation} -constraints {exec} -body {
    exec cat <@
} -returnCodes error -result {cannot specify "<@" as last word in command}
test exec-10.15 {errors in exec invocation} -constraints {exec} -body {
    exec cat < a/b/c
} -returnCodes error -result {couldn't read file "a/b/c": no such file or directory}
test exec-10.16 {errors in exec invocation} -constraints {exec} -body {
    exec cat << foo > a/b/c
} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
test exec-10.17 {errors in exec invocation} -constraints {exec} -body {

test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
    proc foo {} {
	set x 1
	unset x
	return $x
    }
    list [catch {foo} msg] $msg
} {1 {cannot read "x": no such variable}}

# INST_LOAD_SCALAR4
test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
    set body {}
    for {set i 0} {$i < 256} {incr i} {
	append body "set x$i x\n"
    }

    append body {
	set y 1
	unset y
	return $y
    }
    proc foo {} $body
    list [catch {foo} msg] $msg
} {1 {cannot read "y": no such variable}}

# INST_LOAD_SCALAR_STK not tested
# INST_LOAD_ARRAY4 not tested
# INST_LOAD_ARRAY1 not tested
# INST_LOAD_ARRAY_STK not tested
# INST_LOAD_STK not tested
# INST_STORE_SCALAR4 not tested

} -body {
    set x 1
    lappend x 2 3
    trace add variable x write {apply {args {error boo}}}
    lappend x 4 5
} -cleanup {
    unset -nocomplain x y
} -returnCodes error -result {cannot set "x": boo}
test execute-12.2 {failing multi-lappend to shared} -setup {
    unset -nocomplain x y
} -body {
    set x 1
    lappend x 2 3
    set y $x
    trace add variable x write {apply {args {error boo}}}
    lappend x 4 5
} -cleanup {
    unset -nocomplain x y
} -returnCodes error -result {cannot set "x": boo}
test execute-12.3 {failing multi-lappend to unshared: LVT} -body {
    apply {{} {
	set x 1
	lappend x 2 3
	trace add variable x write {apply {args {error boo}}}
	lappend x 4 5
    }}
} -returnCodes error -result {cannot set "x": boo}
test execute-12.4 {failing multi-lappend to shared: LVT} -body {
    apply {{} {
	set x 1
	lappend x 2 3
	set y $x
	trace add variable x write {apply {args {error boo}}}
	lappend x 4 5
    }}
} -returnCodes error -result {cannot set "x": boo}

# cleanup
if {[info commands testobj] != {}} {
   testobj freeallvars
}
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}

    expr {"$b2$b2$b2.[set b2].[set b2]"}
} xyxxyxxyx.xyx.xyx
test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22
test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc}
test expr-old-23.6 {double quotes} {
    unset -nocomplain bogus__
    list [catch {expr {"$bogus__"}} msg] $msg
} {1 {cannot read "bogus__": no such variable}}
test expr-old-23.7 {double quotes} {
    list [catch {expr {"a[error Testing]bc"}} msg] $msg
} {1 Testing}
test expr-old-23.8 {double quotes} {
    list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg
} {0 1}

} -returnCodes error -match glob -result *
test expr-old-26.3 {error conditions} -body {
    expr 2+4*(
} -returnCodes error -match glob -result *
unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
    list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {cannot read "_non_existent_": no such variable}}
set a xx
test expr-old-26.5 {error conditions} {
    list [catch {expr {2+$a}} msg] $msg
} {1 {cannot use non-numeric string "xx" as right operand of "+"}}
test expr-old-26.6 {error conditions} {
    list [catch {expr {2+[set a]}} msg] $msg
} {1 {cannot use non-numeric string "xx" as right operand of "+"}}

test expr-20.3 {broken substitution of integer digits} {
    # fails with 8.0.x, but not 8.1b2
    list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
} {4096 1000}
test expr-20.4 {proper double evaluation compilation, error case} {
    catch {unset a}; # make sure $a doesn't exist
    list [catch {expr 1?{$a}:0} msg] $msg
} {1 {cannot read "a": no such variable}}
test expr-20.5 {proper double evaluation compilation, working case} {
    set a yellow
    expr 1?{$a}:0
} yellow
test expr-20.6 {handling of compile error in trial compile} {
    list [catch {expr + {[incr]}} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}

# Test for non-numeric float handling.
test expr-22.1 {non-numeric floats} {
    list [catch {expr {NaN + 1}} msg] $msg
} {1 {cannot use non-numeric floating-point value "NaN" as left operand of "+"}}
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr {Inf + 1}} msg] $msg
} {1 {cannot use infinite floating-point value as operand of "+"}}
test expr-22.3 {non-numeric floats} {
    set nan NaN
    list [catch {expr {$nan + 1}} msg] $msg
} {1 {cannot use non-numeric floating-point value "NaN" as left operand of "+"}}
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
    set inf Inf
    list [catch {expr {$inf + 1}} msg] $msg
} {1 {cannot use infinite floating-point value as operand of "+"}}
test expr-22.5 {non-numeric floats} {
    list [catch {expr NaN} msg] $msg
} {1 {domain error: argument not in valid range}}
test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr Inf} msg] $msg
} {1 {floating-point value too large to represent}}
test expr-22.7 {non-numeric floats} {
    list [catch {expr {1 / NaN}} msg] $msg
} {1 {cannot use non-numeric floating-point value "NaN" as right operand of "/"}}
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr {1 / Inf}} msg] $msg
} {1 {cannot use infinite floating-point value as operand of "/"}}
# Make sure [Bug 761471] stays fixed.
test expr-22.9 {non-numeric floats: shared object equality and NaN} {
    set x NaN
    expr {$x == $x}
} 0
# Make sure [Bug d0f7ba56f0] stays fixed.
test expr-22.10 {non-numeric arguments: equality and NaN} {

    file mkdir ~_totally_bogus_user
    file isdir ~_totally_bogus_user
} -result 1
test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir ""
} -result {cannot create directory "": no such file or directory}
test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    glob td1
} -result {td1}
test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup {

    list $x [file exists td1]
} -result {1 1}
test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    file mkdir tf1
} -result [subst {cannot create directory "[file join tf1]": file exists}]
test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    set x [file exists td1]
    file mkdir td1
    list $x [file exists td1]
} -result {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod notWsl} -returnCodes error -body {
    file mkdir td1/td2/td3
    testchmod 0 td1/td2
    file mkdir td1/td2/td3/td4
} -cleanup {
    testchmod 0o755 td1/td2
    cleanup
} -result {cannot create directory "td1/td2/td3": permission denied}
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
    cleanup
} -constraints {notRoot} -body {
    set x [file exists td1]
    file mkdir td1
    list $x [file exists td1]
} -result {0 1}
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
    cleanup
    file delete -force foo
} -constraints {unix notRoot notWsl} -body {
    file mkdir foo
    file attr foo -perm 0o40000
    file mkdir foo/tf1
} -returnCodes error -cleanup {
    file delete -force foo
} -result {cannot create directory "foo/tf1": permission denied}
test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir tf1
    file exists tf1
} -result 1

test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir td1
    file mkdir td2
    createfile [file join td2 td1]
    file rename -force td1 td2
} -result [subst {cannot overwrite file "[file join td2 td1]" with directory "td1"}]
test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    file mkdir [file join td1 tf1]
    file rename -force tf1 td1
} -result [subst {cannot overwrite directory "[file join td1 tf1]" with file "tf1"}]
test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup {
    cleanup
} -constraints {notRoot notNetworkFilesystem} -body {
    file mkdir [file join td1 td2]
    file mkdir td2
    createfile [file join td2 tf1]
    file rename -force td2 td1

    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir td1
    createfile tf1
    file rename -force td1 tf1
} -cleanup {
    cleanup
} -result {cannot overwrite file "tf1" with directory "td1"}
test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir td1/tf1
    createfile tf1
    file rename -force tf1 td1
} -result [subst {cannot overwrite directory "[file join td1 tf1]" with file "tf1"}]

test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file copy tf1 tf2
} -result {error copying "tf1": no such file or directory}
test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {

} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir td1
    createfile tf1
    file copy -force td1 tf1
} -result {cannot overwrite file "tf1" with directory "td1"}
test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file mkdir [file join td1 tf1]
    createfile tf1
    file copy -force tf1 td1
} -result [subst {cannot overwrite directory "[file join td1 tf1]" with file "tf1"}]
test fCmd-10.11 {file copy: copy to empty file name} -setup {
    cleanup
} -returnCodes error -body {
    createfile tf1
    file copy tf1 ""
} -result {error copying "tf1" to "": no such file or directory}
test fCmd-10.12 {file rename: rename to empty file name} -setup {

    file mtime ""
} -result {could not read "": no such file or directory}
test filesystem-6.17 {empty file name} -returnCodes error -body {
    file mtime "" 0
} -result {could not read "": no such file or directory}
test filesystem-6.18 {empty file name} -returnCodes error -body {
    file mkdir ""
} -result {cannot create directory "": no such file or directory}
test filesystem-6.19 {empty file name} {file nativename ""} {}
test filesystem-6.20 {empty file name} {file normalize ""} {}
test filesystem-6.21 {empty file name} {file owned ""} 0
test filesystem-6.22 {empty file name} {file pathtype ""} relative
test filesystem-6.23 {empty file name} {file readable ""} 0
test filesystem-6.24 {empty file name} -returnCodes error -body {
    file readlink ""

    list [catch {foreach a {{1 2}3} {}} msg] $msg
} {1 {list element in braces followed by "3" instead of space}}
catch {unset a}
test foreach-1.14 {foreach errors} {
    catch {unset a}
    set a(0) 44
    list [catch {foreach a {1 2 3} {}} msg o] $msg $::errorInfo
} {1 {cannot set "a": variable is array} {cannot set "a": variable is array
    (setting foreach loop variable "a")
    invoked from within
"foreach a {1 2 3} {}"}}
test foreach-1.15 {foreach errors} {
    list [catch {foreach {} {} {}} msg] $msg
} {1 {foreach varlist is empty}}
catch {unset a}

    invoked from within
"incr x 1a"}}
test incr-old-2.6 {incr errors} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace add var x write readonly
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {cannot set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
catch {unset x}
test incr-old-2.7 {incr errors} {
    set x -
    list [catch {incr x 1} msg] $msg

"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
    set x 123
    readonly x
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset -nocomplain x
} -result {1 {cannot set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
    set x "  -  "
    incr x 1
} -returnCodes error -result {expected integer but got "  -  "}

test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
    set z incr
    set x 123
    readonly x
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset -nocomplain x
} -result {1 {cannot set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
    set z incr
    set x "  -  "
    $z x 1

	foreach v $args {
	    upvar $v var
	    return "variable $v existence: [info exists var]"
	}
    }
    foo a
    eval [info body foo]
} -returnCodes error -result {cannot read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
    proc foo args [list subst bar]
    list [string length [info body foo]] \
	    [foo; string length [info body foo]]

} -result {procedure "t1" doesn't have an argument "x"}
test info-6.9 {info default option} -returnCodes error -setup {
    catch {unset a}
} -cleanup {unset a} -body {
    set a(0) 88
    proc t1 {a b} {}
    info default t1 a a
} -returnCodes error -result {cannot set "a": variable is array}
test info-6.10 {info default option} -setup {
    catch {unset a}
} -cleanup {unset a} -body {
    set a(0) 88
    proc t1 {{a 18} b} {}
    info default t1 a a
} -returnCodes error -result {cannot set "a": variable is array}
test info-6.11 {info default option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        list [info default p x foo] $foo [info default q y bar] $bar
    }
} {0 {} 1 27}

test info-14.3 {info patchlevel option} -setup {
    set t $tcl_patchLevel
} -body {
    unset tcl_patchLevel
    info patchlevel
} -cleanup {
    set tcl_patchLevel $t; unset t
} -returnCodes error -result {cannot read "tcl_patchLevel": no such variable}

test info-15.1 {info procs option} -body {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info procs] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
            [string match {* _undefined_ *} $x]

test info-18.3 {info tclversion option} -body {
    unset tcl_version
    info tclversion
} -returnCodes error -setup {
    set t $tcl_version
} -cleanup {
    set tcl_version $t; unset t
} -result {cannot read "tcl_version": no such variable}

test info-19.1 {info vars option} -body {
    set a 1
    set b 2
    proc t1 {x y} {
        global a b
        set c 33

    a alias a1 a1
    proc a1 {} {
	interp invokehidden a -global h1
    }
    set r [catch {interp eval a p1} msg]
    interp delete a
    list $r $msg
} {1 {cannot read "z": no such variable}}
test interp-20.39 {invokehidden at global level} {
    catch {interp delete a}
    interp create a
    a eval {
	proc p1 {} {
	    global z
	    a1

    a alias a1 a1
    proc a1 {} {
	interp invokehidden a -global h1
    }
    set r [catch {interp eval a p1} msg]
    interp delete a
    list $r $msg
} {1 {cannot read "z": no such variable}}
test interp-20.44 {invokehidden at global level} {
    catch {interp delete a}
    interp create a
    a eval {
	proc p1 {} {
	    global z
	    a1

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

set path(test4) [makeFile {} test4]
set path(test5) [makeFile {} test5]

test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} {
    set f [open $path(test4) w]
    close $f
    list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
} {1 {cannot write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
} {1 {cannot read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {cannot read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} {
    list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}

test iocmd-12.1 {POSIX open access modes: RDONLY} {
    file delete $path(test1)
    set f [open $path(test1) w]

} -body {
    apply {filename {
	array set b {1 1}
        foreachLine b $filename {}
    }} $f
} -cleanup {
    removeFile $f
} -returnCodes error -result {cannot set "line": variable is array}
set f [makeFile "" foreachLine14.txt]
removeFile $f
test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body {
    apply {filename {
	foreachLine var $filename {}
    }} $f
} -returnCodes error -result "couldn't open \"$f\": no such file or directory"

} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 12345678901234567890 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890}
test link-2.2 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set int 09a} msg] $msg $int
} -result {1 {cannot set "int": variable must have integer value} 43}
test link-2.3 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set real 1.x3} msg] $msg $real
} -result {1 {cannot set "real": variable must have real value} 1.23}
test link-2.4 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set bool gorp} msg] $msg $bool
} -result {1 {cannot set "bool": variable must have boolean value} 1}
test link-2.5 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set wide gorp} msg] $msg $bool
} -result {1 {cannot set "wide": variable must have wide integer value} 1}
test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
    testlink delete
} -body {
    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    set int "+"
    set real "+"

    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
    list [catch {set int 4} msg] $msg $int \
	[catch {set real 10.6} msg] $msg $real \
	[catch {set bool no} msg] $msg $bool \
	[catch {set string "new value"} msg] $msg $string \
	[catch {set wide 12341234} msg] $msg $wide
} -result {1 {cannot set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {cannot set "string": linked variable is read-only} NULL 1 {cannot set "wide": linked variable is read-only} 56785678}
test link-3.2 {read-only variables} -constraints {testlink} -setup {
    testlink delete
} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
    list [catch {set int 4} msg] $msg $int \
	[catch {set real 10.6} msg] $msg $real \
	[catch {set bool no} msg] $msg $bool \
	[catch {set string "new value"} msg] $msg $string\
	[catch {set wide 12341234} msg] $msg $wide
} -result {0 4 4 1 {cannot set "real": linked variable is read-only} 1.23 1 {cannot set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}

test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
    testlink delete
} -body {
    testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    unset int real bool string wide

    testlink delete
    unset -nocomplain int
} -constraints {testlink} -body {
    set int(44) 1
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
} -cleanup {
    unset -nocomplain int
} -returnCodes error -result {cannot set "int": variable is array}

test link-7.1 {access to linked variables via upvar} -setup {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar int y
	unset y

    proc x {} {
	upvar int y
	set y 44
    }
    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $int
} -result {1 {cannot set "y": linked variable is read-only} 11}
test link-7.4 {access to linked variables via upvar} -setup {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar int y
	set y abc
    }
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $int
} -result {1 {cannot set "y": variable must have integer value} -4}
test link-7.5 {access to linked variables via upvar} -setup {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar real y
	set y abc
    }
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $real
} -result {1 {cannot set "y": variable must have real value} 16.75}
test link-7.6 {access to linked variables via upvar} -setup {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar bool y
	set y abc
    }
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $bool
} -result {1 {cannot set "y": variable must have boolean value} 1}
test link-7.7 {access to linked variables via upvar} -setup {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar wide y
	set y abc
    }
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $wide
} -result {1 {cannot set "y": variable must have wide integer value} 778899}

test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}

    testlinkarray create char* 1 ::my(var)
    lappend mylist [set ::my(var) ""]
    catch {set ::my(var) x} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{} {cannot set "::my(var)": wrong size of char* value}}
test link-10.2 {linkarray char*} -constraints testlinkarray -body {
    testlinkarray create char* 4 ::my(var)
    set ::my(var) x
    catch {set ::my(var) xyzz} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": wrong size of char* value}
test link-10.3 {linkarray char*} -constraints testlinkarray -body {
    testlinkarray create -r char* 4 ::my(var)
    catch {set ::my(var) x} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-11.1 {linkarray char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create char 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1234} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have char value} 120 {cannot set "::my(var)": variable must have char value}}
test link-11.2 {linkarray char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create char 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-11.3 {linkarray char} -constraints testlinkarray -body {
    testlinkarray create -r char 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-12.1 {linkarray unsigned char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uchar 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1234} msg
    lappend mylist $msg
    catch {set ::my(var) -1} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have unsigned char value} 120 {cannot set "::my(var)": variable must have unsigned char value} {cannot set "::my(var)": variable must have unsigned char value}}
test link-12.2 {linkarray unsigned char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uchar 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-12.3 {linkarray unsigned char} -constraints testlinkarray -body {
    testlinkarray create -r uchar 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-13.1 {linkarray short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create short 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 123456} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have short value} 120 {cannot set "::my(var)": variable must have short value}}
test link-13.2 {linkarray short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create short 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-13.3 {linkarray short} -constraints testlinkarray -body {
    testlinkarray create -r short 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-14.1 {linkarray unsigned short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ushort 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 123456} msg
    lappend mylist $msg
    catch {set ::my(var) -1} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have unsigned short value} 120 {cannot set "::my(var)": variable must have unsigned short value} {cannot set "::my(var)": variable must have unsigned short value}}
test link-14.2 {linkarray unsigned short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ushort 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-14.3 {linkarray unsigned short} -constraints testlinkarray -body {
    testlinkarray create -r ushort 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-15.1 {linkarray int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create int 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e3} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have integer value} 120 {cannot set "::my(var)": variable must have integer value}}
test link-15.2 {linkarray int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create int 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-15.3 {linkarray int} -constraints testlinkarray -body {
    testlinkarray create -r int 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-16.1 {linkarray unsigned int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uint 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
    catch {set ::my(var) -1} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain ::my
} -result {{cannot set "::my(var)": variable must have unsigned int value} 120 {cannot set "::my(var)": variable must have unsigned int value} {cannot set "::my(var)": variable must have unsigned int value}}
test link-16.2 {linkarray unsigned int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uint 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain ::my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-16.3 {linkarray unsigned int} -constraints testlinkarray -body {
    testlinkarray create -r uint 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-17.1 {linkarray long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create long 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
} -match glob -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have * value} 120 {cannot set "::my(var)": variable must have * value}}
test link-17.2 {linkarray long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create long 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-17.3 {linkarray long} -constraints testlinkarray -body {
    testlinkarray create -r long 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-18.1 {linkarray unsigned long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ulong 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
} -match glob -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have unsigned * value} 120 {cannot set "::my(var)": variable must have unsigned * value}}
test link-18.2 {linkarray unsigned long} -constraints testlinkarray -body {
    testlinkarray create ulong 1 ::my(var)
    set ::my(var) 120
    catch {set ::my(var) -1} msg
    return $msg
} -match glob -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": variable must have unsigned * value}
test link-18.3 {linkarray unsigned long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ulong 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-18.4 {linkarray unsigned long} -constraints testlinkarray -body {
    testlinkarray create -r ulong 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-19.1 {linkarray wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create wide 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have wide integer value} 120 {cannot set "::my(var)": variable must have wide integer value}}
test link-19.2 {linkarray wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create wide 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-19.3 {linkarray wide} -constraints testlinkarray -body {
    testlinkarray create -r wide 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-20.1 {linkarray unsigned wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uwide 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 0xbabed00dbabed00d]
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": variable must have unsigned wide int value} 120 {cannot set "::my(var)": variable must have unsigned wide int value} 0xbabed00dbabed00d}
test link-20.2 {linkarray unsigned wide} -constraints testlinkarray -body {
    testlinkarray create uwide 1 ::my(var)
    set ::my(var) 120
    catch {set ::my(var) -1} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": variable must have unsigned wide int value}
test link-20.3 {linkarray unsigned wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uwide 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong dimension} {1 2 3 4}}
test link-20.4 {linkarray unsigned wide} -constraints testlinkarray -body {
    testlinkarray create -r uwide 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-21.1 {linkarray string} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create string 1 ::my(var)
    lappend mylist [set ::my(var) ""]
    lappend mylist [set ::my(var) "xyz"]
    lappend mylist $::my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{} xyz xyz}
test link-21.2 {linkarray string} -constraints testlinkarray -body {
    testlinkarray create -r string 4 ::my(var)
    catch {set ::my(var) x} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

test link-22.1 {linkarray binary} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create binary 1 ::my(var)
    set ::my(var) x
    catch {set ::my(var) xy} msg
    lappend mylist $msg
    lappend mylist $::my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong size of binary value} x}
test link-22.2 {linkarray binary} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create binary 4 ::my(var)
    catch {set ::my(var) abc} msg
    lappend mylist $msg
    catch {set ::my(var) abcde} msg
    lappend mylist $msg
    set ::my(var) abcd
    lappend mylist $::my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{cannot set "::my(var)": wrong size of binary value} {cannot set "::my(var)": wrong size of binary value} abcd}
test link-22.3 {linkarray binary} -constraints testlinkarray -body {
    testlinkarray create -r binary 4 ::my(var)
    catch {set ::my(var) xyzv} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {cannot set "::my(var)": linked variable is read-only}

catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
catch {testlink delete}
foreach i {int real bool string wide} {
    unset -nocomplain $i
}

} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-1.15 {lmap errors} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
} -result {1 {cannot set "a": variable is array} {cannot set "a": variable is array
    (setting lmap loop variable "a")
    invoked from within
"lmap a {1 2 3} {}"}}
test lmap-1.16 {lmap errors} -returnCodes error -body {
    lmap {} {} {}
} -result {lmap varlist is empty}
unset -nocomplain a

} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-4.15 {lmap errors} {
    apply {{} {
	set a(0) 44
	list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
    }}
} {1 {cannot set "a": variable is array} {cannot set "a": variable is array
    while executing
"lmap a {1 2 3} {}"}}
test lmap-4.16 {lmap errors} -returnCodes error -body {
    apply {{} {
	lmap {} {} {}
    }}
} -result {lmap varlist is empty}

-body {
    list [catch {load [file join $testDir tcl9pkgc$ext] Foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir tcl9pkga$ext] {} child} msg] $msg
} {1 {cannot use library in a safe interpreter: no Pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir tcl9pkge$ext] Pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing

test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
    set x "not loaded"
    teststaticlibrary Another 0 0
    load {} Another
    child eval {set x "not loaded"}
    list [catch {load {} Another child} msg] $msg \
	[child eval set x] [set x]
} {1 {cannot use library in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
    set x "not loaded"
    teststaticlibrary More 0 1
    load {} More
    set x
} {not loaded}
catch {load [file join $testDir tcl9pkga$ext] Pkga}

    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain no; # following tests expecting var "no" does not exists
test lpop-1.1 {error conditions} -returnCodes error -body {
    lpop no
} -result {cannot read "no": no such variable}
test lpop-1.2 {error conditions} -returnCodes error -body {
    lpop no 0
} -result {cannot read "no": no such variable}
test lpop-1.3 {error conditions} -returnCodes error -body {
    set l "x {}x"
    lpop l
} -result {list element in braces followed by "x" instead of space}
test lpop-1.4 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l -1

test ledit-2.7 {ledit errors} -body {
    set l x
    list [catch {ledit l 2 2} msg] $msg
} -result {0 x}
test ledit-2.8 {ledit errors} -body {
    unset -nocomplain l
    ledit l 0 0 x
} -returnCodes error -result {cannot read "l": no such variable}
test ledit-2.9 {ledit errors} -body {
    unset -nocomplain arr
    ledit arr(x) 0 0 x
} -returnCodes error -result {cannot read "arr(x)": no such variable}
test ledit-2.10 {ledit errors} -body {
    unset -nocomplain arr
    set arr(y) y
    ledit arr(x) 0 0 x
} -returnCodes error -result {cannot read "arr(x)": no such element in array}

test ledit-3.1 {ledit won't modify shared argument objects} {
    proc p {} {
        set l "a b c"
        ledit l 1 1 "x y"
        # The literal in locals table should be unmodified
        return [list "a b c" $l]

} -result {1000 0 999}

test lseq-convertToList {does not result in a memory error} -body {
	trace add variable var1 write [list ::apply [list args {
		error {this is an error}
	} [namespace current]]]
	list [catch {set var1 [lindex [lreplace [lseq 1 2] 1 1 hello] 0]} cres] $cres
} -cleanup {unset var1 cres} -result {1 {cannot set "var1": this is an error}}

test lseq-bug-54329e39c7 {does not cause memory bloat} -constraints {
    hasMemUsage
} -body {
    set l [lseq 1000000]
    proc p l {foreach x $l {}}
    set premem [memusage]

trace add variable noWrite write failTrace

test lset-1.1 {lset, not compiled, arg count} testevalex {
    list [catch {testevalex lset} msg] $msg
} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
test lset-1.2 {lset, not compiled, no such var} testevalex {
    list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg
} "1 {cannot read \"noSuchVar\": no such variable}"
test lset-1.3 {lset, not compiled, var not readable} testevalex {
    list [catch {testevalex {lset noRead 0 {}}} msg] $msg
} "1 {cannot read \"noRead\": trace failed}"

test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex {
    set x {0 1 2}
    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}

test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end-3 w}
    } msg] $msg
} {1 {index "end-3" out of range}}

test lset-5.1 {lset, not compiled, 3 args, cannot set variable} testevalex {
    list [catch {
	testevalex {lset noWrite 0 d}
    } msg] $msg $noWrite
} {1 {cannot set "noWrite": trace failed} {d b c}}
test lset-5.2 {lset, not compiled, 3 args, cannot set variable} testevalex {
    list [catch {
	testevalex {lset noWrite [list 0] d}
    } msg] $msg $noWrite
} {1 {cannot set "noWrite": trace failed} {d b c}}

test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex {
    set a {x y z}
    list [testevalex {lset a 0 a}] $a
} {{a y z} {a y z}}
test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex {
    set a {x y z}

    } -body {
	exec [interpreter] << {set tcl_interactive foo} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "cannot set \"tcl_interactive\":\
	     variable must have boolean value\n"

    test Tcl_Main-5.2 {
	Tcl_Main able to handle non-blocking stdin
    } -constraints {
	exec
    } -setup {

		    puts "In exit"
		    _exit $code
		}
		testexithandler create 0
		after 100 testexitmainloop
		testsetmainloop
		close stdin
		puts "do not reach this"
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
    }
    set msg {}
    list [catch tstProc msg] $msg
} {1 {cannot read "zz": no such variable}}
test misc-1.2 {error in variable ref. in command in array reference} {
    proc tstProc {} "
	global a

	set tst \$a(\[winfo name \$\{zz)
	# this is a bogus comment
	# this is a bogus comment

    list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}
test namespace-old-1.19 {using absolute namespace qualifiers} {
    list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}
test namespace-old-1.20 {variables in a namespace are hidden} {
    list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
} {1 {cannot read "test_ns_x": no such variable} 1 {cannot read "test_ns_y": no such variable}}
test namespace-old-1.21 {using namespace qualifiers} {
    list [catch "set test_ns_simple::test_ns_x" msg] $msg \
         [catch "set test_ns_simple::test_ns_y" msg] $msg
} {0 0 0 123}
test namespace-old-1.22 {using absolute namespace qualifiers} {
    list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
         [catch "set ::test_ns_simple::test_ns_y" msg] $msg

         [test_ns_hier1::test_ns_hier2::test_ns_show]
} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
test namespace-old-5.7 {nested namespaces don't see variables in parent} {
    set cmd {
        namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
    }
    list [catch $cmd msg] $msg
} {1 {cannot read "test_ns_var_hier1": no such variable}}
test namespace-old-5.8 {nested namespaces don't see commands in parent} {
    set cmd {
        namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
    }
    list [catch $cmd msg] $msg
} {1 {invalid command name "test_ns_cmd_hier1"}}
test namespace-old-5.9 {usage for "namespace children"} {

    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
test namespace-old-6.12 {define test variables} {
    variable test_ns_cache_var "global version"
    set trigger {set test_ns_cache_var}
    list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg
} {1 {cannot read "test_ns_cache_var": no such variable}}
    set trigger {set test_ns_cache_var}
test namespace-old-6.13 {one-level check for variable shadowing} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    namespace eval test_ns_cache1 $trigger
} {cache1 version}

# TEST: imported commands
# -----------------------------------------------------------------------
test namespace-old-9.1 {empty "namespace export" list} {
    list [catch "namespace export" msg] $msg
} {0 {}}
test namespace-old-9.2 {usage for "namespace export" command} {
    list [catch "namespace export test_ns_trace::zzz" msg] $msg
} {1 {invalid export pattern "test_ns_trace::zzz": pattern cannot specify a namespace}}
test namespace-old-9.3 {define test namespaces for import} {
    namespace eval test_ns_export {
        namespace export cmd1 cmd2 cmd3
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}

         [lsort [info commands cmd?]]
} {0 {} cmd2}
test namespace-old-9.14 {imported commands can be removed} {
    namespace forget test_ns_import::cmd?
    list [lsort [info commands cmd?]] \
         [catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}
test namespace-old-9.15 {existing commands cannot be overwritten} {
    proc cmd1 {x y} {
        return [expr {$x+$y}]
    }
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
         [cmd1 3 5]
} {1 {cannot import command "cmd1": already exists} 8}
test namespace-old-9.16 {use "-force" option to override existing commands} {
    proc cmd1 {x y} { return [expr {$x+$y}] }
    list [cmd1 3 5] \
         [namespace import -force test_ns_import::cmd?] \
         [cmd1 3 5]
} {8 {} {cmd1: 3 5}}
test namespace-old-9.17 {commands can be imported into many namespaces} {

        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} -result {1 {cannot read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}

# TIP 278: secondary lookup disabled, results changed from {10 20}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        # list $v $test_ns_2::v
        list [catch {set v} msg] $msg  [catch {set test_ns_2::v} msg] $msg
    }
} -result {1 {cannot read "v": no such variable} 0 20}

test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \

    namespace children :::test_ns_1:::::test_ns_2:::
} -result {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    set l {}
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
    lappend l [set test_ns_1::test_ns_2::]
} {1 {cannot read "test_ns_1::test_ns_2::": no such variable} 2525}
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    namespace eval test_ns_1::test_ns_2::foo {}
    unset -nocomplain test_ns_1::test_ns_2::
    set l {}
} -body {
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    set test_ns_1::test_ns_2:: 314159
    lappend l [set test_ns_1::test_ns_2::]
} -result {1 {cannot read "test_ns_1::test_ns_2::": no such variable} 314159}
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup {
    namespace eval test_ns_1::test_ns_2::foo {}
    catch {rename test_ns_1::test_ns_2:: {}}
    set l {}
} -body {
    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
    lappend l [test_ns_1::test_ns_2:: hello]
} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}

# TIP 278: secondary lookup disabled, added catch, result changed from y
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        variable {}
        catch {set test_ns_1::(x) y} ::msg
    }
    list $::msg [catch {set test_ns_1::(x)} msg] $msg
} -result {{cannot set "test_ns_1::(x)": parent namespace doesn't exist} 1 {cannot read "test_ns_1::(x)": no such variable}}
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns cannot have empty name} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    namespace eval test_ns_1 {
	proc {} {} {}
	namespace eval {} {}
	{}
    }
} -result {cannot create namespace "": only global namespace can have empty name}

test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        proc cmd {args} {namespace current}

test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::y
    }
} -returnCodes error -result {cannot read "::test_ns_1::test_ns_2::y": no such variable}
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup {
    namespace eval ::test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace eval test_ns_3 {
            variable ::test_ns_1::test_ns_2::x 2222
        }

# TIP 278: secondary lookup disabled, catch added, result changed from 314159
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
	variable x 777
        unset x
        list [catch {set x} msg] $msg  ;# must not be global x now
    }
} {1 {cannot read "x": no such variable}}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
    namespace eval test_ns_1 {
        set wuzzat
    }
} -returnCodes error -result {cannot read "wuzzat": no such variable}
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
    namespace eval test_ns_1 {
        variable a hello
    }
    set test_ns_1::a
} {hello}

test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace export
} {}
test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
    namespace export -clear
} {}
test namespace-26.3 {NamespaceExportCmd, pattern cannot specify a namespace} {
    namespace eval test_ns_1 {
        list [catch {namespace export ::zzz} msg] $msg
    }
} {1 {invalid export pattern "::zzz": pattern cannot specify a namespace}}
test namespace-26.4 {NamespaceExportCmd, one pattern} {
    namespace eval test_ns_1 {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}

    lappend result [B a] [B b] [B c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}

test oo-11.1 {OO: cleanup} {
    oo::object create foo
    set result [list [catch {oo::object create foo} msg] $msg]
    lappend result [foo destroy] [oo::object create foo] [foo destroy]
} {1 {cannot create object "foo": command already exists with that name} {} ::foo {}}
test oo-11.2 {OO: cleanup} {
    oo::class create bar
    bar create foo
    set result [list [catch {bar create foo} msg] $msg]
    lappend result [bar destroy] [oo::object create foo] [foo destroy]
} {1 {cannot create object "foo": command already exists with that name} {} ::foo {}}
test oo-11.3 {OO: cleanup} {
    oo::class create bar0
    oo::class create bar
    oo::define bar superclass bar0
    bar create foo
    set result [list [catch {bar create foo} msg] $msg]
    lappend result [bar0 destroy] [oo::object create foo] [foo destroy]
} {1 {cannot create object "foo": command already exists with that name} {} ::foo {}}
test oo-11.4 {OO: cleanup} {
    oo::class create bar0
    oo::class create bar1
    oo::define bar1 superclass bar0
    oo::class create bar2
    oo::define bar2 {
	superclass bar0
	destructor {lappend ::result destroyed}
    }
    oo::class create bar
    oo::define bar superclass bar1 bar2
    bar create foo
    set result [list [catch {bar create foo} msg] $msg]
    lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
	[oo::object create bar2] [bar2 destroy]
} {1 {cannot create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
test oo-11.5 {OO: cleanup} {
    oo::class create obj1

    trace add command obj1 delete {apply {{name1 name2 action} {
	set namespace [info object namespace $name1]
	namespace delete $namespace
    }}}

	}
    }
    testClass create foo
    array set [foo varname a] {b c}
    foo bar
} -returnCodes 1 -cleanup {
    catch {testClass destroy}
} -result {cannot define "a(b)": name refers to an element in an array}
test oo-20.4 {OO: variable method} -body {
    oo::class create testClass {
	export varname
	method bar {} {
	    my variable a(b)
	}
    }
    testClass create foo
    set [foo varname a] b
    foo bar
} -returnCodes 1 -cleanup {
    catch {testClass destroy}
} -result {cannot define "a(b)": name refers to an element in an array}
test oo-20.5 {OO: variable method} -body {
    oo::class create testClass {
	method bar {} {
	    my variable a::b
	}
    }
    testClass create foo

	method exists {} {info exists x}
	method get {} {return $x}
    }
    list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \
	[foo exists] [catch {foo get} msg] $msg
} -cleanup {
    foo destroy
} -result {0 7 1 7 {} 0 1 {cannot read "x": no such variable}}
test oo-27.14 {variables declaration - multiple use} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent

} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t 2.1
    set x
} -result {2.4}
test package-3.6 {Tcl_PkgRequire procedure, cannot find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package require t 2.5
} -result {cannot find package t 2.5}
test package-3.7 {Tcl_PkgRequire procedure, cannot find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package require t 4.1
} -result {cannot find package t 4.1}
test package-3.8 {Tcl_PkgRequire procedure, cannot find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package require -exact t 1.3
} -result {cannot find package t exactly 1.3}
test package-3.9 {Tcl_PkgRequire procedure, cannot find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    package require t
} -result {cannot find package t}
test package-3.10 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
    package forget t
} -body {
    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {ifneeded test
    while executing

    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    list [catch {package require -exact t 1.5} msg] $msg $x
} -cleanup {
    package unknown {}
} -result {1 {cannot find package t exactly 1.5} {t 1.5-1.5}}
test package-3.18 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -body {
    package provide t 2.3
    package require t
} -result {2.3}
test package-3.19 {Tcl_PkgRequire procedure, version checks} -setup {

    package provide t 2.3
    package require t 2.1
} -result {2.3}
test package-4.31 {Tcl_PackageCmd procedure, "require" option} -setup {
    package forget t
} -body {
    package require t
} -returnCodes error -result {cannot find package t}
test package-4.32 {Tcl_PackageCmd procedure, "require" option} -setup {
    package forget t
} -body {
    package ifneeded t 2.3 "error {synthetic error}"
    package require t 2.3
} -returnCodes error -result {synthetic error}
test package-4.33 {Tcl_PackageCmd procedure, "unknown" option} -body {

    rename ::unknown {}
    rename unknown.old ::unknown
    list $x $msg
} {0 {unknown asdf poiu}}
test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
    rename ::unknown unknown.old
    proc ::unknown args {
	error "I do not like that command"
    }
    set x [catch {testevalobjv 0 asdf poiu} msg]
    rename ::unknown {}
    rename unknown.old ::unknown
    list $x $msg
} {1 {I do not like that command}}
test parse-8.5 {Tcl_EvalObjv procedure, command traces} {testevalobjv testcmdtrace} {
    testevalobjv 0 set x 123
    testcmdtrace tracetest {testevalobjv 0 set x $x}
} {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}}
test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} -constraints {
    testevalobjv
} -setup {

    unset -nocomplain x
    list [catch {testevalex {for {} 1 {} {


	# asdf
	set x
    }}}] $::errorInfo
} {1 {cannot read "x": no such variable
    while executing
"set x"
    ("for" body line 5)
    invoked from within
"for {} 1 {} {

} {test32test}
test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
    testevalex {concat [expr {2 + 6}]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xxx[expr {$a}]}} msg] $msg
} {1 {cannot read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
    set a hello
    testevalex {concat $a}
} {hello}
test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(1[expr {3 - 1}])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {cannot read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xyz$a(1)}} msg] $msg
} {1 {cannot read "a(1)": no such variable}}
test parse-10.10 {Tcl_EvalTokens, object values} testevalex {
    set a 123
    testevalex {concat $a}
} {123}
test parse-10.11 {Tcl_EvalTokens, object values} testevalex {
    set a 123
    testevalex {concat $a$a$a}

} -result {321 777}
test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex {
    list [catch {testevalex {concat "abc}} msg] $msg
} {1 {missing "}}
test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xyz $a}} msg] $msg
} {1 {cannot read "a": no such variable}}
test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex {
    unset -nocomplain a
    list [catch {testevalex {_bogus_ a b c d}} msg] $msg
} {1 {invalid command name "_bogus_"}}
test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex {
    list [catch {testevalex {break}} msg] $msg
} {3 {}}

	set a b
	set c d
    }] $a $c
} {d b d}
test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg
} {1 {cannot read "a": no such variable}}
test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex {
    testevalex {concat xyz;   }
} {xyz}
test parse-11.11 {Tcl_EvalTokens, empty commands} testevalex {
    testevalex "concat abc; ; # this is a comment\n"
} {abc}
test parse-11.12 {Tcl_EvalTokens, empty commands} testevalex {

} {{$} {}}
test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar {
    testparsevar {$.123}
} {{$} .123}
test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
    unset -nocomplain abc
    list [catch {testparsevar {$abc}} msg] $msg
} {1 {cannot read "abc": no such variable}}
test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
    unset -nocomplain abc
    list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}
test parse-13.6 {Tcl_ParseVar memory leak} -constraints {testparsevar memory} -setup {
    proc getbytes {} {
	return [lindex [split [memory info] \n] 3 3]

    set b a${a}b
    set b
} a78b
test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
test parseOld-5.6 {variable substitution} {
    catch {$_non_existent_} msg
    set msg
} {cannot read "_non_existent_": no such variable}
test parseOld-5.7 {array variable substitution} {
    unset -nocomplain a
    set a(xyz) 123
    set b $a(xyz)foo
    set b
} 123foo
test parseOld-5.8 {array variable substitution} {

    set "a(x y z)" qqq
    set $a([format x]\ y [format z]) foo
    set qqq
} foo
test parseOld-5.10 {array variable substitution} {
    unset -nocomplain a
    list [catch {set b $a(22)} msg] $msg
} {1 {cannot read "a(22)": no such variable}}
test parseOld-5.11 {array variable substitution} {
    set b a$!
    set b
} {a$!}
test parseOld-5.12 {empty array name support} {
    list [catch {set b a$()} msg] $msg
} {1 {cannot read "()": no such variable}}
unset -nocomplain a
test parseOld-5.13 {array variable substitution} {
    unset -nocomplain a
    set long {This is a very long variable, long enough to cause storage \
	allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
	freed up correctly, then a core leak will occur when this test is \
	run.  This text is probably beginning to sound like drivel, but I've \

catch {unset _undefined_}
test proc-old-2.5 {local and global variables} {
    proc tproc x {
	global _undefined_
	return $_undefined_
    }
    list [catch {tproc xxx} msg] $msg
} {1 {cannot read "_undefined_": no such variable}}
test proc-old-2.6 {local and global variables} {
    set a 114
    set b 115
    global a b
    list $a $b
} {114 115}

         [namespace eval test_ns_1 {baz::p}] \
         [info commands test_ns_1::baz::*]
} -result {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    proc test_ns_1::baz::p {} {}
} -result {cannot create procedure "test_ns_1::baz::p": unknown namespace}
test proc-1.3 {Tcl_ProcObjCmd, empty proc name} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    proc :: {} {
        return "empty called"
    }
    list [::] \

    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 {cannot 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": must 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}}

    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 {cannot 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": must 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} {

} {0 0}
test regexpComp-6.8 {regexp errors} {
    evalInProc {
	unset -nocomplain f1
	set f1 44
	list [catch {regexp abc abc f1(f2)} msg] $msg
    }
} {1 {cannot 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": must be integer?[+-]integer? or end?[+-]integer?}}

test regexpComp-7.1 {basic regsub operation} {

} {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 {cannot 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": must be integer?[+-]integer? or end?[+-]integer?}}

# This test crashes on the Mac unless you increase the Stack Space to about 1

    list [catch {rename r1 r2 r3} msg] $msg $errorCode
} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
test rename-3.3 {error conditions} -setup {
    proc r1 {} {}
    proc r2 {} {}
} -returnCodes error -body {
    rename r1 r2
} -result {cannot rename to "r2": command already exists}
test rename-3.4 {error conditions} -setup {
    catch {rename r1 {}}
    catch {rename r2 {}}
} -returnCodes error -body {
    rename r1 r2
} -result {cannot rename "r1": command doesn't exist}
test rename-3.5 {error conditions} -setup {
    catch {rename _non_existent_command {}}
} -returnCodes error -body {
    rename _non_existent_command {}
} -result {cannot delete "_non_existent_command": command doesn't exist}

catch {rename unknown {}}
catch {rename unknown.old unknown}
catch {rename bar {}}

test rename-4.1 {reentrancy issues with command deletion and renaming} testdel {
    set x {}

if {[string match *zipfs:/* [info library]]} {
    # pkgIndex.tcl is in [info library]
    # file to be sourced is in [info library]/opt*
    set pkgOptErrMsg {permission denied}
} else {
    # pkgIndex.tcl and file to be sourced are
    # both in [info library]/opt*
    set pkgOptErrMsg {cannot find package opt}
}

# Directory of opt for tests 7.4, 9.10, 9.12 for "package require opt".
if {[file exists [file join [info library] opt0.4]]} {
    # Installed files in lib8.7/opt0.4
    set pkgOptDir opt0.4
} elseif {[file exists [file join [info library] opt]]} {

    set code2 [catch {interp eval $i {package require platform::shell}} msg2]
    return [list $code1 $msg1 $code2]
} -cleanup {
    safe::interpDelete $i
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -result {1 {cannot find package shell} 0}

# The following test checks whether the definition of tcl_endOfWord can be
# obtained from auto_loading.  It was previously test "safe-5.1".
test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setup {
    catch {safe::interpDelete a}
    safe::interpCreate a
} -body {

    set code2 [catch {interp eval $i {package require platform::shell}} msg2]
    return [list $code1 $msg1 $code2]
} -cleanup {
    safe::interpDelete $i
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -result {1 {cannot find package shell} 0}

set ::auto_path $SaveAutoPath
unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp
rename mapList {}
rename mapAndSortList {}
# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

        # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
        # provided deep path)
        list $token1 $token2 $token3 --  [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg --  $mappA -- [safe::interpDelete $i]
    } -cleanup {
        if {$SyncExists} {
            safe::setSyncMode $SyncVal_TMP
        }
    } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} -- 1 {cannot find package SafeTestPackage1} -- {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
    test safe-zipfs-7.4 {tests specific path and positive search with conventional AutoPathSync; zipfs} -setup {
        set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
        if {$SyncExists} {
            set SyncVal_TMP [safe::setSyncMode]
            safe::setSyncMode 1
        } else {
            set SyncVal_TMP 1

        # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
        # provided deep path)
        list $auto1 $token1 $token2 $token3  [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg  [safe::interpConfigure $i] [safe::interpDelete $i]
    } -cleanup {
        if {$SyncExists} {
            safe::setSyncMode $SyncVal_TMP
        }
    } -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 1 {cannot find package SafeTestPackage1} {-accessPath {[list $tcl_library  */dummy/unixlike/test/path  $ZipMountPoint/auto0]} -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
    test safe-zipfs-18.4 {cf. safe-zipfs-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
        set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
        if {$SyncExists} {
            set SyncVal_TMP [safe::setSyncMode]
            safe::setSyncMode 0
        } else {
            error {This test is meaningful only if the command ::safe::setSyncMode is defined}

	    [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
	    $mappA -- [safe::interpDelete $i]
} -cleanup {
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
        1 {cannot find package SafeTestPackage1} --\
        {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}}
test safe-7.3 {check that safe subinterpreters work} {
    set g [interp children]
    if {$g ne {}} {
        append g { -- residue of an earlier test}
    }
    set h [info vars ::safe::S*]

    set code2 [catch {interp eval $i {package require mod1::test1}} msg2]
    return [list $code1 $msg1 $code2]
} -cleanup {
    safe::interpDelete $i
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -result {1 {cannot find package test1} 0}

###  8. Test source control on file name.

test safe-8.1 {safe source control on file} -setup {
    set i "a"
    catch {safe::interpDelete $i}
} -body {

catch {teststaticlibrary Safepfx1 0 0}
test safe-10.1 {testing statics loading} -constraints tcl::test -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i {load {} Safepfx1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of library for prefix Safepfx1 failed: cannot use library in a safe interpreter: no Safepfx1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints tcl::test -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i {load {} Safepfx1}} m o
    dict get $o -errorinfo
} -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of library for prefix Safepfx1 failed: cannot use library in a safe interpreter: no Safepfx1_SafeInit procedure
    invoked from within
"load {} Safepfx1"
    invoked from within
"interp eval $i {load {} Safepfx1}"}
test safe-10.2 {testing statics loading / -nostatics} -constraints tcl::test -body {
    set i [safe::interpCreate -nostatics]
    interp eval $i {load {} Safepfx1}

    safe::interpDelete $i
} -result {permission denied (nested load)}
test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body {
    set i [safe::interpCreate -nestedloadok]
    interp eval $i {interp create x; load {} Safepfx1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of library for prefix Safepfx1 failed: cannot use library in a safe interpreter: no Safepfx1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body {
    set i [safe::interpCreate -nestedloadok]
    catch {interp eval $i {interp create x; load {} Safepfx1 x}} m o
    dict get $o -errorinfo
} -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of library for prefix Safepfx1 failed: cannot use library in a safe interpreter: no Safepfx1_SafeInit procedure
    invoked from within
"load {} Safepfx1 x"
    invoked from within
"interp eval $i {interp create x; load {} Safepfx1 x}"}

### 11. Safe encoding.

	    [safe::interpConfigure $i]\
	    [safe::interpDelete $i]
} -cleanup {
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)}\
        1 {cannot find package SafeTestPackage1}\
        {-accessPath {[list $tcl_library \
                            */dummy/unixlike/test/path \
                            $TestsDir/auto0]}\
        -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
# (not a counterpart of safe-7.3)
test safe-17.3 {Check that default auto_path is the same as in the parent interpreter, Sync Mode off} -constraints AutoSyncDefined -setup {
    set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]

    set code2 [catch {interp eval $i {package require mod1::test1}} msg2]
    return [list $code1 $msg1 $code2]
} -cleanup {
    safe::interpDelete $i
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -result {1 {cannot find package test1} 0}

### 18. Test tokenization of directories available to a child.

test safe-18.1 {Check that each directory of the default auto_path is a valid token, Sync Mode on} -setup {
    set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
    if {$SyncExists} {
        set SyncVal_TMP [safe::setSyncMode]

            $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
} -cleanup {
    safe::interpDelete $i
    if {$SyncExists} {
        safe::setSyncMode $SyncVal_TMP
    }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:0:)} 2 --\
        {{$p(:0:)} {$p(:1:)}} -- 0 1.2.3 1 {cannot find package SafeTestPackage2} --\
        {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1*} --\
        {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
        0 OK1 1 {invalid command name "HeresPackage2"}}
test safe-19.20 {check module loading, Sync Mode off} -constraints AutoSyncDefined -setup {
    set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
    if {$SyncExists} {
        set SyncVal_TMP [safe::setSyncMode]

    set y {}
    unset -nocomplain z
} -body {
    array set z {}
    list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x $y
} -cleanup {
    unset -nocomplain z
} -result {1 {cannot set "z": variable is array} abc ghi}
test scan-4.61 {Tcl_ScanObjCmd, set errors} -setup {
    set x {}
    unset -nocomplain y
    unset -nocomplain z
} -body {
    array set y {}
    array set z {}
    list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x
} -cleanup {
    unset -nocomplain y
    unset -nocomplain z
} -result {1 {cannot set "z": variable is array} abc}

test scan-4.62 {scanning of large and negative octal integers} {
    lassign [int_range] MIN_INT MAX_INT
    set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
    list [scan $scanstring {%o %o %o} a b c] \
	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
} {3 1 1 1}

test scan-8.12 {error conditions} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    scan 44 %d a
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {cannot set "a": variable is array}
test scan-8.13 {error conditions} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    scan 44 %c a
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {cannot set "a": variable is array}
test scan-8.14 {error conditions} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    scan 44 %s a
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {cannot set "a": variable is array}
test scan-8.15 {error conditions} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    scan 44 %f a
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {cannot set "a": variable is array}
test scan-8.16 {error conditions} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    scan 44 %f a
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {cannot set "a": variable is array}
test scan-8.17 {error conditions} -returnCodes error -body {
    scan 44 %2c a
} -result {field width may not be specified in %c conversion}
test scan-8.18 {error conditions} -returnCodes error -body {
    scan abc {%[} x
} -result {unmatched [ in format string}
test scan-8.19 {error conditions} -returnCodes error -body {

    set a xxx
    format %s $a
} xxx
test set-old-1.4 {basic variable setting and unsetting} {
    set a 44
    unset a
    list [catch {set a} msg] $msg
} {1 {cannot read "a": no such variable}}

# Basic array operations.

catch {unset a}
set a(xyz) 2
set a(44) 3
set {a(a long name)} test

    set a(xyz)
} 2
test set-old-2.4 {basic array operations} {
    set "a(a long name)"
} test
test set-old-2.5 {basic array operations} {
    list [catch {set a(other)} msg] $msg
} {1 {cannot read "a(other)": no such element in array}}
test set-old-2.6 {basic array operations} {
    list [catch {set a} msg] $msg
} {1 {cannot read "a": variable is array}}
test set-old-2.7 {basic array operations} {
    format %s $a(44)
} 3
test set-old-2.8 {basic array operations} {
    format %s $a(a long name)
} test
unset a(44)
test set-old-2.9 {basic array operations} {
    lsort [array names a]
} {{a long name} xyz}
test set-old-2.10 {basic array operations} {
    catch {unset b}
    list [catch {set b(123)} msg] $msg
} {1 {cannot read "b(123)": no such variable}}
test set-old-2.11 {basic array operations} {
    catch {unset b}
    set b 44
    list [catch {set b(123)} msg] $msg
} {1 {cannot read "b(123)": variable isn't array}}
test set-old-2.12 {basic array operations} {
    list [catch {set a 14} msg] $msg
} {1 {cannot set "a": variable is array}}
unset a
test set-old-2.13 {basic array operations} {
    list [catch {set a(xyz)} msg] $msg
} {1 {cannot read "a(xyz)": no such variable}}

# Test the set commands, and exercise the corner cases of the code
# that parses array references into two parts.

test set-old-3.1 {set command} {
    list [catch {set} msg] $msg
} {1 {wrong # args: should be "set varName ?newValue?"}}
test set-old-3.2 {set command} {
    list [catch {set x y z} msg] $msg
} {1 {wrong # args: should be "set varName ?newValue?"}}
test set-old-3.3 {set command} {
    catch {unset a}
    list [catch {set a} msg] $msg
} {1 {cannot read "a": no such variable}}
test set-old-3.4 {set command} {
    catch {unset a}
    set a(14) 83
    list [catch {set a 22} msg] $msg
} {1 {cannot set "a": variable is array}}

# Test the corner-cases of parsing array names, using set and unset.

test set-old-4.1 {parsing array names} {
    catch {unset a}
    set a(()) 44
    list [catch {array names a} msg] $msg

} {0 test}

# Errors in reading variables

test set-old-5.1 {errors in reading variables} {
    catch {unset a}
    list [catch {set a} msg] $msg
} {1 {cannot read "a": no such variable}}
test set-old-5.2 {errors in reading variables} {
    catch {unset a}
    set a 44
    list [catch {set a(18)} msg] $msg
} {1 {cannot read "a(18)": variable isn't array}}
test set-old-5.3 {errors in reading variables} {
    catch {unset a}
    set a(6) 44
    list [catch {set a(18)} msg] $msg
} {1 {cannot read "a(18)": no such element in array}}
test set-old-5.4 {errors in reading variables} {
    catch {unset a}
    set a(6) 44
    list [catch {set a} msg] $msg
} {1 {cannot read "a": variable is array}}

# Errors and other special cases in writing variables

test set-old-6.1 {creating array during write} {
    catch {unset a}
    trace add var a {read write unset} ignore
    list [catch {set a(14) 186} msg] $msg [array names a]
} {0 186 14}
test set-old-6.2 {errors in writing variables} {
    catch {unset a}
    set a xxx
    list [catch {set a(14) 186} msg] $msg
} {1 {cannot set "a(14)": variable isn't array}}
test set-old-6.3 {errors in writing variables} {
    catch {unset a}
    set a(100) yyy
    list [catch {set a 2} msg] $msg
} {1 {cannot set "a": variable is array}}
test set-old-6.4 {expanding variable size} {
    catch {unset a}
    list [set a short] [set a "longer name"] [set a "even longer name"] \
	    [set a "a much much truly longer name"]
} {short {longer name} {even longer name} {a much much truly longer name}}

# Unset command, Tcl_UnsetVar procedures

    list [catch {unset} msg] $msg
} {0 {}}
# Used to return:
#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName ...?"}}
test set-old-7.3 {unset command} {
    catch {unset a}
    list [catch {unset a} msg] $msg
} {1 {cannot unset "a": no such variable}}
test set-old-7.4 {unset command} {
    catch {unset a}
    set a 44
    list [catch {unset a(14)} msg] $msg
} {1 {cannot unset "a(14)": variable isn't array}}
test set-old-7.5 {unset command} {
    catch {unset a}
    set a(0) xx
    list [catch {unset a(14)} msg] $msg
} {1 {cannot unset "a(14)": no such element in array}}
test set-old-7.6 {unset command} {
    catch {unset a}; catch {unset b}; catch {unset c}
    set a foo
    set c gorp
    list [catch {unset a a a(14)} msg] $msg [info exists c]
} {1 {cannot unset "a": no such variable} 1}
test set-old-7.7 {unsetting globals from within procedures} {
    set y 0
    proc p1 {} {
	global y
	set z [p2]
	return [list $z [catch {set y} msg] $msg]
    }
    proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
    p1
} {{1 {cannot read "y": no such variable}} 1 {cannot read "y": no such variable}}
test set-old-7.8 {unsetting globals from within procedures} {
    set y 0
    proc p1 {} {
	global y
	p2
	return [list [catch {set y 44} msg] $msg]
    }

    concat [p1] [list [catch {set y} msg] $msg]
} {0 55 0 55}
test set-old-7.10 {unset command} {
    catch {unset a}
    set a(14) 22
    unset a(14)
    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
} {1 {cannot read "a(14)": no such element in array} 0 {}}
test set-old-7.11 {unset command} {
    catch {unset a}
    set a(14) 22
    unset a
    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
} {1 {cannot read "a(14)": no such variable} 0 {}}
test set-old-7.12 {unset command, -nocomplain} {
    catch {unset a}
    list [info exists a] [catch {unset -nocomplain a}] [info exists a]
} {0 0 0}
test set-old-7.13 {unset command, -nocomplain} {
    set -nocomplain abc
    list [info exists -nocomplain] [catch {unset -nocomplain}] \

test set-old-8.34 {array command, set option} {
    list [catch {array set a "a \{ c"} msg] $msg
} {1 {unmatched open brace in list}}
test set-old-8.35 {array command, set option} {
    catch {unset a}
    set a 44
    list [catch {array set a {a b c d}} msg] $msg
} {1 {cannot set "a(a)": variable isn't array}}
test set-old-8.36 {array command, set option} {
    catch {unset a}
    set a(xx) yy
    array set a {b c d e}
    lsort [array get a]
} {b c d e xx yy}
test set-old-8.37 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
            return [array set a {x 0}]
        }
        set a(x)
    }
    list [catch {foo 1} msg] $msg
} {0 {}}
test set-old-8.38 {array command, set option} {
    catch {unset aVaRnAmE}
    array set aVaRnAmE {}
    list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg
} {1 1 {cannot read "aVaRnAmE": variable is array}}
test set-old-8.38.1 {array command, set scalar} {
    catch {unset aVaRnAmE}
    set aVaRnAmE 1
    list [catch {array set aVaRnAmE {}} msg] $msg
} {1 {cannot array set "aVaRnAmE": variable isn't array}}
test set-old-8.38.2 {array command, set alias} {
    catch {unset aVaRnAmE}
    upvar 0 aVaRnAmE anAliAs
    array set anAliAs {}
    list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg
} {1 1 {cannot read "anAliAs": variable is array}}
test set-old-8.38.3 {array command, set element alias} {
    catch {unset aVaRnAmE}
    list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \
	    [catch {array set elemAliAs {}} msg] $msg
} {0 1 {cannot array set "elemAliAs": variable isn't array}}
test set-old-8.38.4 {array command, empty set with populated array} {
    catch {unset aVaRnAmE}
    array set aVaRnAmE [list e1 v1 e2 v2]
    array set aVaRnAmE {}
    array set aVaRnAmE [list e3 v3]
    list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
} {{e1 e2 e3} 0 v2}
test set-old-8.38.5 {array command, set with non-existent namespace} {
    list [catch {array set bogusnamespace::var {}} msg] $msg
} {1 {cannot set "bogusnamespace::var": parent namespace doesn't exist}}
test set-old-8.38.6 {array command, set with non-existent namespace} {
    list [catch {array set bogusnamespace::var {a b}} msg] $msg
} {1 {cannot set "bogusnamespace::var": parent namespace doesn't exist}}
test set-old-8.38.7 {array command, set with non-existent namespace} {
    list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
} {1 {cannot set "bogusnamespace::var(0)": parent namespace doesn't exist}}
test set-old-8.39 {array command, size option} {
    catch {unset a}
    array size a
} {0}
test set-old-8.40 {array command, size option} {
    list [catch {array size a 4} msg] $msg
} {1 {wrong # args: should be "array size arrayName"}}

} {999}
test set-1.13 {TclCompileSetCmd: simple but new (unknown) local name} {
    proc p {} {
        set bar
    }
    catch {p} msg
    set msg
} {cannot read "bar": no such variable}
test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
    proc 260locals {} {
        # create 260 locals (the last ones with index > 255)
        set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
        set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
        set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
        set b5 0; set b6 0; set b7 0; set b8 0; set b9 0

} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
{b c} foo 51}]; # " just a matching end quote

test set-2.1 {set command: runtime error, bad variable name} -setup {
    unset -nocomplain {"foo}
} -body {
    list [catch {set {"foo}} msg] $msg $::errorInfo
} -result {1 {cannot read ""foo": no such variable} {cannot read ""foo": no such variable
    while executing
"set {"foo}"}}
# Stop my editor highlighter " from being confused
test set-2.2 {set command: runtime error, not array variable} -setup {
    unset -nocomplain b
} -body {
    set b 44
    list [catch {set b(123)} msg] $msg
} -result {1 {cannot read "b(123)": variable isn't array}}
test set-2.3 {set command: runtime error, errors in reading variables} -setup {
    unset -nocomplain a
} -body {
    set a(6) 44
    list [catch {set a(18)} msg] $msg
} -result {1 {cannot read "a(18)": no such element in array}}
test set-2.4 {set command: runtime error, readonly variable} -setup {
    unset -nocomplain x
} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace add var x write readonly
    list [catch {set x 1} msg] $msg $::errorInfo
} -match glob -result {1 {cannot set "x": variable is read-only} {*variable is read-only
    while executing
*
"set x 1"}}
test set-2.5 {set command: runtime error, basic array operations} -setup {
    unset -nocomplain a
} -body {
    array set a {}
    list [catch {set a(other)} msg] $msg
} -result {1 {cannot read "a(other)": no such element in array}}
test set-2.6 {set command: runtime error, basic array operations} -setup {
    unset -nocomplain a
} -body {
    array set a {}
    list [catch {set a} msg] $msg
} -result {1 {cannot read "a": variable is array}}

# Test the uncompiled version of set

catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}

    set z set
    proc p {} {
	set z set
        $z bar
    }
    catch {p} msg
    $z msg
} {cannot read "bar": no such variable}
test set-3.14 {uncompiled set command: simple local name, >255 locals} {
    proc 260locals {} {
	set z set
        # create 260 locals (the last ones with index > 255)
        $z a0 0; $z a1 0; $z a2 0; $z a3 0; $z a4 0
        $z a5 0; $z a6 0; $z a7 0; $z a8 0; $z a9 0
        $z b0 0; $z b1 0; $z b2 0; $z b3 0; $z b4 0

} {wrong # args: should be "set varName ?newValue?"}

test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup {
    unset -nocomplain {"foo}
} -body {
    set z set
    list [catch {$z {"foo}} msg] $msg $::errorInfo
} -result {1 {cannot read ""foo": no such variable} {cannot read ""foo": no such variable
    while executing
"$z {"foo}"}}
# Stop my editor highlighter " from being confused
test set-4.2 {uncompiled set command: runtime error, not array variable} -setup {
    catch {unset b}
} -body {
    set z set
    $z b 44
    list [catch {$z b(123)} msg] $msg
} -result {1 {cannot read "b(123)": variable isn't array}}
test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup {
    catch {unset a}
} -body {
    set z set
    $z a(6) 44
    list [catch {$z a(18)} msg] $msg
} -result {1 {cannot read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
    set z set
    proc readonly args {error "variable is read-only"}
    $z x 123
    trace add var x write readonly
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {cannot set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
    unset -nocomplain a
    array set a {}
} -body {
    set z set
    list [catch {$z a(other)} msg] $msg
} -result {1 {cannot read "a(other)": no such element in array}}
test set-4.6 {set command: runtime error, basic array operations} -setup {
    unset -nocomplain a
    array set a {}
} -body {
    set z set
    list [catch {$z a} msg] $msg
} -result {1 {cannot read "a": variable is array}}

test set-5.1 {error on malformed array name} -constraints testset2 -setup {
    unset -nocomplain z
} -body {
    catch {testset2 z(a) b} msg
    catch {testset2 z(b) a} msg1
    list $msg $msg1
} -result {{cannot read "z(a)(b)": variable isn't array} {cannot read "z(b)(a)": variable isn't array}}
# In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
test set-5.2 {Bug 3602706} -body {
    testset2 ::tcl_platform not-in-there
} -returnCodes error -result * -match glob

# cleanup
catch {unset a}

if {$doTestsWithRemoteServer} {
    catch {close $commandSocket}
    if {![catch {
	set commandSocket [socket $remoteServerIP $remoteServerPort]
    }]} then {
	fconfigure $commandSocket -translation crlf -buffering line
    } elseif {![testConstraint exec]} {
	set noRemoteTestReason "cannot exec"
	set doTestsWithRemoteServer 0
    } else {
	set remoteServerIP $localhost
	# Be *extra* careful in case this file is sourced from
	# a directory other than the current one...
	set remoteFile [file join [pwd] [file dirname [info script]] \
		remote.tcl]

} 1
test string-6.8.$noComp {string is, error in var} {
    list [run {string is alpha -failindex var abc5def}] $var
} {0 3}
test string-6.9.$noComp {string is, var shouldn't get set} {
    catch {unset var}
    list [catch {run {string is alpha -failindex var abc; set var}} msg] $msg
} {1 {cannot read "var": no such variable}}
test string-6.10.$noComp {string is, ok on empty} {
    run {string is alpha {}}
} 1
test string-6.11.$noComp {string is, -strict check against empty} {
    run {string is alpha -strict {}}
} 0
test string-6.12.$noComp {string is alnum, true} {

	additional memory will have to be allocated by subst.  That way,
	if the subst procedure forgets to free up memory while returning
	an error, there will be memory that isn't freed (this will be
	detected when the tests are run under a checking memory allocator
	such as Purify).}
test subst-4.4 {variable substitutions} -returnCodes error -body {
    subst {$long $a}
} -result {cannot read "a": no such variable}

test subst-5.1 {command substitutions} {
    subst {[concat {}]}
} {}
test subst-5.2 {command substitutions} {
    subst {[concat A test string]}
} {A test string}

    set script {[subst {0[set a 1; set a 2}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}

test subst-6.1 {clear the result after command substitution} -body {
    catch {unset a}
    subst {[concat foo] $a}
} -returnCodes error -result {cannot read "a": no such variable}

test subst-7.1 {switches} -returnCodes error -body {
    subst foo bar
} -result {bad option "foo": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.2 {switches} -returnCodes error -body {
    subst -no bar
} -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables}

test switch-11.5 {-matchvar without -regexp} {
    set x {}
    list [catch {switch -glob -matchvar x -- abc . {set x}} msg] $x $msg
} {1 {} {-matchvar option requires -regexp option}}
test switch-11.6 {-matchvar unwritable} {
    set x {}
    list [catch {switch -regexp -matchvar x(x) -- abc . {set x}} msg] $x $msg
} {1 {} {cannot set "x(x)": variable isn't array}}

test switch-12.1 {regexp matching with -indexvar} {
    switch -regexp -indexvar x -- abc {.(.). {set x}}
} {{0 2} {1 1}}
test switch-12.2 {regexp matching with -indexvar} {
    set x GOOD
    switch -regexp -indexvar x -- abc {.(.).. {list $x z}}

test switch-12.5 {-indexvar without -regexp} {
    set x {}
    list [catch {switch -glob -indexvar x -- abc . {set x}} msg] $x $msg
} {1 {} {-indexvar option requires -regexp option}}
test switch-12.6 {-indexvar unwritable} {
    set x {}
    list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg
} {1 {} {cannot set "x(x)": variable isn't array}}
test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} {
    set str abcdef
    switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
} abc
test switch-12.8 {-indexvar and matched empty strings} {
    switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
} {{0 2} {3 2}}

} {{} {}}
test switch-13.5 {-indexvar -matchvar combinations} {
    set x -
    set y -
    list [catch {
	switch -regexp -indexvar x(x) -matchvar y abc {. {list $x $y}}
    } msg] $x $y $msg
} {1 - - {cannot set "x(x)": variable isn't array}}
test switch-13.6 {-indexvar -matchvar combinations} {
    set x -
    set y -
    list [catch {
	switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}}
    } msg] $x $y $msg
} {1 {{0 0}} - {cannot set "y(y)": variable isn't array}}

test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
    switch -regexp -- 0 {
	{[0-9]+} {return yes}
	default  {return no}
    }
    foo

test tcltest-14.1 {-singleproc - single process} {
    -constraints {unixOrWin}
    -body {
	child msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
	return $msg
    }
    -result {Test file error: cannot unset .foo.: no such variable}
    -match regexp
}

test tcltest-14.2 {-singleproc - multiple process} {
    -constraints {unixOrWin}
    -body {
	child msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]

	test tcltest-21.4.0 {foo-1} {
	    -cleanup {unset foo}
	}
    }
    -result {^$}
    -match regexp
    -cleanup {verbose $v; set ::tcltest::currentFailure $fail}
    -output "Test cleanup failed:.*cannot unset \"foo\": no such variable"
}

test tcltest-21.5 {test command with setup failure} {
    -setup {
	if {[info exists foo]} {
	    unset foo
	}
	set fail $::tcltest::currentFailure
    }
    -body {
	test tcltest-21.5.0 {foo-2} {
	    -setup {unset foo}
	}
    }
    -result {^$}
    -match regexp
    -cleanup {set ::tcltest::currentFailure $fail}
    -output "Test setup failed:.*cannot unset \"foo\": no such variable"
}

test tcltest-21.6 {test command - setup occurs before cleanup & before script} {
    -setup {set v [verbose]; set fail $::tcltest::currentFailure}
    -body {
	verbose {}
	test tcltest-21.6.0 {foo-3} {

} -cleanup {
    verbose $v
    set ::tcltest::currentFailure $fail
} -body {
    verbose {}
    test tcltest-21.10.0 {foo-1} -cleanup {unset foo}
} -result {^$} -match regexp \
	-output {Test cleanup failed:.*cannot unset \"foo\": no such variable}

test tcltest-21.11 {test command with setup failure} -setup {
    if {[info exists foo]} {
	unset foo
    }
    set fail $::tcltest::currentFailure
} -cleanup {set ::tcltest::currentFailure $fail} -body {
    test tcltest-21.11.0 {foo-2} -setup {unset foo}
} -result {^$} -output {Test setup failed:.*cannot unset \"foo\": no such variable} -match regexp

test tcltest-21.12 {
	test command - setup occurs before cleanup & before script
} -setup {
	set fail $::tcltest::currentFailure
	set v [verbose]
} -cleanup {

	list [catch {customMatch foo bar baz} result] $result
} -result [list 1 "wrong # args: should be \"customMatch mode script\""]

test tcltest-24.3 {
	customMatch: argument checking
} -body {
	list [catch {customMatch bad "a \{ b"} result] $result
} -result [list 1 "invalid customMatch script; cannot evaluate after completion"]

test tcltest-24.4 {
	test: valid -match values
} -body {
	list [catch {
		test tcltest-24.4.0 {} \
			-match [namespace current]::noSuchMode

test thread-4.3 {TclThreadSend preserve errorInfo} {thread} {
    set len [llength [thread::names]]
    set serverthread [thread::create -preserved]
    set x [catch {thread::send $serverthread {set undef}} msg]
    set savedErrorInfo $::errorInfo
    thread::release $serverthread
    list $len $x $msg $savedErrorInfo
} {1 1 {cannot read "undef": no such variable} {cannot read "undef": no such variable
    while executing
"set undef"
    invoked from within
"thread::send $serverthread {set undef}"}}
test thread-4.4 {TclThreadSend preserve code} {thread} {
    set len [llength [thread::names]]
    set serverthread [thread::create -preserved]

    # see this one fail.
    unset -nocomplain z
    trace add variable z array {set z(foo) 1 ;#}
    set res "names: [array names z]"
    unset -nocomplain ::z
    trace add variable ::z write {unset ::z; error "memory corruption";#}
    list [catch {set ::z 1} msg] $msg
} {1 {cannot set "::z": memory corruption}}

# Read-tracing on variables

test trace-1.1 {trace add variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {1 {cannot read "x": no such variable} {x {} read 1 {cannot read "x": no such variable}}}
test trace-1.2 {trace add variable reads} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {0 123 {x {} read 0 123}}
test trace-1.3 {trace add variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    set x 123
    set info
} {}
test trace-1.4 {trace array element reads} {
    unset -nocomplain x
    set info {}
    trace add variable x(2) read traceArray
    list [catch {set x(2)} msg] $msg $info
} {1 {cannot read "x(2)": no such element in array} {x 2 read 1 {cannot read "x(2)": no such element in array}}}
test trace-1.5 {trace array element reads} {
    unset -nocomplain x
    set x(2) zzz
    set info {}
    trace add variable x(2) read traceArray
    list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}

    list [catch {p} msg] $msg $info
} {0 wolf {x Y read}}
test trace-1.8 {trace reads on whole arrays} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceArray
    list [catch {set x(2)} msg] $msg $info
} {1 {cannot read "x(2)": no such variable} {}}
test trace-1.9 {trace reads on whole arrays} {
    unset -nocomplain x
    set x(2) zzz
    set info {}
    trace add variable x read traceArray
    list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}

} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace add variable x read {set x(foo) 1 ;#}
    trace add variable x read {unset -nocomplain x;#}
    list [catch {array get x} res] $res
} {1 {cannot read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace add variable x read {unset -nocomplain x;#}
    trace add variable x read {set x(foo) 1 ;#}
    list [catch {array get x} res] $res
} {1 {cannot read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace add variable writes} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceScalar

test trace-4.1 {trace add variable unsets} {
    unset -nocomplain x
    set info {}
    trace add variable x unset traceScalar
    unset -nocomplain x
    set info
} {x {} unset 1 {cannot read "x": no such variable}}
test trace-4.2 {variable mustn't exist during unset trace} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x unset traceScalar
    unset x
    set info
} {x {} unset 1 {cannot read "x": no such variable}}
test trace-4.3 {unset traces mustn't be called during reads and writes} {
    unset -nocomplain x
    set info {}
    trace add variable x unset traceScalar
    set x 44
    set x
    set info
} {}
test trace-4.4 {trace unsets on array elements} {
    unset -nocomplain x
    set x(0) 18
    set info {}
    trace add variable x(1) unset traceArray
    unset -nocomplain x(1)
    set info
} {x 1 unset 1 {cannot read "x(1)": no such element in array}}
test trace-4.5 {trace unsets on array elements} {
    unset -nocomplain x
    set x(1) 18
    set info {}
    trace add variable x(1) unset traceArray
    unset x(1)
    set info
} {x 1 unset 1 {cannot read "x(1)": no such element in array}}
test trace-4.6 {trace unsets on array elements} {
    unset -nocomplain x
    set x(1) 18
    set info {}
    trace add variable x(1) unset traceArray
    unset x
    set info
} {x 1 unset 1 {cannot read "x(1)": no such variable}}
test trace-4.7 {trace unsets on whole arrays} {
    unset -nocomplain x
    set x(1) 18
    set info {}
    trace add variable x unset traceProc
    unset -nocomplain x(0)
    set info

test trace-8.1 {error returns from traces} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x read "traceTag 1"
    trace add variable x read traceError
    list [catch {set x} msg] $msg $info
} {1 {cannot read "x": trace returned error} {}}
test trace-8.2 {error returns from traces} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x write "traceTag 1"
    trace add variable x write traceError
    list [catch {set x 44} msg] $msg $info
} {1 {cannot set "x": trace returned error} {}}
test trace-8.3 {error returns from traces} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x write traceError
    list [catch {append x 44} msg] $msg $info
} {1 {cannot set "x": trace returned error} {}}
test trace-8.4 {error returns from traces} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x unset "traceTag 1"
    trace add variable x unset traceError
    list [catch {unset x} msg] $msg $info
} {0 {} 1}
test trace-8.5 {error returns from traces} {
    unset -nocomplain x
    set x(0) 123
    set info {}
    trace add variable x(0) read "traceTag 1"
    trace add variable x read "traceTag 2"
    trace add variable x read traceError
    trace add variable x read "traceTag 3"
    list [catch {set x(0)} msg] $msg $info
} {1 {cannot read "x(0)": trace returned error} 3}
test trace-8.6 {error returns from traces} {
    unset -nocomplain x
    set x 123
    trace add variable x unset traceError
    list [catch {unset x} msg] $msg
} {0 {}}
test trace-8.7 {error returns from traces} {

test trace-9.1 {be sure variable is unset before trace is called} {
    unset -nocomplain x
    set x 33
    set info {}
    trace add variable x unset {traceCheck {uplevel 1 set x}}
    unset x
    set info
} {1 {cannot read "x": no such variable}}
test trace-9.2 {be sure variable is unset before trace is called} {
    unset -nocomplain x
    set x 33
    set info {}
    trace add variable x unset {traceCheck {uplevel 1 set x 22}}
    unset x
    concat $info [list [catch {set x} msg] $msg]

test trace-10.1 {make sure array elements are unset before traces are called} {
    unset -nocomplain x
    set x(0) 33
    set info {}
    trace add variable x(0) unset {traceCheck {uplevel 1 set x(0)}}
    unset x(0)
    set info
} {1 {cannot read "x(0)": no such element in array}}
test trace-10.2 {make sure array elements are unset before traces are called} {
    unset -nocomplain x
    set x(0) 33
    set info {}
    trace add variable x(0) unset {traceCheck {uplevel 1 set x(0) zzz}}
    unset x(0)
    concat $info [list [catch {set x(0)} msg] $msg]

test trace-11.1 {make sure arrays are unset before traces are called} {
    unset -nocomplain x
    set x(0) 33
    set info {}
    trace add variable x unset {traceCheck {uplevel 1 set x(0)}}
    unset x
    set info
} {1 {cannot read "x(0)": no such variable}}
test trace-11.2 {make sure arrays are unset before traces are called} {
    unset -nocomplain x
    set x(y) 33
    set info {}
    trace add variable x unset {traceCheck {uplevel 1 set x(y) 22}}
    unset x
    concat $info [list [catch {set x(y)} msg] $msg]

# Check special conditions (e.g. errors) in Tcl_TraceVar2.

test trace-12.1 {creating array when setting variable traces} {
    unset -nocomplain x
    set info {}
    trace add variable x(0) write traceProc
    list [catch {set x 22} msg] $msg
} {1 {cannot set "x": variable is array}}
test trace-12.2 {creating array when setting variable traces} {
    unset -nocomplain x
    set info {}
    trace add variable x(0) write traceProc
    list [catch {set x(0)} msg] $msg
} {1 {cannot read "x(0)": no such element in array}}
test trace-12.3 {creating array when setting variable traces} {
    unset -nocomplain x
    set info {}
    trace add variable x(0) write traceProc
    set x(0) 22
    set info
} {x 0 write}
test trace-12.4 {creating variable when setting variable traces} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceProc
    list [catch {set x} msg] $msg
} {1 {cannot read "x": no such variable}}
test trace-12.5 {creating variable when setting variable traces} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceProc
    set x 22
    set info
} {x {} write}

    trace add variable x read {traceCrtElement xyzzy}
    list [catch {set x(3)} msg] $msg
} {0 xyzzy}
test trace-12.8 {errors when setting variable traces} {
    unset -nocomplain x
    set x 44
    list [catch {trace add variable x(0) write traceProc} msg] $msg
} {1 {cannot trace "x(0)": variable isn't array}}

# Check trace deletion

test trace-13.1 {delete one trace from another} {
    proc delTraces {args} {
	global x
	trace remove variable x read {traceTag 2}

test trace-16.1 {unsets during read traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y read {traceUnset y}
    trace add variable y unset {traceAppend unset}
    lappend info [catch {set y} msg] $msg
} {unset 0 {} 1 {cannot read "x": no such variable} 1 {cannot read "y": no such variable}}
test trace-16.2 {unsets during read traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) read {traceUnset y(0)}
    lappend info [catch {set y(0)} msg] $msg
} {0 {} 1 {cannot read "x": no such variable} 1 {cannot read "y(0)": no such element in array}}
test trace-16.3 {unsets during read traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) read {traceUnset y}
    lappend info [catch {set y(0)} msg] $msg
} {0 {} 1 {cannot read "x": no such variable} 1 {cannot read "y(0)": no such variable}}
test trace-16.4 {unsets during read traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y read {traceReset y y}
    lappend info [catch {set y} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.5 {unsets during read traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) read {traceReset y(0) y(0)}
    lappend info [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.6 {unsets during read traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) read {traceReset y y(0)}
    lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {cannot set "y": upvar refers to element in deleted array} 1 {cannot read "y(0)": no such variable} 1 {cannot read "y(0)": no such variable}}
test trace-16.7 {unsets during read traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) read {traceReset2 y y(0)}
    lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 1 {cannot read "y(0)": no such element in array} 0 xyzzy}
test trace-16.8 {unsets during write traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y write {traceUnset y}
    trace add variable y unset {traceAppend unset}
    lappend info [catch {set y xxx} msg] $msg
} {unset 0 {} 1 {cannot read "x": no such variable} 0 {}}
test trace-16.9 {unsets during write traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) write {traceUnset y(0)}
    lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 1 {cannot read "x": no such variable} 0 {}}
test trace-16.10 {unsets during write traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) write {traceUnset y}
    lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 1 {cannot read "x": no such variable} 0 {}}
test trace-16.11 {unsets during write traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y write {traceReset y y}
    lappend info [catch {set y xxx} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.12 {unsets during write traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) write {traceReset y(0) y(0)}
    lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.13 {unsets during write traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) write {traceReset y y(0)}
    lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {cannot set "y": upvar refers to element in deleted array} 0 {} 1 {cannot read "y(0)": no such variable}}
test trace-16.14 {unsets during write traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) write {traceReset2 y y(0)}
    lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.15 {unsets during unset traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y unset {traceUnset y}
    lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
} {1 {cannot unset "x": no such variable} 1 {cannot read "x": no such variable} 0 {} 1 {cannot read "y": no such variable}}
test trace-16.16 {unsets during unset traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) unset {traceUnset y(0)}
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {1 {cannot unset "x": no such variable} 1 {cannot read "x": no such variable} 0 {} 1 {cannot read "y(0)": no such element in array}}
test trace-16.17 {unsets during unset traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) unset {traceUnset y}
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {cannot read "x": no such variable} 0 {} 1 {cannot read "y(0)": no such variable}}
test trace-16.18 {unsets during unset traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y unset {traceReset2 y y}
    lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
} {1 {cannot unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.19 {unsets during unset traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) unset {traceReset2 y(0) y(0)}
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {1 {cannot unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.20 {unsets during unset traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) unset {traceReset2 y y(0)}
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.21 {unsets cancelling traces} {
    unset -nocomplain y
    set y 1234
    set info {}
    trace add variable y read {traceAppend first}
    trace add variable y read {traceUnset y}
    trace add variable y read {traceAppend third}
    trace add variable y unset {traceAppend unset}
    lappend info [catch {set y} msg] $msg
} {third unset 0 {} 1 {cannot read "x": no such variable} 1 {cannot read "y": no such variable}}
test trace-16.22 {unsets cancelling traces} {
    unset -nocomplain y
    set y(0) 1234
    set info {}
    trace add variable y(0) read {traceAppend first}
    trace add variable y(0) read {traceUnset y}
    trace add variable y(0) read {traceAppend third}
    trace add variable y(0) unset {traceAppend unset}
    lappend info [catch {set y(0)} msg] $msg
} {third unset 0 {} 1 {cannot read "x": no such variable} 1 {cannot read "y(0)": no such variable}}

# Check various non-interference between traces and other things.

test trace-17.1 {trace doesn't prevent unset errors} {
    unset -nocomplain x
    set info {}
    trace add variable x unset {traceProc}
    list [catch {unset x} msg] $msg $info
} {1 {cannot unset "x": no such variable} {x {} unset}}
test trace-17.2 {traced variables must survive procedure exits} {
    unset -nocomplain x
    proc p1 {} {global x; trace add variable x write traceProc}
    p1
    trace info variable x
} {{write traceProc}}
test trace-17.3 {traced variables must survive procedure exits} {

    unset -nocomplain x y
} -body {
    trace add variable x write {error foo;#}
    trace add variable y write {set x 2;#}
    list [catch {set y 1} msg opts] $msg [dict get $opts -errorinfo]
} -cleanup {
    unset -nocomplain x y
} -result {1 {cannot set "y": cannot set "x": foo} {foo
    while executing
"error foo"
    (write trace on "x")
    invoked from within
"set x 2"
    (write trace on "y")
    invoked from within

test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {cannot wait for variable "x": would wait forever}} -cleanup {
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1
    vwait y
    close $f2
    list [catch {vwait x} msg] $msg
} -result {1 {cannot wait for variable "x": would wait forever}} -cleanup {
    catch { close $f1 }
    catch { close $f2 }
    catch { removeFile foo }
    catch { removeFile foo2 }
}

test unixNotfy-2.1 {Tcl_DeleteFileHandler} \

	return "$x $y"
    }
    p1 xyz abc
} {abc abc}
test upvar-7.4 {upvar to same level: tricky problems when deleting variable table} {
    proc tt {} {upvar #1 toto loc;  return $loc}
    list [catch tt msg] $msg
} {1 {cannot read "loc": no such variable}}
test upvar-7.5 {potential memory leak when deleting variable table} {
    proc leak {} {
	array set foo {1 2 3 4}
	upvar 0 foo(1) bar
    }
    leak
} {}

    i eval { upvar b b; lappend b UNEXPECTED }
} -returnCodes error -result {bad level "1"} -cleanup {
    interp delete i
}
test upvar-8.4 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {upvar 0 b b}
    p1
} -result {cannot upvar from variable to itself}
test upvar-8.5 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {upvar 0 a b; upvar 0 b a}
    p1
} -result {cannot upvar from variable to itself}
test upvar-8.6 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {set a 33; upvar b a}
    p1
} -result {variable "a" already exists}
test upvar-8.7 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {trace add variable a write foo; upvar b a}
    p1
} -result {variable "a" has traces: cannot use for upvar}
test upvar-8.8 {create nested array with upvar} -body {
    proc p1 {} {upvar x(a) b; set b(2) 44}
    catch {unset x}
    p1
} -returnCodes error -cleanup {
    unset x
} -result {cannot set "b(2)": variable isn't array}
test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename MakeLink ""}
    namespace eval ::test_ns_1 {}
} -returnCodes error -body {
    proc MakeLink {a} {
	namespace eval ::test_ns_1 {
	    upvar a a
	}
	unset ::test_ns_1::a
    }
    MakeLink 1
} -result {bad variable name "a": cannot create namespace variable that refers to procedure variable}
test upvar-8.10 {upvar will create element alias for new array element} -setup {
    catch {unset upvarArray}
} -body {
    array set upvarArray {}
    catch {upvar 0 upvarArray(elem) upvarArrayElemAlias}
} -result {0}
test upvar-8.11 {upvar will not create a variable that looks like an array} -setup {

    set a
} foo
test upvar-9.2 {Tcl_UpVar2 procedure} testupvar {
    catch {unset a}
    catch {unset x}
    set a 44
    list [catch "testupvar #0 a 1 x global" msg] $msg
} {1 {cannot access "a(1)": variable isn't array}}
test upvar-9.3 {Tcl_UpVar2 procedure} testupvar {
    proc foo {} {
	testupvar 1 a {} x local
	set x
    }
    catch {unset a}
    catch {unset x}
    set a 44
    foo
} {44}
test upvar-9.4 {Tcl_UpVar2 procedure} testupvar {
    proc foo {} {
	testupvar 1 a {} _up_ global
	list [catch {set x} msg] $msg
    }
    catch {unset a}
    catch {unset _up_}
    set a 44
    concat [foo] $_up_
} {1 {cannot read "x": no such variable} 44}
test upvar-9.5 {Tcl_UpVar2 procedure} testupvar {
    proc foo {} {
	testupvar 1 a b x local
	set x
    }
    catch {unset a}
    catch {unset x}

    namespace eval test_ns_1 {
	namespace eval test_ns_0 {}
	namespace upvar test_ns_0 x w
	set w
    }
} -cleanup {
    namespace delete test_ns_1
} -result {cannot read "w": no such variable} -returnCodes error
test upvar-NS-1.6 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {}
	proc a {} {
	    namespace upvar test_ns_0 x w
	    set w
	}
	return [a]
    }
} -cleanup {
    namespace delete test_ns_1
} -result {cannot read "w": no such variable} -returnCodes error
test upvar-NS-1.7 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {
	    variable x test_ns_1::test_ns_0
	}
	namespace upvar test_ns_0 x w
	set w

    namespace eval test_ns_var {set x}
} {namespace value}
test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
    namespace eval test_ns_var {set ::x}
} {global value}
test var-1.7 {TclLookupVar, error finding namespace var} -body {
    set a:::b
} -returnCodes error -result {cannot read "a:::b": no such variable}
test var-1.8 {TclLookupVar, error finding namespace var} -body {
    set ::foobarfoo
} -returnCodes error -result {cannot read "::foobarfoo": no such variable}
test var-1.9 {TclLookupVar, create new namespace var} {
    namespace eval test_ns_var {
        set v hello
    }
} {hello}
test var-1.10 {TclLookupVar, create new namespace var} -setup {
    catch {unset y}
} -body {
    namespace eval test_ns_var {
        set ::y 789
    }
    set y
} -result {789}
test var-1.11 {TclLookupVar, error creating new namespace var} -body {
    namespace eval test_ns_var {
        set ::test_ns_var::foo::bar 314159
    }
} -returnCodes error -result {cannot set "::test_ns_var::foo::bar": parent namespace doesn't exist}
test var-1.12 {TclLookupVar, error creating new namespace var} -body {
    namespace eval test_ns_var {
        set ::test_ns_var::foo:: 1997
    }
} -returnCodes error -result {cannot set "::test_ns_var::foo::": parent namespace doesn't exist}
test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
    catch {unset aNeWnAmEiNnS}
    namespace eval test_ns_var {
        namespace eval test_ns_var2::test_ns_var3 {
            set aNeWnAmEiNnS 77777
        }
        # namespace which builds a name by traversing nsPtr chain to ::

	variable ::test_ns_var::foo
	lappend result [catch {set foo} msg] $msg
        namespace delete ::test_ns_var
	lappend result [catch {set foo 3} msg] $msg
	lappend result [catch {set foo(3) 3} msg] $msg
    }
    p
} {0 2 1 {cannot set "foo": upvar refers to variable in deleted namespace} 1 {cannot set "foo(3)": upvar refers to variable in deleted namespace}}
test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
    namespace eval test_ns_var {
	variable result
        namespace eval subns {
	    variable foo 2
	}
	upvar 0 subns::foo foo
	lappend result [catch {set foo} msg] $msg
        namespace delete subns
	lappend result [catch {set foo 3} msg] $msg
	lappend result [catch {set foo(3) 3} msg] $msg
        namespace delete [namespace current]
	set result
    }
} {0 2 1 {cannot set "foo": upvar refers to variable in deleted namespace} 1 {cannot set "foo(3)": upvar refers to variable in deleted namespace}}
test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
    namespace eval test_ns_var {
	variable result
	proc p {} {
	    array set x {1 2 3 4}
	    upvar 0 x(1) foo
	    lappend result [catch {set foo} msg] $msg
	    unset x
	    lappend result [catch {set foo 3} msg] $msg
	}
	set result [p]
        namespace delete [namespace current]
	set result
    }
} {0 2 1 {cannot set "foo": upvar refers to element in deleted array}}
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
    unset -nocomplain test_ns_var::x
} -body {
    namespace eval test_ns_var {
	variable result {}
	variable x
	array set x {1 2 3 4}
	upvar 0 x(1) foo
	lappend result [catch {set foo} msg] $msg
	unset x
	lappend result [catch {set foo 3} msg] $msg
        namespace delete [namespace current]
	set result
    }
} -result {0 2 1 {cannot set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
    [format set] thisvar(doesntexist)
} -returnCodes error -result {cannot read "thisvar(doesntexist)": no such variable}
test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup {
    proc p [list € ä] {info vars}
} -body {
    # test variable with non-ascii name is available (euro and a-uml chars here):
    list \
	[p 1 2] \
	[apply [list [list € ä] {info vars}] 1 2] \

test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
    catch {unset aaaaa}
} -returnCodes error -body {
    set aaaaa 789789
    upvar #0 aaaaa test_ns_fred::lnk
} -cleanup {
    unset ::aaaaa
} -result {cannot create "test_ns_fred::lnk": parent namespace doesn't exist}
test var-3.10 {MakeUpvar, between namespaces} -body {
    namespace eval {} {
	variable bar 0
	namespace eval foo upvar bar bar
	set foo::bar 1
	list $bar $foo::bar
    }
} -result {1 1}
test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
    catch {unset aaaaa}
} -returnCodes error -body {
    set aaaaa 789789
    upvar #0 aaaaa foo(bar)
} -result {bad variable name "foo(bar)": cannot create a scalar variable that looks like an array element}

test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
    catch {unset a}
    set a 123
    testgetvarfullname a global
} ::a
test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
    namespace eval test_ns_var {
	variable george
	testgetvarfullname george namespace
    }
} ::test_ns_var::george
test var-4.3 {Tcl_GetVariableName, variable cannot be array element} -setup {
    catch {unset a}
} -constraints testgetvarfullname -body {
    set a(1) foo
    testgetvarfullname a(1) global
} -returnCodes error -result {unknown variable "a(1)"}

test var-5.1 {Tcl_GetVariableFullName, global variable} -setup {

} -result {::test_ns_var::one 1}
test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
    set two 2222222
    namespace eval test_ns_var {
        variable two
    }
    list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
} {0 1 {cannot read "test_ns_var::two": no such variable}}
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
    catch {namespace delete test_ns_var}
    namespace eval test_ns_var {variable one 1}
} -body {
    namespace eval test_ns_var {
        variable two 2
    }

} -cleanup {
    catch {unset newvar}
} -result {cheers!}
test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body {
    namespace eval test_ns_var {
        variable sev:::en 7
    }
} -result {cannot define "sev:::en": parent namespace doesn't exist}
test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
    set a ""
    namespace eval test_ns_var {
        variable eight 8
        lappend ::a $eight
        variable eight
        lappend ::a $eight

    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
    lappend a [lsort [info vars test_ns_var2::*]]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
    lappend a [namespace delete test_ns_var2]
} -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
	{1 {cannot read "test_ns_var2::y": no such variable}}\
	[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
	hello 1 0\
	{0 {}}\
	[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
	{1 {cannot unset "test_ns_var2::z": no such variable}}\
	{}]
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
    namespace eval test_ns_var { variable eight 8 }
} -body {
    namespace eval test_ns_var {
        proc p {} {
            variable eight

	    list [set :] [info vars]
	}
	p
    }
} {{My name is ":"} :}
test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var { variable arrayvar(1) }
} -returnCodes error -result "cannot define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var {
	variable arrayvar
	set arrayvar(1) x
	variable arrayvar(1) y
    }
} -returnCodes error -result "cannot define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
    variable
} {}
test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
    namespace eval test_ns_var {
	variable
    }

} -result [list {before get a} {before set b} {before get a} {before set b}]
test var-9.3 {behaviour of TclGetVar no variable} -setup {
    catch {unset u}
} -constraints testsetnoerr -body {
    list \
	[catch {testsetnoerr u} res] $res \
	[catch {testseterr u} res] $res
} -result {1 {before get} 1 {cannot read "u": no such variable}}
test var-9.4 {behaviour of TclGetVar no namespace variable} -setup {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    namespace eval ns {}
    list \
	[catch {testsetnoerr ns::w} res] $res \
	[catch {testseterr ns::w} res] $res
} -result {1 {before get} 1 {cannot read "ns::w": no such variable}}
test var-9.5 {behaviour of TclGetVar no namespace} -setup {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    list \
	[catch {testsetnoerr ns::u} res] $res \
	[catch {testseterr ns::v} res] $res
} -result {1 {before get} 1 {cannot read "ns::v": no such variable}}
test var-9.6 {behaviour of TclSetVar no namespace} -setup {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    list \
	[catch {testsetnoerr ns::v 1} res] $res \
	[catch {testseterr ns::v 1} res] $res
} -result {1 {before set} 1 {cannot set "ns::v": parent namespace doesn't exist}}
test var-9.7 {behaviour of TclGetVar array variable} -setup {
    catch {unset arr}
} -constraints testsetnoerr -body {
    set arr(1) 1
    list \
	[catch {testsetnoerr arr} res] $res \
	[catch {testseterr arr} res] $res
} -result {1 {before get} 1 {cannot read "arr": variable is array}}
test var-9.8 {behaviour of TclSetVar array variable} -setup {
    catch {unset arr}
} -constraints testsetnoerr -body {
    set arr(1) 1
    list \
	[catch {testsetnoerr arr 2} res] $res \
	[catch {testseterr arr 2} res] $res
} -result {1 {before set} 1 {cannot set "arr": variable is array}}
test var-9.9 {behaviour of TclGetVar read trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
    set u 10
    trace add var u read [list resetvar 1]
    trace add var v read [list resetvar 2]
    list \
	[testsetnoerr u] \
	[testseterr v]
} -result {{before get 1} {before get 2}}
test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
    proc writeonly args {error "write-only"}
    set v 456
    trace add var v read writeonly
    list \
	[catch {testsetnoerr v} msg] $msg \
	[catch {testseterr v} msg] $msg
} {1 {before get} 1 {cannot read "v": write-only}}
test var-9.11 {behaviour of TclSetVar write trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
    set v 1
    trace add var v write doubleval
    trace add var u write doubleval
    list \
	[testsetnoerr u 2] \
	[testseterr v 3]
} -result {{before set 4} {before set 6}}
test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
    proc readonly args {error "read-only"}
    set v 456
    trace add var v write readonly
    list \
	[catch {testsetnoerr v 2} msg] $msg $v \
	[catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {cannot set "v": read-only} 3}

test var-10.1 {cannot nest arrays with array set} -setup {
   catch {unset arr}
} -returnCodes error -body {
   array set arr(x) {a 1 b 2}
} -result {cannot set "arr(x)": variable isn't array}
test var-10.2 {cannot nest arrays with array set} -setup {
   catch {unset arr}
} -returnCodes error -body {
   array set arr(x) {}
} -result {cannot set "arr(x)": variable isn't array}

test var-11.1 {array unset} -setup {
    catch {unset a}
} -body {
    array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
    array unset a 1,*
    lsort -dict [array names a]

test var-24.16 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default set ary 7
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {cannot array default set "ary": variable isn't array}
test var-24.17 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

} -returnCodes error -result {wrong # args: should be "const varName value"}

test var-26.1 {const: unmodifiable by set} -body {
    apply {{} {
	const X 123
	set X gorp
    }}
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-26.2 {const: unmodifiable by append} -body {
    apply {{} {
	const X 123
	append X gorp
    }}
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-26.3 {const: unmodifiable by lappend} -body {
    apply {{} {
	const X 123
	lappend X gorp
    }}
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-26.4 {const: unmodifiable by incr} -body {
    apply {{} {
	const X 123
	incr X
    }}
} -returnCodes error -result {cannot incr "X": variable is a constant}
test var-26.5 {const: unmodifiable by dict set} -body {
    apply {{} {
	const X {a 123}
	dict set X a gorp
    }}
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-26.6 {const: unmodifiable by regsub} -body {
    apply {{} {
	const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }}
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-26.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var26.7.txt]
    set f [open $file]
} -body {
    apply {f {
	const X abcabc
	gets $f X
    }} $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {cannot set "X": variable is a constant}
test var-26.8 {const: may not be array} -body {
    apply {{} {
	array set X {a b}
	const X 1
	return $X
    }}
} -returnCodes error -result {cannot make constant "X": variable is array}
test var-26.9.1 {const: may not be array element} -body {
    apply {{} {
	array set X {a b}
	const X(a) 1
	return $X(a)
    }}
} -returnCodes error -result {cannot make constant "X(a)": name refers to an element in an array}
test var-26.9.2 {const: may not be array element} -body {
    apply {{} {
	array set X {a b}
	const X(b) 1
	return $X(b)
    }}
} -returnCodes error -result {cannot make constant "X(b)": name refers to an element in an array}
test var-26.10.1 {const: unmodifiable by const but not an error} {
    apply {{} {
	const X 1
	const X 2
	return $X
    }}
} 1

    }}
} {10 19 32}
test var-26.11 {const: may not be unset} -body {
   apply {{} {
	const X 1
	unset X
   }}
} -returnCodes error -result {cannot unset "X": variable is a constant}
test var-26.12 {const: may not be unset, but -nocomplain doesn't complain} {
   apply {{} {
	const X 1
	unset -nocomplain X
	return $X
   }}
} 1
test var-26.13 {const and traces: write trace causes fail} -body {
    apply {{} {
	trace add variable X write {apply {args {
	    error "ERR: $args"
	}}}
	const X gorp
	return $X
    }}
} -returnCodes error -result {cannot set "X": ERR: X {} write}
test var-26.14 {const and traces: write trace err causes no const} -body {
    apply {{} {
	set trace {apply {args {
	    error "ERR: $args"
	}}}
	trace add variable X write $trace
	catch {

# Same [const], but definitely not compiled
test var-27.1 {const: unmodifiable by set} -body {
    apply {const {
	$const X 123
	set X gorp
    }} const
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-27.2 {const: unmodifiable by append} -body {
    apply {const {
	$const X 123
	append X gorp
    }} const
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-27.3 {const: unmodifiable by lappend} -body {
    apply {const {
	$const X 123
	lappend X gorp
    }} const
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-27.4 {const: unmodifiable by incr} -body {
    apply {const {
	$const X 123
	incr X
    }} const
} -returnCodes error -result {cannot incr "X": variable is a constant}
test var-27.5 {const: unmodifiable by dict set} -body {
    apply {const {
	$const X {a 123}
	dict set X a gorp
    }} const
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-27.6 {const: unmodifiable by regsub} -body {
    apply {const {
	$const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }} const
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-27.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var27.7.txt]
    set f [open $file]
} -body {
    apply {{const f} {
	$const X abcabc
	gets $f X
    }} const $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {cannot set "X": variable is a constant}
test var-27.8 {const: may not be array} -body {
    apply {const {
	array set X {a b}
	$const X 1
	return $X
    }} const
} -returnCodes error -result {cannot make constant "X": variable is array}
test var-27.9.1 {const: may not be array element} -body {
    apply {const {
	array set X {a b}
	$const X(a) 1
	return $X(a)
    }} const
} -returnCodes error -result {cannot make constant "X(a)": name refers to an element in an array}
test var-27.9.2 {const: may not be array element} -body {
    apply {const {
	array set X {a b}
	$const X(b) 1
	return $X(b)
    }} const
} -returnCodes error -result {cannot make constant "X(b)": name refers to an element in an array}
test var-27.10.1 {const: unmodifiable by const but not an error} {
    apply {const {
	$const X 1
	$const X 2
	return $X
    }} const
} 1

    }} const
} {10 19 32}
test var-27.11 {const: may not be unset} -body {
   apply {const {
	$const X 1
	unset X
   }} const
} -returnCodes error -result {cannot unset "X": variable is a constant}
test var-27.12 {const: may not be unset, but -nocomplain doesn't complain} {
   apply {const {
	$const X 1
	unset -nocomplain X
	return $X
   }} const
} 1
test var-27.13 {const and traces: write trace causes fail} -body {
    apply {const {
	trace add variable X write {apply {args {
	    error "ERR: $args"
	}}}
	$const X gorp
	return $X
    }} const
} -returnCodes error -result {cannot set "X": ERR: X {} write}
test var-27.14 {const and traces: write trace err causes no const} -body {
    apply {const {
	set trace {apply {args {
	    error "ERR: $args"
	}}}
	trace add variable X write $trace
	catch {

    }
    apply {{} {
	variable X
	set X 123
    } var28}
} -cleanup {
    namespace delete var28
} -returnCodes error -result {cannot set "X": variable is a constant}
test var-28.3 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    apply {{} {
	variable X
	unset X
    } var28}
} -cleanup {
    namespace delete var28
} -returnCodes error -result {cannot unset "X": variable is a constant}
test var-28.4 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }

    }}]
    apply {res {
	variable X
	list $res [catch {unset X} msg] $msg $X
    } var28} $result
} -cleanup {
    namespace delete var28
} -result {0 1 {cannot unset "X": variable is a constant} abc}

test var-29.1 {const: globally} -setup {
    set int [interp create]
} -body {
    $int eval {
	const X gorp
	apply {{} {

	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {1 {cannot set "X": variable is a constant}} {1 {cannot unset "X": variable is a constant}} 1 X}
test var-29.3 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	private variable X
	constructor {} {

	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {1 {cannot set "X": variable is a constant}} {1 {cannot unset "X": variable is a constant}} 1 X}
test var-29.4 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	variable X
	constructor {} {