diff options
| author | Kevin B Kenny <kennykb@acm.org> | 2009-07-14 16:52:28 (GMT) |
|---|---|---|
| committer | Kevin B Kenny <kennykb@acm.org> | 2009-07-14 16:52:28 (GMT) |
| commit | 67e100ed95642d0ec30b5718d5c2eb66535c3cbe (patch) | |
| tree | 3f792ab808ad24f569fa00894c9bab62e4972d9f /generic/tclCmdMZ.c | |
| parent | 08604cad04da0d67c84406f99bda814f6a416386 (diff) | |
| download | tcl-67e100ed95642d0ec30b5718d5c2eb66535c3cbe.zip tcl-67e100ed95642d0ec30b5718d5c2eb66535c3cbe.tar.gz tcl-67e100ed95642d0ec30b5718d5c2eb66535c3cbe.tar.bz2 | |
* generic/tclInt.h (TclNRSwitchObjCmd):
* generic/tclBasic.c (builtInCmds):
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
* tests/switch.test (switch-15.1):
Make non-bytecoded [switch] command aware of NRE. [Bug 2821401]
Diffstat (limited to 'generic/tclCmdMZ.c')
| -rw-r--r-- | generic/tclCmdMZ.c | 39 |
1 files changed, 36 insertions, 3 deletions
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)) { |