Check-in [4bd77df23d]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Tranche 1 of adoption of TclPrintfResult
Timelines: family | ancestors | descendants | both | c11-printf-result
Files: files | file ages | folders
SHA3-256: 4bd77df23ddc791e8582709c7c9158508dc6d48a82ef17bb4d107f1fa60d07a2
User & Date: dkf 2025-10-04 11:12:31.598
Context
2025-10-05
10:38
Tranche 2 of adoption of TclPrintfResult check-in: 9a6fb43196 user: dkf tags: c11-printf-result
2025-10-04
11:12
Tranche 1 of adoption of TclPrintfResult check-in: 4bd77df23d user: dkf tags: c11-printf-result
2025-10-03
16:42
Define macros for printing to the result conveniently check-in: 7b73f4ae3a user: dkf tags: c11-printf-result
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclArithSeries.c.
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
    Tcl_SetObjResult(interp, Tcl_NewStringObj(description, TCL_AUTO_LENGTH));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
    return NULL;

  notANumber:
    description = "non-numeric floating-point value";
    Tcl_PrintDouble(NULL, isnan(dstart) ? dstart : dend, tmp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot use %s \"%s\" to estimate length of arith-series",
	    description, tmp));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *







|

|







787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
    Tcl_SetObjResult(interp, Tcl_NewStringObj(description, TCL_AUTO_LENGTH));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
    return NULL;

  notANumber:
    description = "non-numeric floating-point value";
    Tcl_PrintDouble(NULL, isnan(dstart) ? dstart : dend, tmp);
    TclPrintfResult(interp,
	    "cannot use %s \"%s\" to estimate length of arith-series",
	    description, tmp);
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclAssembly.c.
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
    for (i = 0; i < objc; i+=2) {
	DEBUG_PRINT("  %s -> %s\n", TclGetString(objv[i]),
		TclGetString(objv[i+1]));
	hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, TclGetString(objv[i]),
		&isNew);
	if (!isNew) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"duplicate entry in jump table for \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
	    }
	    DeleteMirrorJumpTable(jtPtr, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, objv[i+1]);
	Tcl_IncrRefCount(objv[i+1]);







|

|







1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
    for (i = 0; i < objc; i+=2) {
	DEBUG_PRINT("  %s -> %s\n", TclGetString(objv[i]),
		TclGetString(objv[i+1]));
	hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, TclGetString(objv[i]),
		&isNew);
	if (!isNew) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		TclPrintfResult(interp,
			"duplicate entry in jump table for \"%s\"",
			TclGetString(objv[i]));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
	    }
	    DeleteMirrorJumpTable(jtPtr, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, objv[i+1]);
	Tcl_IncrRefCount(objv[i+1]);
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLEENTRY", (char *)NULL);
	    }
	    goto error;
	}
	hPtr = Tcl_CreateHashEntry(&jtnPtr->hashTable, INT2PTR(key), &isNew);
	if (!isNew) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"duplicate entry in jump table for \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
	    }
	    goto error;
	}
	Tcl_SetHashValue(hPtr, objv[i+1]);
	Tcl_IncrRefCount(objv[i+1]);
    }







|

|







2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLEENTRY", (char *)NULL);
	    }
	    goto error;
	}
	hPtr = Tcl_CreateHashEntry(&jtnPtr->hashTable, INT2PTR(key), &isNew);
	if (!isNew) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		TclPrintfResult(interp,
			"duplicate entry in jump table for \"%s\"",
			TclGetString(objv[i]));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
	    }
	    goto error;
	}
	Tcl_SetHashValue(hPtr, objv[i+1]);
	Tcl_IncrRefCount(objv[i+1]);
    }
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
    const char* name,		/* Variable name to check */
    Tcl_Size nameLen)		/* Length of the variable */
{
    const char* p;

    for (p = name; p+2 < name+nameLen;  p++) {
	if ((*p == ':') && (p[1] == ':')) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "variable \"%s\" is not local", name));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, (char *)NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}








<
|







2417
2418
2419
2420
2421
2422
2423

2424
2425
2426
2427
2428
2429
2430
2431
    const char* name,		/* Variable name to check */
    Tcl_Size nameLen)		/* Length of the variable */
{
    const char* p;

    for (p = name; p+2 < name+nameLen;  p++) {
	if ((*p == ':') && (p[1] == ':')) {

	    TclPrintfResult(interp, "variable \"%s\" is not local", name);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, (char *)NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
    entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
    if (!isNew) {
	/*
	 * This is a duplicate label.
	 */

	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "duplicate definition of label \"%s\"", labelName));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
		    (char *)NULL);
	}
	return TCL_ERROR;
    }

    /*







|
|







2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
    entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
    if (!isNew) {
	/*
	 * This is a duplicate label.
	 */

	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    TclPrintfResult(interp,
		    "duplicate definition of label \"%s\"", labelName);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
		    (char *)NULL);
	}
	return TCL_ERROR;
    }

    /*
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"undefined label \"%s\"", TclGetString(jumpTarget)));
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
		TclGetString(jumpTarget), (char *)NULL);
	Tcl_SetErrorLine(interp, bbPtr->jumpLine);
    }
}

/*







|
|







2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	TclPrintfResult(interp,
		"undefined label \"%s\"", TclGetString(jumpTarget));
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
		TclGetString(jumpTarget), (char *)NULL);
	Tcl_SetErrorLine(interp, bbPtr->jumpLine);
    }
}

/*
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
	opcode = (envPtr->codeStart)[offset];
	if (BytecodeMightThrow(opcode)) {
	    /*
	     * Report an error for a throw in the wrong context.
	     */

	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" instruction may not appear in "
			"a context where an exception has been "
			"caught and not disposed of.",
			tclInstructionTable[opcode].name));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", (char *)NULL);
		AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    }
	    return TCL_ERROR;
	}
	offset += tclInstructionTable[opcode].numBytes;
    }







|



|







3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
	opcode = (envPtr->codeStart)[offset];
	if (BytecodeMightThrow(opcode)) {
	    /*
	     * Report an error for a throw in the wrong context.
	     */

	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		TclPrintfResult(interp,
			"\"%s\" instruction may not appear in "
			"a context where an exception has been "
			"caught and not disposed of.",
			tclInstructionTable[opcode].name);
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", (char *)NULL);
		AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    }
	    return TCL_ERROR;
	}
	offset += tclInstructionTable[opcode].numBytes;
    }
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595

	/*
	 * Exit with unbalanced stack.
	 */

	if (depth != 1) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"stack is unbalanced on exit from the code (depth=%d)",
			depth));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Record stack usage.







|

|







3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594

	/*
	 * Exit with unbalanced stack.
	 */

	if (depth != 1) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		TclPrintfResult(interp,
			"stack is unbalanced on exit from the code (depth=%d)",
			depth);
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Record stack usage.
Changes to generic/tclBasic.c.
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
    void *clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of %s",
	    infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *







|

|







1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
    void *clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;

    Tcl_PrintfResult(interp,
	    "not allowed to invoke subcommand %s of %s",
	    infoPtr->commandName, infoPtr->ensembleNsName);
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */

    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"hidden command named \"%s\" already exists",
		hiddenCmdToken));
	Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a special separate name
     * table. Changes here and in TclRenameCommand must be kept in synch until







|
|
<







2267
2268
2269
2270
2271
2272
2273
2274
2275

2276
2277
2278
2279
2280
2281
2282
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */

    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
    if (!isNew) {
	Tcl_PrintfResult(interp,
		"hidden command named \"%s\" already exists", hiddenCmdToken);

	Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a special separate name
     * table. Changes here and in TclRenameCommand must be kept in synch until
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403

    hPtr = NULL;
    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr != NULL) {
	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown hidden command \"%s\"", hiddenCmdToken));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
		hiddenCmdToken, (char *)NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*







|
|







2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402

    hPtr = NULL;
    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr != NULL) {
	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
    }
    if (hPtr == NULL) {
	Tcl_PrintfResult(interp,
		"unknown hidden command \"%s\"", hiddenCmdToken);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
		hiddenCmdToken, (char *)NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
    /*
     * It is an error to overwrite an existing exposed command as a result of
     * exposing a previously hidden command.
     */

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"exposed command \"%s\" already exists", cmdName));
	Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Command resolvers (per-interp, per-namespace) might have resolved to a
     * command for the given namespace scope with this command not being







|
|







2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
    /*
     * It is an error to overwrite an existing exposed command as a result of
     * exposing a previously hidden command.
     */

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
    if (!isNew) {
	Tcl_PrintfResult(interp,
		"exposed command \"%s\" already exists", cmdName);
	Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Command resolvers (per-interp, per-namespace) might have resolved to a
     * command for the given namespace scope with this command not being
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
     * Find the existing command. An error is returned if cmdName can't be
     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't %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;
    }

    /*
     * If the new command name is NULL or empty, delete the command. Do this
     * with Tcl_DeleteCommandFromToken, since we already have the command.







|


|







3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
     * Find the existing command. An error is returned if cmdName can't be
     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
	Tcl_PrintfResult(interp,
		"can't %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;
    }

    /*
     * If the new command name is NULL or empty, delete the command. Do this
     * with Tcl_DeleteCommandFromToken, since we already have the command.
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
     * create the containing namespaces just like Tcl_CreateObjCommand would.
     */

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

    if ((newNsPtr == NULL) || (newTail == NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't 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(
		"can't rename to \"%s\": command already exists", newName));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
		"TARGET_EXISTS", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*







|
|





|
|







3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
     * create the containing namespaces just like Tcl_CreateObjCommand would.
     */

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

    if ((newNsPtr == NULL) || (newTail == NULL)) {
	Tcl_PrintfResult(interp,
		"can't 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_PrintfResult(interp,
		"can't rename to \"%s\": command already exists", newName);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
		"TARGET_EXISTS", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
	    cmdPtr = preCmdPtr;
	} else if (flags & TCL_EVAL_NORESOLVE) {
	    /*
	     * When it's been deleted, and we're told not to attempt resolving
	     * it ourselves, all we can do is raise an error.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to invoke a deleted command"));
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", (char *)NULL);
	    return TCL_ERROR;
	}
    }
    if (cmdPtr == NULL) {
	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
	if (!cmdPtr) {







<
|







4523
4524
4525
4526
4527
4528
4529

4530
4531
4532
4533
4534
4535
4536
4537
	    cmdPtr = preCmdPtr;
	} else if (flags & TCL_EVAL_NORESOLVE) {
	    /*
	     * When it's been deleted, and we're told not to attempt resolving
	     * it ourselves, all we can do is raise an error.
	     */


	    Tcl_PrintfResult(interp, "attempt to invoke a deleted command");
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", (char *)NULL);
	    return TCL_ERROR;
	}
    }
    if (cmdPtr == NULL) {
	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
	if (!cmdPtr) {
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
     *
     * In this case we worry a bit less about recursion for now, and call the
     * "blocking" interface.
     */

    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid command name \"%s\"", TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		TclGetString(objv[0]), (char *)NULL);

	/*
	 * Release any resources we locked and allocated during the handler
	 * call.
	 */







|
|







4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
     *
     * In this case we worry a bit less about recursion for now, and call the
     * "blocking" interface.
     */

    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
    if (cmdPtr == NULL) {
	Tcl_PrintfResult(interp,
		"invalid command name \"%s\"", TclGetString(objv[0]));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		TclGetString(objv[0]), (char *)NULL);

	/*
	 * Release any resources we locked and allocated during the handler
	 * call.
	 */
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
    if (returnCode == TCL_BREAK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"break\" outside of a loop", TCL_INDEX_NONE));
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", TCL_INDEX_NONE));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"command returned bad code: %d", returnCode));
    }
    snprintf(buf, sizeof(buf), "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, (char *)NULL);
}

/*
 *---------------------------------------------------------------------------







|
|







6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
    if (returnCode == TCL_BREAK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"break\" outside of a loop", TCL_INDEX_NONE));
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", TCL_INDEX_NONE));
    } else {
	Tcl_PrintfResult(interp,
		"command returned bad code: %d", returnCode);
    }
    snprintf(buf, sizeof(buf), "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, (char *)NULL);
}

/*
 *---------------------------------------------------------------------------
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid hidden command name \"%s\"", cmdName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
		(char *)NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*







|
|







6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
	Tcl_PrintfResult(interp,
		"invalid hidden command name \"%s\"", cmdName);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
		(char *)NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
8231
8232
8233
8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8246
    case FP_SUBNORMAL:
	TclNewLiteralStringObj(objPtr, "subnormal");
	break;
    case FP_ZERO:
	TclNewLiteralStringObj(objPtr, "zero");
	break;
    default:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unable to classify number: %f", d));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*







<
|







8229
8230
8231
8232
8233
8234
8235

8236
8237
8238
8239
8240
8241
8242
8243
    case FP_SUBNORMAL:
	TclNewLiteralStringObj(objPtr, "subnormal");
	break;
    case FP_ZERO:
	TclNewLiteralStringObj(objPtr, "zero");
	break;
    default:

	Tcl_PrintfResult(interp, "unable to classify number: %f", d);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
    while (tail > name + 1) {
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail + 1;
	    break;
	}
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s arguments for math function \"%s\"",
	    (found < expected ? "not enough" : "too many"), name));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
}

#ifdef USE_DTRACE
/*
 *----------------------------------------------------------------------
 *







|

|







8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
    while (tail > name + 1) {
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail + 1;
	    break;
	}
    }
    Tcl_PrintfResult(interp,
	    "%s arguments for math function \"%s\"",
	    (found < expected ? "not enough" : "too many"), name);
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
}

#ifdef USE_DTRACE
/*
 *----------------------------------------------------------------------
 *
9583
9584
9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = (CoroutineData *)clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"coroutine \"%s\" is already running",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine







<
|
|







9580
9581
9582
9583
9584
9585
9586

9587
9588
9589
9590
9591
9592
9593
9594
9595
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = (CoroutineData *)clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {

	Tcl_PrintfResult(interp, "coroutine \"%s\" is already running",
		TclGetString(objv[0]));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine
9661
9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
9672
9673
9674
9675
9676
9677
9678
9679
9680
9681
9682
9683
9684
    }

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

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't 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(
		"can't 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
     * struct and create the corresponding command.







|

|




|

|







9657
9658
9659
9660
9661
9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
9672
9673
9674
9675
9676
9677
9678
9679
9680
    }

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

    if (nsPtr == NULL) {
	Tcl_PrintfResult(interp,
		"can't create procedure \"%s\": unknown namespace",
		procName);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_PrintfResult(interp,
		"can't 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
     * struct and create the corresponding command.
Changes to generic/tclBinary.c.
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
	int ch;
	Tcl_Size count = TclUtfToUniChar(src, &ch);

	if (ch > 255) {
	    proper = 0;
	    if (demandProper) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected byte sequence but character %"
			    TCL_Z_MODIFIER "u was '%1s' (U+%06X)",
			    dst - byteArrayPtr->bytes, src, ch));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", (char *)NULL);
		}
		Tcl_Free(byteArrayPtr);
		*byteArrayPtrPtr = NULL;
		return proper;
	    }
	}







|


|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
	int ch;
	Tcl_Size count = TclUtfToUniChar(src, &ch);

	if (ch > 255) {
	    proper = 0;
	    if (demandProper) {
		if (interp) {
		    Tcl_PrintfResult(interp,
			    "expected byte sequence but character %"
			    TCL_Z_MODIFIER "u was '%1s' (U+%06X)",
			    dst - byteArrayPtr->bytes, src, ch);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", (char *)NULL);
		}
		Tcl_Free(byteArrayPtr);
		*byteArrayPtrPtr = NULL;
		return proper;
	    }
	}
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;

  badValue:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue));
    return TCL_ERROR;

  badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;

  badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

  badField:
    {
	Tcl_UniChar ch = 0;
	char buf[5] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

  error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}







|

|

















<
|







1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325
1326
1327
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;

  badValue:
    Tcl_ResetResult(interp);
    Tcl_PrintfResult(interp,
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue);
    return TCL_ERROR;

  badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;

  badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

  badField:
    {
	Tcl_UniChar ch = 0;
	char buf[5] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';

	Tcl_PrintfResult(interp, "bad field specifier \"%s\"", buf);
	return TCL_ERROR;
    }

  error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
  badField:
    {
	Tcl_UniChar ch = 0;
	char buf[5] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

  error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}







|
|







1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
  badField:
    {
	Tcl_UniChar ch = 0;
	char buf[5] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_PrintfResult(interp,
		"bad field specifier \"%s\"", buf);
	return TCL_ERROR;
    }

  error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
  badChar:
    if (pure) {
	ucs4 = c;
    } else {
	TclUtfToUniChar((const char *)(data - 1), &ucs4);
    }
    TclDecrRefCount(resultObj);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid hexadecimal digit \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|

|







2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
  badChar:
    if (pure) {
	ucs4 = c;
    } else {
	TclUtfToUniChar((const char *)(data - 1), &ucs4);
    }
    TclDecrRefCount(resultObj);
    Tcl_PrintfResult(interp,
	    "invalid hexadecimal digit \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1);
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
	goto shortUu;
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  shortUu:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", (char *)NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;

  badUu:
    if (pure) {
	ucs4 = c;
    } else {
	TclUtfToUniChar((const char *)(data - 1), &ucs4);
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid uuencode character \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------







|










|

|







3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
	goto shortUu;
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  shortUu:
    Tcl_PrintfResult(interp, "short uuencode data");
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", (char *)NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;

  badUu:
    if (pure) {
	ucs4 = c;
    } else {
	TclUtfToUniChar((const char *)(data - 1), &ucs4);
    }
    Tcl_PrintfResult(interp,
	    "invalid uuencode character \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1);
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
	 * valid member of the base64 alphabet, it could be the lead byte
	 * of a multi-byte character. */

	/* Safe because we know data is NUL-terminated */
	TclUtfToUniChar((const char *)(data - 1), &ucs4);
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid base64 character \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|

