diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 39 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 |
3 files changed, 40 insertions, 6 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a097976..fcc7d46 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.395 2009/07/14 16:34:08 andreas_kupries Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.396 2009/07/14 16:52:28 kennykb Exp $ */ #include "tclInt.h" @@ -214,7 +214,7 @@ static const CmdInfo builtInCmds[] = { {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, 1}, {"split", Tcl_SplitObjCmd, NULL, NULL, 1}, {"subst", Tcl_SubstObjCmd, NULL, NULL, 1}, - {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, NULL, 1}, + {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1}, {"throw", Tcl_ThrowObjCmd, NULL, NULL, 1}, {"trace", Tcl_TraceObjCmd, NULL, NULL, 1}, {"try", Tcl_TryObjCmd, NULL, TclNRTryObjCmd, 1}, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d6f2987..9d416bc 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -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: tclCmdMZ.c,v 1.185 2009/07/14 16:34:08 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.186 2009/07/14 16:52:28 kennykb Exp $ */ #include "tclInt.h" @@ -23,6 +23,8 @@ static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); +static int SwitchPostProc(ClientData data[], Tcl_Interp* interp, + int result); static int TryPostBody(ClientData data[], Tcl_Interp *interp, int result); static int TryPostFinal(ClientData data[], Tcl_Interp *interp, @@ -3426,7 +3428,16 @@ Tcl_SwitchObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved; + return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, dummy, objc, objv); +} +int +TclNRSwitchObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int i,j, index, mode, foundmode, splitObjs, numMatchesSaved; int noCase, patternLength; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; @@ -3853,7 +3864,29 @@ Tcl_SwitchObjCmd( * TIP #280: Make invoking context available to switch branch. */ - result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, j); + Tcl_NRAddCallback(interp, SwitchPostProc, (ClientData) splitObjs, + (ClientData) ctxPtr, (ClientData) pc, + (ClientData) pattern); + return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, j); +} +static int +SwitchPostProc( + ClientData data[], /* Data passed from Tcl_NRAddCallback above */ + Tcl_Interp* interp, /* Tcl interpreter */ + int result) /* Result to return*/ +{ + /* Unpack the preserved data */ + + int splitObjs = (int) data[0]; + CmdFrame* ctxPtr = (CmdFrame*) data[1]; + int pc = (int) data[2]; + const char* pattern = (const char*) data[3]; + int patternLength = strlen(pattern); + + /* + * Clean up TIP 280 context information + */ + if (splitObjs) { ckfree((char *) ctxPtr->line); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 7374b23..8c5cf3d 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.428 2009/07/14 16:34:09 andreas_kupries Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.429 2009/07/14 16:52:28 kennykb Exp $ */ #ifndef _TCLINT @@ -2602,6 +2602,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; |