diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 8 | ||||
| -rw-r--r-- | generic/tclCompile.c | 5 | ||||
| -rw-r--r-- | generic/tclCompile.h | 4 | ||||
| -rw-r--r-- | generic/tclEnsemble.c | 291 | ||||
| -rw-r--r-- | generic/tclExecute.c | 63 | ||||
| -rw-r--r-- | tests/info.test | 26 | ||||
| -rw-r--r-- | tests/nre.test | 26 |
8 files changed, 333 insertions, 98 deletions
@@ -1,3 +1,11 @@ +2013-01-03 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE): + * generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to + allow for more efficient dispatch of non-bytecode-compiled subcommands + of bytecode-compiled ensembles. This can provide substantial speed + benefits in some cases. + 2013-01-02 Miguel Sofer <msofer@users.sf.net> * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 160fa3c..8fa191b 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -5791,7 +5791,7 @@ TclCompileVariableCmd( */ valueTokenPtr = parsePtr->tokenPtr; - for (i=2; i<=numWords; i+=2) { + for (i=1; i<numWords; i+=2) { varTokenPtr = TokenAfter(valueTokenPtr); valueTokenPtr = TokenAfter(varTokenPtr); @@ -5801,15 +5801,15 @@ TclCompileVariableCmd( return TCL_ERROR; } - CompileWord(envPtr, varTokenPtr, interp, 1); + CompileWord(envPtr, varTokenPtr, interp, i); TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr); - if (i != numWords) { + if (i+1 < numWords) { /* * A value has been given: set the variable, pop the value */ - CompileWord(envPtr, valueTokenPtr, interp, 1); + CompileWord(envPtr, valueTokenPtr, interp, i+1); Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); TclEmitOpcode( INST_POP, envPtr); } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 309682d..45a74d7 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -529,6 +529,11 @@ InstructionDesc const tclInstructionTable[] = { /* Forces the variable indexed by opnd to be an array. Does not touch * the stack. */ + {"invokeReplace", 6, INT_MIN, 2, {OPERAND_UINT4,OPERAND_UINT1}}, + /* Invoke command named objv[0], replacing the first two words with + * the word at the top of the stack; + * <objc,objv> = <op4,top op4 after popping 1> */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 3302f9b..4d8ed65 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -711,8 +711,10 @@ typedef struct ByteCode { #define INST_ARRAY_MAKE_STK 161 #define INST_ARRAY_MAKE_IMM 162 +#define INST_INVOKE_REPLACE 163 + /* The last opcode */ -#define LAST_INST_OPCODE 162 +#define LAST_INST_OPCODE 163 /* * Table describing the Tcl bytecode instructions: their name (for displaying diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index d8fcf97..0cad216 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -4,7 +4,7 @@ * Contains support for ensembles (see TIP#112), which provide simple * mechanism for creating composite commands on top of namespaces. * - * Copyright (c) 2005-2010 Donal K. Fellows. + * Copyright (c) 2005-2013 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -35,6 +35,12 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr); +static int CompileToCompiledCommand(Tcl_Interp *interp, + Tcl_Parse *parsePtr, int depth, Command *cmdPtr, + CompileEnv *envPtr); +static void CompileToInvokedCommand(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Tcl_Obj *replacements, + Command *cmdPtr, CompileEnv *envPtr); /* * The lists of subcommands and options for the [namespace ensemble] command. @@ -78,6 +84,17 @@ const Tcl_ObjType tclEnsembleCmdType = { StringOfEnsembleCmdRep, /* updateStringProc */ NULL /* setFromAnyProc */ }; + +/* + * Copied from tclCompCmds.c + */ + +#define DefineLineInformation \ + ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ + int eclIndex = mapPtr->nuloc - 1 +#define SetLineInformation(word) \ + envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ + envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] static inline Tcl_Obj * NewNsObj( @@ -1565,15 +1582,17 @@ TclMakeEnsemble( NULL); } cmdPtr->compileProc = map[i].compileProc; - if (map[i].compileProc != NULL) { - ensembleFlags |= ENSEMBLE_COMPILE; - } } } Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict); - if (ensembleFlags & ENSEMBLE_COMPILE) { - Tcl_SetEnsembleFlags(interp, ensemble, ensembleFlags); - } + + /* + * Switch on compilation always for core ensembles now that we can do + * nice bytecode things with them. + */ + + Tcl_SetEnsembleFlags(interp, ensemble, + ensembleFlags | ENSEMBLE_COMPILE); } Tcl_DStringFree(&buf); @@ -2731,25 +2750,33 @@ TclCompileEnsemble( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; + Tcl_Obj *replaced = Tcl_NewObj(), *replacement; Tcl_Command ensemble = (Tcl_Command) cmdPtr; - Tcl_Parse synthetic; - int len, result, flags = 0, i; + Command *oldCmdPtr = cmdPtr, *newCmdPtr; + int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; + int ourResult = TCL_ERROR; unsigned numBytes; const char *word; - if (parsePtr->numWords < 2) { - return TCL_ERROR; - } + Tcl_IncrRefCount(replaced); + + /* + * This is where we return to if we are parsing multiple nested compiled + * ensembles. [info object] is such a beast. + */ - tokenPtr = TokenAfter(parsePtr->tokenPtr); + checkNextWord: + if (parsePtr->numWords < depth + 1) { + goto failed; + } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Too hard. */ - return TCL_ERROR; + goto failed; } word = tokenPtr[1].start; @@ -2768,7 +2795,7 @@ TclCompileEnsemble( * to proceed. */ - return TCL_ERROR; + goto failed; } /* @@ -2782,7 +2809,7 @@ TclCompileEnsemble( * Figuring out how to compile this has become too much. Bail out. */ - return TCL_ERROR; + goto failed; } /* @@ -2805,7 +2832,7 @@ TclCompileEnsemble( Tcl_Obj *matchObj = NULL; if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { - return TCL_ERROR; + goto failed; } for (i=0 ; i<len ; i++) { str = Tcl_GetStringFromObj(elems[i], &sclen); @@ -2816,8 +2843,9 @@ TclCompileEnsemble( result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj); if (result != TCL_OK || targetCmdObj == NULL) { - return TCL_ERROR; + goto failed; } + replacement = elems[i]; goto doneMapLookup; } @@ -2833,18 +2861,19 @@ TclCompileEnsemble( if ((flags & TCL_ENSEMBLE_PREFIX) && strncmp(word, str, numBytes) == 0) { if (matchObj != NULL) { - return TCL_ERROR; + goto failed; } matchObj = elems[i]; } } if (matchObj == NULL) { - return TCL_ERROR; + goto failed; } result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj); if (result != TCL_OK || targetCmdObj == NULL) { - return TCL_ERROR; + goto failed; } + replacement = matchObj; } else { Tcl_DictSearch s; int done, matched; @@ -2856,14 +2885,15 @@ TclCompileEnsemble( TclNewStringObj(subcmdObj, word, (int) numBytes); result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj); - TclDecrRefCount(subcmdObj); if (result == TCL_OK && targetCmdObj != NULL) { /* * Got it. Skip the fiddling around with prefixes. */ + replacement = subcmdObj; goto doneMapLookup; } + TclDecrRefCount(subcmdObj); /* * We've not literally got a valid subcommand. But maybe we have a @@ -2871,7 +2901,7 @@ TclCompileEnsemble( */ if (!(flags & TCL_ENSEMBLE_PREFIX)) { - return TCL_ERROR; + goto failed; } /* @@ -2881,6 +2911,7 @@ TclCompileEnsemble( Tcl_DictObjFirst(NULL, mapObj, &s, &subcmdObj, &tmpObj, &done); matched = 0; + replacement = NULL; /* Silence, fool compiler! */ while (!done) { if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) { if (matched++) { @@ -2891,6 +2922,7 @@ TclCompileEnsemble( break; } + replacement = subcmdObj; targetCmdObj = tmpObj; } Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done); @@ -2903,7 +2935,8 @@ TclCompileEnsemble( */ if (matched != 1) { - return TCL_ERROR; + invokeAnyway = 1; + goto failed; } } @@ -2917,75 +2950,149 @@ TclCompileEnsemble( */ doneMapLookup: + Tcl_ListObjAppendElement(NULL, replaced, replacement); if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) { - return TCL_ERROR; + goto failed; } - if (len > 1 && Tcl_IsSafe(interp)) { - return TCL_ERROR; + if (len != 1) { + goto failed; } targetCmdObj = elems[0]; + oldCmdPtr = cmdPtr; Tcl_IncrRefCount(targetCmdObj); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj); + newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj); TclDecrRefCount(targetCmdObj); - if (cmdPtr == NULL || cmdPtr->compileProc == NULL - || cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION - || cmdPtr->flags * CMD_HAS_EXEC_TRACES + if (newCmdPtr == NULL || Tcl_IsSafe(interp) + || newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION + || newCmdPtr->flags & CMD_HAS_EXEC_TRACES || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) { /* * Maps to an undefined command or a command without a compiler. * Cannot compile. */ - return TCL_ERROR; + goto cleanup; + } + cmdPtr = newCmdPtr; + depth++; + + /* + * See whether we have a nested ensemble. If we do, we can go round the + * mulberry bush again, consuming the next word. + */ + + if (cmdPtr->compileProc == TclCompileEnsemble) { + tokenPtr = TokenAfter(tokenPtr); + ensemble = (Tcl_Command) cmdPtr; + goto checkNextWord; } /* * Now we've done the mapping process, can now actually try to compile. - * We do this by handing off to the subcommand's actual compiler. But to - * do that, we have to perform some trickery to rewrite the arguments. + * If there is a subcommand compiler and that successfully produces code, + * we'll use that. Otherwise, we fall back to generating opcodes to do the + * invoke at runtime. */ - TclParseInit(interp, NULL, 0, &synthetic); - synthetic.numWords = parsePtr->numWords - 2 + len; - TclGrowParseTokenArray(&synthetic, 2*len); - synthetic.numTokens = 2*len; + invokeAnyway = 1; + if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr, + envPtr) == TCL_OK) { + ourResult = TCL_OK; + goto cleanup; + } /* - * Now we have the space to work in, install something rewritten. Note - * that we are here praying for all our might that none of these words are - * a script; the error detection code will crash if that happens and there - * is nothing we can do to avoid it! + * Failed to do a full compile for some reason. Try to do a direct invoke + * instead of going through the ensemble lookup process again. */ - for (i=0 ; i<len ; i++) { - int sclen; - const char *str = Tcl_GetStringFromObj(elems[i], &sclen); + failed: + if (len == 1 && depth < 250) { + if (depth > 1) { + if (!invokeAnyway) { + cmdPtr = oldCmdPtr; + depth--; + } + (void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL); + } + CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr); + ourResult = TCL_OK; + } + + /* + * Release the memory we allocated. If we've got here, we've either done + * something useful or we're in a case that we can't compile at all and + * we're just giving up. + */ - synthetic.tokenPtr[2*i].type = TCL_TOKEN_SIMPLE_WORD; - synthetic.tokenPtr[2*i].start = str; - synthetic.tokenPtr[2*i].size = sclen; - synthetic.tokenPtr[2*i].numComponents = 1; + cleanup: + Tcl_DecrRefCount(replaced); + return ourResult; +} + +/* + * How to compile a subcommand using its own command compiler. To do that, we + * have to perform some trickery to rewrite the arguments, as compilers *must* + * have parse tokens that refer to addresses in the original script. + */ + +static int +CompileToCompiledCommand( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + int depth, + Command *cmdPtr, + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Parse synthetic; + Tcl_Token *tokenPtr; + int result, i; + + if (cmdPtr->compileProc == NULL) { + return TCL_ERROR; + } + + TclParseInit(interp, NULL, 0, &synthetic); + synthetic.numWords = parsePtr->numWords - depth + 1; + TclGrowParseTokenArray(&synthetic, 2); + synthetic.numTokens = 2; + + /* + * Now we have the space to work in, install something rewritten. The + * first word will "officially" be the bytes of the structured ensemble + * name. That's technically wrong, but nobody will care; we just need + * *something* here... + */ - synthetic.tokenPtr[2*i+1].type = TCL_TOKEN_TEXT; - synthetic.tokenPtr[2*i+1].start = str; - synthetic.tokenPtr[2*i+1].size = sclen; - synthetic.tokenPtr[2*i+1].numComponents = 0; + synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD; + synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start; + synthetic.tokenPtr[0].numComponents = 1; + synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT; + synthetic.tokenPtr[1].start = parsePtr->tokenPtr[0].start; + synthetic.tokenPtr[1].numComponents = 0; + for (i=0,tokenPtr=parsePtr->tokenPtr ; i<depth ; i++) { + int sclen = (tokenPtr->start - synthetic.tokenPtr[0].start) + + tokenPtr->size; + + synthetic.tokenPtr[0].size = sclen; + synthetic.tokenPtr[1].size = sclen; + tokenPtr = TokenAfter(tokenPtr); } /* * Copy over the real argument tokens. */ - for (i=len; i<synthetic.numWords; i++) { + for (i=1; i<synthetic.numWords; i++) { int toCopy; - tokenPtr = TokenAfter(tokenPtr); toCopy = tokenPtr->numComponents + 1; TclGrowParseTokenArray(&synthetic, toCopy); memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr, sizeof(Tcl_Token) * toCopy); synthetic.numTokens += toCopy; + tokenPtr = TokenAfter(tokenPtr); } /* @@ -3001,6 +3108,78 @@ TclCompileEnsemble( Tcl_FreeParse(&synthetic); return result; } + +/* + * How to compile a subcommand to a _replacing_ invoke of its implementation + * command. + */ + +static void +CompileToInvokedCommand( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Tcl_Obj *replacements, + Command *cmdPtr, + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokPtr; + Tcl_Obj *objPtr, **words; + char *bytes; + int length, i, numWords, cmdLit; + DefineLineInformation; + + /* + * Push the words of the command. Take care; the command words may be + * scripts that have backslashes in them, and [info frame 0] can see the + * difference. Hence the call to TclContinuationsEnterDerived... + */ + + Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); + for (i=0,tokPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) { + if (i > 0 && i < numWords+1) { + bytes = Tcl_GetStringFromObj(words[i-1], &length); + PushLiteral(envPtr, bytes, length); + } else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { + int literal = TclRegisterNewLiteral(envPtr, + tokPtr[1].start, tokPtr[1].size); + + if (envPtr->clNext) { + TclContinuationsEnterDerived( + envPtr->literalArrayPtr[literal].objPtr, + tokPtr[1].start - envPtr->source, + mapPtr->loc[eclIndex].next[i]); + } + TclEmitPush(literal, envPtr); + } else { + if (envPtr->clNext) { + SetLineInformation(i); + } + CompileTokens(envPtr, tokPtr, interp); + } + tokPtr = TokenAfter(tokPtr); + } + + /* + * Push the name of the command we're actually dispatching to as part of + * the implementation. + */ + + objPtr = Tcl_NewObj(); + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); + bytes = Tcl_GetStringFromObj(objPtr, &length); + cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length); + TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr, cmdPtr); + TclEmitPush(cmdLit, envPtr); + TclDecrRefCount(objPtr); + + /* + * Do the replacing dispatch. + */ + + TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr); + TclEmitInt1(numWords+1, envPtr); + TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */ +} /* * Local Variables: diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a9b3fb4..9fcc8a5 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2972,6 +2972,69 @@ TEBCresume( Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); #endif + case INST_INVOKE_REPLACE: + objc = TclGetUInt4AtPtr(pc+1); + opnd = TclGetUInt1AtPtr(pc+5); + objPtr = POP_OBJECT(); + objv = &OBJ_AT_DEPTH(objc-1); + cleanup = objc; +#ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 2) { + int i; + + if (traceInstructions) { + strncpy(cmdNameBuf, TclGetString(objv[0]), 20); + TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr))); + } else { + fprintf(stdout, + "%d: (%u) invoking (using implementation %s) ", + iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), + O2S(objPtr)); + } + for (i = 0; i < objc; i++) { + if (i < opnd) { + fprintf(stdout, "<"); + TclPrintObject(stdout, objv[i], 15); + fprintf(stdout, ">"); + } else { + TclPrintObject(stdout, objv[i], 15); + } + fprintf(stdout, " "); + } + fprintf(stdout, "\n"); + fflush(stdout); + } +#endif /*TCL_COMPILE_DEBUG*/ + { + Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL); + register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1; + Tcl_Obj **copyObjv = &listRepPtr->elements; + int i; + + listRepPtr->elemCount = objc - opnd + 1; + copyObjv[0] = objPtr; + memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd)); + for (i=1 ; i<objc-opnd+1 ; i++) { + Tcl_IncrRefCount(copyObjv[i]); + } + objPtr = copyPtr; + } + bcFramePtr->data.tebc.pc = (char *) pc; + iPtr->cmdFramePtr = bcFramePtr; + if (iPtr->flags & INTERP_DEBUG_FRAME) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, pc - codePtr->codeStart); + } + iPtr->ensembleRewrite.sourceObjs = objv; + iPtr->ensembleRewrite.numRemovedObjs = opnd; + iPtr->ensembleRewrite.numInsertedObjs = 1; + DECACHE_STACK_INFO(); + pc += 6; + TEBC_YIELD(); + TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); + iPtr->evalFlags |= TCL_EVAL_REDIRECT; + return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN); + /* * ----------------------------------------------------------------- * Start of INST_LOAD instructions. diff --git a/tests/info.test b/tests/info.test index 5078e11..ebc853a 100644 --- a/tests/info.test +++ b/tests/info.test @@ -692,31 +692,31 @@ test info-21.5 {miscellaneous error conditions} -returnCodes error -body { ## # ### ### ### ######### ######### ######### ## info frame + ## Helper # For the more complex results we cut the file name down to remove path # dependencies, and we use only part of the first line of the reported # command. The latter is required because otherwise the whole test case may # appear in some results, but the result is part of the testcase. An infinite # string would be required to describe that. The cutting-down breaks this. + proc reduce {frame} { - set pos [lsearch -exact $frame cmd] - incr pos - set cmd [lindex $frame $pos] + set cmd [dict get $frame cmd] if {[regexp \n $cmd]} { - set first [string range [lindex [split $cmd \n] 0] 0 end-4] - set frame [lreplace $frame $pos $pos $first] + dict set frame cmd \ + [string range [lindex [split $cmd \n] 0] 0 end-4] } - set pos [lsearch -exact $frame file] - if {$pos >=0} { - incr pos - set tail [file tail [lindex $frame $pos]] - set frame [lreplace $frame $pos $pos $tail] + if {[dict exists $frame file]} { + dict set frame file \ + [file tail [dict get $frame file]] } - set frame + return $frame } + proc subinterp {} { interp create sub ; interp debug sub -frame 1; interp eval sub [list proc reduce [info args reduce] [info body reduce]] } + ## Helper # Generate a stacktrace from the current location to top. This code # not only depends on the exact location of things, but also on the @@ -1454,9 +1454,9 @@ test info-30.1 {bs+nl in literal words, procedure body, compiled} -body { test info-30.2 {bs+nl in literal words, namespace script} { namespace eval xxx { variable res \ - [reduce [info frame 0]];# line 1457 + [info frame 0];# line 1457 } - return $xxx::res + return [reduce $xxx::res] } {type source line 1457 file info.test cmd {info frame 0} level 0} test info-30.3 {bs+nl in literal words, namespace multi-word script} { diff --git a/tests/nre.test b/tests/nre.test index b8ef2e0..b5eb032 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -74,7 +74,6 @@ test nre-1.1 {self-recursive procs} -setup { } -constraints { testnrelevels } -result {{0 1 1 1} 0} - test nre-1.2 {self-recursive lambdas} -setup { set a [list i [makebody {apply $::a $i}]] } -body { @@ -85,7 +84,6 @@ test nre-1.2 {self-recursive lambdas} -setup { } -constraints { testnrelevels } -result {{0 1 1 1} 0} - test nre-1.3 {mutually recursive procs and lambdas} -setup { proc a i { apply $::b [incr i] @@ -164,8 +162,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup { namespace delete ::foo } -constraints { testnrelevels -} -result {{0 3 2 2} 0} - +} -result {{0 2 2 2} 0} test nre-5.2 {[namespace eval] is not recursive} -setup { namespace eval ::foo { setabs @@ -177,7 +174,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup { namespace delete ::foo } -constraints { testnrelevels -} -result {{0 3 2 2} 0} +} -result {{0 2 2 2} 0} test nre-6.1 {[uplevel] is not recursive} -setup { proc a i [makebody {uplevel 1 [list a $i]}] @@ -189,7 +186,6 @@ test nre-6.1 {[uplevel] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 2 2 0} 0} - test nre-6.2 {[uplevel] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "set x $i; a $i"}] @@ -211,7 +207,6 @@ test nre-7.1 {[catch] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 3 3 0} 0} - test nre-7.2 {[if] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "if 1 {a $i}"}] @@ -222,7 +217,6 @@ test nre-7.2 {[if] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 2 2 0} 0} - test nre-7.3 {[while] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}] @@ -233,7 +227,6 @@ test nre-7.3 {[while] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 2 2 0} 0} - test nre-7.4 {[for] is not recursive} -setup { setabs proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}] @@ -244,7 +237,6 @@ test nre-7.4 {[for] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 2 2 0} 0} - test nre-7.5 {[foreach] is not recursive} -setup { # # Enable once [foreach] is NR-enabled @@ -258,7 +250,6 @@ test nre-7.5 {[foreach] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 3 3 0} 0} - test nre-7.6 {[eval] is not recursive} -setup { proc a i [makebody {eval [list a $i]}] } -body { @@ -269,7 +260,6 @@ test nre-7.6 {[eval] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 2 2 1} 0} - test nre-7.7 {[eval] is not recursive} -setup { proc a i [makebody {eval "a $i"}] } -body { @@ -280,7 +270,6 @@ test nre-7.7 {[eval] is not recursive} -setup { } -constraints { testnrelevels } -result {{0 2 2 1} 0} - test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup { proc foo args {} foo @@ -295,18 +284,15 @@ test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup { } -body { # if switching to plain eval is not nre aware, this will cause a "cannot # yield" error - list [bar] [bar] [bar] } -cleanup { rename bar {} rename foo {} } -result {1 2 3} - test nre-8.1 {nre and {*}} -body { # force an expansion that grows the evaluation stack, check that nre # adapts the TEBCdataPtr. This crashes on failure. - proc inner {} { set long [lrepeat 1000000 1] list {*}$long @@ -321,21 +307,18 @@ test nre-8.2 {nre and {*}, [Bug 2415422]} -body { # force an expansion that grows the evaluation stack, check that nre # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not # done properly. - proc nop {} {} proc crash {} { foreach val [list {*}[lrepeat 100000 x]] { nop } } - crash } -cleanup { rename nop {} rename crash {} } - # # Basic TclOO tests # @@ -351,7 +334,6 @@ test nre-oo.1 {really deep calls in oo - direct} -setup { } -constraints { testnrelevels } -result {{0 1 1 1} 0} - test nre-oo.2 {really deep calls in oo - call via [self]} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {[self] bar $i}] @@ -363,7 +345,6 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup { } -constraints { testnrelevels } -result {{0 1 1 1} 0} - test nre-oo.3 {really deep calls in oo - private calls} -setup { oo::object create foo oo::objdefine foo method bar i [makebody {my bar $i}] @@ -375,7 +356,6 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup { } -constraints { testnrelevels } -result {{0 1 1 1} 0} - test nre-oo.4 {really deep calls in oo - overriding} -setup { oo::class create foo { method bar i [makebody {my bar $i}] @@ -392,7 +372,6 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup { } -constraints { testnrelevels } -result {{0 1 1 1} 0} - test nre-oo.5 {really deep calls in oo - forwards} -setup { oo::object create foo set body [makebody {my boo $i}] @@ -409,7 +388,6 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup { testnrelevels } -result {{0 2 1 1} 0} - # # NASTY BUG found by tcllib's interp package # |