|












3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
	 * valid member of the base64 alphabet, it could be the lead byte
	 * of a multi-byte character. */

	/* Safe because we know data is NUL-terminated */
	TclUtfToUniChar((const char *)(data - 1), &ucs4);
    }

    Tcl_PrintfResult(interp,
	    "invalid base64 character \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1);
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclCkalloc.c.
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
		    TclGetString(objv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
	Tcl_WideInt value;
	if (objc != 3) {
	    goto argError;
	}
	if (TclGetWideIntFromObj(interp, objv[2], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	break_on_malloc = value;
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"info") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "init") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "objs") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot open output file: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }







|
|
















|





|




















|

|







821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_PrintfResult(interp, "error accessing %s: %s",
		    TclGetString(objv[2]), Tcl_PosixError(interp));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
	Tcl_WideInt value;
	if (objc != 3) {
	    goto argError;
	}
	if (TclGetWideIntFromObj(interp, objv[2], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	break_on_malloc = value;
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"info") == 0) {
	Tcl_PrintfResult(interp,
		"%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", maximum_bytes_malloced);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "init") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "objs") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_PrintfResult(interp,
		    "cannot open output file: %s",
		    Tcl_PosixError(interp));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
	if (objc != 3) {
	    goto bad_suboption;
	}
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }

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

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

  bad_suboption:







|


|







931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
	if (objc != 3) {
	    goto bad_suboption;
	}
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }

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

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

  bad_suboption:
Changes to generic/tclClock.c.
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
	    goto badOptionMsg;
	}
	/* if already specified */
	if (saw & (1 << optionIndex)) {
	    if (operation != CLC_OP_SCN && optionIndex == CLC_ARGS_BASE) {
		goto badOptionMsg;
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": doubly present",
		    TclGetString(objv[i])));
	    goto badOption;
	}
	switch (optionIndex) {
	case CLC_ARGS_FORMAT:
	    if (operation == CLC_OP_ADD) {
		goto badOptionMsg;
	    }







<
|
|







3335
3336
3337
3338
3339
3340
3341

3342
3343
3344
3345
3346
3347
3348
3349
3350
	    goto badOptionMsg;
	}
	/* if already specified */
	if (saw & (1 << optionIndex)) {
	    if (operation != CLC_OP_SCN && optionIndex == CLC_ARGS_BASE) {
		goto badOptionMsg;
	    }

	    Tcl_PrintfResult(interp, "bad option \"%s\": doubly present",
		    TclGetString(objv[i]));
	    goto badOption;
	}
	switch (optionIndex) {
	case CLC_ARGS_FORMAT:
	    if (operation == CLC_OP_ADD) {
		goto badOptionMsg;
	    }
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
		goto baseNow;
	    }

	    if (TclHasInternalRep(baseObj, &tclBignumType)) {
		goto baseOverflow;
	    }

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad seconds \"%s\": must be now or integer",
		    TclGetString(baseObj)));
	    i = baseIdx;
	    goto badOption;
	}
	/*
	 * Seconds could be an unsigned number that overflowed. Make sure
	 * that it isn't. Additionally it may be too complex to calculate
	 * julianday etc (forwards/backwards) by too large/small values, thus







|

|







3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
		goto baseNow;
	    }

	    if (TclHasInternalRep(baseObj, &tclBignumType)) {
		goto baseOverflow;
	    }

	    Tcl_PrintfResult(interp,
		    "bad seconds \"%s\": must be now or integer",
		    TclGetString(baseObj));
	    i = baseIdx;
	    goto badOption;
	}
	/*
	 * Seconds could be an unsigned number that overflowed. Make sure
	 * that it isn't. Additionally it may be too complex to calculate
	 * julianday etc (forwards/backwards) by too large/small values, thus
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
	memcpy(&dataPtr->lastBase.date, date, ClockCacheableDateFieldsSize);
	TclSetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj);
    }

    return TCL_OK;

  badOptionMsg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad option \"%s\": must be %s",
	    TclGetString(objv[i]), syntax));

  badOption:
    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
	    (i < objc) ? TclGetString(objv[i]) : (char *)NULL, (char *)NULL);
    return TCL_ERROR;
}








<
|
|







3493
3494
3495
3496
3497
3498
3499

3500
3501
3502
3503
3504
3505
3506
3507
3508
	memcpy(&dataPtr->lastBase.date, date, ClockCacheableDateFieldsSize);
	TclSetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj);
    }

    return TCL_OK;

  badOptionMsg:

    Tcl_PrintfResult(interp, "bad option \"%s\": must be %s",
	    TclGetString(objv[i]), syntax);

  badOption:
    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
	    (i < objc) ? TclGetString(objv[i]) : (char *)NULL, (char *)NULL);
    return TCL_ERROR;
}

3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
	    goto error;
	}
    }

    return TCL_OK;

  error:
    Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf(
	    "unable to convert input string: %s", errMsg));
    Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, (char *)NULL);
    return TCL_ERROR;
}

/*----------------------------------------------------------------------
 *
 * ClockFreeScan --







<
|







3966
3967
3968
3969
3970
3971
3972

3973
3974
3975
3976
3977
3978
3979
3980
	    goto error;
	}
    }

    return TCL_OK;

  error:

    TclPrintfResult(opts->interp, "unable to convert input string: %s", errMsg);
    Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, (char *)NULL);
    return TCL_ERROR;
}

/*----------------------------------------------------------------------
 *
 * ClockFreeScan --
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
     * Notice that many yy-defines point to values in the "info" or "date"
     * structure, e. g. yySecondOfDay -> info->date.secondOfDay or
     *			yyMonth -> info->date.month (same as yydate.month)
     */
    yyInput = TclGetString(strObj);

    if (TclClockFreeScan(interp, info) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unable to convert date-time string \"%s\": %s",
		TclGetString(strObj), Tcl_GetString(Tcl_GetObjResult(interp))));
	return TCL_ERROR;
    }

    /*
     * If the caller supplied a date in the string, update the date with
     * the value. If the caller didn't specify a time with the date, default to
     * midnight.







|

|







4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
     * Notice that many yy-defines point to values in the "info" or "date"
     * structure, e. g. yySecondOfDay -> info->date.secondOfDay or
     *			yyMonth -> info->date.month (same as yydate.month)
     */
    yyInput = TclGetString(strObj);

    if (TclClockFreeScan(interp, info) != TCL_OK) {
	Tcl_PrintfResult(interp,
		"unable to convert date-time string \"%s\": %s",
		TclGetString(strObj), Tcl_GetString(Tcl_GetObjResult(interp)));
	return TCL_ERROR;
    }

    /*
     * If the caller supplied a date in the string, update the date with
     * the value. If the caller didn't specify a time with the date, default to
     * midnight.
Changes to generic/tclClockFmt.c.
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
    ret = TCL_OK;
  done:
    return ret;

    /* Error case reporting. */

  overflow:
    Tcl_SetObjResult(opts->interp, Tcl_NewStringObj(
	    "integer value too large to represent", TCL_AUTO_LENGTH));
    Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL);
    goto done;

  not_match:
#if 1
    Tcl_SetObjResult(opts->interp, Tcl_NewStringObj(
	    "input string does not match supplied format", TCL_AUTO_LENGTH));
#else
    /* to debug where exactly scan breaks */
    Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf(
	    "input string \"%s\" does not match supplied format \"%s\","
	    " locale \"%s\" - token \"%s\"",
	    info->dateStart, HashEntry4FmtScn(fss)->key.string,
	    TclGetString(opts->localeObj),
	    tok && tok->tokWord.start ? tok->tokWord.start : "NULL"));
#endif
    Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", (char *)NULL);
    goto done;
}

#define FrmResultIsAllocated(dateFmt) \
    (dateFmt->resEnd - dateFmt->resMem > MIN_FMT_RESULT_BLOCK_ALLOC)







<
|





|
|


|




|







2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
    ret = TCL_OK;
  done:
    return ret;

    /* Error case reporting. */

  overflow:

    TclPrintfResult(opts->interp, "integer value too large to represent");
    Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL);
    goto done;

  not_match:
#if 1
    TclPrintfResult(opts->interp,
	    "input string does not match supplied format");
#else
    /* to debug where exactly scan breaks */
    TclPrintfResult(opts->interp,
	    "input string \"%s\" does not match supplied format \"%s\","
	    " locale \"%s\" - token \"%s\"",
	    info->dateStart, HashEntry4FmtScn(fss)->key.string,
	    TclGetString(opts->localeObj),
	    tok && tok->tokWord.start ? tok->tokWord.start : "NULL");
#endif
    Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", (char *)NULL);
    goto done;
}

#define FrmResultIsAllocated(dateFmt) \
    (dateFmt->resEnd - dateFmt->resMem > MIN_FMT_RESULT_BLOCK_ALLOC)
Changes to generic/tclCmdAH.c.
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	Tcl_DString ds;
	result = Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(dir), -1, 0, &ds, NULL);
	Tcl_DStringFree(&ds);
	if (result == TCL_OK) {
	    result = Tcl_FSChdir(dir);
	}
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't change working directory to \"%s\": %s",
		    TclGetString(dir), Tcl_PosixError(interp)));
	    result = TCL_ERROR;
	}
    }
    if (objc != 2) {
	Tcl_DecrRefCount(dir);
    }
    return result;







|

|







287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	Tcl_DString ds;
	result = Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, TclGetString(dir), -1, 0, &ds, NULL);
	Tcl_DStringFree(&ds);
	if (result == TCL_OK) {
	    result = Tcl_FSChdir(dir);
	}
	if (result != TCL_OK) {
	    Tcl_PrintfResult(interp,
		    "couldn't change working directory to \"%s\": %s",
		    TclGetString(dir), Tcl_PosixError(interp));
	    result = TCL_ERROR;
	}
    }
    if (objc != 2) {
	Tcl_DecrRefCount(dir);
    }
    return result;
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
	return TCL_OK;
    }

    dirListObj = objv[1];
    if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"expected directory list but got \"%s\"",
		TclGetString(dirListObj)));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
		(char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirListObj);
    return TCL_OK;
}







<
|
|







728
729
730
731
732
733
734

735
736
737
738
739
740
741
742
743
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
	return TCL_OK;
    }

    dirListObj = objv[1];
    if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {

	Tcl_PrintfResult(interp, "expected directory list but got \"%s\"",
		TclGetString(dirListObj));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
		(char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirListObj);
    return TCL_OK;
}
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not get access time for file \"%s\"",
		TclGetString(objv[1])));
	return TCL_ERROR;
    }
#endif

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = Tcl_GetModificationTimeFromStat(&buf);

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * atime - hopefully the same as the one we sent in. However, fs's
	 * like FAT don't even know what atime is.







<
|
|




















|

|







1223
1224
1225
1226
1227
1228
1229

1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (Tcl_GetAccessTimeFromStat(&buf) == 0) {

	Tcl_PrintfResult(interp, "could not get access time for file \"%s\"",
		TclGetString(objv[1]));
	return TCL_ERROR;
    }
#endif

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = newTime;
	tval.modtime = Tcl_GetModificationTimeFromStat(&buf);

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_PrintfResult(interp,
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * atime - hopefully the same as the one we sent in. However, fs's
	 * like FAT don't even know what atime is.
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not get modification time for file \"%s\"",
		TclGetString(objv[1])));
	return TCL_ERROR;
    }
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = Tcl_GetAccessTimeFromStat(&buf);
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set modification time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * mtime - hopefully the same as the one we sent in.
	 */







|

|



















|

|







