summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclAssembly.c32
-rw-r--r--generic/tclCompCmds.c5
-rw-r--r--generic/tclCompCmdsGR.c1
-rw-r--r--generic/tclCompCmdsSZ.c3
-rw-r--r--generic/tclCompile.c503
-rw-r--r--generic/tclExecute.c18
-rw-r--r--tests/misc.test7
7 files changed, 548 insertions, 21 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 62641e6..1a061f0 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -930,6 +930,12 @@ TclCompileAssembleCmd(
{
Tcl_Token *tokenPtr; /* Token in the input script */
+#if 0
+ int numCommands = envPtr->numCommands;
+ int offset = envPtr->codeNext - envPtr->codeStart;
+ int depth = envPtr->currStackDepth;
+#endif
+
/*
* Make sure that the command has a single arg that is a simple word.
*/
@@ -943,10 +949,32 @@ TclCompileAssembleCmd(
}
/*
- * Compile the code and return any error from the compilation.
+ * Compile the code and convert any error from the compilation into
+ * bytecode reporting the error;
*/
- return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
+ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
+ tokenPtr[1].size, TCL_EVAL_DIRECT)) {
+
+ /*
+ * TODO: Finish working out how to capture syntax errors captured
+ * during compile and make them bytecode reporting the error.
+ */
+#if 0
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%.*s\" body, line %d)",
+ parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
+ Tcl_GetErrorLine(interp)));
+ envPtr->numCommands = numCommands;
+ envPtr->codeNext = envPtr->codeStart + offset;
+ envPtr->currStackDepth = depth;
+ TclCompileSyntaxError(interp, envPtr);
+#else
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
+#endif
+ }
+ return TCL_OK;
}
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fddf152..18295eb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2544,7 +2544,7 @@ CompileEachloopCmd(
Tcl_DStringInit(&varList);
TclDStringAppendToken(&varList, &tokenPtr[1]);
- code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
+ code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
if (code != TCL_OK) {
@@ -2988,7 +2988,8 @@ TclCompileFormatCmd(
ckfree(objv);
Tcl_DecrRefCount(formatObj);
if (tmpObj == NULL) {
- return TCL_ERROR;
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
}
/*
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index f7c15e6..4de8cf2 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2534,6 +2534,7 @@ TclCompileSyntaxError(
TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
+ Tcl_ResetResult(interp);
}
/*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 855dd8f..026b214 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -748,6 +748,9 @@ TclSubstCompile(
Tcl_InterpState state = NULL;
TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
+ if (state != NULL) {
+ Tcl_ResetResult(interp);
+ }
/*
* Tricky point! If the first token does not result in a *guaranteed* push
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 633966e..a1ad5c8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -16,6 +16,8 @@
#include "tclCompile.h"
#include <assert.h>
+#define REWRITE
+
/*
* Table of all AuxData types.
*/
@@ -562,8 +564,10 @@ static void EnterCmdExtentData(CompileEnv *envPtr,
int cmdNumber, int numSrcBytes, int numCodeBytes);
static void EnterCmdStartData(CompileEnv *envPtr,
int cmdNumber, int srcOffset, int codeOffset);
+#ifndef REWRITE
static Command * FindCompiledCommandFromToken(Tcl_Interp *interp,
Tcl_Token *tokenPtr);
+#endif
static void FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1671,6 +1675,7 @@ TclWordKnownAtCompileTime(
return 1;
}
+#ifndef REWRITE
/*
* ---------------------------------------------------------------------
*
@@ -1718,6 +1723,7 @@ FindCompiledCommandFromToken(
Tcl_DStringFree(&ds);
return cmdPtr;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -1737,6 +1743,386 @@ FindCompiledCommandFromToken(
*----------------------------------------------------------------------
*/
+#ifdef REWRITE
+
+static int
+ExpandRequested(
+ Tcl_Token *tokenPtr,
+ int numWords)
+{
+ /* Determine whether any words of the command require expansion */
+ while (numWords--) {
+ if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ return 1;
+ }
+ tokenPtr += tokenPtr->numComponents + 1;
+ }
+ return 0;
+}
+
+static void
+CompileCmdLiteral(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdObj,
+ CompileEnv *envPtr)
+{
+ int numBytes;
+ const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
+ int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);
+ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+
+ if (cmdPtr) {
+ TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
+ }
+ TclEmitPush(cmdLitIdx, envPtr);
+}
+
+static void
+CompileInvocation(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ Tcl_Obj *cmdObj,
+ int numWords,
+ int wlineat,
+ CompileEnv *envPtr)
+{
+ int isnew, wordIdx = 0;
+ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+
+ if (cmdObj) {
+ CompileCmdLiteral(interp, cmdObj, envPtr);
+ wordIdx = 1;
+ tokenPtr += tokenPtr->numComponents + 1;
+ }
+
+ for (; wordIdx < numWords;
+ wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+ int objIdx;
+
+ envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+ envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ CompileTokens(envPtr, tokenPtr, interp);
+ continue;
+ }
+
+ objIdx = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+ tokenPtr[1].start - envPtr->source,
+ eclPtr->loc[wlineat].next[wordIdx]);
+ }
+ TclEmitPush(objIdx, envPtr);
+ }
+
+ /*
+ * Save PC -> command map for the TclArgumentBC* functions.
+ */
+
+ Tcl_SetHashValue(Tcl_CreateHashEntry(&eclPtr->litInfo,
+ INT2PTR(envPtr->codeNext - envPtr->codeStart), &isnew),
+ INT2PTR(wlineat));
+
+ if (wordIdx <= 255) {
+ TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+ } else {
+ TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+ }
+}
+
+static void
+CompileExpanded(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ Tcl_Obj *cmdObj,
+ int numWords,
+ int wlineat,
+ CompileEnv *envPtr)
+{
+ int wordIdx = 0;
+ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+
+ StartExpanding(envPtr);
+ if (cmdObj) {
+ CompileCmdLiteral(interp, cmdObj, envPtr);
+ wordIdx = 1;
+ tokenPtr += tokenPtr->numComponents + 1;
+ }
+
+ for (; wordIdx < numWords;
+ wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
+ int objIdx;
+
+ envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+ envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ CompileTokens(envPtr, tokenPtr, interp);
+ if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ TclEmitInstInt4(INST_EXPAND_STKTOP,
+ envPtr->currStackDepth, envPtr);
+ }
+ continue;
+ }
+
+ objIdx = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
+ tokenPtr[1].start - envPtr->source,
+ eclPtr->loc[wlineat].next[wordIdx]);
+ }
+ TclEmitPush(objIdx, envPtr);
+ }
+
+ /*
+ * The stack depth during argument expansion can only be
+ * managed at runtime, as the number of elements in the
+ * expanded lists is not known at compile time. We adjust here
+ * the stack depth estimate so that it is correct after the
+ * command with expanded arguments returns.
+ *
+ * The end effect of this command's invocation is that all the
+ * words of the command are popped from the stack, and the
+ * result is pushed: the stack top changes by (1-wordIdx).
+ *
+ * Note that the estimates are not correct while the command
+ * is being prepared and run, INST_EXPAND_STKTOP is not
+ * stack-neutral in general.
+ */
+
+ TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+ envPtr->expandCount--;
+ TclAdjustStackDepth(1 - wordIdx, envPtr);
+}
+
+static int
+CompileCmdCompileProc(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ Command *cmdPtr,
+ int startCodeOffset,
+ CompileEnv *envPtr)
+{
+ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+ int savedNumCmds = envPtr->numCommands;
+ int startStackDepth = envPtr->currStackDepth;
+ int wlineat = eclPtr->nuloc - 1;
+ int update = 0;
+
+ /*
+ * Mark the start of the command; the proper bytecode
+ * length will be updated later. There is no need to
+ * do this for the first bytecode in the compile env,
+ * as the check is done before calling
+ * TclNRExecuteByteCode(). Do emit an INST_START_CMD
+ * in special cases where the first bytecode is in a
+ * loop, to insure that the corresponding command is
+ * counted properly. Compilers for commands able to
+ * produce such a beast (currently 'while 1' only) set
+ * envPtr->atCmdStart to 0 in order to signal this
+ * case. [Bug 1752146]
+ *
+ * Note that the environment is initialised with
+ * atCmdStart=1 to avoid emitting ISC for the first
+ * command.
+ */
+
+ if (envPtr->atCmdStart == 1) {
+ if (startCodeOffset) {
+ /*
+ * Increase the number of commands being
+ * started at the current point. Note that
+ * this depends on the exact layout of the
+ * INST_START_CMD's operands, so be careful!
+ */
+
+ TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
+ }
+ } else if (envPtr->atCmdStart == 0) {
+ TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+ TclEmitInt4(1, envPtr);
+ update = 1;
+ }
+
+ if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
+
+#ifdef TCL_COMPILE_DEBUG
+ /*
+ * Confirm that the command compiler generated a
+ * single value on the stack as its result. This
+ * is only done in debugging mode, as it *should*
+ * be correct and normal users have no reasonable
+ * way to fix it anyway.
+ */
+
+ int diff = envPtr->currStackDepth - startStackDepth;
+
+ if (diff != 1) {
+ Tcl_Panic("bad stack adjustment when compiling"
+ " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
+ parsePtr->tokenPtr->start, diff);
+ }
+#endif
+ if (update) {
+ /*
+ * Fix the bytecode length.
+ */
+
+ unsigned char *fixPtr = envPtr->codeStart + startCodeOffset + 1;
+ unsigned fixLen = envPtr->codeNext - fixPtr + 1;
+
+ TclStoreInt4AtPtr(fixLen, fixPtr);
+ }
+ return TCL_OK;
+ }
+
+ if (envPtr->atCmdStart == 1 && startCodeOffset != 0) {
+ /*
+ * Decrease the number of commands being started
+ * at the current point. Note that this depends on
+ * the exact layout of the INST_START_CMD's
+ * operands, so be careful!
+ */
+
+ TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
+ }
+
+ /*
+ * Restore numCommands, codeNext, and currStackDepth to their
+ * correct values, removing any commands compiled before the
+ * failure to produce bytecode got reported.
+ * [Bugs 705406, 735055, 3614102]
+ */
+
+ envPtr->numCommands = savedNumCmds;
+ envPtr->codeNext = envPtr->codeStart + startCodeOffset;
+ envPtr->currStackDepth = startStackDepth;
+
+ envPtr->line = eclPtr->loc[wlineat].line[0];
+ envPtr->clNext = eclPtr->loc[wlineat].next[0];
+ return TCL_ERROR;
+}
+
+static int
+CompileCommandTokens(
+ Tcl_Interp *interp,
+ Tcl_Parse *parsePtr,
+ CompileEnv *envPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+ Tcl_Obj *cmdObj = Tcl_NewObj();
+ Command *cmdPtr = NULL;
+ int code = TCL_ERROR;
+ int cmdKnown, expand = -1;
+ int *wlines, wlineat;
+ int cmdLine = envPtr->line;
+ int *clNext = envPtr->clNext;
+ int cmdIdx = envPtr->numCommands;
+ int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+
+ assert (parsePtr->numWords > 0);
+
+ /* Pre-Compile */
+
+ envPtr->numCommands++;
+ EnterCmdStartData(envPtr, cmdIdx,
+ parsePtr->commandStart - envPtr->source, startCodeOffset);
+
+ /*
+ * TIP #280. Scan the words and compute the extended location
+ * information. The map first contain full per-word line
+ * information for use by the compiler. This is later replaced by
+ * a reduced form which signals non-literal words, stored in
+ * 'wlines'.
+ */
+
+ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
+ parsePtr->tokenPtr, parsePtr->commandStart,
+ parsePtr->commandSize, parsePtr->numWords, cmdLine,
+ clNext, &wlines, envPtr);
+ wlineat = eclPtr->nuloc - 1;
+
+ envPtr->line = eclPtr->loc[wlineat].line[0];
+ envPtr->clNext = eclPtr->loc[wlineat].next[0];
+
+ /* Do we know the command word? */
+ Tcl_IncrRefCount(cmdObj);
+ tokenPtr = parsePtr->tokenPtr;
+ cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
+
+ /* Is this a command we should (try to) compile with a compileProc ? */
+ if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
+ if (cmdPtr) {
+ /*
+ * Found a command. Test the ways we can be told
+ * not to attempt to compile it.
+ */
+ if ((cmdPtr->compileProc == NULL)
+ || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
+ || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+ cmdPtr = NULL;
+ }
+ }
+ if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+ expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+ if (expand) {
+ /* We need to expand, but compileProc cannot. */
+ cmdPtr = NULL;
+ }
+ }
+ }
+
+ /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
+ if (cmdPtr) {
+ code = CompileCmdCompileProc(interp, parsePtr, cmdPtr,
+ startCodeOffset, envPtr);
+ }
+
+ if (code == TCL_ERROR) {
+ if (expand < 0) {
+ expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
+ }
+
+ if (expand) {
+ CompileExpanded(interp, parsePtr->tokenPtr,
+ cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat,
+ envPtr);
+ } else {
+ CompileInvocation(interp, parsePtr->tokenPtr,
+ cmdKnown ? cmdObj : NULL, parsePtr->numWords, wlineat,
+ envPtr);
+ }
+ }
+
+ Tcl_DecrRefCount(cmdObj);
+
+ TclEmitOpcode(INST_POP, envPtr);
+ EnterCmdExtentData(envPtr, cmdIdx,
+ parsePtr->term - parsePtr->commandStart,
+ (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
+
+ /*
+ * TIP #280: Free full form of per-word line data and insert the
+ * reduced form now
+ */
+
+ envPtr->line = cmdLine;
+ envPtr->clNext = clNext;
+ ckfree(eclPtr->loc[wlineat].line);
+ ckfree(eclPtr->loc[wlineat].next);
+ eclPtr->loc[wlineat].line = wlines;
+ eclPtr->loc[wlineat].next = NULL;
+
+ return cmdIdx;
+}
+#endif
+
void
TclCompileScript(
Tcl_Interp *interp, /* Used for error and status reporting. Also
@@ -1748,6 +2134,122 @@ TclCompileScript(
* first null character. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+#ifdef REWRITE
+ int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last
+ * command this routine compiles into bytecode.
+ * Initial value of -1 indicates this routine
+ * has not yet generated any bytecode. */
+ const char *p = script; /* Where we are in our compile. */
+
+ if (envPtr->iPtr == NULL) {
+ Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
+ }
+
+ /* Each iteration compiles one command from the script. */
+
+ while (numBytes > 0) {
+ Tcl_Parse parse;
+ const char *next;
+
+ if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
+ /*
+ * Compile bytecodes to report the parse error at runtime.
+ */
+
+ Tcl_LogCommandInfo(interp, script, parse.commandStart,
+ parse.term + 1 - parse.commandStart);
+ TclCompileSyntaxError(interp, envPtr);
+ Tcl_FreeParse(&parse);
+ return;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ /*
+ * If tracing, print a line for each top level command compiled.
+ */
+
+ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+ int commandLength = parse.term - parse.commandStart;
+ fprintf(stdout, " Compiling: ");
+ TclPrintSource(stdout, parse.commandStart,
+ TclMin(commandLength, 55));
+ fprintf(stdout, "\n");
+ }
+#endif
+
+ /*
+ * TIP #280: Count newlines before the command start.
+ * (See test info-30.33).
+ */
+
+ TclAdvanceLines(&envPtr->line, p, parse.commandStart);
+ TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+ parse.commandStart - envPtr->source);
+
+ /*
+ * Advance parser to the next command in the script.
+ */
+
+ next = parse.commandStart + parse.commandSize;
+ numBytes -= next - p;
+ p = next;
+
+ if (parse.numWords == 0) {
+ /*
+ * The "command" parsed has no words. In this case
+ * we can skip the rest of the loop body. With no words,
+ * clearly CompileCommandTokens() has nothing to do. Since
+ * the parser aggressively sucks up leading comment and white
+ * space, including newlines, parse.commandStart must be
+ * pointing at either the end of script, or a command-terminating
+ * semi-colon. In either case, the TclAdvance*() calls have
+ * nothing to do. Finally, when no words are parsed, no
+ * tokens have been allocated at parse.tokenPtr so there's
+ * also nothing for Tcl_FreeParse() to do.
+ *
+ * The advantage of this shortcut is that CompileCommandTokens()
+ * can be written with an assumption that parse.numWords > 0,
+ * with the implication the CCT() always generates bytecode.
+ */
+ continue;
+ }
+
+ lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr);
+
+ /*
+ * TIP #280: Track lines in the just compiled command.
+ */
+
+ TclAdvanceLines(&envPtr->line, parse.commandStart, p);
+ TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+ p - envPtr->source);
+ Tcl_FreeParse(&parse);
+ }
+
+ if (lastCmdIdx == -1) {
+ /*
+ * Compiling the script yielded no bytecode. The script must be
+ * all whitespace, comments, and empty commands. Such scripts
+ * are defined to successfully produce the empty string result,
+ * so we emit the simple bytecode that makes that happen.
+ */
+ PushStringLiteral(envPtr, "");
+ } else {
+ /*
+ * We compiled at least one command to bytecode. The routine
+ * CompileCommandTokens() follows the bytecode of each compiled
+ * command with an INST_POP, so that stack balance is maintained
+ * when several commands are in sequence. (The result of each
+ * command is thrown away before moving on to the next command).
+ * For the last command compiled, we need to undo that INST_POP
+ * so that the result of the last command becomes the result of
+ * the script. The code here removes that trailing INST_POP.
+ */
+ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
+ envPtr->codeNext--;
+ envPtr->currStackDepth++;
+ }
+#else
int lastTopLevelCmdIndex = -1;
/* Index of most recent toplevel command in
* the command location table. Initialized to
@@ -2192,6 +2694,7 @@ TclCompileScript(
if (envPtr->codeNext == entryCodeNext) {
PushStringLiteral(envPtr, "");
}
+#endif
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d3a0d32..37bf072 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1426,17 +1426,12 @@ Tcl_NRExprObj(
Tcl_Obj *resultPtr)
{
ByteCode *codePtr;
+ Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK);
- /* TODO: consider saving whole state? */
- Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp);
-
- Tcl_IncrRefCount(saveObjPtr);
-
+ Tcl_ResetResult(interp);
codePtr = CompileExprObj(interp, objPtr);
- /* TODO: Confirm reset not required? */
- /*Tcl_ResetResult(interp);*/
- Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr,
+ Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
NULL, NULL);
return TclNRExecuteByteCode(interp, codePtr);
}
@@ -1447,14 +1442,15 @@ ExprObjCallback(
Tcl_Interp *interp,
int result)
{
- Tcl_Obj *saveObjPtr = data[0];
+ Tcl_InterpState state = data[0];
Tcl_Obj *resultPtr = data[1];
if (result == TCL_OK) {
TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
- Tcl_SetObjResult(interp, saveObjPtr);
+ (void) Tcl_RestoreInterpState(interp, state);
+ } else {
+ Tcl_DiscardInterpState(state);
}
- TclDecrRefCount(saveObjPtr);
return result;
}
diff --git a/tests/misc.test b/tests/misc.test
index 6ddc718..d4ece74 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -59,12 +59,7 @@ test misc-1.2 {error in variable ref. in command in array reference} {
missing close-brace for variable name
missing close-brace for variable name
while executing
-"set tst $a([winfo name $\{zz)
- # this is a bogus comment
- # this is a bogus comment
- # this is a bogus comment
- # this is a bogus comment
- # this is a ..."
+"set tst $a([winfo name $\{"
(procedure "tstProc" line 4)
invoked from within
"tstProc"}]