summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c217
1 files changed, 104 insertions, 113 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4d6ff0c..971ae36 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -131,13 +131,11 @@ static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc,
Tcl_Obj *const objv[], int lookup);
static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
-static Tcl_NRPostProc NRCoroutineActivateCallback;
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
static Tcl_NRPostProc NRRunObjProc;
-static Tcl_NRPostProc NRTailcallEval;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
static void ProcessUnexpectedResult(Tcl_Interp *interp,
@@ -219,7 +217,7 @@ static const CmdInfo builtInCmds[] = {
{"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1},
{"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1},
{"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, 1},
- {"format", Tcl_FormatObjCmd, NULL, NULL, 1},
+ {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, 1},
{"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, 1},
{"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, 1},
{"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, 1},
@@ -230,6 +228,7 @@ static const CmdInfo builtInCmds[] = {
{"linsert", Tcl_LinsertObjCmd, NULL, NULL, 1},
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, 1},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, 1},
+ {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, 1},
{"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, 1},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, 1},
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, 1},
@@ -240,7 +239,7 @@ static const CmdInfo builtInCmds[] = {
{"package", Tcl_PackageObjCmd, NULL, NULL, 1},
{"proc", Tcl_ProcObjCmd, NULL, NULL, 1},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, 1},
- {"regsub", Tcl_RegsubObjCmd, NULL, NULL, 1},
+ {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, 1},
{"rename", Tcl_RenameObjCmd, NULL, NULL, 1},
{"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, 1},
{"scan", Tcl_ScanObjCmd, NULL, NULL, 1},
@@ -248,7 +247,7 @@ static const CmdInfo builtInCmds[] = {
{"split", Tcl_SplitObjCmd, NULL, NULL, 1},
{"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, 1},
{"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1},
- {"tailcall", NULL, NULL, TclNRTailcallObjCmd, 1},
+ {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, 1},
{"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, 1},
{"trace", Tcl_TraceObjCmd, NULL, NULL, 1},
{"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1},
@@ -257,7 +256,7 @@ static const CmdInfo builtInCmds[] = {
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1},
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1},
- {"yield", NULL, NULL, TclNRYieldObjCmd, 1},
+ {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, 1},
{"yieldto", NULL, NULL, TclNRYieldToObjCmd, 1},
/*
@@ -1696,9 +1695,9 @@ Tcl_HideCommand(
*/
if (strstr(hiddenCmdToken, "::") != NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use namespace qualifiers in hidden command"
- " token (rename)", NULL);
+ " token (rename)", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
return TCL_ERROR;
}
@@ -1721,8 +1720,9 @@ Tcl_HideCommand(
*/
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
- Tcl_AppendResult(interp, "can only hide global namespace commands"
- " (use rename then hide)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only hide global namespace commands (use rename then hide)",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
return TCL_ERROR;
}
@@ -1746,8 +1746,9 @@ Tcl_HideCommand(
hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
- "\" already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "hidden command named \"%s\" already exists",
+ hiddenCmdToken));
Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
return TCL_ERROR;
}
@@ -1849,8 +1850,9 @@ Tcl_ExposeCommand(
*/
if (strstr(cmdName, "::") != NULL) {
- Tcl_AppendResult(interp, "cannot expose to a namespace "
- "(use expose to toplevel, then rename)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot expose to a namespace (use expose to toplevel, then rename)",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
return TCL_ERROR;
}
@@ -1865,8 +1867,8 @@ Tcl_ExposeCommand(
hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown hidden command \"%s\"", hiddenCmdToken));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
hiddenCmdToken, NULL);
return TCL_ERROR;
@@ -1885,9 +1887,9 @@ Tcl_ExposeCommand(
* than 'nicely' erroring out ?
*/
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"trying to expose a non-global command namespace command",
- NULL);
+ -1));
return TCL_ERROR;
}
@@ -1904,8 +1906,8 @@ Tcl_ExposeCommand(
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "exposed command \"", cmdName,
- "\" already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "exposed command \"%s\" already exists", cmdName));
Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL);
return TCL_ERROR;
}
@@ -2478,9 +2480,10 @@ TclRenameCommand(
cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
cmdPtr = (Command *) cmd;
if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "can't ",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't %s \"%s\": command doesn't exist",
((newName == NULL)||(*newName == '\0'))? "delete":"rename",
- " \"", oldName, "\": command doesn't exist", NULL);
+ oldName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
return TCL_ERROR;
}
@@ -2510,15 +2513,15 @@ TclRenameCommand(
TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
if ((newNsPtr == NULL) || (newTail == NULL)) {
- Tcl_AppendResult(interp, "can't rename to \"", newName,
- "\": bad command name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't rename to \"%s\": bad command name", newName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
result = TCL_ERROR;
goto done;
}
if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
- Tcl_AppendResult(interp, "can't rename to \"", newName,
- "\": command already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't rename to \"%s\": command already exists", newName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
"TARGET_EXISTS", NULL);
result = TCL_ERROR;
@@ -3519,9 +3522,9 @@ OldMathFuncProc(
* We have a non-numeric argument.
*/
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
- TCL_STATIC);
+ -1));
TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
ckfree(args);
return TCL_ERROR;
@@ -3734,41 +3737,28 @@ Tcl_ListMathFuncs(
Tcl_Interp *interp,
const char *pattern)
{
- Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- Namespace *nsPtr;
- Namespace *dummy1NsPtr;
- Namespace *dummy2NsPtr;
- const char *dummyNamePtr;
- Tcl_Obj *result = Tcl_NewObj();
-
- TclGetNamespaceForQualName(interp, "::tcl::mathfunc",
- globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr);
- if (nsPtr == NULL) {
- return result;
+ Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
+ Tcl_Obj *result;
+ Tcl_InterpState state;
+
+ if (pattern) {
+ Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
+ Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
+
+ Tcl_AppendObjToObj(script, arg);
+ Tcl_DecrRefCount(arg); /* Should tear down patternObj too */
}
- if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
- if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(pattern, -1));
- }
+ state = Tcl_SaveInterpState(interp, TCL_OK);
+ Tcl_IncrRefCount(script);
+ if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
+ result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
} else {
- Tcl_HashSearch cmdHashSearch;
- Tcl_HashEntry *cmdHashEntry =
- Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);
-
- for (; cmdHashEntry != NULL;
- cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
- const char *cmdNamePtr =
- Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);
-
- if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(cmdNamePtr, -1));
- }
- }
+ result = Tcl_NewObj();
}
+ Tcl_DecrRefCount(script);
+ Tcl_RestoreInterpState(interp, state);
+
return result;
}
@@ -3808,9 +3798,8 @@ TclInterpReady(
*/
if (iPtr->flags & DELETED) {
- /* JJM - Superfluous Tcl_ResetResult call removed. */
- Tcl_AppendResult(interp,
- "attempt to call eval in deleted interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to call eval in deleted interpreter", -1));
Tcl_SetErrorCode(interp, "TCL", "IDELETE",
"attempt to call eval in deleted interpreter", NULL);
return TCL_ERROR;
@@ -3838,8 +3827,8 @@ TclInterpReady(
return TCL_OK;
}
- Tcl_AppendResult(interp,
- "too many nested evaluations (infinite loop?)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "too many nested evaluations (infinite loop?)", -1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
return TCL_ERROR;
}
@@ -3973,8 +3962,7 @@ Tcl_Canceled(
}
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, message, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
}
@@ -4582,8 +4570,8 @@ TEOV_NotFound(
cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[0]), NULL);
@@ -6242,11 +6230,11 @@ ProcessUnexpectedResult(
Tcl_ResetResult(interp);
if (returnCode == TCL_BREAK) {
- Tcl_AppendResult(interp,
- "invoked \"break\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"break\" outside of a loop", -1));
} else if (returnCode == TCL_CONTINUE) {
- Tcl_AppendResult(interp,
- "invoked \"continue\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"continue\" outside of a loop", -1));
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"command returned bad code: %d", returnCode));
@@ -6567,7 +6555,8 @@ TclObjInvoke(
}
if ((objc < 1) || (objv == NULL)) {
- Tcl_AppendResult(interp, "illegal argument vector", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal argument vector", -1));
return TCL_ERROR;
}
@@ -6585,8 +6574,8 @@ TclObjInvoke(
hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "invalid hidden command name \"",
- cmdName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid hidden command name \"%s\"", cmdName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
NULL);
return TCL_ERROR;
@@ -7194,7 +7183,8 @@ ExprIsqrtFunc(
return TCL_OK;
negarg:
- Tcl_SetResult(interp, "square root of negative argument", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "square root of negative argument", -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range", NULL);
return TCL_ERROR;
@@ -8243,10 +8233,9 @@ TclNRTailcallObjCmd(
return TCL_ERROR;
}
- if (!iPtr->varFramePtr->isProcCallFrame) { /* or is upleveled */
- Tcl_SetResult(interp,
- "tailcall can only be called from a proc or lambda",
- TCL_STATIC);
+ if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tailcall can only be called from a proc or lambda", -1));
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
return TCL_ERROR;
}
@@ -8284,7 +8273,7 @@ TclNRTailcallObjCmd(
}
Tcl_IncrRefCount(nsObjPtr);
- TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr,
+ TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
NULL, NULL);
tailcallPtr = TOP_CB(interp);
TOP_CB(interp) = tailcallPtr->nextPtr;
@@ -8294,7 +8283,7 @@ TclNRTailcallObjCmd(
}
int
-NRTailcallEval(
+TclNRTailcallEval(
ClientData data[],
Tcl_Interp *interp,
int result)
@@ -8405,8 +8394,8 @@ TclNRYieldObjCmd(
}
if (!corPtr) {
- Tcl_SetResult(interp, "yield can only be called in a coroutine",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yield can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
return TCL_ERROR;
}
@@ -8416,7 +8405,7 @@ TclNRYieldObjCmd(
}
NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
clientData, NULL, NULL);
return TCL_OK;
}
@@ -8439,8 +8428,8 @@ TclNRYieldToObjCmd(
}
if (!corPtr) {
- Tcl_SetResult(interp, "yieldto can only be called in a coroutine",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
return TCL_ERROR;
}
@@ -8488,7 +8477,7 @@ YieldToCallback(
* yieldTo: invoke the command using tailcall tech.
*/
- TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL);
+ TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL);
cbPtr = TOP_CB(interp);
TOP_CB(interp) = cbPtr->nextPtr;
@@ -8633,7 +8622,7 @@ NRCoroutineExitCallback(
/*
*----------------------------------------------------------------------
*
- * NRCoroutineActivateCallback --
+ * TclNRCoroutineActivateCallback --
*
* This is the workhorse for coroutines: it implements both yield and
* resume.
@@ -8647,8 +8636,8 @@ NRCoroutineExitCallback(
*----------------------------------------------------------------------
*/
-static int
-NRCoroutineActivateCallback(
+int
+TclNRCoroutineActivateCallback(
ClientData data[],
Tcl_Interp *interp,
int result)
@@ -8688,8 +8677,8 @@ NRCoroutineActivateCallback(
*/
if (corPtr->stackLevel != stackLevel) {
- Tcl_SetResult(interp, "cannot yield: C stack busy",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot yield: C stack busy", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
NULL);
return TCL_ERROR;
@@ -8748,8 +8737,8 @@ NRCoroInjectObjCmd(
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
- Tcl_AppendResult(interp, "can only inject a command into a coroutine",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
@@ -8757,8 +8746,8 @@ NRCoroInjectObjCmd(
corPtr = cmdPtr->objClientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_AppendResult(interp,
- "can only inject a command into a suspended coroutine", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a suspended coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
return TCL_ERROR;
}
@@ -8774,7 +8763,7 @@ NRCoroInjectObjCmd(
return TCL_OK;
}
-
+
int
TclNRInterpCoroutine(
ClientData clientData,
@@ -8785,9 +8774,9 @@ TclNRInterpCoroutine(
CoroutineData *corPtr = clientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]),
- "\" is already running", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "coroutine \"%s\" is already running",
+ Tcl_GetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
return TCL_ERROR;
}
@@ -8823,7 +8812,7 @@ TclNRInterpCoroutine(
break;
}
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
NULL, NULL, NULL);
return TCL_OK;
}
@@ -8868,22 +8857,24 @@ TclNRCoroutineObjCmd(
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": unknown namespace",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": bad procedure name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": bad procedure name",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
- Tcl_AppendResult(interp, "can't create procedure \"", procName,
- "\" in non-global namespace with name starting with \":\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\" in non-global namespace with"
+ " name starting with \":\"", procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
return TCL_ERROR;
}
@@ -8947,7 +8938,6 @@ TclNRCoroutineObjCmd(
corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
corPtr->stackLevel = NULL;
corPtr->auxNumLevels = 0;
- iPtr->numLevels--;
/*
* Create the coro's execEnv, switch to it to push the exit and coro
@@ -8966,19 +8956,20 @@ TclNRCoroutineObjCmd(
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
+ /* insure that the command is looked up in the correct namespace */
iPtr->lookupNsPtr = lookupNsPtr;
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
+ iPtr->numLevels--;
SAVE_CONTEXT(corPtr->running);
RESTORE_CONTEXT(corPtr->caller);
iPtr->execEnvPtr = corPtr->callerEEPtr;
/*
- * Now just resume the coroutine. Take care to insure that the command is
- * looked up in the correct namespace.
+ * Now just resume the coroutine.
*/
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
NULL, NULL, NULL);
return TCL_OK;
}
generated by cgit v0.12 at 2024-08-21 18:08:33 (GMT)