diff options
Diffstat (limited to 'generic/tclBasic.c')
| -rw-r--r-- | generic/tclBasic.c | 323 |
1 files changed, 209 insertions, 114 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d6a460d..cceef45 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -203,7 +203,7 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, -#ifndef EXCLUDE_OBSOLETE_COMMANDS +#ifndef TCL_NO_DEPRECATED {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, @@ -265,7 +265,6 @@ static const CmdInfo builtInCmds[] = { {"cd", Tcl_CdObjCmd, NULL, NULL, 0}, {"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"encoding", Tcl_EncodingObjCmd, NULL, NULL, 0}, {"exec", Tcl_ExecObjCmd, NULL, NULL, 0}, {"exit", Tcl_ExitObjCmd, NULL, NULL, 0}, {"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE}, @@ -511,7 +510,11 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; +#ifdef TCL_NO_DEPRECATED + iPtr->result = &tclEmptyString; +#else iPtr->result = iPtr->resultSpace; +#endif iPtr->freeProc = NULL; iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); @@ -571,23 +574,26 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; +#ifndef TCL_NO_DEPRECATED iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; +#endif Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; /* TIP #268 */ +#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE) if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; - } else { + } else +#endif iPtr->packagePrefer = PKG_PREFER_LATEST; - } iPtr->cmdCount = 0; TclInitLiteralTable(&iPtr->literalTable); - iPtr->compileEpoch = 0; + iPtr->compileEpoch = 1; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; @@ -602,7 +608,9 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); +#ifndef TCL_NO_DEPRECATED iPtr->resultSpace[0] = 0; +#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -789,16 +797,17 @@ Tcl_CreateInterp(void) } /* - * Create the "array", "binary", "chan", "dict", "file", "info", - * "namespace" and "string" ensembles. Note that all these commands (and - * their subcommands that are not present in the global namespace) are - * wholly safe *except* for "file". + * Create the "array", "binary", "chan", "clock", "dict", "encoding", + * "file", "info", "namespace" and "string" ensembles. Note that all these + * commands (and their subcommands that are not present in the global + * namespace) are wholly safe *except* for "clock", "encoding" and "file". */ TclInitArrayCmd(interp); TclInitBinaryCmd(interp); TclInitChanCmd(interp); TclInitDictCmd(interp); + TclInitEncodingCmd(interp); TclInitFileCmd(interp); TclInitInfoCmd(interp); TclInitNamespaceCmd(interp); @@ -939,8 +948,8 @@ Tcl_CreateInterp(void) * Set up other variables such as tcl_version and tcl_library */ - Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); @@ -965,11 +974,11 @@ Tcl_CreateInterp(void) Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); if (TclTommath_Init(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } if (TclOOInit(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } /* @@ -979,7 +988,7 @@ Tcl_CreateInterp(void) #ifdef HAVE_ZLIB if (TclZlibInit(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } #endif @@ -1026,6 +1035,7 @@ TclHideUnsafeCommands( Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } + TclMakeEncodingCommandSafe(interp); /* Ugh! */ TclMakeFileCommandSafe(interp); /* Ugh! */ return TCL_OK; } @@ -1061,7 +1071,7 @@ Tcl_CallWhenDeleted( Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = - Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int)); + Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = ckalloc(sizeof(AssocData)); @@ -1533,10 +1543,12 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } +#ifndef TCL_NO_DEPRECATED if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); iPtr->appendResult = NULL; } +#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -1634,7 +1646,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree((char *) iPtr->lineLAPtr); + ckfree(iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { @@ -2041,11 +2053,11 @@ Tcl_CreateCommand( { Interp *iPtr = (Interp *) interp; ImportRef *oldRefPtr = NULL; - Namespace *nsPtr, *dummy1, *dummy2; - Command *cmdPtr, *refCmdPtr; + Namespace *nsPtr; + Command *cmdPtr; Tcl_HashEntry *hPtr; const char *tail; - int isNew; + int isNew = 0, deleted = 0; ImportedCmdData *dataPtr; if (iPtr->flags & DELETED) { @@ -2058,32 +2070,52 @@ Tcl_CreateCommand( } /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; otherwise, - * we always put it in the global namespace. + * If the command name we seek to create already exists, we need to + * delete that first. That can be tricky in the presence of traces. + * Loop until we no longer find an existing command in the way, or + * until we've deleted one command and that didn't finish the job. */ - if (strstr(cmdName, "::") != NULL) { - TclGetNamespaceForQualName(interp, cmdName, NULL, - TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); - if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; - } - } else { - nsPtr = iPtr->globalNsPtr; - tail = cmdName; - } + while (1) { + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; + * otherwise, we always put it in the global namespace. + */ + + if (strstr(cmdName, "::") != NULL) { + Namespace *dummy1, *dummy2; + + TclGetNamespaceForQualName(interp, cmdName, NULL, + TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + if ((nsPtr == NULL) || (tail == NULL)) { + return (Tcl_Command) NULL; + } + } else { + nsPtr = iPtr->globalNsPtr; + tail = cmdName; + } + + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + + if (isNew || deleted) { + /* + * isNew - No conflict with existing command. + * deleted - We've already deleted a conflicting command + */ + break; + } + + /* An existing command conflicts. Try to delete it.. */ + cmdPtr = Tcl_GetHashValue(hPtr); - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - if (!isNew) { /* - * Command already exists. Delete the old one. Be careful to preserve + * Be careful to preserve * any existing import links so we can restore them down below. That * way, you can redefine a command and its import status will remain * intact. */ - cmdPtr = Tcl_GetHashValue(hPtr); cmdPtr->refCount++; if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; @@ -2096,18 +2128,21 @@ Tcl_CreateCommand( cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); + deleted = 1; + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - if (!isNew) { - /* - * If the deletion callback recreated the command, just throw away - * the new command (if we try to delete it again, we could get - * stuck in an infinite loop). - */ + if (!isNew) { + /* + * If the deletion callback recreated the command, just throw away + * the new command (if we try to delete it again, we could get + * stuck in an infinite loop). + */ + + ckfree(Tcl_GetHashValue(hPtr)); + } + + if (!deleted) { - ckfree(Tcl_GetHashValue(hPtr)); - } - } else { /* * Command resolvers (per-interp, per-namespace) might have resolved * to a command for the given namespace scope with this command not @@ -2155,7 +2190,7 @@ Tcl_CreateCommand( if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { - refCmdPtr = oldRefPtr->importedCmdPtr; + Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; @@ -2216,11 +2251,11 @@ Tcl_CreateObjCommand( { Interp *iPtr = (Interp *) interp; ImportRef *oldRefPtr = NULL; - Namespace *nsPtr, *dummy1, *dummy2; - Command *cmdPtr, *refCmdPtr; + Namespace *nsPtr; + Command *cmdPtr; Tcl_HashEntry *hPtr; const char *tail; - int isNew; + int isNew = 0, deleted = 0; ImportedCmdData *dataPtr; if (iPtr->flags & DELETED) { @@ -2233,28 +2268,44 @@ Tcl_CreateObjCommand( } /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; otherwise, - * we always put it in the global namespace. + * If the command name we seek to create already exists, we need to + * delete that first. That can be tricky in the presence of traces. + * Loop until we no longer find an existing command in the way, or + * until we've deleted one command and that didn't finish the job. */ - if (strstr(cmdName, "::") != NULL) { - TclGetNamespaceForQualName(interp, cmdName, NULL, + while (1) { + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; + * otherwise, we always put it in the global namespace. + */ + + if (strstr(cmdName, "::") != NULL) { + Namespace *dummy1, *dummy2; + + TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); - if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; - } - } else { - nsPtr = iPtr->globalNsPtr; - tail = cmdName; - } + if ((nsPtr == NULL) || (tail == NULL)) { + return (Tcl_Command) NULL; + } + } else { + nsPtr = iPtr->globalNsPtr; + tail = cmdName; + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - TclInvalidateNsPath(nsPtr); - if (!isNew) { - cmdPtr = Tcl_GetHashValue(hPtr); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + + if (isNew || deleted) { + /* + * isNew - No conflict with existing command. + * deleted - We've already deleted a conflicting command + */ + break; + } - /* Command already exists. */ + /* An existing command conflicts. Try to delete it.. */ + cmdPtr = Tcl_GetHashValue(hPtr); /* * [***] This is wrong. See Tcl Bug a16752c252. @@ -2292,18 +2343,20 @@ Tcl_CreateObjCommand( cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); + deleted = 1; + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - if (!isNew) { - /* - * If the deletion callback recreated the command, just throw away - * the new command (if we try to delete it again, we could get - * stuck in an infinite loop). - */ + if (!isNew) { + /* + * If the deletion callback recreated the command, just throw away + * the new command (if we try to delete it again, we could get + * stuck in an infinite loop). + */ - ckfree(Tcl_GetHashValue(hPtr)); - } - } else { + ckfree(Tcl_GetHashValue(hPtr)); + } + + if (!deleted) { /* * Command resolvers (per-interp, per-namespace) might have resolved * to a command for the given namespace scope with this command not @@ -2323,6 +2376,7 @@ Tcl_CreateObjCommand( */ TclInvalidateNsCmdLookup(nsPtr); + TclInvalidateNsPath(nsPtr); } cmdPtr = ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); @@ -2350,7 +2404,7 @@ Tcl_CreateObjCommand( if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { - refCmdPtr = oldRefPtr->importedCmdPtr; + Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; @@ -2402,7 +2456,7 @@ TclInvokeStringCommand( TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { - argv[i] = Tcl_GetString(objv[i]); + argv[i] = TclGetString(objv[i]); } argv[objc] = 0; @@ -2656,7 +2710,7 @@ TclRenameCommand( } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; - CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName), + CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); Tcl_DStringFree(&newFullName); @@ -3023,13 +3077,6 @@ Tcl_DeleteCommandFromToken( Tcl_Command importCmd; /* - * Bump the command epoch counter. This will invalidate all cached - * references that point to this command. - */ - - cmdPtr->cmdEpoch++; - - /* * The code here is tricky. We can't delete the hash table entry before * invoking the deletion callback because there are cases where the * deletion callback needs to invoke the command (e.g. object systems such @@ -3051,6 +3098,14 @@ Tcl_DeleteCommandFromToken( Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; } + + /* + * Bump the command epoch counter. This will invalidate all cached + * references that point to this command. + */ + + cmdPtr->cmdEpoch++; + return 0; } @@ -3153,6 +3208,13 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; + + /* + * Bump the command epoch counter. This will invalidate all cached + * references that point to this command. + */ + + cmdPtr->cmdEpoch++; } /* @@ -3399,8 +3461,7 @@ TclCleanupCommand( register Command *cmdPtr) /* Points to the Command structure to * be freed. */ { - cmdPtr->refCount--; - if (cmdPtr->refCount <= 0) { + if (cmdPtr->refCount-- <= 1) { ckfree(cmdPtr); } } @@ -3522,7 +3583,7 @@ OldMathFuncProc( Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", -1)); - TclCheckBadOctal(interp, Tcl_GetString(valuePtr)); + TclCheckBadOctal(interp, TclGetString(valuePtr)); ckfree(args); return TCL_ERROR; } @@ -3542,7 +3603,7 @@ OldMathFuncProc( args[k].type = TCL_INT; break; } - if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue) + if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue) == TCL_OK) { args[k].type = TCL_WIDE_INT; break; @@ -3568,7 +3629,7 @@ OldMathFuncProc( return TCL_ERROR; } valuePtr = Tcl_GetObjResult(interp); - Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); + TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); Tcl_ResetResult(interp); break; } @@ -3942,7 +4003,7 @@ Tcl_Canceled( */ if (iPtr->asyncCancelMsg != NULL) { - message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length); + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); } else { length = 0; } @@ -4041,7 +4102,7 @@ Tcl_CancelEval( */ if (resultObjPtr != NULL) { - result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length); + result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, (size_t) cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ @@ -4553,7 +4614,7 @@ TEOV_Error( */ listPtr = Tcl_NewListObj(objc, objv); - cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen); + cmdString = TclGetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(listPtr); } @@ -4697,9 +4758,9 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; - const char *command = Tcl_GetStringFromObj(commandPtr, &length); + const char *command = TclGetStringFromObj(commandPtr, &length); /* * Call trace functions. @@ -4751,7 +4812,7 @@ TEOV_RunLeaveTraces( Command *cmdPtr = data[2]; Tcl_Obj **objv = data[3]; int length; - const char *command = Tcl_GetStringFromObj(commandPtr, &length); + const char *command = TclGetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){ @@ -5577,8 +5638,7 @@ TclArgumentRelease( } cfwPtr = Tcl_GetHashValue(hPtr); - cfwPtr->refCount--; - if (cfwPtr->refCount > 0) { + if (cfwPtr->refCount-- > 1) { continue; } @@ -5843,6 +5903,7 @@ TclArgumentGet( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED #undef Tcl_Eval int Tcl_Eval( @@ -5895,6 +5956,7 @@ Tcl_GlobalEvalObj( { return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -6048,7 +6110,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); - ListObjGetElements(listPtr, objc, objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } @@ -6116,7 +6178,7 @@ TclNREvalObjEx( Tcl_IncrRefCount(objPtr); - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + script = TclGetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); @@ -6147,7 +6209,7 @@ TEOEx_ByteCodeCallback( ProcessUnexpectedResult(interp, result); result = TCL_ERROR; - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + script = TclGetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } @@ -6695,11 +6757,10 @@ Tcl_AppendObjToErrorInfo( * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - int length; - const char *message = TclGetStringFromObj(objPtr, &length); + const char *message = TclGetString(objPtr); Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, length); + Tcl_AddObjErrorInfo(interp, message, objPtr->length); Tcl_DecrRefCount(objPtr); } @@ -6722,6 +6783,7 @@ Tcl_AppendObjToErrorInfo( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED #undef Tcl_AddErrorInfo void Tcl_AddErrorInfo( @@ -6731,6 +6793,7 @@ Tcl_AddErrorInfo( { Tcl_AddObjErrorInfo(interp, message, -1); } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -6846,7 +6909,7 @@ Tcl_VarEvalVA( Tcl_DStringAppend(&buf, string, -1); } - result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); Tcl_DStringFree(&buf); return result; } @@ -6903,6 +6966,7 @@ Tcl_VarEval( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED #undef Tcl_GlobalEval int Tcl_GlobalEval( @@ -6916,10 +6980,11 @@ Tcl_GlobalEval( savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_Eval(interp, command); + result = Tcl_EvalEx(interp, command, -1, 0); iPtr->varFramePtr = savedVarFramePtr; return result; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -7173,7 +7238,7 @@ ExprIsqrtFunc( } break; default: - if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) { return TCL_ERROR; } if (w < 0) { @@ -7616,7 +7681,7 @@ ExprWideFunc( return TCL_ERROR; } objPtr = Tcl_GetObjResult(interp); - if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) { /* * Truncate the bignum; keep only bits in wide int range. */ @@ -7627,7 +7692,7 @@ ExprWideFunc( mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); - Tcl_GetWideIntFromObj(NULL, objPtr, &wResult); + TclGetWideIntFromObj(NULL, objPtr, &wResult); Tcl_DecrRefCount(objPtr); } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult)); @@ -7883,7 +7948,7 @@ MathFuncWrongNumArgs( int found, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { - const char *name = Tcl_GetString(objv[0]); + const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); while (tail > name+1) { @@ -8747,6 +8812,35 @@ TclNRCoroutineActivateCallback( /* *---------------------------------------------------------------------- * + * TclNREvalList -- + * + * Callback to invoke command as list, used in order to delayed + * processing of canonical list command in sane environment. + * + *---------------------------------------------------------------------- + */ + +static int +TclNREvalList( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + int objc; + Tcl_Obj **objv; + Tcl_Obj *listPtr = data[0]; + + Tcl_IncrRefCount(listPtr); + + TclMarkTailcall(interp); + TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); + TclListObjGetElements(NULL, listPtr, &objc, &objv); + return TclNREvalObjv(interp, objc, objv, 0, NULL); +} + +/* + *---------------------------------------------------------------------- + * * NRCoroInjectObjCmd -- * * Implementation of [::tcl::unsupported::inject] command. @@ -8798,7 +8892,8 @@ NRCoroInjectObjCmd( */ iPtr->execEnvPtr = corPtr->eePtr; - TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN); + TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), + NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -8816,7 +8911,7 @@ TclNRInterpCoroutine( if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "coroutine \"%s\" is already running", - Tcl_GetString(objv[0]))); + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL); return TCL_ERROR; } |