summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-10-06 09:28:53 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-10-06 09:28:53 (GMT)
commit243de42fd28301b4b4fffbeb555fe06c4a1ac9c7 (patch)
treef86f8e76fa9438c56e1b88fb6d8ac7e6e59c1d5a
parent90acad395b7d389f5b0b5092f9e1ecfab22973f1 (diff)
downloadtcl-243de42fd28301b4b4fffbeb555fe06c4a1ac9c7.zip
tcl-243de42fd28301b4b4fffbeb555fe06c4a1ac9c7.tar.gz
tcl-243de42fd28301b4b4fffbeb555fe06c4a1ac9c7.tar.bz2
Simplify [switch] implementation.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdMZ.c273
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 <donal.k.fellows@man.ac.uk>
+
+ * 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 <dgp@users.sourceforge.net>
* 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 ; i+=2) {
- if (Tcl_GetString(objv[i])[0] == '#') {
+ if (TclGetString(objv[i])[0] == '#') {
Tcl_AppendResult(interp, ", this may be due to a ",
"comment incorrectly placed outside of a ",
"switch body - see the \"switch\" ",
@@ -2874,10 +2873,10 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* check assumes that the list is non-empty!
*/
- if (strcmp(Tcl_GetString(objv[objc-1]), "-") == 0) {
+ if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "no body specified for pattern \"",
- Tcl_GetString(objv[objc-2]), "\"", NULL);
+ TclGetString(objv[objc-2]), "\"", NULL);
return TCL_ERROR;
}
@@ -2886,15 +2885,12 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* See if the pattern matches the string.
*/
- pattern = Tcl_GetString(objv[i]);
+ pattern = TclGetString(objv[i]);
- matched = 0;
- if ((i == objc - 2)
- && (*pattern == 'd')
+ if ((i == objc - 2) && (*pattern == 'd')
&& (strcmp(pattern, "default") == 0)) {
Tcl_Obj *emptyObj = NULL;
- matched = 1;
/*
* If either indexVarObj or matchVarObj are non-NULL,
* we're in REGEXP mode but have reached the default
@@ -2922,142 +2918,153 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
}
- numMatchesSaved = 0;
+ goto matchFound;
} else {
switch (mode) {
case OPT_EXACT:
- matched = (strcmp(Tcl_GetString(stringObj), pattern) == 0);
+ if (strcmp(TclGetString(stringObj), pattern) == 0) {
+ goto matchFound;
+ }
break;
case OPT_GLOB:
- matched = Tcl_StringMatch(Tcl_GetString(stringObj), pattern);
+ if (Tcl_StringMatch(TclGetString(stringObj), pattern)) {
+ goto matchFound;
+ }
break;
case OPT_REGEXP:
regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
TCL_REG_ADVANCED);
if (regExpr == NULL) {
return TCL_ERROR;
- }
- matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0,
- numMatchesSaved, 0);
- if (matched < 0) {
- return TCL_ERROR;
+ } else {
+ int matched = Tcl_RegExpExecObj(interp, regExpr,
+ stringObj, 0, numMatchesSaved, 0);
+ if (matched < 0) {
+ return TCL_ERROR;
+ } else if (matched) {
+ goto matchFoundRegexp;
+ }
}
break;
}
}
- if (matched == 0) {
- continue;
- }
+ }
+ return TCL_OK;
- /*
- * We are operating in REGEXP mode and we need to store
- * information about what we matched in some user-nominated
- * arrays. So build the lists of values and indices to write
- * here. [TIP#75]
- */
+ matchFoundRegexp:
+ /*
+ * We are operating in REGEXP mode and we need to store
+ * information about what we matched in some user-nominated
+ * arrays. So build the lists of values and indices to write
+ * here. [TIP#75]
+ */
- if (numMatchesSaved) {
- Tcl_RegExpInfo info;
- Tcl_Obj *matchesObj, *indicesObj = NULL;
+ if (numMatchesSaved) {
+ Tcl_RegExpInfo info;
+ Tcl_Obj *matchesObj, *indicesObj = NULL;
- Tcl_RegExpGetInfo(regExpr, &info);
- if (matchVarObj != NULL) {
- TclNewObj(matchesObj);
- } else {
- matchesObj = NULL;
- }
+ Tcl_RegExpGetInfo(regExpr, &info);
+ if (matchVarObj != NULL) {
+ TclNewObj(matchesObj);
+ } else {
+ matchesObj = NULL;
+ }
+ if (indexVarObj != NULL) {
+ TclNewObj(indicesObj);
+ }
+ for (j=0 ; j<=info.nsubs ; j++) {
if (indexVarObj != NULL) {
- TclNewObj(indicesObj);
- }
- for (j=0 ; j<=info.nsubs ; j++) {
- if (indexVarObj != NULL) {
- Tcl_Obj *rangeObjAry[2];
-
- rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
- rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
- /*
- * Never fails; the object is always clean at this point.
- */
- Tcl_ListObjAppendElement(NULL, indicesObj,
- Tcl_NewListObj(2, rangeObjAry));
- }
- if (matchVarObj != NULL) {
- Tcl_Obj *substringObj;
+ Tcl_Obj *rangeObjAry[2];
- substringObj = Tcl_GetRange(stringObj,
- info.matches[j].start, info.matches[j].end-1);
- /*
- * Never fails; the object is always clean at this point.
- */
- Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);
- }
- }
- if (indexVarObj != NULL) {
- if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_DecrRefCount(indicesObj);
- /*
- * Careful! Check to see if we have allocated the
- * list of matched strings; if so (but there was
- * an error assigning the indices list) we have a
- * potential memory leak because the match list
- * has not been written to a variable. Except
- * that we'll clean that up right now.
- */
- if (matchesObj != NULL) {
- Tcl_DecrRefCount(matchesObj);
- }
- return TCL_ERROR;
- }
+ rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
+ rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
+ /*
+ * Never fails; the object is always clean at this point.
+ */
+ Tcl_ListObjAppendElement(NULL, indicesObj,
+ Tcl_NewListObj(2, rangeObjAry));
}
if (matchVarObj != NULL) {
- if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_Obj *substringObj;
+
+ substringObj = Tcl_GetRange(stringObj,
+ info.matches[j].start, info.matches[j].end-1);
+ /*
+ * Never fails; the object is always clean at this point.
+ */
+ Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);
+ }
+ }
+ if (indexVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_DecrRefCount(indicesObj);
+ /*
+ * Careful! Check to see if we have allocated the
+ * list of matched strings; if so (but there was an
+ * error assigning the indices list) we have a
+ * potential memory leak because the match list has
+ * not been written to a variable. Except that we'll
+ * clean that up right now.
+ */
+ if (matchesObj != NULL) {
Tcl_DecrRefCount(matchesObj);
- /*
- * 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.
- */
- return TCL_ERROR;
}
+ return TCL_ERROR;
}
}
-
- /*
- * We've got a match. Find a body to execute, skipping bodies
- * that are "-".
- */
-
- for (j = i + 1; ; j += 2) {
- if (j >= 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;
}
/*