1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
	Tcl_PrintfResult(interp,
		"could not get modification time for file \"%s\"",
		TclGetString(objv[1]));
	return TCL_ERROR;
    }
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}

	tval.actime = Tcl_GetAccessTimeFromStat(&buf);
	tval.modtime = newTime;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_PrintfResult(interp,
		    "could not set modification time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * mtime - hopefully the same as the one we sent in.
	 */
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], (Tcl_Size *)NULL);
    if (res == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		(char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}







|

|







2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], (Tcl_Size *)NULL);
    if (res == NULL) {
	Tcl_PrintfResult(interp,
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1]));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		(char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
    } else {
	status = statProc(pathPtr, statPtr);
    }
    Tcl_DStringFree(&ds);

    if (status < 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*







|

|







2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
    } else {
	status = statProc(pathPtr, statPtr);
    }
    Tcl_DStringFree(&ds);

    if (status < 0) {
	if (interp != NULL) {
	    Tcl_PrintfResult(interp,
		    "could not read \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp));
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
	result = TclListObjLength(interp, statePtr->vCopyList[i],
		&statePtr->varcList[i]);
	if (result != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (statePtr->varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s varlist is empty",
		(statePtr->resultList != NULL ? "lmap" : "foreach")));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", (char *)NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],







|
|
|







2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
	result = TclListObjLength(interp, statePtr->vCopyList[i],
		&statePtr->varcList[i]);
	if (result != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (statePtr->varcList[i] < 1) {
	    Tcl_PrintfResult(interp,
		    "%s varlist is empty",
		    (statePtr->resultList != NULL ? "lmap" : "foreach"));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", (char *)NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
Changes to generic/tclCmdIL.c.
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *boolObj;

    if (objc <= 1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"wrong # args: no expression after \"%s\" argument",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * At this point, objv[1] refers to the main expression to test. The
     * arguments after the expression must be "then" (optional) and a script







|

|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *boolObj;

    if (objc <= 1) {
	Tcl_PrintfResult(interp,
		"wrong # args: no expression after \"%s\" argument",
		TclGetString(objv[0]));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * At this point, objv[1] refers to the main expression to test. The
     * arguments after the expression must be "then" (optional) and a script
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
	 * At this point in the loop, objv and objc refer to an expression to
	 * test, either for the main expression or an expression following an
	 * "elseif". The arguments after the expression must be "then"
	 * (optional) and a script to execute if the expression is true.
	 */

	if (i >= objc) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "wrong # args: no expression after \"%s\" argument",
		    clause));
	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
	    return TCL_ERROR;
	}
	if (!thenScriptIndex) {
	    TclNewObj(boolObj);
	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
		    INT2PTR(i), boolObj);







|

|







309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
	 * At this point in the loop, objv and objc refer to an expression to
	 * test, either for the main expression or an expression following an
	 * "elseif". The arguments after the expression must be "then"
	 * (optional) and a script to execute if the expression is true.
	 */

	if (i >= objc) {
	    Tcl_PrintfResult(interp,
		    "wrong # args: no expression after \"%s\" argument",
		    clause);
	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
	    return TCL_ERROR;
	}
	if (!thenScriptIndex) {
	    TclNewObj(boolObj);
	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
		    INT2PTR(i), boolObj);
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369

	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
		iPtr->cmdFramePtr, thenScriptIndex);
    }
    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);

  missingScript:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "wrong # args: no script following \"%s\" argument",
	    TclGetString(objv[i-1])));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|

|







353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369

	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
		iPtr->cmdFramePtr, thenScriptIndex);
    }
    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);

  missingScript:
    Tcl_PrintfResult(interp,
	    "wrong # args: no script following \"%s\" argument",
	    TclGetString(objv[i-1]));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Build a return list containing the arguments.
     */







<
|







483
484
485
486
487
488
489

490
491
492
493
494
495
496
497
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {

	TclPrintfResult(interp, "\"%s\" isn't a procedure", name);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Build a return list containing the arguments.
     */
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Here we used to return procPtr->bodyPtr, except when the body was
     * bytecompiled - in that case, the return was a copy of the body's string







<
|







544
545
546
547
548
549
550

551
552
553
554
555
556
557
558
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {

	TclPrintfResult(interp, "\"%s\" isn't a procedure", name);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Here we used to return procPtr->bodyPtr, except when the body was
     * bytecompiled - in that case, the return was a copy of the body's string
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
    }

    procName = TclGetString(objv[1]);
    argName = TclGetString(objv[2]);

    procPtr = TclFindProc(iPtr, procName);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", procName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
		(char *)NULL);
	return TCL_ERROR;
    }

    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {







<
|







963
964
965
966
967
968
969

970
971
972
973
974
975
976
977
    }

    procName = TclGetString(objv[1]);
    argName = TclGetString(objv[2]);

    procPtr = TclFindProc(iPtr, procName);
    if (procPtr == NULL) {

	TclPrintfResult(interp, "\"%s\" isn't a procedure", procName);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
		(char *)NULL);
	return TCL_ERROR;
    }

    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
		}
		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	    }
	    return TCL_OK;
	}
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "procedure \"%s\" doesn't have an argument \"%s\"",
	    procName, argName));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







<
|
|







995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1009
1010
		}
		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	    }
	    return TCL_OK;
	}
    }


    TclPrintfResult(interp, "procedure \"%s\" doesn't have an argument \"%s\"",
	    procName, argName);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    if ((level > topLevel) || (level <= - topLevel)) {
    levelError:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad level \"%s\"", TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
		TclGetString(objv[1]), (char *)NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*







<
|







1177
1178
1179
1180
1181
1182
1183

1184
1185
1186
1187
1188
1189
1190
1191
    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    if ((level > topLevel) || (level <= - topLevel)) {
    levelError:

	TclPrintfResult(interp, "bad level \"%s\"", TclGetString(objv[1]));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
		TclGetString(objv[1]), (char *)NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
	return TCL_OK;
    }

    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
    return TCL_ERROR;

  levelError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad level \"%s\"", TclGetString(objv[1])));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
	    TclGetString(objv[1]), (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------







<
|







1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629
1630
	return TCL_OK;
    }

    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
    return TCL_ERROR;

  levelError:

    TclPrintfResult(interp, "bad level \"%s\"", TclGetString(objv[1]));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
	    TclGetString(objv[1]), (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE,
			TCL_INDEX_NONE, &encoded) != TCL_OK) {
		    result = TCL_ERROR;
		}
		if (encoded == (int)TCL_INDEX_NONE) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" out of range",
			    TclGetString(indices[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %" TCL_Z_MODIFIER "u)", j));
		    goto done;







<
|
|







3328
3329
3330
3331
3332
3333
3334

3335
3336
3337
3338
3339
3340
3341
3342
3343
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE,
			TCL_INDEX_NONE, &encoded) != TCL_OK) {
		    result = TCL_ERROR;
		}
		if (encoded == (int)TCL_INDEX_NONE) {

		    TclPrintfResult(interp, "index \"%s\" out of range",
			    TclGetString(indices[j]));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %" TCL_Z_MODIFIER "u)", j));
		    goto done;
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
    if (allowedArgs & RangeKeywordArg) {
	result = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
		"range operation", 0, &opmode);
    }
    if (result == TCL_OK) {
	if (allowedArgs & LastArg) {
	    /* keyword found, but no followed number */
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "missing \"%s\" value.", TclGetString(argPtr)));
	    return ErrArg;
	}
	*keywordIndexPtr = opmode;
	return RangeKeywordArg;
    } else {
	Tcl_Obj *exprValueObj;
	if (!(allowedArgs & NumericArg)) {







|
|







3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
    if (allowedArgs & RangeKeywordArg) {
	result = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations,
		"range operation", 0, &opmode);
    }
    if (result == TCL_OK) {
	if (allowedArgs & LastArg) {
	    /* keyword found, but no followed number */
	    TclPrintfResult(interp, "missing \"%s\" value.",
		    TclGetString(argPtr));
	    return ErrArg;
	}
	*keywordIndexPtr = opmode;
	return RangeKeywordArg;
    } else {
	Tcl_Obj *exprValueObj;
	if (!(allowedArgs & NumericArg)) {
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490

	    for (j=0 ; j<sortindex ; j++) {
		int encoded = 0;
		int result = TclIndexEncode(interp, indexv[j],
			TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded);

		if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" out of range",
			    TclGetString(indexv[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %" TCL_Z_MODIFIER "u)", j));
		    sortInfo.resultCode = TCL_ERROR;
		    goto done;
		}
	    }
	    indexPtr = objv[i+1];
	    i++;
	    break;







<
|
|




|
|







4461
4462
4463
4464
4465
4466
4467

4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482

	    for (j=0 ; j<sortindex ; j++) {
		int encoded = 0;
		int result = TclIndexEncode(interp, indexv[j],
			TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded);

		if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) {

		    TclPrintfResult(interp, "index \"%s\" out of range",
			    TclGetString(indexv[j]));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    TclPrintfResult(interp,
			    "\n    (-index option item number %" TCL_Z_MODIFIER "u)", j);
		    sortInfo.resultCode = TCL_ERROR;
		    goto done;
		}
	    }
	    indexPtr = objv[i+1];
	    i++;
	    break;
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
    elmArrSize = length * sizeof(SortElement);
    if (elmArrSize <= MAXCALLOC) {
	elementArray = (SortElement *)Tcl_Alloc(elmArrSize);
    } else {
	elementArray = (SortElement *)malloc(elmArrSize);
    }
    if (!elementArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no enough memory to proccess sort of %" TCL_Z_MODIFIER "u items", length));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
	sortInfo.resultCode = TCL_ERROR;
	goto done;
    }

    for (i=0; i < length; i++) {
	idx = groupSize * i + groupOffset;







|
|







4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
    elmArrSize = length * sizeof(SortElement);
    if (elmArrSize <= MAXCALLOC) {
	elementArray = (SortElement *)Tcl_Alloc(elmArrSize);
    } else {
	elementArray = (SortElement *)malloc(elmArrSize);
    }
    if (!elementArray) {
	TclPrintfResult(interp,
		"no enough memory to proccess sort of %" TCL_Z_MODIFIER "u items", length);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
	sortInfo.resultCode = TCL_ERROR;
	goto done;
    }

    for (i=0; i < length; i++) {
	idx = groupSize * i + groupOffset;
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    } else {
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element %d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    }
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", (char *)NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;







|

|

|

|







5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
		TclPrintfResult(infoPtr->interp,
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr));
	    } else {
		TclPrintfResult(infoPtr->interp,
			"element %d missing from sublist \"%s\"",
			index, TclGetString(objPtr));
	    }
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", (char *)NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;
Changes to generic/tclCmdMZ.c.
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
    if (objc == 4) {
	const char *string = TclGetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }

    /*







|
|







1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
    if (objc == 4) {
	const char *string = TclGetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", length2) == 0) {
	    nocase = 1;
	} else {
	    TclPrintfResult(interp,
		    "bad option \"%s\": must be -nocase", string);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }

    /*
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
    if (objc == 4) {
	Tcl_Size length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) && strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));







|
|







2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
    if (objc == 4) {
	Tcl_Size length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) && strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    TclPrintfResult(interp,
		    "bad option \"%s\": must be -nocase", string);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
	    if (TclGetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((Tcl_WideUInt)reqlength > TCL_SIZE_MAX) {
		reqlength = -1;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string2));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, (char *)NULL);
	    return TCL_ERROR;
	}
    }

    /*







|

|







2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
	    if (TclGetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((Tcl_WideUInt)reqlength > TCL_SIZE_MAX) {
		reqlength = -1;
	    }
	} else {
	    TclPrintfResult(interp,
		    "bad option \"%s\": must be -nocase or -length",
		    string2);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, (char *)NULL);
	    return TCL_ERROR;
	}
    }

    /*
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
	    }
	    if ((Tcl_WideUInt)wreqlength > TCL_SIZE_MAX) {
		*reqlength = -1;
	    } else {
		*reqlength = wreqlength;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}







|

|







2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
	    }
	    if ((Tcl_WideUInt)wreqlength > TCL_SIZE_MAX) {
		*reqlength = -1;
	    } else {
		*reqlength = wreqlength;
	    }
	} else {
	    TclPrintfResult(interp,
		    "bad option \"%s\": must be -nocase or -length",
		    string);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, (char *)NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593

	default:
	    if (foundmode) {
		/*
		 * Mode already set via -exact, -glob, or -regexp.
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad option \"%s\": %s option already found",
			TclGetString(objv[i]), options[mode]));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"DOUBLEOPT", (char *)NULL);
		return TCL_ERROR;
	    }
	    foundmode = 1;
	    mode = index;
	    break;

	    /*
	     * Check for TIP#75 options specifying the variables to write
	     * regexp information into.
	     */

	case OPT_INDEXV:
	    i++;
	    if (i >= objc-2) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"missing variable name argument to %s option",
			"-indexvar"));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", (char *)NULL);
		return TCL_ERROR;
	    }
	    indexVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	case OPT_MATCHV:
	    i++;
	    if (i >= objc-2) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"missing variable name argument to %s option",
			"-matchvar"));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", (char *)NULL);
		return TCL_ERROR;
	    }
	    matchVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	}
    }

  finishedOptions:
    if (objc - i < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? string ?pattern body ...? ?default body?");
	return TCL_ERROR;
    }
    if (indexVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-indexvar"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }
    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-matchvar"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }
    if (noCase && mode == OPT_INTEGER) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"-nocase option cannot be used with -integer option"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }

    valueObj = objv[i];
    objc -= i + 1;







|

|
















|

|










|

|

















|
|





|
|





|
|







3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593

	default:
	    if (foundmode) {
		/*
		 * Mode already set via -exact, -glob, or -regexp.
		 */

		TclPrintfResult(interp,
			"bad option \"%s\": %s option already found",
			TclGetString(objv[i]), options[mode]);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"DOUBLEOPT", (char *)NULL);
		return TCL_ERROR;
	    }
	    foundmode = 1;
	    mode = index;
	    break;

	    /*
	     * Check for TIP#75 options specifying the variables to write
	     * regexp information into.
	     */

	case OPT_INDEXV:
	    i++;
	    if (i >= objc-2) {
		TclPrintfResult(interp,
			"missing variable name argument to %s option",
			"-indexvar");
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", (char *)NULL);
		return TCL_ERROR;
	    }
	    indexVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	case OPT_MATCHV:
	    i++;
	    if (i >= objc-2) {
		TclPrintfResult(interp,
			"missing variable name argument to %s option",
			"-matchvar");
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", (char *)NULL);
		return TCL_ERROR;
	    }
	    matchVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	}
    }

  finishedOptions:
    if (objc - i < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? string ?pattern body ...? ?default body?");
	return TCL_ERROR;
    }
    if (indexVarObj != NULL && mode != OPT_REGEXP) {
	TclPrintfResult(interp,
		"%s option requires -regexp option", "-indexvar");
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }
    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	TclPrintfResult(interp,
		"%s option requires -regexp option", "-matchvar");
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }
    if (noCase && mode == OPT_INTEGER) {
	TclPrintfResult(interp,
		"-nocase option cannot be used with -integer option");
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }

    valueObj = objv[i];
    objc -= i + 1;
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685

    /*
     * Complain if the last body is a continuation. Note that this check
     * assumes that the list is non-empty!
     */

    if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no body specified for pattern \"%s\"",
		TclGetString(objv[objc-2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		"FALLTHROUGH", (char *)NULL);
	return TCL_ERROR;
    }

    if (mode == OPT_INTEGER) {
	if (Tcl_GetWideIntFromObj(interp, valueObj, &intValue) != TCL_OK) {







<
|
|







3669
3670
3671
3672
3673
3674
3675

3676
3677
3678
3679
3680
3681
3682
3683
3684

    /*
     * Complain if the last body is a continuation. Note that this check
     * assumes that the list is non-empty!
     */

    if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {

	TclPrintfResult(interp, "no body specified for pattern \"%s\"",
		TclGetString(objv[objc-2]));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		"FALLTHROUGH", (char *)NULL);
	return TCL_ERROR;
    }

    if (mode == OPT_INTEGER) {
	if (Tcl_GetWideIntFromObj(interp, valueObj, &intValue) != TCL_OK) {
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"ARGUMENT", (char *)NULL);
		return TCL_ERROR;
	    }
	    code = 1;
	    if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad prefix '%s': must be a list",
			TclGetString(objv[i+1])));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"EXNFORMAT", (char *)NULL);
		return TCL_ERROR;
	    }
	    info[2] = objv[i+1];








