Attachment "1076088.patch" to
ticket [1076088fff]
added by
dgp
2005-05-06 01:32:13.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.149
diff -u -r1.149 tclBasic.c
--- generic/tclBasic.c 3 May 2005 18:07:45 -0000 1.149
+++ generic/tclBasic.c 5 May 2005 18:25:39 -0000
@@ -2822,6 +2822,14 @@
Tcl_HashSearch hSearch;
CONST char *name;
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ if ((Tcl_FindHashEntry(&iPtr->mathFuncTable, pattern) != NULL)
+ && (Tcl_ListObjAppendElement(interp, resultList,
+ Tcl_NewStringObj(pattern,-1)) != TCL_OK)) {
+ goto error;
+ }
+ return resultList;
+ }
for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
name = Tcl_GetHashKey(&iPtr->mathFuncTable, hPtr);
@@ -2829,6 +2837,7 @@
/* I don't expect this to fail, but... */
Tcl_ListObjAppendElement(interp, resultList,
Tcl_NewStringObj(name,-1)) != TCL_OK) {
+error:
Tcl_DecrRefCount(resultList);
return NULL;
}
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.72
diff -u -r1.72 tclCmdIL.c
--- generic/tclCmdIL.c 2 Apr 2005 02:08:31 -0000 1.72
+++ generic/tclCmdIL.c 5 May 2005 18:25:39 -0000
@@ -1455,6 +1455,13 @@
}
if (localVarTablePtr != NULL) {
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ if (Tcl_FindHashEntry(localVarTablePtr, pattern)) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(pattern,-1));
+ }
+ return;
+ }
for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
entryPtr != NULL;
entryPtr = Tcl_NextHashEntry(&search)) {
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.66
diff -u -r1.66 tclCompCmds.c
--- generic/tclCompCmds.c 5 May 2005 17:21:03 -0000 1.66
+++ generic/tclCompCmds.c 5 May 2005 18:25:40 -0000
@@ -2612,18 +2612,13 @@
length = varTokenPtr[1].size;
if (!nocase && (i == 0)) {
/*
- * On the first (pattern) arg, check to see if any
- * glob special characters are in the word '*[]?\\'.
- * If not, this is the same as 'string equal'. We
- * can use strpbrk here because the glob chars are all
- * in the ascii-7 range. If -nocase was specified,
- * we can't do this because INST_STR_EQ has no support
- * for nocase.
+ * Trivial matches can be done by 'string equal'.
+ * If -nocase was specified, we can't do this
+ * because INST_STR_EQ has no support for nocase.
*/
Tcl_Obj *copy = Tcl_NewStringObj(str, length);
Tcl_IncrRefCount(copy);
- exactMatch = (strpbrk(Tcl_GetString(copy),
- "*[]?\\") == NULL);
+ exactMatch = TclMatchIsTrivial(Tcl_GetString(copy));
Tcl_DecrRefCount(copy);
}
TclEmitPush(
Index: generic/tclDictObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDictObj.c,v
retrieving revision 1.29
diff -u -r1.29 tclDictObj.c
--- generic/tclDictObj.c 22 Apr 2005 15:46:54 -0000 1.29
+++ generic/tclDictObj.c 5 May 2005 18:25:40 -0000
@@ -1671,6 +1671,14 @@
pattern = TclGetString(objv[3]);
}
listPtr = Tcl_NewListObj(0, NULL);
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ Tcl_Obj *valuePtr = NULL;
+ Tcl_DictObjGet(interp, objv[2], objv[3], &valuePtr);
+ if (valuePtr != NULL) {
+ Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
+ }
+ goto searchDone;
+ }
for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) {
if (pattern==NULL || Tcl_StringMatch(TclGetString(keyPtr), pattern)) {
/*
@@ -1679,6 +1687,7 @@
Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
}
}
+searchDone:
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -2531,11 +2540,18 @@
}
pattern = TclGetString(objv[4]);
resultObj = Tcl_NewDictObj();
- while (!done) {
- if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ if (TclMatchIsTrivial(pattern)) {
+ Tcl_DictObjGet(interp, objv[2], objv[4], &valueObj);
+ if (valueObj != NULL) {
+ Tcl_DictObjPut(interp, resultObj, objv[4], valueObj);
+ }
+ } else {
+ while (!done) {
+ if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ }
+ Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
- Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
Index: generic/tclIO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
retrieving revision 1.84
diff -u -r1.84 tclIO.c
--- generic/tclIO.c 14 Apr 2005 02:41:15 -0000 1.84
+++ generic/tclIO.c 5 May 2005 18:25:41 -0000
@@ -8766,7 +8766,16 @@
hTblPtr = GetChannelTable(interp);
TclNewObj(resultPtr);
-
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)
+ && !((pattern[0] == 's') && (pattern[1] == 't')
+ && (pattern[2] == 'd'))) {
+ if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL)
+ && (Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(pattern, -1)) != TCL_OK)) {
+ goto error;
+ }
+ goto done;
+ }
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
@@ -8790,10 +8799,12 @@
if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
(Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(name, -1)) != TCL_OK)) {
+error:
TclDecrRefCount(resultPtr);
return TCL_ERROR;
}
}
+done:
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.86
diff -u -r1.86 tclInt.decls
--- generic/tclInt.decls 2 Apr 2005 02:08:36 -0000 1.86
+++ generic/tclInt.decls 5 May 2005 18:25:41 -0000
@@ -807,9 +807,9 @@
CallFrame **framePtrPtr)
}
-declare 199 generic {
- int TclMatchIsTrivial(CONST char *pattern)
-}
+#declare 199 generic {
+# int TclMatchIsTrivial(CONST char *pattern)
+#}
# 200-208 exported for use by the test suite [Bug 1054748]
declare 200 generic {
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.227
diff -u -r1.227 tclInt.h
--- generic/tclInt.h 5 May 2005 15:32:20 -0000 1.227
+++ generic/tclInt.h 5 May 2005 18:25:41 -0000
@@ -2718,6 +2718,19 @@
/*
*----------------------------------------------------------------
+ * Macro used by the Tcl core to check whether a pattern has
+ * any characters special to [string match].
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int TclMatchIsTrivial _ANSI_ARGS_((
+ * CONST char *pattern));
+ *----------------------------------------------------------------
+ */
+
+#define TclMatchIsTrivial(pattern) strpbrk((pattern), "*[]]?\\") == NULL
+
+/*
+ *----------------------------------------------------------------
* Macros used by the Tcl core to set a Tcl_Obj's numeric representation
* avoiding the corresponding function calls in time critical parts of the
* core. They should only be called on unshared objects. The ANSI C
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.77
diff -u -r1.77 tclIntDecls.h
--- generic/tclIntDecls.h 2 Apr 2005 02:08:56 -0000 1.77
+++ generic/tclIntDecls.h 5 May 2005 18:25:41 -0000
@@ -1015,11 +1015,7 @@
EXTERN int TclObjGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, CallFrame ** framePtrPtr));
#endif
-#ifndef TclMatchIsTrivial_TCL_DECLARED
-#define TclMatchIsTrivial_TCL_DECLARED
-/* 199 */
-EXTERN int TclMatchIsTrivial _ANSI_ARGS_((CONST char * pattern));
-#endif
+/* Slot 199 is reserved */
#ifndef TclpObjRemoveDirectory_TCL_DECLARED
#define TclpObjRemoveDirectory_TCL_DECLARED
/* 200 */
@@ -1351,7 +1347,7 @@
void (*tclFinalizeThreadStorageDataKey) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr)); /* 196 */
int (*tclCompEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 197 */
int (*tclObjGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CallFrame ** framePtrPtr)); /* 198 */
- int (*tclMatchIsTrivial) _ANSI_ARGS_((CONST char * pattern)); /* 199 */
+ void *reserved199;
int (*tclpObjRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 200 */
int (*tclpObjCopyDirectory) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr, Tcl_Obj ** errorPtr)); /* 201 */
int (*tclpObjCreateDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 202 */
@@ -2048,10 +2044,7 @@
#define TclObjGetFrame \
(tclIntStubsPtr->tclObjGetFrame) /* 198 */
#endif
-#ifndef TclMatchIsTrivial
-#define TclMatchIsTrivial \
- (tclIntStubsPtr->tclMatchIsTrivial) /* 199 */
-#endif
+/* Slot 199 is reserved */
#ifndef TclpObjRemoveDirectory
#define TclpObjRemoveDirectory \
(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.72
diff -u -r1.72 tclNamesp.c
--- generic/tclNamesp.c 9 Mar 2005 10:20:37 -0000 1.72
+++ generic/tclNamesp.c 5 May 2005 18:25:41 -0000
@@ -180,6 +180,10 @@
*/
static void DeleteImportedCmd _ANSI_ARGS_((ClientData clientData));
+static int DoImport _ANSI_ARGS_((Tcl_Interp *interp,
+ Namespace *nsPtr, Tcl_HashEntry *hPtr,
+ CONST char *cmdName, CONST char *pattern,
+ Namespace *importNsPtr, int allowOverwrite));
static void DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
Tcl_Obj *copyPtr));
static char * ErrorCodeRead _ANSI_ARGS_(( ClientData clientData,
@@ -1490,107 +1494,129 @@
* commands redirect their invocations to the "real" command.
*/
+ if ((simplePattern != NULL) && TclMatchIsTrivial(simplePattern)) {
+ hPtr = Tcl_FindHashEntry(&importNsPtr->cmdTable, simplePattern);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ return DoImport(interp, nsPtr, hPtr, simplePattern, pattern,
+ importNsPtr, allowOverwrite);
+ }
for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
(hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
- if (Tcl_StringMatch(cmdName, simplePattern)) {
- /*
- * The command cmdName in the source namespace matches the
- * pattern. Check whether it was exported. If it wasn't,
- * we ignore it.
- */
- Tcl_HashEntry *found;
- int wasExported = 0, i;
+ if (Tcl_StringMatch(cmdName, simplePattern)
+ && (TCL_ERROR == DoImport( interp, nsPtr, hPtr, cmdName,
+ pattern, importNsPtr, allowOverwrite))) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
- for (i = 0; i < importNsPtr->numExportPatterns; i++) {
- if (Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i])) {
- wasExported = 1;
- break;
- }
- }
- if (!wasExported) {
- continue;
- }
+static int
+DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr, allowOverwrite)
+ Tcl_Interp *interp;
+ Namespace *nsPtr;
+ Tcl_HashEntry *hPtr;
+ CONST char *cmdName;
+ CONST char *pattern;
+ Namespace *importNsPtr;
+ int allowOverwrite;
+{
+ int i = 0, exported = 0;
+ Tcl_HashEntry *found;
- /*
- * Unless there is a name clash, create an imported command
- * in the current namespace that refers to cmdPtr.
- */
+ /*
+ * The command cmdName in the source namespace matches the
+ * pattern. Check whether it was exported. If it wasn't,
+ * we ignore it.
+ */
- found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
- if ((found == NULL) || allowOverwrite) {
- /*
- * Create the imported command and its client data.
- * To create the new command in the current namespace,
- * generate a fully qualified name for it.
- */
+ while (!exported && (i < importNsPtr->numExportPatterns)) {
+ exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]);
+ }
+ if (!exported) {
+ return TCL_OK;
+ }
- Tcl_DString ds;
- Tcl_Command importedCmd;
- ImportedCmdData *dataPtr;
- Command *cmdPtr;
- ImportRef *refPtr;
+ /*
+ * Unless there is a name clash, create an imported command
+ * in the current namespace that refers to cmdPtr.
+ */
- Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
- if (nsPtr != ((Interp *) interp)->globalNsPtr) {
- Tcl_DStringAppend(&ds, "::", 2);
- }
- Tcl_DStringAppend(&ds, cmdName, -1);
+ found = Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName);
+ if ((found == NULL) || allowOverwrite) {
+ /*
+ * Create the imported command and its client data.
+ * To create the new command in the current namespace,
+ * generate a fully qualified name for it.
+ */
- /*
- * Check whether creating the new imported command in the
- * current namespace would create a cycle of imported
- * command references.
- */
+ Tcl_DString ds;
+ Tcl_Command importedCmd;
+ ImportedCmdData *dataPtr;
+ Command *cmdPtr;
+ ImportRef *refPtr;
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+ if (nsPtr != ((Interp *) interp)->globalNsPtr) {
+ Tcl_DStringAppend(&ds, "::", 2);
+ }
+ Tcl_DStringAppend(&ds, cmdName, -1);
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
- if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
- Command *overwrite = (Command *) Tcl_GetHashValue(found);
- Command *link = cmdPtr;
-
- while (link->deleteProc == DeleteImportedCmd) {
- ImportedCmdData *dataPtr;
-
- dataPtr = (ImportedCmdData *) link->objClientData;
- link = dataPtr->realCmdPtr;
- if (overwrite == link) {
- Tcl_AppendResult(interp, "import pattern \"",
- pattern,
- "\" would create a loop containing ",
- "command \"", Tcl_DStringValue(&ds),
- "\"", (char *) NULL);
- Tcl_DStringFree(&ds);
- return TCL_ERROR;
- }
- }
- }
+ /*
+ * Check whether creating the new imported command in the
+ * current namespace would create a cycle of imported
+ * command references.
+ */
- dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
- importedCmd = Tcl_CreateObjCommand(interp,
- Tcl_DStringValue(&ds), InvokeImportedCmd,
- (ClientData) dataPtr, DeleteImportedCmd);
- dataPtr->realCmdPtr = cmdPtr;
- dataPtr->selfPtr = (Command *) importedCmd;
- dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
- Tcl_DStringFree(&ds);
+ cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
+ Command *overwrite = (Command *) Tcl_GetHashValue(found);
+ Command *link = cmdPtr;
- /*
- * Create an ImportRef structure describing this new import
- * command and add it to the import ref list in the "real"
- * command.
- */
+ while (link->deleteProc == DeleteImportedCmd) {
+ ImportedCmdData *dataPtr;
- refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
- refPtr->importedCmdPtr = (Command *) importedCmd;
- refPtr->nextPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = refPtr;
- } else {
- Tcl_AppendResult(interp, "can't import command \"", cmdName,
- "\": already exists", (char *) NULL);
- return TCL_ERROR;
+ dataPtr = (ImportedCmdData *) link->objClientData;
+ link = dataPtr->realCmdPtr;
+ if (overwrite == link) {
+ Tcl_AppendResult(interp, "import pattern \"",
+ pattern,
+ "\" would create a loop containing ",
+ "command \"", Tcl_DStringValue(&ds),
+ "\"", (char *) NULL);
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
}
}
+
+ dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
+ importedCmd = Tcl_CreateObjCommand(interp,
+ Tcl_DStringValue(&ds), InvokeImportedCmd,
+ (ClientData) dataPtr, DeleteImportedCmd);
+ dataPtr->realCmdPtr = cmdPtr;
+ dataPtr->selfPtr = (Command *) importedCmd;
+ dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
+ Tcl_DStringFree(&ds);
+
+ /*
+ * Create an ImportRef structure describing this new import
+ * command and add it to the import ref list in the "real"
+ * command.
+ */
+
+ refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
+ refPtr->importedCmdPtr = (Command *) importedCmd;
+ refPtr->nextPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = refPtr;
+ } else {
+ Tcl_AppendResult(interp, "can't import command \"", cmdName,
+ "\": already exists", (char *) NULL);
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -1670,6 +1696,15 @@
* Delete any imported commands that match it.
*/
+ if (TclMatchIsTrivial(simplePattern)) {
+ Command *cmdPtr;
+ hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
+ (hPtr != NULL)
+ && (cmdPtr = (Command *) Tcl_GetHashValue(hPtr))
+ && (cmdPtr->deleteProc == DeleteImportedCmd)
+ && Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+ return TCL_OK;
+ }
for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
(hPtr != NULL);
hPtr = Tcl_NextHashEntry(&search)) {
@@ -2959,6 +2994,13 @@
*/
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ if (Tcl_FindHashEntry(&nsPtr->childTable, pattern) != NULL) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(pattern, -1));
+ }
+ goto searchDone;
+ }
entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
while (entryPtr != NULL) {
childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
@@ -2970,6 +3012,7 @@
entryPtr = Tcl_NextHashEntry(&search);
}
+searchDone:
Tcl_SetObjResult(interp, listPtr);
Tcl_DStringFree(&buffer);
return TCL_OK;
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.114
diff -u -r1.114 tclStubInit.c
--- generic/tclStubInit.c 2 Apr 2005 02:08:59 -0000 1.114
+++ generic/tclStubInit.c 5 May 2005 18:25:42 -0000
@@ -283,7 +283,7 @@
TclFinalizeThreadStorageDataKey, /* 196 */
TclCompEvalObj, /* 197 */
TclObjGetFrame, /* 198 */
- TclMatchIsTrivial, /* 199 */
+ NULL, /* 199 */
TclpObjRemoveDirectory, /* 200 */
TclpObjCopyDirectory, /* 201 */
TclpObjCreateDirectory, /* 202 */
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.57
diff -u -r1.57 tclUtil.c
--- generic/tclUtil.c 3 May 2005 18:08:21 -0000 1.57
+++ generic/tclUtil.c 5 May 2005 18:25:42 -0000
@@ -1416,43 +1416,6 @@
/*
*----------------------------------------------------------------------
*
- * TclMatchIsTrivial --
- *
- * Test whether a particular glob pattern is a trivial pattern.
- * (i.e. where matching is the same as equality testing).
- *
- * Results:
- * A boolean indicating whether the pattern is free of all of the
- * glob special chars.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclMatchIsTrivial(pattern)
- CONST char *pattern;
-{
- CONST char *p = pattern;
-
- while (1) {
- switch (*p++) {
- case '\0':
- return 1;
- case '*':
- case '?':
- case '[':
- case '\\':
- return 0;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_DStringInit --
*
* Initializes a dynamic string, discarding any previous contents
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.104
diff -u -r1.104 tclVar.c
--- generic/tclVar.c 16 Apr 2005 19:17:34 -0000 1.104
+++ generic/tclVar.c 5 May 2005 18:25:42 -0000
@@ -2771,7 +2771,23 @@
TclNewObj(nameLstPtr);
Tcl_IncrRefCount(nameLstPtr);
-
+ if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+ hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
+ if (hPtr == NULL) {
+ goto searchDone;
+ }
+ varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+ if (TclIsVarUndefined(varPtr2)) {
+ goto searchDone;
+ }
+ result = Tcl_ListObjAppendElement(interp, nameLstPtr,
+ Tcl_NewStringObj(pattern, -1));
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(nameLstPtr);
+ return result;
+ }
+ goto searchDone;
+ }
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
@@ -2792,6 +2808,7 @@
return result;
}
}
+searchDone:
/*
* Make sure the Var structure of the array is not removed by
@@ -2881,6 +2898,19 @@
}
}
TclNewObj(resultPtr);
+ if ((((enum options) mode) == OPT_GLOB) && (pattern != NULL)
+ && TclMatchIsTrivial(pattern)) {
+ hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
+ if ((hPtr != NULL)
+ && !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr))
+ && (result = Tcl_ListObjAppendElement(interp,
+ resultPtr, Tcl_NewStringObj(pattern, -1))) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ return result;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+ }
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
@@ -3059,6 +3089,15 @@
}
} else {
pattern = TclGetString(objv[3]);
+ if (TclMatchIsTrivial(pattern)) {
+ hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern);
+ result = TCL_OK;
+ (hPtr != NULL)
+ && !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr))
+ && (result
+ = TclObjUnsetVar2(interp, varNamePtr, pattern, 0));
+ return result;
+ }
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr,
&search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
