Reduce code nesting in [namespace ensemble] implementation.

1 files changed, 116 insertions, 139 deletions

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 4dd86b7..49d0ed9 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1,15 +1,15 @@
 /*
  * tclEnsemble.c --
  *
- *	Contains support for ensembles, which provide simple mechanism
- *	for creating composite commands on top of namespaces.
+ *	Contains support for ensembles (see TIP#112), which provide simple
+ *	mechanism for creating composite commands on top of namespaces.
  *
  * Copyright (c) 2005-2010 Donal K. Fellows.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEnsemble.c,v 1.1 2010/02/13 18:11:06 dkf Exp $
+ * RCS: @(#) $Id: tclEnsemble.c,v 1.2 2010/02/14 13:37:33 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -38,6 +38,34 @@ static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
 static void		StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
 
 /*
+ * The lists of subcommands and options for the [namespace ensemble] command.
+ */
+
+static const char *const ensembleSubcommands[] = {
+    "configure", "create", "exists", NULL
+};
+enum EnsSubcmds {
+    ENS_CONFIG, ENS_CREATE, ENS_EXISTS
+};
+
+static const char *const ensembleCreateOptions[] = {
+    "-command", "-map", "-parameters", "-prefixes", "-subcommands",
+    "-unknown", NULL
+};
+enum EnsCreateOpts {
+    CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
+};
+
+static const char *const ensembleConfigOptions[] = {
+    "-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
+    "-unknown", NULL
+};
+enum EnsConfigOpts {
+    CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
+    CONF_UNKNOWN
+};
+
+/*
  * This structure defines a Tcl object type that contains a reference to an
  * ensemble subcommand (e.g. the "length" in [string length ab]). It is used
  * to cache the mapping between the subcommand itself and the real command
@@ -81,36 +109,18 @@ TclNamespaceEnsembleCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
-    Namespace *nsPtr;
+    Tcl_Namespace *namespacePtr;
+    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     Tcl_Command token;
-    static const char *const subcommands[] = {
-	"configure", "create", "exists", NULL
-    };
-    enum EnsSubcmds {
-	ENS_CONFIG, ENS_CREATE, ENS_EXISTS
-    };
-    static const char *const createOptions[] = {
-	"-command", "-map", "-parameters", "-prefixes", "-subcommands",
-	"-unknown", NULL
-    };
-    enum EnsCreateOpts {
-	CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
-    };
-    static const char *const configOptions[] = {
-	"-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
-	"-unknown", NULL
-    };
-    enum EnsConfigOpts {
-	CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
-	CONF_UNKNOWN
-    };
-    int index;
-
-    nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    Tcl_DictSearch search;
+    Tcl_Obj *listObj;
+    int index, done;
+
     if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
 	if (!Tcl_InterpDeleted(interp)) {
 	    Tcl_AppendResult(interp,
-		    "tried to manipulate ensemble of deleted namespace", NULL);
+		    "tried to manipulate ensemble of deleted namespace",
+		    NULL);
 	}
 	return TCL_ERROR;
     }
@@ -119,17 +129,15 @@ TclNamespaceEnsembleCmd(
 	Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?");
 	return TCL_ERROR;
     }
-    if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "subcommand", 0,
-	    &index) != TCL_OK) {
+    if (Tcl_GetIndexFromObj(interp, objv[2], ensembleSubcommands,
+	    "subcommand", 0, &index) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     switch ((enum EnsSubcmds) index) {
     case ENS_CREATE: {
 	const char *name;
-	Tcl_DictSearch search;
-	Tcl_Obj *listObj;
-	int done, len, allocatedMapFlag = 0;
+	int len, allocatedMapFlag = 0;
 	/*
 	 * Defaults
 	 */
