Attachment "triv.patch" to
ticket [1076088fff]
added by
dgp
2005-03-29 05:40:31.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.142
diff -u -r1.142 tclBasic.c
--- generic/tclBasic.c 18 Mar 2005 15:50:59 -0000 1.142
+++ generic/tclBasic.c 28 Mar 2005 22:36:20 -0000
@@ -2819,6 +2819,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);
@@ -2826,6 +2834,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.71
diff -u -r1.71 tclCmdIL.c
--- generic/tclCmdIL.c 14 Dec 2004 21:11:45 -0000 1.71
+++ generic/tclCmdIL.c 28 Mar 2005 22:36:20 -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/tclDictObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDictObj.c,v
retrieving revision 1.27
diff -u -r1.27 tclDictObj.c
--- generic/tclDictObj.c 13 Nov 2004 00:19:09 -0000 1.27
+++ generic/tclDictObj.c 28 Mar 2005 22:36:21 -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.82
diff -u -r1.82 tclIO.c
--- generic/tclIO.c 27 Jan 2005 00:23:23 -0000 1.82
+++ generic/tclIO.c 28 Mar 2005 22:36:22 -0000
@@ -8759,7 +8759,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)) {
@@ -8783,10 +8792,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/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 28 Mar 2005 22:36:22 -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/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.101
diff -u -r1.101 tclVar.c
--- generic/tclVar.c 14 Dec 2004 21:11:47 -0000 1.101
+++ generic/tclVar.c 28 Mar 2005 22:36:23 -0000
@@ -2813,7 +2813,23 @@
nameLstPtr = Tcl_NewObj();
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);
@@ -2834,6 +2850,7 @@
return result;
}
}
+searchDone:
/*
* Make sure the Var structure of the array is not removed by
@@ -2923,6 +2940,19 @@
}
}
resultPtr = Tcl_NewObj();
+ 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);
@@ -3101,6 +3131,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)) {
