diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | doc/NRE.3 | 27 | ||||
| -rw-r--r-- | generic/tcl.decls | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 43 | ||||
| -rw-r--r-- | generic/tclDecls.h | 13 | ||||
| -rw-r--r-- | generic/tclExecute.c | 182 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclObj.c | 53 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 | ||||
| -rw-r--r-- | tests/expr.test | 9 |
11 files changed, 264 insertions, 97 deletions
@@ -1,3 +1,19 @@ +2009-08-12 Don Porter <dgp@users.sourceforge.net> + + TIP #353 IMPLEMENTATION + + * doc/NRE.3: New public routine Tcl_NRExprObj() permits + * generic/tcl.decls: extension commands to evaluate Tcl expressions + * generic/tclBasic.c: in NR-enabled command procedures. + * generic/tclCmdAH.c: + * generic/tclExecute.c: + * generic/tclInt.h: + * generic/tclObj.c: + * tests/expr.test: + + * generic/tclDecls.h: make genstubs + * generic/tclStubInit.c: + 2009-08-06 Andreas Kupries <andreask@activestate.com> * doc/refchan.n [Bug 2827000]: Extended the implementation of @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: NRE.3,v 1.3 2008/12/19 18:23:04 dgp Exp $ +'\" RCS: @(#) $Id: NRE.3,v 1.4 2009/08/12 16:06:38 dgp Exp $ '\" .so man.macros .TH NRE 3 8.6 Tcl "Tcl Library Procedures" @@ -31,6 +31,9 @@ int int \fBTcl_NRCmdSwap\fR(\fIinterp, cmd, objc, objv, flags\fR) .sp +int +\fBTcl_NRExprObj\fR(\fIinterp, objPtr, resultPtr\fR) +.sp void \fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR) .fi @@ -59,13 +62,16 @@ Count of parameters provided to the implementation of a command. Pointer to an array of Tcl objects. Each object holds the value of a single word in the command to execute. .AP Tcl_Obj *objPtr in -Pointer to a Tcl_Obj whose value is a script to execute. +Pointer to a Tcl_Obj whose value is a script or expression to execute. .AP int flags in ORed combination of flag bits that specify additional options. \fBTCL_EVAL_GLOBAL\fR is the only flag that is currently supported. .\" TODO: This is a lie. But kbk didn't grasp TCL_EVAL_INVOKE and .\" TCL_EVAL_NOERR well enough to document them. .AP Tcl_Command cmd in +.AP Tcl_Obj *resultPtr out +Pointer to an unshared Tcl_Obj where the result of expression +evaluation is written. .AP Tcl_NRPostProc *postProcPtr in Pointer to a function that will be invoked when the command currently executing in the interpreter designated by \fIinterp\fR completes. @@ -150,9 +156,18 @@ If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is evaluated in the global namespace. If it is not set, it is evaluated in the current namespace. .PP -All three of the routines return \fBTCL_OK\fR if command invocation -has been scheduled successfully. If for any reason command invocation -cannot be scheduled (for example, if the interpreter is unable to find +\fBTcl_NRExprObj\fR arranges for the expression contained in \fIobjPtr\fR +to be evaluated in the interpreter designated by \fIinterp\fR after +the current command (which must be trampoline-enabled) returns. It is +the method by which a command may evaluate a Tcl expression without consuming +space on the C stack. The argument \fIresultPtr\fR is a pointer to an +unshared Tcl_Obj where the result of expression evaluation is to be written. +If expression evaluation returns any code other than TCL_OK, the +\fIresultPtr\fR value is left untouched. +.PP +All of the routines return \fBTCL_OK\fR if command or expression invocation +has been scheduled successfully. If for any reason the scheduling cannot +be completed (for example, if the interpreter is unable to find the requested command), they return \fBTCL_ERROR\fR with an appropriate message left in the interpreter's result. .PP @@ -296,7 +311,7 @@ and the second is for use when there is already a trampoline in place. \fITheCmdDeleteProc\fR); .CE .SH "SEE ALSO" -Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3) +Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3) .SH KEYWORDS stackless, nonrecursive, execute, command, global, object, result, script .SH COPYRIGHT diff --git a/generic/tcl.decls b/generic/tcl.decls index 0ce6825..26f3a83 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.169 2009/02/27 23:03:42 nijtmans Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.170 2009/08/12 16:06:39 dgp Exp $ library tcl @@ -2295,6 +2295,11 @@ declare 624 generic { int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags) } +# TIP #353 (NR-enabled expressions) dgp +declare 625 generic { + int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr) +} + # ----- BASELINE -- FOR -- 8.6.0 ----- # ############################################################################## diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7941c7d..b83afe5 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.400 2009/08/02 13:03:47 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.401 2009/08/12 16:06:41 dgp Exp $ */ #include "tclInt.h" @@ -182,7 +182,7 @@ static const CmdInfo builtInCmds[] = { {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1}, {"error", Tcl_ErrorObjCmd, NULL, NULL, 1}, {"eval", Tcl_EvalObjCmd, NULL, NULL, 1}, - {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, NULL, 1}, + {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, 1}, {"format", Tcl_FormatObjCmd, NULL, NULL, 1}, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index b268bfc..85b098a 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.118 2009/07/24 20:45:22 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.119 2009/08/12 16:06:43 dgp Exp $ */ #include "tclInt.h" @@ -58,6 +58,7 @@ static const char * GetTypeFromMode(int mode); static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName, Tcl_StatBuf *statPtr); static Tcl_NRPostProc CatchObjCmdCallback; +static Tcl_NRPostProc ExprCallback; static Tcl_NRPostProc ForNextCallback; static Tcl_NRPostProc ForeachLoopStep; static Tcl_NRPostProc EvalCmdErrMsg; @@ -837,29 +838,53 @@ Tcl_ExprObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *resultPtr; - int result; + return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, dummy, objc, objv); +} + +int +TclNRExprObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Obj *resultPtr, *objPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; } + TclNewObj(resultPtr); + Tcl_IncrRefCount(resultPtr); if (objc == 2) { - result = Tcl_ExprObj(interp, objv[1], &resultPtr); + objPtr = objv[1]; + TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL); } else { - Tcl_Obj *objPtr = Tcl_ConcatObj(objc-1, objv+1); + objPtr = Tcl_ConcatObj(objc-1, objv+1); + TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL); + } + + return Tcl_NRExprObj(interp, objPtr, resultPtr); +} + +static int +ExprCallback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_Obj *resultPtr = data[0]; + Tcl_Obj *objPtr = data[1]; - Tcl_IncrRefCount(objPtr); - result = Tcl_ExprObj(interp, objPtr, &resultPtr); + if (objPtr != NULL) { Tcl_DecrRefCount(objPtr); } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); - Tcl_DecrRefCount(resultPtr); /* Done with the result object */ } - + Tcl_DecrRefCount(resultPtr); return result; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 6c3869f..032fb75 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.170 2009/02/27 23:03:42 nijtmans Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.171 2009/08/12 16:06:43 dgp Exp $ */ #ifndef _TCLDECLS @@ -3725,6 +3725,12 @@ EXTERN Tcl_Obj * Tcl_GetStartupScript (const char ** encodingPtr); EXTERN int Tcl_CloseEx (Tcl_Interp * interp, Tcl_Channel chan, int flags); #endif +#ifndef Tcl_NRExprObj_TCL_DECLARED +#define Tcl_NRExprObj_TCL_DECLARED +/* 625 */ +EXTERN int Tcl_NRExprObj (Tcl_Interp * interp, Tcl_Obj * objPtr, + Tcl_Obj * resultPtr); +#endif typedef struct TclStubHooks { const struct TclPlatStubs *tclPlatStubs; @@ -4385,6 +4391,7 @@ typedef struct TclStubs { void (*tcl_SetStartupScript) (Tcl_Obj * path, const char * encoding); /* 622 */ Tcl_Obj * (*tcl_GetStartupScript) (const char ** encodingPtr); /* 623 */ int (*tcl_CloseEx) (Tcl_Interp * interp, Tcl_Channel chan, int flags); /* 624 */ + int (*tcl_NRExprObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj * resultPtr); /* 625 */ } TclStubs; #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) @@ -6915,6 +6922,10 @@ extern const TclStubs *tclStubsPtr; #define Tcl_CloseEx \ (tclStubsPtr->tcl_CloseEx) /* 624 */ #endif +#ifndef Tcl_NRExprObj +#define Tcl_NRExprObj \ + (tclStubsPtr->tcl_NRExprObj) /* 625 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 1a9c9a9..c668539 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.443 2009/07/24 20:45:23 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.444 2009/08/12 16:06:43 dgp Exp $ */ #include "tclInt.h" @@ -693,6 +693,9 @@ static inline int OFFSET(void *ptr); static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); +static Tcl_NRPostProc CopyCallback; +static Tcl_NRPostProc ExprObjCallback; + /* * The structure below defines a bytecode Tcl object type to hold the * compiled bytecode for Tcl expressions. @@ -1243,6 +1246,127 @@ TclStackRealloc( *-------------------------------------------------------------- */ +int +Tcl_ExprObj( + Tcl_Interp *interp, /* Context in which to evaluate the + * expression. */ + register Tcl_Obj *objPtr, /* Points to Tcl object containing expression + * to evaluate. */ + Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression + * result is stored if no errors occur. */ +{ + TEOV_callback *rootPtr = TOP_CB(interp); + Tcl_Obj *resultPtr; + + TclNewObj(resultPtr); + TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr, + NULL, NULL); + Tcl_NRExprObj(interp, objPtr, resultPtr); + return TclNRRunCallbacks(interp, TCL_OK, rootPtr, 0); +} + +static int +CopyCallback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_Obj **resultPtrPtr = data[0]; + Tcl_Obj *resultPtr = data[1]; + + if (result == TCL_OK) { + *resultPtrPtr = resultPtr; + Tcl_IncrRefCount(resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); + } + return result; +} + +/* + *-------------------------------------------------------------- + * + * Tcl_NRExprObj -- + * + * Request evaluation of the expression in a Tcl_Obj by the NR stack. + * + * Results: + * Returns TCL_OK. + * + * Side effects: + * Compiles objPtr as a Tcl expression and places callbacks on the + * NR stack to execute the bytecode and store the result in resultPtr. + * If bytecode execution raises an exception, nothing is written + * to resultPtr, and the exceptional return code flows up the NR + * stack. If the exception is TCL_ERROR, an error message is left + * in the interp result and the interp's return options dictionary + * holds additional error information too. Execution of the bytecode + * may have other side effects, depending on the expression. + * + *-------------------------------------------------------------- + */ + +int +Tcl_NRExprObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr, + Tcl_Obj *resultPtr) +{ + ByteCode *codePtr; + + /* TODO: consider saving whole state? */ + Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp); + + Tcl_IncrRefCount(saveObjPtr); + + codePtr = CompileExprObj(interp, objPtr); + + /* TODO: Confirm reset not required? */ + /*Tcl_ResetResult(interp);*/ + Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr, + NULL, NULL); + Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr, + NULL, NULL); + return TCL_OK; +} + +static int +ExprObjCallback( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_Obj *saveObjPtr = data[0]; + Tcl_Obj *resultPtr = data[1]; + + if (result == TCL_OK) { + TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp)); + Tcl_IncrRefCount(resultPtr); + Tcl_SetObjResult(interp, saveObjPtr); + } + TclDecrRefCount(saveObjPtr); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * CompileExprObj -- + * Compile a Tcl expression value into ByteCode. + * + * Results: + * A (ByteCode *) is returned pointing to the resulting ByteCode. + * The caller must manage its refCount and arrange for a call to + * TclCleanupByteCode() when the last reference disappears. + * + * Side effects: + * The Tcl_ObjType of objPtr is changed to the "bytecode" type, + * and the ByteCode is kept in the internal rep (along with context + * data for checking validity) for faster operations the next time + * CompileExprObj is called on the same value. + * + *---------------------------------------------------------------------- + */ static ByteCode * CompileExprObj( @@ -1318,62 +1442,6 @@ CompileExprObj( } return codePtr; } - -int -Tcl_ExprObj( - Tcl_Interp *interp, /* Context in which to evaluate the - * expression. */ - register Tcl_Obj *objPtr, /* Points to Tcl object containing expression - * to evaluate. */ - Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression - * result is stored if no errors occur. */ -{ - Interp *iPtr = (Interp *) interp; - int result; - ByteCode *codePtr; - - /* - * Execute the expression after first saving the interpreter's result. - */ - - Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(saveObjPtr); - - codePtr = CompileExprObj(interp, objPtr); - - - Tcl_ResetResult(interp); - - /* - * Increment the code's ref count while it is being executed. If - * afterwards no references to it remain, free the code. - */ - - codePtr->refCount++; - result = TclExecuteByteCode(interp, codePtr); - codePtr->refCount--; - if (codePtr->refCount <= 0) { - TclCleanupByteCode(codePtr); - } - - /* - * If the expression evaluated successfully, store a pointer to its value - * object in resultPtrPtr then restore the old interpreter result. We - * increment the object's ref count to reflect the reference that we are - * returning to the caller. We also decrement the ref count of the - * interpreter's result object after calling Tcl_SetResult since we next - * store into that field directly. - */ - - if (result == TCL_OK) { - *resultPtrPtr = iPtr->objResultPtr; - Tcl_IncrRefCount(iPtr->objResultPtr); - - Tcl_SetObjResult(interp, saveObjPtr); - } - TclDecrRefCount(saveObjPtr); - return result; -} /* *---------------------------------------------------------------------- diff --git a/generic/tclInt.h b/generic/tclInt.h index ac3b3bc..b441bf6b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.432 2009/08/02 13:03:47 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.433 2009/08/12 16:06:44 dgp Exp $ */ #ifndef _TCLINT @@ -2607,6 +2607,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRNamespaceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; @@ -2890,6 +2891,7 @@ MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, mp_int *bignumValue); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); +MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); diff --git a/generic/tclObj.c b/generic/tclObj.c index 46758fa..8052028 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.154 2009/08/02 13:03:47 dkf Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.155 2009/08/12 16:06:44 dgp Exp $ */ #include "tclInt.h" @@ -1133,30 +1133,47 @@ TclObjBeingDeleted( *---------------------------------------------------------------------- */ +#define SetDuplicateObj(dupPtr, objPtr) \ + { \ + const Tcl_ObjType *typePtr = (objPtr)->typePtr; \ + const char *bytes = (objPtr)->bytes; \ + if (bytes) { \ + TclInitStringRep((dupPtr), bytes, (objPtr)->length); \ + } else { \ + (dupPtr)->bytes = NULL; \ + } \ + if (typePtr) { \ + if (typePtr->dupIntRepProc) { \ + typePtr->dupIntRepProc((objPtr), (dupPtr)); \ + } else { \ + (dupPtr)->internalRep = (objPtr)->internalRep; \ + (dupPtr)->typePtr = typePtr; \ + } \ + } \ + } + Tcl_Obj * Tcl_DuplicateObj( - register Tcl_Obj *objPtr) /* The object to duplicate. */ + Tcl_Obj *objPtr) /* The object to duplicate. */ { - register const Tcl_ObjType *typePtr = objPtr->typePtr; - register Tcl_Obj *dupPtr; + Tcl_Obj *dupPtr; TclNewObj(dupPtr); + SetDuplicateObj(dupPtr, objPtr); + return dupPtr; +} - if (objPtr->bytes == NULL) { - dupPtr->bytes = NULL; - } else if (objPtr->bytes != tclEmptyStringRep) { - TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length); - } - - if (typePtr != NULL) { - if (typePtr->dupIntRepProc == NULL) { - dupPtr->internalRep = objPtr->internalRep; - dupPtr->typePtr = typePtr; - } else { - typePtr->dupIntRepProc(objPtr, dupPtr); - } +void +TclSetDuplicateObj( + Tcl_Obj *dupPtr, + Tcl_Obj *objPtr) +{ + if (Tcl_IsShared(dupPtr)) { + Tcl_Panic("%s called with shared object", "TclSetDuplicateObj"); } - return dupPtr; + TclInvalidateStringRep(dupPtr); + TclFreeIntRep(dupPtr); + SetDuplicateObj(dupPtr, objPtr); } /* diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d80c19a..c71b944 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.183 2009/07/15 13:17:19 dkf Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.184 2009/08/12 16:06:44 dgp Exp $ */ #include "tclInt.h" @@ -1109,6 +1109,7 @@ static const TclStubs tclStubs = { Tcl_SetStartupScript, /* 622 */ Tcl_GetStartupScript, /* 623 */ Tcl_CloseEx, /* 624 */ + Tcl_NRExprObj, /* 625 */ }; /* !END!: Do not edit above this line. */ diff --git a/tests/expr.test b/tests/expr.test index 5662169..f1612b6 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.75 2009/06/01 21:34:22 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.76 2009/08/12 16:06:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -7146,6 +7146,13 @@ test expr-48.1 {Bug 1770224} { expr {-0x8000000000000001 >> 0x8000000000000000} } -1 +test expr-49.1 {Bug 2823282} { + coroutine foo apply {{} {set expr expr; $expr {[yield]}}} + foo 1 +} 1 + + + # cleanup if {[info exists a]} { unset a |