@@ -166,8 +174,8 @@ TclNamespaceEnsembleCmd(
 	 */
 
 	for (; objc>1 ; objc-=2,objv+=2) {
-	    if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, "option",
-		    0, &index) != TCL_OK) {
+	    if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions,
+		    "option", 0, &index) != TCL_OK) {
 		if (allocatedMapFlag) {
 		    Tcl_DecrRefCount(mapObj);
 		}
@@ -337,8 +345,8 @@ TclNamespaceEnsembleCmd(
 	if (objc == 5) {
 	    Tcl_Obj *resultObj = NULL;		/* silence gcc 4 warning */
 
-	    if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
-		    0, &index) != TCL_OK) {
+	    if (Tcl_GetIndexFromObj(interp, objv[4], ensembleConfigOptions,
+		    "option", 0, &index) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	    switch ((enum EnsConfigOpts) index) {
@@ -360,14 +368,12 @@ TclNamespaceEnsembleCmd(
 		    Tcl_SetObjResult(interp, resultObj);
 		}
 		break;
-	    case CONF_NAMESPACE: {
-		Tcl_Namespace *namespacePtr = NULL; /* silence gcc 4 warning */
-
+	    case CONF_NAMESPACE:
+		namespacePtr = NULL;		/* silence gcc 4 warning */
 		Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
 		Tcl_SetResult(interp, ((Namespace *) namespacePtr)->fullName,
 			TCL_VOLATILE);
 		break;
-	    }
 	    case CONF_PREFIX: {
 		int flags = 0;			/* silence gcc 4 warning */
 
@@ -383,68 +389,64 @@ TclNamespaceEnsembleCmd(
 		}
 		break;
 	    }
-	    return TCL_OK;
-
 	} else if (objc == 4) {
 	    /*
 	     * Produce list of all information.
 	     */
 
 	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
-	    Tcl_Namespace *namespacePtr = NULL;	/* silence gcc 4 warning */
 	    int flags = 0;			/* silence gcc 4 warning */
 
 	    TclNewObj(resultObj);
 
 	    /* -map option */
 	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_MAP], -1));
+		    Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], -1));
 	    Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
 
 	    /* -namespace option */
 	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_NAMESPACE], -1));
+		    Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE],
+			    -1));
+	    namespacePtr = NULL;		/* silence gcc 4 warning */
 	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    Tcl_NewStringObj(((Namespace *) namespacePtr)->fullName,
-		    -1));
+			    -1));
 
 	    /* -parameters option */
 	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_PARAM], -1));
+		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1));
 	    Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
 
 	    /* -prefix option */
 	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
+		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], -1));
 	    Tcl_GetEnsembleFlags(NULL, token, &flags);
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
 
 	    /* -subcommands option */
 	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_SUBCMDS], -1));
+		    Tcl_NewStringObj(ensembleConfigOptions[CONF_SUBCMDS],-1));
 	    Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
 
 	    /* -unknown option */
 	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(configOptions[CONF_UNKNOWN], -1));
+		    Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
 	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
 
 	    Tcl_SetObjResult(interp, resultObj);