<
|
|







4852
4853
4854
4855
4856
4857
4858

4859
4860
4861
4862
4863
4864
4865
4866
4867
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"ARGUMENT", (char *)NULL);
		return TCL_ERROR;
	    }
	    code = 1;
	    if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {

		TclPrintfResult(interp, "bad prefix '%s': must be a list",
			TclGetString(objv[i+1]));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"EXNFORMAT", (char *)NULL);
		return TCL_ERROR;
	    }
	    info[2] = objv[i+1];

5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
	}
	const char *s = Tcl_GetString(objv[2]);
	if (!strcmp(s, "replace")) {
	    profile = TCL_ENCODING_PROFILE_REPLACE;
	} else if (!strcmp(s, "strict")) {
	    profile = TCL_ENCODING_PROFILE_STRICT;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Invalid value \"%s\" supplied for option \"-profile\". "
		    "Must be \"strict\" or \"replace\".", s));
	    return TCL_ERROR;
	}
    } else if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-profile PROFILE? STRING");
	return TCL_ERROR;
    }








|

|







5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
	}
	const char *s = Tcl_GetString(objv[2]);
	if (!strcmp(s, "replace")) {
	    profile = TCL_ENCODING_PROFILE_REPLACE;
	} else if (!strcmp(s, "strict")) {
	    profile = TCL_ENCODING_PROFILE_STRICT;
	} else {
	    TclPrintfResult(interp,
		    "Invalid value \"%s\" supplied for option \"-profile\". "
		    "Must be \"strict\" or \"replace\".", s);
	    return TCL_ERROR;
	}
    } else if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-profile PROFILE? STRING");
	return TCL_ERROR;
    }

Changes to generic/tclCompile.c.
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526

    if (numBytes > 0) {
	if (numBytes >= INT_MAX) {
	    /*
	     * Note this gets -errorline as 1. Not worth figuring out which line
	     * crosses the limit to get -errorline for this error case.
	     */
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Script length %" TCL_SIZE_MODIFIER
		    "d exceeds max permitted length %d.",
		    numBytes, INT_MAX - 1));
	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", (char *)NULL);
	    TclCompileSyntaxError(interp, envPtr);
	    return;
	}
	/*
	 * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
	 * many nested compilations (body enclosed in body) can cause abnormal







|


|







2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526

    if (numBytes > 0) {
	if (numBytes >= INT_MAX) {
	    /*
	     * Note this gets -errorline as 1. Not worth figuring out which line
	     * crosses the limit to get -errorline for this error case.
	     */
	    TclPrintfResult(interp,
		    "Script length %" TCL_SIZE_MODIFIER
		    "d exceeds max permitted length %d.",
		    numBytes, INT_MAX - 1);
	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", (char *)NULL);
	    TclCompileSyntaxError(interp, envPtr);
	    return;
	}
	/*
	 * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
	 * many nested compilations (body enclosed in body) can cause abnormal
Changes to generic/tclDictObj.c.
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
	    int isNew;			/* Dummy */

	    if (flags & DICT_PATH_EXISTS) {
		return DICT_PATH_NON_EXISTENT;
	    }
	    if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "key \"%s\" not known in dictionary",
			    TclGetString(keyv[i])));
		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			    TclGetString(keyv[i]), (char *)NULL);
		}
		return NULL;
	    }

	    /*







|

|







807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
	    int isNew;			/* Dummy */

	    if (flags & DICT_PATH_EXISTS) {
		return DICT_PATH_NON_EXISTENT;
	    }
	    if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
		if (interp != NULL) {
		    TclPrintfResult(interp,
			    "key \"%s\" not known in dictionary",
			    TclGetString(keyv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			    TclGetString(keyv[i]), (char *)NULL);
		}
		return NULL;
	    }

	    /*
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
	return TCL_ERROR;
    }
    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"key \"%s\" not known in dictionary",
		TclGetString(objv[objc-1])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		TclGetString(objv[objc-1]), (char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}







<
|
|







1767
1768
1769
1770
1771
1772
1773

1774
1775
1776
1777
1778
1779
1780
1781
1782
	return TCL_ERROR;
    }
    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (valuePtr == NULL) {

	TclPrintfResult(interp, "key \"%s\" not known in dictionary",
		TclGetString(objv[objc-1]));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		TclGetString(objv[objc-1]), (char *)NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}
Changes to generic/tclDisassemble.c.
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
	    return TCL_ERROR;
	}

	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" isn't a procedure", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
		    TclGetString(objv[2]), (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile (if uncompiled) and disassemble a procedure.







|
|







1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
	    return TCL_ERROR;
	}

	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
	if (procPtr == NULL) {
	    TclPrintfResult(interp, "\"%s\" isn't a procedure",
		    TclGetString(objv[2]));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
		    TclGetString(objv[2]), (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile (if uncompiled) and disassemble a procedure.
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
	classPtr = TclOOGetClassFromObj(interp, ooWhat);
	if (classPtr == NULL) {
	    return TCL_ERROR;
	}

	methodPtr = classPtr->constructorPtr;
	if (methodPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" has no defined constructor",
		    TclGetString(ooWhat)));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "CONSRUCTOR", (char *)NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(







<
|
|







1477
1478
1479
1480
1481
1482
1483

1484
1485
1486
1487
1488
1489
1490
1491
1492
	classPtr = TclOOGetClassFromObj(interp, ooWhat);
	if (classPtr == NULL) {
	    return TCL_ERROR;
	}

	methodPtr = classPtr->constructorPtr;
	if (methodPtr == NULL) {

	    TclPrintfResult(interp, "\"%s\" has no defined constructor",
		    TclGetString(ooWhat));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "CONSRUCTOR", (char *)NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
	classPtr = TclOOGetClassFromObj(interp, ooWhat);
	if (classPtr == NULL) {
	    return TCL_ERROR;
	}

	methodPtr = classPtr->destructorPtr;
	if (methodPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" has no defined destructor",
		    TclGetString(ooWhat)));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "DESRUCTOR", (char *)NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(







<
|
|







1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1528
1529
	classPtr = TclOOGetClassFromObj(interp, ooWhat);
	if (classPtr == NULL) {
	    return TCL_ERROR;
	}

	methodPtr = classPtr->destructorPtr;
	if (methodPtr == NULL) {

	    TclPrintfResult(interp, "\"%s\" has no defined destructor",
		    TclGetString(ooWhat));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "DESRUCTOR", (char *)NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
	/*
	 * Compile (if necessary) and disassemble a method body.
	 */

    methodBody:
	if (hPtr == NULL) {
	unknownMethod:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown method \"%s\"", TclGetString(ooWhat)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(ooWhat), (char *)NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(







|
|







1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
	/*
	 * Compile (if necessary) and disassemble a method body.
	 */

    methodBody:
	if (hPtr == NULL) {
	unknownMethod:
	    TclPrintfResult(interp, "unknown method \"%s\"",
		    TclGetString(ooWhat));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(ooWhat), (char *)NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
Changes to generic/tclEncoding.c.
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
			? TCL_INDEX_NONE : nBytesProcessed;
	    } else {
		/* Caller wants error message on failure */
		if (result != TCL_OK && interp != NULL) {
		    char buf[TCL_INTEGER_SPACE];
		    snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d",
			    nBytesProcessed);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "unexpected byte sequence starting at index %"
			    TCL_SIZE_MODIFIER "d: '\\x%02X'",
			    nBytesProcessed, UCHAR(srcStart[nBytesProcessed])));
		    Tcl_SetErrorCode(
			    interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf,
			    (char *)NULL);
		}
	    }
	    if (result != TCL_OK) {
		errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;







|


|







1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
			? TCL_INDEX_NONE : nBytesProcessed;
	    } else {
		/* Caller wants error message on failure */
		if (result != TCL_OK && interp != NULL) {
		    char buf[TCL_INTEGER_SPACE];
		    snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d",
			    nBytesProcessed);
		    TclPrintfResult(interp,
			    "unexpected byte sequence starting at index %"
			    TCL_SIZE_MODIFIER "d: '\\x%02X'",
			    nBytesProcessed, UCHAR(srcStart[nBytesProcessed]));
		    Tcl_SetErrorCode(
			    interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf,
			    (char *)NULL);
		}
	    }
	    if (result != TCL_OK) {
		errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
		    Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
		    int ucs4;
		    char buf[TCL_INTEGER_SPACE];

		    TclUtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
		    snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d",
			    nBytesProcessed);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "unexpected character at index %" TCL_SIZE_MODIFIER
			    "u: 'U+%06X'",
			    pos, ucs4));
		    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
			    buf, (char *)NULL);
		}
	    }
	    if (result != TCL_OK) {
		errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
	    }







|


|







1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
		    Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
		    int ucs4;
		    char buf[TCL_INTEGER_SPACE];

		    TclUtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
		    snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d",
			    nBytesProcessed);
		    TclPrintfResult(interp,
			    "unexpected character at index %" TCL_SIZE_MODIFIER
			    "u: 'U+%06X'",
			    pos, ucs4);
		    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
			    buf, (char *)NULL);
		}
	    }
	    if (result != TCL_OK) {
		errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
	    }
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
	    map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
	    TclDictPut(NULL, map, name, dir[i]);
	    TclSetProcessGlobalValue(&encodingFileMap, map);
	}
    }

    if ((NULL == chan) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown encoding \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (char *)NULL);
    }
    Tcl_DecrRefCount(fileNameObj);
    Tcl_DecrRefCount(searchPath);

    return chan;
}







<
|







1838
1839
1840
1841
1842
1843
1844

1845
1846
1847
1848
1849
1850
1851
1852
	    map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
	    TclDictPut(NULL, map, name, dir[i]);
	    TclSetProcessGlobalValue(&encodingFileMap, map);
	}
    }

    if ((NULL == chan) && (interp != NULL)) {

	TclPrintfResult(interp, "unknown encoding \"%s\"", name);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (char *)NULL);
    }
    Tcl_DecrRefCount(fileNameObj);
    Tcl_DecrRefCount(searchPath);

    return chan;
}
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
	encoding = LoadTableEncoding(name, ENCODING_MULTIBYTE, chan);
	break;
    case 'E':
	encoding = LoadEscapeEncoding(name, chan);
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid encoding file \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (char *)NULL);
    }
    Tcl_CloseEx(NULL, chan, 0);

    return encoding;
}








<
|







1911
1912
1913
1914
1915
1916
1917

1918
1919
1920
1921
1922
1923
1924
1925
	encoding = LoadTableEncoding(name, ENCODING_MULTIBYTE, chan);
	break;
    case 'E':
	encoding = LoadEscapeEncoding(name, chan);
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {

	TclPrintfResult(interp, "invalid encoding file \"%s\"", name);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (char *)NULL);
    }
    Tcl_CloseEx(NULL, chan, 0);

    return encoding;
}

4612
4613
4614
4615
4616
4617
4618
4619
4620

4621
4622
4623
4624
4625
4626
4627

    for (i = 0; i < sizeof(encodingProfiles) / sizeof(encodingProfiles[0]); ++i) {
	if (profileValue == encodingProfiles[i].value) {
	    return encodingProfiles[i].name;
	}
    }
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Internal error. Bad profile id \"%d\".", profileValue));

	Tcl_SetErrorCode(
		interp, "TCL", "ENCODING", "PROFILEID", (char *)NULL);
    }
    return NULL;
}

/*







<
|
>







4610
4611
4612
4613
4614
4615
4616

4617
4618
4619
4620
4621
4622
4623
4624
4625

    for (i = 0; i < sizeof(encodingProfiles) / sizeof(encodingProfiles[0]); ++i) {
	if (profileValue == encodingProfiles[i].value) {
	    return encodingProfiles[i].name;
	}
    }
    if (interp) {

	TclPrintfResult(interp, "Internal error. Bad profile id \"%d\".",
		profileValue);
	Tcl_SetErrorCode(
		interp, "TCL", "ENCODING", "PROFILEID", (char *)NULL);
    }
    return NULL;
}

/*
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
    Tcl_UnicodeNormalizationForm normForm, // TCL_{NFC,NFD,NFKC,NFKC}
    int profile,		// TCL_ENCODING_PROFILE_{STRICT,REPLACE}
    utf8proc_uint8_t **bufPtrPtr) // On success, output length excluding nul.
{
    if (profile != TCL_ENCODING_PROFILE_REPLACE &&
	    profile != TCL_ENCODING_PROFILE_STRICT) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Invalid value %d passed for encoding profile.",
		    profile));
	    Tcl_SetErrorCode(
		    interp, "TCL", "ENCODING", "PROFILEID", (char *)NULL);
	}
	return -1;
    }

    unsigned options = UTF8PROC_STABLE;







|

|







4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
    Tcl_UnicodeNormalizationForm normForm, // TCL_{NFC,NFD,NFKC,NFKC}
    int profile,		// TCL_ENCODING_PROFILE_{STRICT,REPLACE}
    utf8proc_uint8_t **bufPtrPtr) // On success, output length excluding nul.
{
    if (profile != TCL_ENCODING_PROFILE_REPLACE &&
	    profile != TCL_ENCODING_PROFILE_STRICT) {
	if (interp) {
	    TclPrintfResult(interp,
		    "Invalid value %d passed for encoding profile.",
		    profile);
	    Tcl_SetErrorCode(
		    interp, "TCL", "ENCODING", "PROFILEID", (char *)NULL);
	}
	return -1;
    }

    unsigned options = UTF8PROC_STABLE;
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
	options |= UTF8PROC_COMPOSE | UTF8PROC_COMPAT;
	break;
    case TCL_NFKD:
	options |= UTF8PROC_DECOMPOSE | UTF8PROC_COMPAT;
	break;
    default:
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Invalid value %d passed for normalization form.",
		    normForm));
	    Tcl_SetErrorCode(
		    interp, "TCL", "ENCODING", "NORMFORM", (char *)NULL);
	}
	return -1;
    }

    if (numBytes < 0) {







|

|







4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
	options |= UTF8PROC_COMPOSE | UTF8PROC_COMPAT;
	break;
    case TCL_NFKD:
	options |= UTF8PROC_DECOMPOSE | UTF8PROC_COMPAT;
	break;
    default:
	if (interp) {
	    TclPrintfResult(interp,
		    "Invalid value %d passed for normalization form.",
		    normForm);
	    Tcl_SetErrorCode(
		    interp, "TCL", "ENCODING", "NORMFORM", (char *)NULL);
	}
	return -1;
    }

    if (numBytes < 0) {
Changes to generic/tclEnsemble.c.
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
	 */

	token = TclGetOriginalCommand(token);

	if (token == NULL ||
		((Command *) token)->objProc != TclEnsembleImplementationCmd) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj)));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), (char *)NULL);
	    }
	    return NULL;
	}
    }








