From 243de42fd28301b4b4fffbeb555fe06c4a1ac9c7 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 6 Oct 2004 09:28:53 +0000 Subject: Simplify [switch] implementation. --- ChangeLog | 6 ++ generic/tclCmdMZ.c | 273 +++++++++++++++++++++++++++-------------------------- 2 files changed, 146 insertions(+), 133 deletions(-) diff --git a/ChangeLog b/ChangeLog index 22f42b5..e9c6b24 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-10-06 Donal K. Fellows + + * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reorganized to have fewer + magic flag variables and to separate the code that scans for a + match from the code that processes a match body. + 2004-10-06 Don Porter * generic/tclBasic.c: diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 71e2ee5..2300799 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.109 2004/10/06 05:52:21 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.110 2004/10/06 09:28:55 dkf Exp $ */ #include "tclInt.h" @@ -1167,7 +1167,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) { Tcl_UniChar ch; int len; - char *splitChars, *string, *end; + char *splitChars, *stringPtr, *end; int splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; @@ -1181,8 +1181,8 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - string = Tcl_GetStringFromObj(objv[1], &stringLen); - end = string + stringLen; + stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen); + end = stringPtr + stringLen; listPtr = Tcl_NewObj(); if (stringLen == 0) { @@ -1204,12 +1204,12 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) */ Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); - for ( ; string < end; string += len) { - len = TclUtfToUniChar(string, &ch); + for ( ; stringPtr < end; stringPtr += len) { + len = TclUtfToUniChar(stringPtr, &ch); /* Assume Tcl_UniChar is an integral type... */ hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew); if (isNew) { - objPtr = Tcl_NewStringObj(string, len); + objPtr = Tcl_NewStringObj(stringPtr, len); /* Don't need to fiddle with refcount... */ Tcl_SetHashValue(hPtr, (ClientData) objPtr); } else { @@ -1227,12 +1227,12 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) * char is > 1 byte in length. */ - while (*string && (p = strchr(string, (int) *splitChars)) != NULL) { - objPtr = Tcl_NewStringObj(string, p - string); + while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) { + objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); - string = p + 1; + stringPtr = p + 1; } - objPtr = Tcl_NewStringObj(string, end - string); + objPtr = Tcl_NewStringObj(stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { char *element, *p, *splitEnd; @@ -1246,19 +1246,19 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) splitEnd = splitChars + splitCharLen; - for (element = string; string < end; string += len) { - len = TclUtfToUniChar(string, &ch); + for (element = stringPtr; stringPtr < end; stringPtr += len) { + len = TclUtfToUniChar(stringPtr, &ch); for (p = splitChars; p < splitEnd; p += splitLen) { splitLen = TclUtfToUniChar(p, &splitChar); if (ch == splitChar) { - objPtr = Tcl_NewStringObj(element, string - element); + objPtr = Tcl_NewStringObj(element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); - element = string + len; + element = stringPtr + len; break; } } } - objPtr = Tcl_NewStringObj(element, string - element); + objPtr = Tcl_NewStringObj(element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } Tcl_SetObjResult(interp, listPtr); @@ -2729,8 +2729,8 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int i, j, index, mode, matched, result, splitObjs, numMatchesSaved; - char *string, *pattern; + int i, j, index, mode, result, splitObjs, numMatchesSaved; + char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *CONST *savedObjv = objv; Tcl_RegExp regExpr = NULL; @@ -2747,8 +2747,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) matchVarObj = NULL; numMatchesSaved = 0; for (i = 1; i < objc; i++) { - string = Tcl_GetString(objv[i]); - if (string[0] != '-') { + if (TclGetString(objv[i])[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, @@ -2856,7 +2855,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) if (splitObjs) { for (i=0 ; i= objc) { + if (matchVarObj != NULL) { + if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj, + TCL_LEAVE_ERR_MSG) == NULL) { + Tcl_DecrRefCount(matchesObj); /* - * This shouldn't happen since we've checked that the - * last body is not a continuation... + * Unlike above, if indicesObj is non-NULL at this + * point, it will have been written to a variable + * already and will hence not be leaked. */ - Tcl_Panic("fall-out when searching for body to match pattern"); - } - if (strcmp(Tcl_GetString(objv[j]), "-") != 0) { - break; + return TCL_ERROR; } } - result = Tcl_EvalObjEx(interp, objv[j], 0); - if (result == TCL_ERROR) { - Tcl_Obj *msg = Tcl_NewStringObj("\n (\"", -1); - Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine); - Tcl_IncrRefCount(msg); - Tcl_IncrRefCount(errorLine); - TclAppendLimitedToObj(msg, pattern, -1, 50, ""); - Tcl_AppendToObj(msg,"\" arm line ", -1); - Tcl_AppendObjToObj(msg, errorLine); - Tcl_DecrRefCount(errorLine); - Tcl_AppendToObj(msg,")", -1); - TclAppendObjToErrorInfo(interp, msg); - Tcl_DecrRefCount(msg); - } - return result; } - return TCL_OK; + + matchFound: + /* + * We've got a match. Find a body to execute, skipping bodies that + * are "-". + */ + + for (j = i + 1; ; j += 2) { + if (j >= objc) { + /* + * This shouldn't happen since we've checked that the + * last body is not a continuation... + */ + Tcl_Panic("fall-out when searching for body to match pattern"); + } + if (strcmp(TclGetString(objv[j]), "-") != 0) { + break; + } + } + + result = Tcl_EvalObjEx(interp, objv[j], 0); + + /* + * Generate an error message if necessary. + */ + if (result == TCL_ERROR) { + Tcl_Obj *msg = Tcl_NewStringObj("\n (\"", -1); + Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine); + Tcl_IncrRefCount(msg); + Tcl_IncrRefCount(errorLine); + TclAppendLimitedToObj(msg, pattern, -1, 50, ""); + Tcl_AppendToObj(msg,"\" arm line ", -1); + Tcl_AppendObjToObj(msg, errorLine); + Tcl_DecrRefCount(errorLine); + Tcl_AppendToObj(msg,")", -1); + TclAppendObjToErrorInfo(interp, msg); + Tcl_DecrRefCount(msg); + } + return result; } /* -- cgit v0.12