-	    return TCL_OK;
 	} else {
-	    Tcl_DictSearch search;
-	    Tcl_Obj *listObj;
-	    int done, len, allocatedMapFlag = 0;
+	    int len, allocatedMapFlag = 0;
 	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
 		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
 	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */
@@ -467,8 +469,9 @@ TclNamespaceEnsembleCmd(
 	     */
 
 	    for (; objc>0 ; objc-=2,objv+=2) {
-		if (Tcl_GetIndexFromObj(interp, objv[0], configOptions,
+		if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions,
 			"option", 0, &index) != TCL_OK) {
+		freeMapAndError:
 		    if (allocatedMapFlag) {
 			Tcl_DecrRefCount(mapObj);
 		    }
@@ -477,24 +480,19 @@ TclNamespaceEnsembleCmd(
 		switch ((enum EnsConfigOpts) index) {
 		case CONF_SUBCMDS:
 		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
+			goto freeMapAndError;
 		    }
 		    subcmdObj = (len > 0 ? objv[1] : NULL);
 		    continue;
 		case CONF_PARAM:
 		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
+			goto freeMapAndError;
 		    }
 		    paramObj = (len > 0 ? objv[1] : NULL);
 		    continue;
 		case CONF_MAP: {
-		    Tcl_Obj *patchedDict = NULL, *subcmdObj;
+		    Tcl_Obj *patchedDict = NULL, *subcmdObj, **listv;
+		    const char *cmd;
 
 		    /*
 		     * Verify that the map is sensible.
@@ -502,29 +500,20 @@ TclNamespaceEnsembleCmd(
 
 		    if (Tcl_DictObjFirst(interp, objv[1], &search,
 			    &subcmdObj, &listObj, &done) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
+			goto freeMapAndError;
 		    }
 		    if (done) {
 			mapObj = NULL;
 			continue;
 		    }
 		    do {
-			Tcl_Obj **listv;
-			const char *cmd;
-
 			if (TclListObjGetElements(interp, listObj, &len,
 				&listv) != TCL_OK) {
 			    Tcl_DictObjDone(&search);
 			    if (patchedDict) {
 				Tcl_DecrRefCount(patchedDict);
 			    }
-			    if (allocatedMapFlag) {
-				Tcl_DecrRefCount(mapObj);
-			    }
-			    return TCL_ERROR;
+			    goto freeMapAndError;
 			}
 			if (len < 1) {
 			    Tcl_SetResult(interp,
@@ -534,14 +523,11 @@ TclNamespaceEnsembleCmd(
 			    if (patchedDict) {
 				Tcl_DecrRefCount(patchedDict);
 			    }
-			    if (allocatedMapFlag) {
-				Tcl_DecrRefCount(mapObj);
-			    }
-			    return TCL_ERROR;
+			    goto freeMapAndError;
 			}
 			cmd = TclGetString(listv[0]);
 			if (!(cmd[0] == ':' && cmd[1] == ':')) {
-			    Tcl_Obj *newList = Tcl_NewListObj(len, listv);
+			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
 			    Tcl_Obj *newCmd =
 				    Tcl_NewStringObj(nsPtr->fullName, -1);
 
@@ -568,27 +554,18 @@ TclNamespaceEnsembleCmd(
 		    continue;
 		}
 		case CONF_NAMESPACE:
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
 		    Tcl_AppendResult(interp, "option -namespace is read-only",
 			    NULL);
-		    return TCL_ERROR;
+		    goto freeMapAndError;
 		case CONF_PREFIX:
 		    if (Tcl_GetBooleanFromObj(interp, objv[1],
 			    &permitPrefix) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
+			goto freeMapAndError;
 		    }
 		    continue;
 		case CONF_UNKNOWN:
 		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			if (allocatedMapFlag) {
-			    Tcl_DecrRefCount(mapObj);
-			}
-			return TCL_ERROR;
+			goto freeMapAndError;
 		    }
 		    unknownObj = (len > 0 ? objv[1] : NULL);
 		    continue;
@@ -606,8 +583,8 @@ TclNamespaceEnsembleCmd(
 	    Tcl_SetEnsembleParameterList(interp, token, paramObj);
 	    Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
 	    Tcl_SetEnsembleFlags(interp, token, flags);
-	    return TCL_OK;
 	}
+	return TCL_OK;
 
     default:
 	Tcl_Panic("unexpected ensemble command");
@@ -2692,7 +2669,8 @@ TclCompileEnsemble(
     Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
     Tcl_Command ensemble = (Tcl_Command) cmdPtr;
     Tcl_Parse synthetic;
-    int len, numBytes, result, flags = 0, i;
+    int len, result, flags = 0, i;
+    unsigned numBytes;
     const char *word;
 
     if (parsePtr->numWords < 2) {
@@ -2742,7 +2720,8 @@ TclCompileEnsemble(
     }
 
     /*
-     * Next, get the flags. We need them on several code paths.
+     * Next, get the flags. We need them on several code paths so that we can
+     * know whether we're to do prefix matching.
      */
 
     (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags);
@@ -2764,7 +2743,7 @@ TclCompileEnsemble(
 	}
 	for (i=0 ; i<len ; i++) {
 	    str = Tcl_GetStringFromObj(elems[i], &sclen);
-	    if (sclen==numBytes && !memcmp(word, str, (unsigned) numBytes)) {
+	    if ((sclen == numBytes) && !memcmp(word, str, numBytes)) {
 		/*
 		 * Exact match! Excellent!
 		 */
@@ -2786,27 +2765,30 @@ TclCompileEnsemble(
 	     */
 
 	    if ((flags & TCL_ENSEMBLE_PREFIX)
-		    && strncmp(word, str, (unsigned) numBytes) == 0) {
+		    && strncmp(word, str, numBytes) == 0) {
 		if (matchObj != NULL) {
 		    return TCL_ERROR;
 		}
 		matchObj = elems[i];
 	    }
 	}
-	if (matchObj != NULL) {
-	    result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
-	    if (result != TCL_OK || targetCmdObj == NULL) {
-		return TCL_ERROR;
-	    }
-	    goto doneMapLookup;
+	if (matchObj == NULL) {
+	    return TCL_ERROR;
+	}
+	result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
+	if (result != TCL_OK || targetCmdObj == NULL) {
+	    return TCL_ERROR;
 	}
-	return TCL_ERROR;
     } else {
+	Tcl_DictSearch s;
+	int done, matched;
+	Tcl_Obj *tmpObj;
+
 	/*
 	 * No map, so check the dictionary directly.
 	 */
 
-	TclNewStringObj(subcmdObj, word, numBytes);
+	TclNewStringObj(subcmdObj, word, (int) numBytes);
 	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
 	TclDecrRefCount(subcmdObj);
 	if (result == TCL_OK && targetCmdObj != NULL) {
@@ -2822,44 +2804,39 @@ TclCompileEnsemble(
 	 * prefix. Check if prefix matches are allowed.
 	 */
 
-	if (flags & TCL_ENSEMBLE_PREFIX) {
-	    Tcl_DictSearch s;
-	    int done, matched;
-	    Tcl_Obj *tmpObj;
+	if (!(flags & TCL_ENSEMBLE_PREFIX)) {
+	    return TCL_ERROR;
+	}
 
-	    /*
-	     * Iterate over the keys in the dictionary, checking to see if
-	     * we're a prefix.
-	     */
+	/*
+	 * Iterate over the keys in the dictionary, checking to see if we're a
+	 * prefix.
+	 */
 
-	    Tcl_DictObjFirst(NULL,mapObj,&s,&subcmdObj,&tmpObj,&done);
-	    matched = 0;
-	    while (!done) {
-		if (strncmp(TclGetString(subcmdObj), word,
-			(unsigned) numBytes) == 0) {
-		    if (matched++) {
-			/*
-			 * Must have matched twice! Not unique, so no point
-			 * looking further.
-			 */
-
-			break;
-		    }
-		    targetCmdObj = tmpObj;
+	Tcl_DictObjFirst(NULL, mapObj, &s, &subcmdObj, &tmpObj, &done);
+	matched = 0;
+	while (!done) {
+	    if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) {
+		if (matched++) {
+		    /*
+		     * Must have matched twice! Not unique, so no point
+		     * looking further.
+		     */
+
+		    break;
 		}
-		Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
+		targetCmdObj = tmpObj;
 	    }
-	    Tcl_DictObjDone(&s);
+	    Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
+	}
+	Tcl_DictObjDone(&s);
 
-	    /*
-	     * If we have anything other than a single match, we've failed the
-	     * unique prefix check.
-	     */
+	/*
+	 * If we have anything other than a single match, we've failed the
+	 * unique prefix check.
+	 */
 
-	    if (matched != 1) {
-		return TCL_ERROR;
-	    }
-	} else {
+	if (matched != 1) {
 	    return TCL_ERROR;
 	}
     }