<
|
|







1492
1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1506
1507
	 */

	token = TclGetOriginalCommand(token);

	if (token == NULL ||
		((Command *) token)->objProc != TclEnsembleImplementationCmd) {
	    if (flags & TCL_LEAVE_ERR_MSG) {

		TclPrintfResult(interp, "\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), (char *)NULL);
	    }
	    return NULL;
	}
    }

2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
     * all...
     */

    Tcl_ResetResult(interp);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
	    TclGetString(subObj), (char *)NULL);
    if (ensemblePtr->subcommandTable.numEntries == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown subcommand \"%s\": namespace %s does not"
		" export any commands", TclGetString(subObj),
		ensemblePtr->nsPtr->fullName));
	return TCL_ERROR;
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0],







|


|







2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
     * all...
     */

    Tcl_ResetResult(interp);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
	    TclGetString(subObj), (char *)NULL);
    if (ensemblePtr->subcommandTable.numEntries == 0) {
	TclPrintfResult(interp,
		"unknown subcommand \"%s\": namespace %s does not"
		" export any commands", TclGetString(subObj),
		ensemblePtr->nsPtr->fullName);
	return TCL_ERROR;
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0],
Changes to generic/tclEvent.c.
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
	case OPT_NO_WEVTS:
	    mask &= ~TCL_WINDOW_EVENTS;
	    break;
	case OPT_TIMEOUT:
	    if (++i >= objc) {
	needArg:
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"argument required for \"%s\"", vWaitOptionStrings[index]));
		Tcl_SetErrorCode(interp, "TCL", "EVENT", "ARGUMENT", (char *)NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[i], &timeout) != TCL_OK) {
		result = TCL_ERROR;
		goto done;







|
|







1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
	case OPT_NO_WEVTS:
	    mask &= ~TCL_WINDOW_EVENTS;
	    break;
	case OPT_TIMEOUT:
	    if (++i >= objc) {
	needArg:
		Tcl_ResetResult(interp);
		TclPrintfResult(interp, "argument required for \"%s\"",
			vWaitOptionStrings[index]);
		Tcl_SetErrorCode(interp, "TCL", "EVENT", "ARGUMENT", (char *)NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[i], &timeout) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
	    }
	    if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0)
		    != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (!(mode & TCL_READABLE)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"channel \"%s\" wasn't open for reading",
			TclGetString(objv[i])));
		result = TCL_ERROR;
		goto done;
	    }
	    Tcl_CreateChannelHandler(chan, TCL_READABLE,
		    VwaitChannelReadProc, &vwaitItems[numItems]);
	    vwaitItems[numItems].donePtr = &done;
	    vwaitItems[numItems].sequence = -1;







|

|







1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
	    }
	    if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0)
		    != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (!(mode & TCL_READABLE)) {
		TclPrintfResult(interp,
			"channel \"%s\" wasn't open for reading",
			TclGetString(objv[i]));
		result = TCL_ERROR;
		goto done;
	    }
	    Tcl_CreateChannelHandler(chan, TCL_READABLE,
		    VwaitChannelReadProc, &vwaitItems[numItems]);
	    vwaitItems[numItems].donePtr = &done;
	    vwaitItems[numItems].sequence = -1;
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
	    }
	    if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0)
		    != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (!(mode & TCL_WRITABLE)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"channel \"%s\" wasn't open for writing",
			TclGetString(objv[i])));
		result = TCL_ERROR;
		goto done;
	    }
	    Tcl_CreateChannelHandler(chan, TCL_WRITABLE,
		    VwaitChannelWriteProc, &vwaitItems[numItems]);
	    vwaitItems[numItems].donePtr = &done;
	    vwaitItems[numItems].sequence = -1;







|

|







1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
	    }
	    if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0)
		    != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (!(mode & TCL_WRITABLE)) {
		TclPrintfResult(interp,
			"channel \"%s\" wasn't open for writing",
			TclGetString(objv[i]));
		result = TCL_ERROR;
		goto done;
	    }
	    Tcl_CreateChannelHandler(chan, TCL_WRITABLE,
		    VwaitChannelWriteProc, &vwaitItems[numItems]);
	    vwaitItems[numItems].donePtr = &done;
	    vwaitItems[numItems].sequence = -1;
Changes to generic/tclExecute.c.
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
	    goto gotError;
	}
	Tcl_Size yieldTargetLength;
	if (TclListObjLength(NULL, valuePtr, &yieldTargetLength) != TCL_OK
		|| yieldTargetLength < 2) {
	    TRACE_APPEND(("ERROR: no valid target list in yieldto"));
	    // Weird case; pretend it's like no arguments given to scripts
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "wrong # args: should be \"yieldto command ?arg ...?\""));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG







|
|







2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
	    goto gotError;
	}
	Tcl_Size yieldTargetLength;
	if (TclListObjLength(NULL, valuePtr, &yieldTargetLength) != TCL_OK
		|| yieldTargetLength < 2) {
	    TRACE_APPEND(("ERROR: no valid target list in yieldto"));
	    // Weird case; pretend it's like no arguments given to scripts
	    TclPrintfResult(interp,
		    "wrong # args: should be \"yieldto command ?arg ...?\"");
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
	    level += framePtr->level;
	}
	for (; ((int)framePtr->level!=level) && (framePtr!=rootFramePtr) ;
		framePtr = framePtr->callerVarPtr) {
	    /* Empty loop body */
	}
	if (framePtr == rootFramePtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
	    TRACE_ERROR(interp);
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}







|
|







4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
	    level += framePtr->level;
	}
	for (; ((int)framePtr->level!=level) && (framePtr!=rootFramePtr) ;
		framePtr = framePtr->callerVarPtr) {
	    /* Empty loop body */
	}
	if (framePtr == rootFramePtr) {
	    TclPrintfResult(interp, "bad level \"%s\"",
		    TclGetString(OBJ_AT_TOS));
	    TRACE_ERROR(interp);
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
	origCmd = TclGetOriginalCommand(cmd);
	if (origCmd == NULL) {
	    origCmd = cmd;
	}

	TclNewObj(objResultPtr);
	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
	if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) {
	    Tcl_DecrRefCount(objResultPtr);
	    instOriginError:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    TRACE_APPEND(("ERROR: not command\n"));
	    goto gotError;
	}







|

|
|
|







4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
	origCmd = TclGetOriginalCommand(cmd);
	if (origCmd == NULL) {
	    origCmd = cmd;
	}

	TclNewObj(objResultPtr);
	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
	if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES) {
	    Tcl_DecrRefCount(objResultPtr);
	instOriginError:
	    TclPrintfResult(interp, "invalid command name \"%s\"",
		    TclGetString(OBJ_AT_TOS));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    TRACE_APPEND(("ERROR: not command\n"));
	    goto gotError;
	}
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
	    }
	    return mPtr->type2Ptr->callProc(mPtr->clientData, interp,
		    (Tcl_ObjectContext) contextPtr, numArgs, objv);
	}

    tclooFrameRequired:
	TRACE_APPEND(("ERROR: no TclOO call context\n"));
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	DECACHE_STACK_INFO();
	OO_ERROR(interp, CONTEXT_REQUIRED);
	CACHE_STACK_INFO();
	goto gotError;
    tclooNoNext:
	TRACE_APPEND(("ERROR: no TclOO next impl\n"));
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no next %s implementation", TclOOContextTypeName(contextPtr)));
	OO_ERROR(interp, NOTHING_NEXT);
	CACHE_STACK_INFO();
	goto gotError;
    tclooNoTargetClass:
	TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
		O2S(valuePtr)));
	// Decide what error message to issue
	for (Tcl_Size i = contextPtr->index ; i >= 0 ; i--) {
	    MInvoke *miPtr = contextPtr->callPtr->chain + i;
	    if (miPtr->isFilter) {
		/* Filters are always at the head of the chain, and we never
		 * want them at this point. */
		break;
	    }
	    if (miPtr->mPtr->declaringClassPtr == clsPtr) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s implementation by \"%s\" not reachable from here",
			TclOOContextTypeName(contextPtr),
			TclGetString(valuePtr)));
		OO_ERROR(interp, CLASS_NOT_REACHABLE);
		CACHE_STACK_INFO();
		goto gotError;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s has no non-filter implementation by \"%s\"",
		TclOOContextTypeName(contextPtr), TclGetString(valuePtr)));
	OO_ERROR(interp, CLASS_NOT_THERE);
	CACHE_STACK_INFO();
	goto gotError;

    case INST_TCLOO_IS_OBJECT:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	DECACHE_STACK_INFO();







<
|
|






|
|















|


|





|

|







4968
4969
4970
4971
4972
4973
4974

4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
	    }
	    return mPtr->type2Ptr->callProc(mPtr->clientData, interp,
		    (Tcl_ObjectContext) contextPtr, numArgs, objv);
	}

    tclooFrameRequired:
	TRACE_APPEND(("ERROR: no TclOO call context\n"));

	TclPrintfResult(interp, "%s may only be called from inside a method",
		TclGetString(objv[0]));
	DECACHE_STACK_INFO();
	OO_ERROR(interp, CONTEXT_REQUIRED);
	CACHE_STACK_INFO();
	goto gotError;
    tclooNoNext:
	TRACE_APPEND(("ERROR: no TclOO next impl\n"));
	TclPrintfResult(interp, "no next %s implementation",
		TclOOContextTypeName(contextPtr));
	OO_ERROR(interp, NOTHING_NEXT);
	CACHE_STACK_INFO();
	goto gotError;
    tclooNoTargetClass:
	TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
		O2S(valuePtr)));
	// Decide what error message to issue
	for (Tcl_Size i = contextPtr->index ; i >= 0 ; i--) {
	    MInvoke *miPtr = contextPtr->callPtr->chain + i;
	    if (miPtr->isFilter) {
		/* Filters are always at the head of the chain, and we never
		 * want them at this point. */
		break;
	    }
	    if (miPtr->mPtr->declaringClassPtr == clsPtr) {
		TclPrintfResult(interp,
			"%s implementation by \"%s\" not reachable from here",
			TclOOContextTypeName(contextPtr),
			TclGetString(valuePtr));
		OO_ERROR(interp, CLASS_NOT_REACHABLE);
		CACHE_STACK_INFO();
		goto gotError;
	    }
	}
	TclPrintfResult(interp,
		"%s has no non-filter implementation by \"%s\"",
		TclOOContextTypeName(contextPtr), TclGetString(valuePtr));
	OO_ERROR(interp, CLASS_NOT_THERE);
	CACHE_STACK_INFO();
	goto gotError;

    case INST_TCLOO_IS_OBJECT:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	DECACHE_STACK_INFO();
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
		&fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (flags & TCL_LREPLACE_NEED_IN_RANGE) {
	    if (fromIdx < 0 || fromIdx >= length) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%s\" out of range", Tcl_GetString(fromIdxObj)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE",
			(char *)NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}







|
|







5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
		&fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (flags & TCL_LREPLACE_NEED_IN_RANGE) {
	    if (fromIdx < 0 || fromIdx >= length) {
		TclPrintfResult(interp, "index \"%s\" out of range",
			Tcl_GetString(fromIdxObj));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE",
			(char *)NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}
7260
7261
7262
7263
7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
		&objResultPtr) != TCL_OK) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s\n",
		    O2S(OBJ_AT_TOS), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	if (!objResultPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "key \"%s\" not known in dictionary",
		    TclGetString(OBJ_AT_TOS)));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    TRACE_APPEND(("ERROR leaf dictionary key \"%.30s\" absent: %s\n",
		    O2S(OBJ_AT_TOS), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;







<
|
|







7259
7260
7261
7262
7263
7264
7265

7266
7267
7268
7269
7270
7271
7272
7273
7274
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
		&objResultPtr) != TCL_OK) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s\n",
		    O2S(OBJ_AT_TOS), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	if (!objResultPtr) {

	    TclPrintfResult(interp, "key \"%s\" not known in dictionary",
		    TclGetString(OBJ_AT_TOS));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), (char *)NULL);
	    CACHE_STACK_INFO();
	    TRACE_APPEND(("ERROR leaf dictionary key \"%.30s\" absent: %s\n",
		    O2S(OBJ_AT_TOS), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
9441
9442
9443
9444
9445
9446
9447
9448
9449
9450
9451
9452
9453
9454
9455
9456
9457
9458
9459
9460
9461
9462
9463
9464
9465
9466
9467
9468
9469
9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483
9484
9485
9486
9487
9488
9489
9490
9491
9492
	    goto cleanupOnError;
	}
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    useDoubles = 1;
	    break;
	case TCL_NUMBER_NAN:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "domain error: argument not in valid range"));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    if (to) {
	if (ParseArithSeriesArgument(interp, &to, &ptr, &type) != TCL_OK) {
	    goto cleanupOnError;
	}
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    useDoubles = 1;
	    break;
	case TCL_NUMBER_NAN:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot use non-numeric floating-point value \"%s\" to "
		    "estimate length of arith-series",
		    TclGetString(to)));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    if (step) {
	if (ParseArithSeriesArgument(interp, &step, &ptr, &type) != TCL_OK) {
	    goto cleanupOnError;
	}
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    useDoubles = 1;
	    break;
	case TCL_NUMBER_NAN:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "domain error: argument not in valid range"));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    // Convert count to integer if not already







|
|















|


|















|
|







9439
9440
9441
9442
9443
9444
9445
9446
9447
9448
9449
9450
9451
9452
9453
9454
9455
9456
9457
9458
9459
9460
9461
9462
9463
9464
9465
9466
9467
9468
9469
9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483
9484
9485
9486
9487
9488
9489
9490
	    goto cleanupOnError;
	}
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    useDoubles = 1;
	    break;
	case TCL_NUMBER_NAN:
	    TclPrintfResult(interp,
		    "domain error: argument not in valid range");
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    if (to) {
	if (ParseArithSeriesArgument(interp, &to, &ptr, &type) != TCL_OK) {
	    goto cleanupOnError;
	}
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    useDoubles = 1;
	    break;
	case TCL_NUMBER_NAN:
	    TclPrintfResult(interp,
		    "cannot use non-numeric floating-point value \"%s\" to "
		    "estimate length of arith-series",
		    TclGetString(to));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    if (step) {
	if (ParseArithSeriesArgument(interp, &step, &ptr, &type) != TCL_OK) {
	    goto cleanupOnError;
	}
	switch (type) {
	case TCL_NUMBER_DOUBLE:
	    useDoubles = 1;
	    break;
	case TCL_NUMBER_NAN:
	    TclPrintfResult(interp,
		    "domain error: argument not in valid range");
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    // Convert count to integer if not already
9504
9505
9506
9507
9508
9509
9510
9511
9512
9513
9514
9515
9516
9517
9518
9519
9520
		// Switch to the object holding integer version of the count.
		TclNewIntObj(count, wCount);
		Tcl_IncrRefCount(count);
	    }
	    break;
	}
	case TCL_NUMBER_NAN:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "expected integer but got \"%s\"",
		    TclGetString(count)));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    // Parameters comprehended and normalised. Now construct the series.







