diff options
Diffstat (limited to 'generic/tclCmdMZ.c')
| -rw-r--r-- | generic/tclCmdMZ.c | 106 |
1 files changed, 103 insertions, 3 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 21a54e0..5a39466 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.142 2006/11/22 23:22:23 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.143 2006/11/28 22:20:28 andreas_kupries Exp $ */ #include "tclInt.h" @@ -2635,6 +2635,13 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *CONST *savedObjv = objv; Tcl_RegExp regExpr = NULL; + Interp* iPtr = (Interp*) interp; + int pc = 0; + int bidx = 0; /* Index of body argument */ + Tcl_Obj* blist = NULL; /* List obj which is the body */ + CmdFrame ctx; /* Copy of the topmost cmdframe, + * to allow us to mess with the + * line information */ /* * If you add options that make -e and -g not unique prefixes of -exact or @@ -2734,15 +2741,21 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) stringObj = objv[i]; objc -= i + 1; objv += i + 1; + bidx = i+1; /* First after the match string */ /* * If all of the pattern/command pairs are lumped into a single argument, * split them out again. + * + * TIP #280: Determine the lines the words in the list start at, based on + * the same data for the list word itself. The cmdFramePtr line information + * is manipulated directly. */ splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; + blist = objv[0]; if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) { return TCL_ERROR; @@ -2956,6 +2969,52 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) */ matchFound: + ctx = *iPtr->cmdFramePtr; + + if (splitObjs) { + /* We have to perform the GetSrc and other type dependent handling of + * the frame here because we are munging with the line numbers, + * something the other commands like if, etc. are not doing. Them are + * fine with simply passing the CmdFrame through and having the + * special handling done in 'info frame', or the bc compiler + */ + + if (ctx.type == TCL_LOCATION_BC) { + /* Note: Type BC => ctx.data.eval.path is not used. + * ctx.data.tebc.codePtr is used instead. + */ + TclGetSrcInfoForPc (&ctx); + pc = 1; + /* The line information in the cmdFrame is now a copy we do not + * own */ + } + + if (ctx.type == TCL_LOCATION_SOURCE) { + int bline = ctx.line [bidx]; + if (bline >= 0) { + ctx.line = (int*) ckalloc (objc * sizeof(int)); + ctx.nline = objc; + + TclListLines (Tcl_GetString (blist), bline, objc, ctx.line); + } else { + int k; + /* Dynamic code word ... All elements are relative to + * themselves */ + + ctx.line = (int*) ckalloc (objc * sizeof(int)); + ctx.nline = objc; + for (k=0; k < objc; k++) {ctx.line[k] = -1;} + } + } else { + int k; + /* Anything else ... No information, or dynamic ... */ + + ctx.line = (int*) ckalloc (objc * sizeof(int)); + ctx.nline = objc; + for (k=0; k < objc; k++) {ctx.line[k] = -1;} + } + } + for (j = i + 1; ; j += 2) { if (j >= objc) { /* @@ -2970,7 +3029,15 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) } } - result = Tcl_EvalObjEx(interp, objv[j], 0); + /* TIP #280. Make invoking context available to switch branch */ + result = TclEvalObjEx(interp, objv[j], 0, &ctx, j); + if (splitObjs) { + ckfree ((char*) ctx.line); + if (pc && (ctx.type == TCL_LOCATION_SOURCE)) { + /* Death of SrcInfo reference */ + Tcl_DecrRefCount (ctx.data.eval.path); + } + } /* * Generate an error message if necessary. @@ -3110,6 +3177,7 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result, value; + Interp* iPtr = (Interp*) interp; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "test command"); @@ -3124,7 +3192,8 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) if (!value) { break; } - result = Tcl_EvalObjEx(interp, objv[2], 0); + /* TIP #280. */ + result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr,2); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -3142,6 +3211,37 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) return result; } +void +TclListLines(listStr, line, n, lines) + CONST char* listStr; /* Pointer to string with list structure. + * Assumed to be valid. Assumed to contain + * n elements. + */ + int line; /* line the list as a whole starts on */ + int n; /* #elements in lines */ + int* lines; /* Array of line numbers, to fill */ +{ + int i; + int length = strlen( listStr); + CONST char *element = NULL; + CONST char* next = NULL; + + for (i = 0; i < n; i++) { + TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL); + + TclAdvanceLines (&line, listStr, element); /* Leading whitespace */ + lines [i] = line; + length -= (next - listStr); + TclAdvanceLines (&line, element, next); /* Element */ + listStr = next; + + if (*element == 0) { + /* ASSERT i == n */ + break; + } + } +} + /* * Local Variables: * mode: c |