<
|
|







9502
9503
9504
9505
9506
9507
9508

9509
9510
9511
9512
9513
9514
9515
9516
9517
		// Switch to the object holding integer version of the count.
		TclNewIntObj(count, wCount);
		Tcl_IncrRefCount(count);
	    }
	    break;
	}
	case TCL_NUMBER_NAN:

	    TclPrintfResult(interp, "expected integer but got \"%s\"",
		    TclGetString(count));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		    "domain error: argument not in valid range", NULL);
	    goto cleanupOnError;
	}
    }

    // Parameters comprehended and normalised. Now construct the series.
9722
9723
9724
9725
9726
9727
9728
9729
9730
9731
9732
9733
9734
9735
9736
9737

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
	Tcl_Size length;
	if (TclHasInternalRep(opndPtr, &tclDictType)) {
	    Tcl_DictObjSize(NULL, opndPtr, &length);
	    if (length > 0) {
	    listRep:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot use a list as %soperand of \"%s\"", ord, op));
		Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "list", (char *)NULL);
		return;
	    }
	}
	Tcl_ObjTypeLengthProc *lengthProc = TclObjTypeHasProc(opndPtr, lengthProc);
	Tcl_Size objcPtr;
	Tcl_Obj **objvPtr;







|
|







9719
9720
9721
9722
9723
9724
9725
9726
9727
9728
9729
9730
9731
9732
9733
9734

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
	Tcl_Size length;
	if (TclHasInternalRep(opndPtr, &tclDictType)) {
	    Tcl_DictObjSize(NULL, opndPtr, &length);
	    if (length > 0) {
	    listRep:
		TclPrintfResult(interp,
			"cannot use a list as %soperand of \"%s\"", ord, op);
		Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "list", (char *)NULL);
		return;
	    }
	}
	Tcl_ObjTypeLengthProc *lengthProc = TclObjTypeHasProc(opndPtr, lengthProc);
	Tcl_Size objcPtr;
	Tcl_Obj **objvPtr;
9746
9747
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762
    } else if (type == TCL_NUMBER_DOUBLE) {
	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
	description = "(big) integer";
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot use %s \"%s\" as %soperand of \"%s\"", description,
	    TclGetString(opndPtr), ord, op));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --







<
|
|







9743
9744
9745
9746
9747
9748
9749

9750
9751
9752
9753
9754
9755
9756
9757
9758
    } else if (type == TCL_NUMBER_DOUBLE) {
	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
	description = "(big) integer";
    }


    TclPrintfResult(interp, "cannot use %s \"%s\" as %soperand of \"%s\"",
	    description, TclGetString(opndPtr), ord, op);
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
Changes to generic/tclFCmd.c.
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
     * overwriting the symlink.
     */

    if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
	if ((objc - i) > 2) {
	    errno = ENOTDIR;
	    Tcl_PosixError(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error %s: target \"%s\" is not a directory",
		    (copyFlag?"copying":"renaming"), TclGetString(target)));
	    result = TCL_ERROR;
	} else {
	    /*
	     * Even though already have target == translated(objv[i+1]), pass
	     * the original argument down, so if there's an error, the error
	     * message will reflect the original arguments.
	     */







|

|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
     * overwriting the symlink.
     */

    if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
	if ((objc - i) > 2) {
	    errno = ENOTDIR;
	    Tcl_PosixError(interp);
	    TclPrintfResult(interp,
		    "error %s: target \"%s\" is not a directory",
		    (copyFlag?"copying":"renaming"), TclGetString(target));
	    result = TCL_ERROR;
	} else {
	    /*
	     * Even though already have target == translated(objv[i+1]), pass
	     * the original argument down, so if there's an error, the error
	     * message will reflect the original arguments.
	     */
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
	}
	Tcl_DecrRefCount(split);
	split = NULL;
    }

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







<
|
|







337
338
339
340
341
342
343

344
345
346
347
348
349
350
351
352
	}
	Tcl_DecrRefCount(split);
	split = NULL;
    }

  done:
    if (errfile != NULL) {

	TclPrintfResult(interp, "can't create directory \"%s\": %s",
		TclGetString(errfile), Tcl_PosixError(interp));
	result = TCL_ERROR;
    }
    if (split != NULL) {
	Tcl_DecrRefCount(split);
    }
    if (target != NULL) {
	Tcl_DecrRefCount(target);
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
	     * We own a reference count on errorBuffer, if it was set as a
	     * result of this call.
	     */

	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
	    if (result != TCL_OK) {
		if ((force == 0) && (errno == EEXIST)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error deleting \"%s\": directory not empty",
			    TclGetString(objv[i])));
		    Tcl_PosixError(interp);
		    goto done;
		}

		/*
		 * If possible, use the untranslated name for the file.
		 */







|

|







414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
	     * We own a reference count on errorBuffer, if it was set as a
	     * result of this call.
	     */

	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
	    if (result != TCL_OK) {
		if ((force == 0) && (errno == EEXIST)) {
		    TclPrintfResult(interp,
			    "error deleting \"%s\": directory not empty",
			    TclGetString(objv[i]));
		    Tcl_PosixError(interp);
		    goto done;
		}

		/*
		 * If possible, use the untranslated name for the file.
		 */
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /*
	     * We try to accommodate poor error results from our Tcl_FS calls.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting unknown file: %s",
		    Tcl_PosixError(interp)));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));
	}
    }

  done:
    if (errorBuffer != NULL) {
	Tcl_DecrRefCount(errorBuffer);
    }







<
|
|

<
|
|







463
464
465
466
467
468
469

470
471
472

473
474
475
476
477
478
479
480
481
    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /*
	     * We try to accommodate poor error results from our Tcl_FS calls.
	     */


	    TclPrintfResult(interp, "error deleting unknown file: %s",
		    Tcl_PosixError(interp));
	} else {

	    TclPrintfResult(interp, "error deleting \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp));
	}
    }

  done:
    if (errorBuffer != NULL) {
	Tcl_DecrRefCount(errorBuffer);
    }
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
	 * implementations of copy and rename on all platforms also prevent
	 * this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
		&& !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't 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(
		    "can't 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
	 * operation succeeds. If we can't adjust permissions, we'll let the







|

|





|

|







582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
	 * implementations of copy and rename on all platforms also prevent
	 * this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
		&& !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    TclPrintfResult(interp,
		    "can't 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;
	    TclPrintfResult(interp,
		    "can't 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
	 * operation succeeds. If we can't adjust permissions, we'll let the
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
    if (copyFlag == 0) {
	result = Tcl_FSRenameFile(source, target);
	if (result == TCL_OK) {
	    goto done;
	}

	if (errno == EINVAL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error renaming \"%s\" to \"%s\": trying to rename a"
		    " volume or move a directory into itself",
		    TclGetString(source), TclGetString(target)));
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}

	/*







|


|







623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
    if (copyFlag == 0) {
	result = Tcl_FSRenameFile(source, target);
	if (result == TCL_OK) {
	    goto done;
	}

	if (errno == EINVAL) {
	    TclPrintfResult(interp,
		    "error renaming \"%s\" to \"%s\": trying to rename a"
		    " volume or move a directory into itself",
		    TclGetString(source), TclGetString(target));
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}

	/*
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
	 */

	if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
	    /*
	     * Actual file doesn't exist.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error copying \"%s\": the target of this link doesn't"
		    " exist", TclGetString(source)));
	    goto done;
	} else {
	    int counter = 0;

	    while (1) {
		Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
		if (path == NULL) {







|

|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	 */

	if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
	    /*
	     * Actual file doesn't exist.
	     */

	    TclPrintfResult(interp,
		    "error copying \"%s\": the target of this link doesn't"
		    " exist", TclGetString(source));
	    goto done;
	} else {
	    int counter = 0;

	    while (1) {
		Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
		if (path == NULL) {
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
	} else {
	    result = Tcl_FSDeleteFile(source);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));
	    errfile = NULL;
	}
    }

  done:
    if (errfile != NULL) {
	Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",







|
|







804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
	} else {
	    result = Tcl_FSDeleteFile(source);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    TclPrintfResult(interp, "can't unlink \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp));
	    errfile = NULL;
	}
    }

  done:
    if (errfile != NULL) {
	Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
	if (objStrings == NULL) {
	    if (Tcl_GetErrno() != 0) {
		/*
		 * There was an error, probably that the filePtr is not
		 * accepted by any filesystem
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not read \"%s\": %s",
			TclGetString(filePtr), Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}

	/*
	 * We own the object now.
	 */







<
|
|







1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1036
1037
	if (objStrings == NULL) {
	    if (Tcl_GetErrno() != 0) {
		/*
		 * There was an error, probably that the filePtr is not
		 * accepted by any filesystem
		 */


		TclPrintfResult(interp, "could not read \"%s\": %s",
			TclGetString(filePtr), Tcl_PosixError(interp));
	    }
	    return TCL_ERROR;
	}

	/*
	 * We own the object now.
	 */
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
	 * Get one attribute.
	 */

	int index;
	Tcl_Obj *objPtr = NULL;

	if (numObjStrings == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
		"option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
	    goto end;







|

|







1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
	 * Get one attribute.
	 */

	int index;
	Tcl_Obj *objPtr = NULL;

	if (numObjStrings == 0) {
	    TclPrintfResult(interp,
		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0]));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
		"option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
	    goto end;
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
	/*
	 * Set option/value pairs.
	 */

	int i, index;

	if (numObjStrings == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
		goto end;
	    }
	    if (i + 1 == objc) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"value for \"%s\" missing", TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", (char *)NULL);
		goto end;
	    }
	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
		    objv[i + 1]) != TCL_OK) {
		goto end;







|

|










|
|







1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
	/*
	 * Set option/value pairs.
	 */

	int i, index;

	if (numObjStrings == 0) {
	    TclPrintfResult(interp,
		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0]));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
		goto end;
	    }
	    if (i + 1 == objc) {
		TclPrintfResult(interp, "value for \"%s\" missing",
			TclGetString(objv[i]));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", (char *)NULL);
		goto end;
	    }
	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
		    objv[i + 1]) != TCL_OK) {
		goto end;
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
	if (contents == NULL) {
	    /*
	     * We handle three common error cases specially, and for all other
	     * errors, we use the standard Posix error message.
	     */

	    if (errno == EEXIST) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\": that path already"
			" exists", TclGetString(objv[index])));
		Tcl_PosixError(interp);
	    } else if (errno == ENOENT) {
		/*
		 * There are two cases here: either the target doesn't exist,
		 * or the directory of the src doesn't exist.
		 */

		int access;
		Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
			TCL_PATH_DIRNAME);

		if (dirPtr == NULL) {
		    return TCL_ERROR;
		}
		access = Tcl_FSAccess(dirPtr, F_OK);
		Tcl_DecrRefCount(dirPtr);
		if (access != 0) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not create new link \"%s\": no such file"
			    " or directory", TclGetString(objv[index])));
		    Tcl_PosixError(interp);
		} else {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not create new link \"%s\": target \"%s\" "
			    "doesn't exist", TclGetString(objv[index]),
			    TclGetString(objv[index+1])));
		    errno = ENOENT;
		    Tcl_PosixError(interp);
		}
	    } else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\" pointing to \"%s\": %s",
			TclGetString(objv[index]),
			TclGetString(objv[index+1]), Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
    } else {
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckFilenameEncodable(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Read link
	 */

	contents = Tcl_FSLink(objv[index], NULL, 0);
	if (contents == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read link \"%s\": %s",
		    TclGetString(objv[index]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, contents);
    if (objc == 2) {
	/*
	 * If we are reading a link, we need to free this result refCount. If







|

|

















|

|


|


|




|


|

















|

|







1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
	if (contents == NULL) {
	    /*
	     * We handle three common error cases specially, and for all other
	     * errors, we use the standard Posix error message.
	     */

	    if (errno == EEXIST) {
		TclPrintfResult(interp,
			"could not create new link \"%s\": that path already"
			" exists", TclGetString(objv[index]));
		Tcl_PosixError(interp);
	    } else if (errno == ENOENT) {
		/*
		 * There are two cases here: either the target doesn't exist,
		 * or the directory of the src doesn't exist.
		 */

		int access;
		Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
			TCL_PATH_DIRNAME);

		if (dirPtr == NULL) {
		    return TCL_ERROR;
		}
		access = Tcl_FSAccess(dirPtr, F_OK);
		Tcl_DecrRefCount(dirPtr);
		if (access != 0) {
		    TclPrintfResult(interp,
			    "could not create new link \"%s\": no such file"
			    " or directory", TclGetString(objv[index]));
		    Tcl_PosixError(interp);
		} else {
		    TclPrintfResult(interp,
			    "could not create new link \"%s\": target \"%s\" "
			    "doesn't exist", TclGetString(objv[index]),
			    TclGetString(objv[index+1]));
		    errno = ENOENT;
		    Tcl_PosixError(interp);
		}
	    } else {
		TclPrintfResult(interp,
			"could not create new link \"%s\" pointing to \"%s\": %s",
			TclGetString(objv[index]),
			TclGetString(objv[index+1]), Tcl_PosixError(interp));
	    }
	    return TCL_ERROR;
	}
    } else {
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckFilenameEncodable(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Read link
	 */

	contents = Tcl_FSLink(objv[index], NULL, 0);
	if (contents == NULL) {
	    TclPrintfResult(interp,
		    "could not read link \"%s\": %s",
		    TclGetString(objv[index]), Tcl_PosixError(interp));
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, contents);
    if (objc == 2) {
	/*
	 * If we are reading a link, we need to free this result refCount. If
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
    if (CheckFilenameEncodable(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }

    contents = Tcl_FSLink(objv[1], NULL, 0);

    if (contents == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read link \"%s\": %s",
		TclGetString(objv[1]), Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, contents);
    Tcl_DecrRefCount(contents);
    return TCL_OK;
}








<
|
|







1373
1374
1375
1376
1377
1378
1379

1380
1381
1382
1383
1384
1385
1386
1387
1388
    if (CheckFilenameEncodable(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }

    contents = Tcl_FSLink(objv[1], NULL, 0);

    if (contents == NULL) {

	TclPrintfResult(interp, "could not read link \"%s\": %s",
		TclGetString(objv[1]), Tcl_PosixError(interp));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, contents);
    Tcl_DecrRefCount(contents);
    return TCL_OK;
}

1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
     * Deal with results.
     */

    if (chan == NULL) {
	if (nameVarObj) {
	    TclDecrRefCount(nameObj);
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't 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);







|
|







1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
     * Deal with results.
     */

    if (chan == NULL) {
	if (nameVarObj) {
	    TclDecrRefCount(nameObj);
	}
	TclPrintfResult(interp, "can't 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);
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
    }

    /*
     * Deal with results.
     */

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







<
|
|







1680
1681
1682
1683
1684
1685
1686

1687
1688
1689
1690
1691
1692
1693
1694
1695
    }

    /*
     * Deal with results.
     */

    if (dirNameObj == NULL) {

	TclPrintfResult(interp, "can't create temporary directory: %s",
		Tcl_PosixError(interp));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirNameObj);
    return TCL_OK;
}

/*
Changes to generic/tclFileName.c.
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

		/*
		 * Error cases. We reset the 'join' flag to zero, since we
		 * haven't yet made use of it.
		 */

	    badTypesArg:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad argument to \"-types\": %s",
			TclGetString(look)));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (char *)NULL);
		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"only one MacOS type or creator argument"
			" to \"-types\" allowed", -1));
		result = TCL_ERROR;
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (char *)NULL);
		join = 0;
		goto endOfGlob;
	    }
	}
    }







<
|
|






|

|







1451
1452
1453
1454
1455
1456
1457

1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475

		/*
		 * Error cases. We reset the 'join' flag to zero, since we
		 * haven't yet made use of it.
		 */

	    badTypesArg:

		TclPrintfResult(interp, "bad argument to \"-types\": %s",
			TclGetString(look));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (char *)NULL);
		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		TclPrintfResult(interp,
			"only one MacOS type or creator argument"
			" to \"-types\" allowed");
		result = TCL_ERROR;
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (char *)NULL);
		join = 0;
		goto endOfGlob;
	    }
	}
    }
Changes to generic/tclIO.c.
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
	    name = chanPtr->state->channelName;
	}
    }

    hTblPtr = GetChannelTable(interp);
    hPtr = Tcl_FindHashEntry(hTblPtr, name);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can not find channel named \"%s\"", chanName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL);
	return NULL;
    }

    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs







<
|







1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1483
	    name = chanPtr->state->channelName;
	}
    }

    hTblPtr = GetChannelTable(interp);
    hPtr = Tcl_FindHashEntry(hTblPtr, name);
    if (hPtr == NULL) {

	TclPrintfResult(interp, "can not find channel named \"%s\"", chanName);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL);
	return NULL;
    }

    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872

    while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
	statePtr = statePtr->nextCSPtr;
    }

    if (statePtr == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't find state for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	}
	return NULL;
    }

    /*
     * Here we check if the given "mask" matches the "flags" of the already
     * existing channel.
     *
     *	  | - | R | W | RW |
     *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
     *	- |   |   |   |    |
     *	R |   | + |   | +  |	The superceding channel is allowed to restrict
     *	W |   |   | + | +  |	the capabilities of the superceded one!
     *	RW|   | + | + | +  |
     *	--+---+---+---+----+
     */

    if ((mask & GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE)) == 0) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "reading and writing both disallowed for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	}
	return NULL;
    }

    /*
     * Flush the buffers. This ensures that any data still in them at this
     * time is not handled by the new transformation. Restrict this to







<
|
|



















|

|







1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870

    while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
	statePtr = statePtr->nextCSPtr;
    }

    if (statePtr == NULL) {
	if (interp) {

	    TclPrintfResult(interp, "couldn't find state for channel \"%s\"",
		    Tcl_GetChannelName(prevChan));
	}
	return NULL;
    }

    /*
     * Here we check if the given "mask" matches the "flags" of the already
     * existing channel.
     *
     *	  | - | R | W | RW |
     *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
     *	- |   |   |   |    |
     *	R |   | + |   | +  |	The superceding channel is allowed to restrict
     *	W |   |   | + | +  |	the capabilities of the superceded one!
     *	RW|   | + | + | +  |
     *	--+---+---+---+----+
     */

    if ((mask & GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE)) == 0) {
	if (interp) {
	    TclPrintfResult(interp,
		    "reading and writing both disallowed for channel \"%s\"",
		    Tcl_GetChannelName(prevChan));
	}
	return NULL;
    }

    /*
     * Flush the buffers. This ensures that any data still in them at this
     * time is not handled by the new transformation. Restrict this to
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
	 * the stacking state of this channel during its operations.
	 */
	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan)));
	    }
	    return NULL;
	}

	statePtr->csPtrR = csPtrR;
	statePtr->csPtrW = csPtrW;
    }







|

|







1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
	 * the stacking state of this channel during its operations.
	 */
	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		TclPrintfResult(interp,
			"could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan));
	    }
	    return NULL;
	}

	statePtr->csPtrR = csPtrR;
	statePtr->csPtrW = csPtrW;
    }
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
		 * Move error messages put by the driver into the chan/ip
		 * bypass area into the regular interpreter result. Fall back
		 * to the regular message if nothing was found in the
		 * bypasses.
		 */

		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not flush channel \"%s\"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));
		}
		return TCL_ERROR;
	    }

	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	}







<
|
|







2078
2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091
2092
2093
		 * Move error messages put by the driver into the chan/ip
		 * bypass area into the regular interpreter result. Fall back
		 * to the regular message if nothing was found in the
		 * bypasses.
		 */

		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {

		    TclPrintfResult(interp, "could not flush channel \"%s\"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr));
		}
		return TCL_ERROR;
	    }

	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	}
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
    }

    ResetFlag(statePtr, mode);
    return TCL_OK;

  error:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Tcl_RemoveChannelMode error: %s. Channel: \"%s\"",
		emsg, Tcl_GetChannelName((Tcl_Channel) chan)));
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *







|

|







2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
    }

    ResetFlag(statePtr, mode);
    return TCL_OK;

  error:
    if (interp != NULL) {
	TclPrintfResult(interp,
		"Tcl_RemoveChannelMode error: %s. Channel: \"%s\"",
		emsg, Tcl_GetChannelName((Tcl_Channel) chan));
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;

    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) {
	return TclClose(interp, chan);
    }
    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"double-close of channels not supported by %ss",
		chanPtr->typePtr->typeName));
	return TCL_ERROR;
    }

    /*
     * Does the channel support half-close anyway? Error if not.
     */

    if (!chanPtr->typePtr->close2Proc) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"half-close of channels not supported by %ss",
		chanPtr->typePtr->typeName));
	return TCL_ERROR;
    }

    /*
     * Is the channel unstacked ? If not we fail.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"half-close not applicable to stack of transformations", -1));
	return TCL_ERROR;
    }

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

    if (!(GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & flags)) {
	const char *msg;

	if (flags & TCL_CLOSE_READ) {
	    msg = "read";
	} else {
	    msg = "write";
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Half-close of %s-side not possible, side not opened or"
		" already closed", msg));
	return TCL_ERROR;
    }

    /*
     * A user may try to call half-close from within a channel close handler.
     * That won't do.
     */

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "illegal recursive call to close through close-handler"
		    " of channel", -1));
	}
	return TCL_ERROR;
    }

    if (flags & TCL_CLOSE_READ) {
	/*
	 * Call the finalization code directly. There are no events to handle,







|

|








<
|
|








|
|

















|

|










|

|







3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666

3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;

    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) {
	return TclClose(interp, chan);
    }
    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) {
	TclPrintfResult(interp,
		"double-close of channels not supported by %ss",
		chanPtr->typePtr->typeName);
	return TCL_ERROR;
    }

    /*
     * Does the channel support half-close anyway? Error if not.
     */

    if (!chanPtr->typePtr->close2Proc) {

	TclPrintfResult(interp, "half-close of channels not supported by %ss",
		chanPtr->typePtr->typeName);
	return TCL_ERROR;
    }

    /*
     * Is the channel unstacked ? If not we fail.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclPrintfResult(interp,
		"half-close not applicable to stack of transformations");
	return TCL_ERROR;
    }

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

    if (!(GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & flags)) {
	const char *msg;

	if (flags & TCL_CLOSE_READ) {
	    msg = "read";
	} else {
	    msg = "write";
	}
	TclPrintfResult(interp,
		"Half-close of %s-side not possible, side not opened or"
		" already closed", msg);
	return TCL_ERROR;
    }

    /*
     * A user may try to call half-close from within a channel close handler.
     * That won't do.
     */

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    TclPrintfResult(interp,
		    "illegal recursive call to close through close-handler"
		    " of channel");
	}
	return TCL_ERROR;
    }

    if (flags & TCL_CLOSE_READ) {
	/*
	 * Call the finalization code directly. There are no events to handle,
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
	return TCL_OK;
    } else if (HaveOpt(2, "-encoding")) {
	Tcl_Encoding encoding;
	int profile;

	if ((newValue[0] == '\0') || !strcmp(newValue, "binary")) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unknown encoding \"%s\": No longer supported.\n"
			"\tplease use either \"-translation binary\" "
			"or \"-encoding iso8859-1\"", newValue));
	    }
	    return TCL_ERROR;
	} else {
	    encoding = Tcl_GetEncoding(interp, newValue);
	    if (encoding == NULL) {
		return TCL_ERROR;
	    }







|


|







8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
	return TCL_OK;
    } else if (HaveOpt(2, "-encoding")) {
	Tcl_Encoding encoding;
	int profile;

	if ((newValue[0] == '\0') || !strcmp(newValue, "binary")) {
	    if (interp) {
		TclPrintfResult(interp,
			"unknown encoding \"%s\": No longer supported.\n"
			"\tplease use either \"-translation binary\" "
			"or \"-encoding iso8859-1\"", newValue);
	    }
	    return TCL_ERROR;
	} else {
	    encoding = Tcl_GetEncoding(interp, newValue);
	    if (encoding == NULL) {
		return TCL_ERROR;
	    }
9268
9269
9270
9271
9272
9273
9274
9275
9276
9277
9278
9279
9280
9281
9282
9283
    chan = Tcl_GetChannel(interp, chanName, NULL);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    if (GotFlag(statePtr, mask) == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
		(mask == TCL_READABLE) ? "readable" : "writable"));
	return TCL_ERROR;
    }

    /*
     * If we are supposed to return the script, do so.
     */








|
|







9264
9265
9266
9267
9268
9269
9270
9271
9272
9273
9274
9275
9276
9277
9278
9279
    chan = Tcl_GetChannel(interp, chanName, NULL);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    if (GotFlag(statePtr, mask) == 0) {
	TclPrintfResult(interp, "channel is not %s",
		(mask == TCL_READABLE) ? "readable" : "writable");
	return TCL_ERROR;
    }

    /*
     * If we are supposed to return the script, do so.
     */

9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
    int moveBytes;

    inStatePtr = inPtr->state;
    outStatePtr = outPtr->state;

    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
	}
	return TCL_ERROR;
    }
    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
	}
	return TCL_ERROR;
    }

    readFlags = inStatePtr->flags;
    writeFlags = outStatePtr->flags;








|
|





|
|







9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
    int moveBytes;

    inStatePtr = inPtr->state;
    outStatePtr = outPtr->state;

    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
	if (interp) {
	    TclPrintfResult(interp, "channel \"%s\" is busy",
		    Tcl_GetChannelName(inChan));
	}
	return TCL_ERROR;
    }
    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
	if (interp) {
	    TclPrintfResult(interp, "channel \"%s\" is busy",
		    Tcl_GetChannelName(outChan));
	}
	return TCL_ERROR;
    }

    readFlags = inStatePtr->flags;
    writeFlags = outStatePtr->flags;

10542
10543
10544
10545
10546
10547
10548
10549
10550
10551
10552
10553
10554
10555
10556
10557
10558
	     *
	     * Note that we cannot have a message in the interpreter bypass
	     * area, StackSetBlockMode is restricted to the channel bypass.
	     * We still need the interp as the destination of the move.
	     */

	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error setting blocking mode: %s",
			Tcl_PosixError(interp)));
	    }
	} else {
	    /*
	     * TIP #219.
	     * If we have no interpreter to put a bypass message into we have
	     * to clear it, to prevent its propagation and use in other places
	     * unrelated to the actual occurence of the problem.







<
|
|







10538
10539
10540
10541
10542
10543
10544

10545
10546
10547
10548
10549
10550
10551
10552
10553
	     *
	     * Note that we cannot have a message in the interpreter bypass
	     * area, StackSetBlockMode is restricted to the channel bypass.
	     * We still need the interp as the destination of the move.
	     */

	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {

		TclPrintfResult(interp, "error setting blocking mode: %s",
			Tcl_PosixError(interp));
	    }
	} else {
	    /*
	     * TIP #219.
	     * If we have no interpreter to put a bypass message into we have
	     * to clear it, to prevent its propagation and use in other places
	     * unrelated to the actual occurence of the problem.
Changes to generic/tclIcu.c.
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    UErrorCodex code)
{
    if (interp) {
	const char *codeMessage = NULL;
	if (u_errorName) {
	    codeMessage = u_errorName(code);
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s%sICU error (%d): %s",
		message ? message : "",
		message ? ". " : "",
		code,
		codeMessage ? codeMessage : ""));
	Tcl_SetErrorCode(interp, "TCL", "ICU", codeMessage, NULL);
    }
    return TCL_ERROR;
}

/*
 * Detect the likely encoding of the string encoded in the given byte array.







<
|



|







281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296
297
298
299
    UErrorCodex code)
{
    if (interp) {
	const char *codeMessage = NULL;
	if (u_errorName) {
	    codeMessage = u_errorName(code);
	}

	TclPrintfResult(interp, "%s%sICU error (%d): %s",
		message ? message : "",
		message ? ". " : "",
		code,
		codeMessage ? codeMessage : "");
	Tcl_SetErrorCode(interp, "TCL", "ICU", codeMessage, NULL);
    }
    return TCL_ERROR;
}

/*
 * Detect the likely encoding of the string encoded in the given byte array.
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
    if (objc == 1) {
	return DetectableEncodings(interp);
    }

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

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







<
|
|







566
567
568
569
570
571
572

573
574
575
576
577
578
579
580
581
    if (objc == 1) {
	return DetectableEncodings(interp);
    }

    int all = 0;
    if (objc == 3) {
	if (strcmp("-all", Tcl_GetString(objv[2]))) {

	    TclPrintfResult(interp, "Invalid option %s, must be \"-all\"",
		    Tcl_GetString(objv[2]));
	    return TCL_ERROR;
	}
	all = 1;
    }

    return DetectEncoding(interp, objv[1], all);
}
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
    for (i = 1; i < objc; ++i) {
	if (Tcl_GetIndexFromObj(
		interp, objv[i], optNames, "option", 0, &opt) != TCL_OK) {
	    return TCL_ERROR;
	}
	++i;
	if (i == objc) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Missing value for option %s.",
		    Tcl_GetString(objv[i - 1])));
	    return TCL_ERROR;
	}
	const char *s = Tcl_GetString(objv[i]);
	switch (opt) {
	case OPT_PROFILE:
	    if (!strcmp(s, "replace")) {
		strict = 0;
	    } else if (strcmp(s, "strict")) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"Invalid value \"%s\" supplied for option"
			" \"-profile\". Must be \"strict\" or \"replace\".",
			s));
		return TCL_ERROR;
	    }
	    break;
	case OPT_FAILINDEX:
	    /* TBD */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "Option -failindex not implemented.", TCL_INDEX_NONE));







<
|
|








|


|







971
972
973
974
975
976
977

978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
    for (i = 1; i < objc; ++i) {
	if (Tcl_GetIndexFromObj(
		interp, objv[i], optNames, "option", 0, &opt) != TCL_OK) {
	    return TCL_ERROR;
	}
	++i;
	if (i == objc) {

	    TclPrintfResult(interp, "Missing value for option %s.",
		    Tcl_GetString(objv[i - 1]));
	    return TCL_ERROR;
	}
	const char *s = Tcl_GetString(objv[i]);
	switch (opt) {
	case OPT_PROFILE:
	    if (!strcmp(s, "replace")) {
		strict = 0;
	    } else if (strcmp(s, "strict")) {
		TclPrintfResult(interp,
			"Invalid value \"%s\" supplied for option"
			" \"-profile\". Must be \"strict\" or \"replace\".",
			s);
		return TCL_ERROR;
	    }
	    break;
	case OPT_FAILINDEX:
	    /* TBD */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "Option -failindex not implemented.", TCL_INDEX_NONE));
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(
		interp, objv[i], optNames, "option", 0, &opt) != TCL_OK) {
	    return TCL_ERROR;
	}
	++i;
	if (i == (objc-1)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Missing value for option %s.",
		    Tcl_GetString(objv[i - 1])));
	    return TCL_ERROR;
	}
	const char *s = Tcl_GetString(objv[i]);
	switch (opt) {
	case OPT_PROFILE:
	    if (!strcmp(s, "replace")) {
		strict = 0;
	    } else if (strcmp(s, "strict")) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"Invalid value \"%s\" supplied for option \"-profile\". "
			"Must be \"strict\" or \"replace\".",
			s));
		return TCL_ERROR;
	    }
	    break;
	case OPT_MODE:
	    if (Tcl_GetIndexFromObj(interp, objv[i], normalizationForms,
		    "normalization mode", 0, &mode) != TCL_OK) {
		return TCL_ERROR;







<
|
|








|


|







1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(
		interp, objv[i], optNames, "option", 0, &opt) != TCL_OK) {
	    return TCL_ERROR;
	}
	++i;
	if (i == (objc-1)) {

	    TclPrintfResult(interp, "Missing value for option %s.",
		    Tcl_GetString(objv[i - 1]));
	    return TCL_ERROR;
	}
	const char *s = Tcl_GetString(objv[i]);
	switch (opt) {
	case OPT_PROFILE:
	    if (!strcmp(s, "replace")) {
		strict = 0;
	    } else if (strcmp(s, "strict")) {
		TclPrintfResult(interp,
			"Invalid value \"%s\" supplied for option \"-profile\". "
			"Must be \"strict\" or \"replace\".",
			s);
		return TCL_ERROR;
	    }
	    break;
	case OPT_MODE:
	    if (Tcl_GetIndexFromObj(interp, objv[i], normalizationForms,
		    "normalization mode", 0, &mode) != TCL_OK) {
		return TCL_ERROR;
Changes to generic/tclIndexObj.c.
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;
    const Tcl_ObjInternalRep *irPtr;

    if (offset < (Tcl_Size)sizeof(char *)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Invalid %s value %" TCL_SIZE_MODIFIER "d.",
		    "struct offset", offset));
	}
	return TCL_ERROR;
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */








|

|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;
    const Tcl_ObjInternalRep *irPtr;

    if (offset < (Tcl_Size)sizeof(char *)) {
	if (interp) {
	    TclPrintfResult(interp,
		    "Invalid %s value %" TCL_SIZE_MODIFIER "d.",
		    "struct offset", offset);
	}
	return TCL_ERROR;
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
		continue;
	    }
	    if (infoPtr->keyStr[length] == 0) {
		matchPtr = infoPtr;
		goto gotMatch;
	    }
	    if (matchPtr != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"ambiguous option \"%s\"", str));
		goto error;
	    }
	    matchPtr = infoPtr;
	}
	if (matchPtr == NULL) {
	    /*
	     * Unrecognized argument. Just copy it down, unless the caller
	     * prefers an error to be registered.
	     */

	    if (remObjv == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unrecognized argument \"%s\"", str));
		goto error;
	    }

	    dstIndex++;		/* This argument is now handled */
	    leftovers[nrem++] = curArg;
	    continue;
	}







<
|











<
|







1077
1078
1079
1080
1081
1082
1083

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103
		continue;
	    }
	    if (infoPtr->keyStr[length] == 0) {
		matchPtr = infoPtr;
		goto gotMatch;
	    }
	    if (matchPtr != NULL) {

		TclPrintfResult(interp, "ambiguous option \"%s\"", str);
		goto error;
	    }
	    matchPtr = infoPtr;
	}
	if (matchPtr == NULL) {
	    /*
	     * Unrecognized argument. Just copy it down, unless the caller
	     * prefers an error to be registered.
	     */

	    if (remObjv == NULL) {

		TclPrintfResult(interp, "unrecognized argument \"%s\"", str);
		goto error;
	    }

	    dstIndex++;		/* This argument is now handled */
	    leftovers[nrem++] = curArg;
	    continue;
	}
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
	    break;
	case TCL_ARGV_INT:
	    if (objc == 0) {
		goto missingArg;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[srcIndex],
		    (int *) infoPtr->dstPtr) == TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer argument for \"%s\" but got \"%s\"",
			infoPtr->keyStr, TclGetString(objv[srcIndex])));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_STRING:
	    if (objc == 0) {







|

|







1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
	    break;
	case TCL_ARGV_INT:
	    if (objc == 0) {
		goto missingArg;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[srcIndex],
		    (int *) infoPtr->dstPtr) == TCL_ERROR) {
		TclPrintfResult(interp,
			"expected integer argument for \"%s\" but got \"%s\"",
			infoPtr->keyStr, TclGetString(objv[srcIndex]));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_STRING:
	    if (objc == 0) {
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
	    goto argsDone;
	case TCL_ARGV_FLOAT:
	    if (objc == 0) {
		goto missingArg;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
		    (double *)infoPtr->dstPtr) == TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected floating-point argument for \"%s\" but got \"%s\"",
			infoPtr->keyStr, TclGetString(objv[srcIndex])));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_FUNC: {
	    Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *)







|

|







1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
	    goto argsDone;
	case TCL_ARGV_FLOAT:
	    if (objc == 0) {
		goto missingArg;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
		    (double *)infoPtr->dstPtr) == TCL_ERROR) {
		TclPrintfResult(interp,
			"expected floating-point argument for \"%s\" but got \"%s\"",
			infoPtr->keyStr, TclGetString(objv[srcIndex]));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_FUNC: {
	    Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *)
1176
1177
1178
1179
1180
1181
1182
1183
1184

1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
		objc--;
	    }
	    break;
	}
	case TCL_ARGV_GENFUNC: {

	    if (objc > INT_MAX) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC", objc));

		goto error;
	    }
	    Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
		    infoPtr->srcPtr;

	    gf_ret = handlerProc(infoPtr->clientData, interp, objc,
		    &objv[srcIndex], infoPtr->dstPtr);
	    if (gf_ret < 0) {
		goto error;
	    } else {
		srcIndex += gf_ret;
		objc -= gf_ret;
	    }
	    break;
	}
	case TCL_ARGV_HELP:
	    PrintUsage(interp, argTable);
	    goto error;
	default:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad argument type %d in Tcl_ArgvInfo", infoPtr->type));
	    goto error;
	}
    }

    /*
     * If we broke out of the loop because of an OPT_REST argument, copy the
     * remaining arguments down. Note that there is always at least one







|
|
>



















|
|







1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
		objc--;
	    }
	    break;
	}
	case TCL_ARGV_GENFUNC: {

	    if (objc > INT_MAX) {
		TclPrintfResult(interp,
			"too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC",
			objc);
		goto error;
	    }
	    Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
		    infoPtr->srcPtr;

	    gf_ret = handlerProc(infoPtr->clientData, interp, objc,
		    &objv[srcIndex], infoPtr->dstPtr);
	    if (gf_ret < 0) {
		goto error;
	    } else {
		srcIndex += gf_ret;
		objc -= gf_ret;
	    }
	    break;
	}
	case TCL_ARGV_HELP:
	    PrintUsage(interp, argTable);
	    goto error;
	default:
	    TclPrintfResult(interp, "bad argument type %d in Tcl_ArgvInfo",
		    infoPtr->type);
	    goto error;
	}
    }

    /*
     * If we broke out of the loop because of an OPT_REST argument, copy the
     * remaining arguments down. Note that there is always at least one
1234
1235
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246
1247
1248
1249

    /*
     * Make sure to handle freeing any temporary space we've allocated on the
     * way to an error.
     */

  missingArg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "\"%s\" option requires an additional argument", str));

  error:
    if (leftovers != NULL) {
	Tcl_Free(leftovers);
    }
    return TCL_ERROR;
}








<
|
>







1233
1234
1235
1236
1237
1238
1239

1240
1241
1242
1243
1244
1245
1246
1247
1248

    /*
     * Make sure to handle freeing any temporary space we've allocated on the
     * way to an error.
     */

  missingArg:

    TclPrintfResult(interp, "\"%s\" option requires an additional argument",
	    str);
  error:
    if (leftovers != NULL) {
	Tcl_Free(leftovers);
    }
    return TCL_ERROR;
}

1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
    }

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

    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad completion code \"%s\": must be"
		" ok, error, return, break, continue, or an integer",
		TclGetString(value)));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", (char *)NULL);
    }
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|


|












1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
    }

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

    if (interp != NULL) {
	TclPrintfResult(interp,
		"bad completion code \"%s\": must be"
		" ok, error, return, break, continue, or an integer",
		TclGetString(value));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", (char *)NULL);
    }
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclInterp.c.
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
	}

	aliasName = TclGetString(objv[3]);

	iiPtr = INTERP_INFO(childInterp);
	hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "alias \"%s\" in path \"%s\" not found",
		    aliasName, TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		    (char *)NULL);
	    return TCL_ERROR;
	}
	aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
	if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "target interpreter for alias \"%s\" in path \"%s\" is "
		    "not my descendant", aliasName, TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "TARGETSHROUDED", (char *)NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    default:







<
|
|






|

|







1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
	}

	aliasName = TclGetString(objv[3]);

	iiPtr = INTERP_INFO(childInterp);
	hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
	if (hPtr == NULL) {

	    TclPrintfResult(interp, "alias \"%s\" in path \"%s\" not found",
		    aliasName, TclGetString(objv[2]));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		    (char *)NULL);
	    return TCL_ERROR;
	}
	aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
	if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
	    TclPrintfResult(interp,
		    "target interpreter for alias \"%s\" in path \"%s\" is "
		    "not my descendant", aliasName, TclGetString(objv[2]));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "TARGETSHROUDED", (char *)NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    default:
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
    Tcl_HashEntry *hPtr;
    Alias *aliasPtr;
    Tcl_Size objc;
    Tcl_Obj **objv;

    hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"alias \"%s\" not found", aliasName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		(char *)NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    objc = aliasPtr->objc;
    objv = &aliasPtr->objPtr;







<
|







1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341
    Tcl_HashEntry *hPtr;
    Alias *aliasPtr;
    Tcl_Size objc;
    Tcl_Obj **objv;

    hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
    if (hPtr == NULL) {

	TclPrintfResult(interp, "alias \"%s\" not found", aliasName);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		(char *)NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    objc = aliasPtr->objc;
    objv = &aliasPtr->objPtr;
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450

	if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {
	    /*
	     * The child interpreter can be deleted while creating the alias.
	     * [Bug #641195]
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot define or rename alias \"%s\": interpreter deleted",
		    Tcl_GetCommandName(cmdInterp, cmd)));
	    return TCL_ERROR;
	}
	cmdNamePtr = nextAliasPtr->objPtr;
	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
		TclGetString(cmdNamePtr),
		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
		/*flags*/ 0);
	if (aliasCmd == NULL) {
	    return TCL_OK;
	}
	aliasCmdPtr = (Command *) aliasCmd;
	if (aliasCmdPtr == cmdPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot define or rename alias \"%s\": would create a loop",
		    Tcl_GetCommandName(cmdInterp, cmd)));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "ALIASLOOP", (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * Otherwise, follow the chain one step further. See if the target







|

|












|

|







1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448

	if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {
	    /*
	     * The child interpreter can be deleted while creating the alias.
	     * [Bug #641195]
	     */

	    TclPrintfResult(interp,
		    "cannot define or rename alias \"%s\": interpreter deleted",
		    Tcl_GetCommandName(cmdInterp, cmd));
	    return TCL_ERROR;
	}
	cmdNamePtr = nextAliasPtr->objPtr;
	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
		TclGetString(cmdNamePtr),
		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
		/*flags*/ 0);
	if (aliasCmd == NULL) {
	    return TCL_OK;
	}
	aliasCmdPtr = (Command *) aliasCmd;
	if (aliasCmdPtr == cmdPtr) {
	    TclPrintfResult(interp,
		    "cannot define or rename alias \"%s\": would create a loop",
		    Tcl_GetCommandName(cmdInterp, cmd));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "ALIASLOOP", (char *)NULL);
	    return TCL_ERROR;
	}

	/*
	 * Otherwise, follow the chain one step further. See if the target
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
     * the original name (with which it was created) to find the alias to
     * delete it.
     */

    childPtr = &INTERP_INFO(childInterp)->child;
    hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr));
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"alias \"%s\" not found", TclGetString(namePtr)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
		TclGetString(namePtr), (char *)NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
    return TCL_OK;







|
|







1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
     * the original name (with which it was created) to find the alias to
     * delete it.
     */

    childPtr = &INTERP_INFO(childInterp)->child;
    hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr));
    if (hPtr == NULL) {
	TclPrintfResult(interp, "alias \"%s\" not found",
		TclGetString(namePtr));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
		TclGetString(namePtr), (char *)NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
    return TCL_OK;
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
	childPtr = (Child *) Tcl_GetHashValue(hPtr);
	searchInterp = childPtr->childInterp;
	if (searchInterp == NULL) {
	    break;
	}
    }
    if (searchInterp == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not find interpreter \"%s\"", TclGetString(pathPtr)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
		TclGetString(pathPtr), (char *)NULL);
    }
    return searchInterp;
}

/*







|
|







2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
	childPtr = (Child *) Tcl_GetHashValue(hPtr);
	searchInterp = childPtr->childInterp;
	if (searchInterp == NULL) {
	    break;
	}
    }
    if (searchInterp == NULL) {
	TclPrintfResult(interp, "could not find interpreter \"%s\"",
		TclGetString(pathPtr));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
		TclGetString(pathPtr), (char *)NULL);
    }
    return searchInterp;
}

/*
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
	safe = Tcl_IsSafe(parentInterp);
    }

    parentInfoPtr = INTERP_INFO(parentInterp);
    hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path,
	    &isNew);
    if (isNew == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"interpreter named \"%s\" already exists, cannot create",
		path));
	return NULL;
    }

    childInterp = Tcl_CreateInterp();
    childPtr = &INTERP_INFO(childInterp)->child;
    childPtr->parentInterp = parentInterp;
    childPtr->childEntryPtr = hPtr;







|

|







2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
	safe = Tcl_IsSafe(parentInterp);
    }

    parentInfoPtr = INTERP_INFO(parentInterp);
    hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path,
	    &isNew);
    if (isNew == 0) {
	TclPrintfResult(interp,
		"interpreter named \"%s\" already exists, cannot create",
		path);
	return NULL;
    }

    childInterp = Tcl_CreateInterp();
    childPtr = &INTERP_INFO(childInterp)->child;
    childPtr->parentInterp = parentInterp;
    childPtr->childEntryPtr = hPtr;