Attachment "1177363.patch" to
ticket [1177363fff]
added by
dgp
2005-04-13 03:23:07.
Index: generic/tclEncoding.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEncoding.c,v
retrieving revision 1.33
diff -u -r1.33 tclEncoding.c
--- generic/tclEncoding.c 8 Apr 2005 20:04:04 -0000 1.33
+++ generic/tclEncoding.c 12 Apr 2005 20:16:35 -0000
@@ -150,9 +150,8 @@
* threads. Access to the shared string is governed by a mutex lock.
*/
-static TclInitProcessGlobalValueProc InitializeEncodingFileMap;
static ProcessGlobalValue encodingFileMap =
- {0, 0, NULL, NULL, InitializeEncodingFileMap, NULL, NULL};
+ {0, 0, NULL, NULL, NULL, NULL, NULL};
/*
* A list of directories making up the "library path". Historically
@@ -224,7 +223,8 @@
int type, Tcl_Channel chan));
static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name,
Tcl_Channel chan));
-static Tcl_Obj * MakeFileMap ();
+static Tcl_Channel OpenEncodingFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *name));
static void TableFreeProc _ANSI_ARGS_((ClientData clientData));
static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
CONST char *src, int srcLen, int flags,
@@ -388,7 +388,6 @@
return TCL_ERROR;
}
TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
- FillEncodingFileMap();
return TCL_OK;
}
@@ -441,7 +440,10 @@
/*
*---------------------------------------------------------------------------
*
- * MakeFileMap --
+ * FillEncodingFileMap --
+ *
+ * Called to bring the encoding file map in sync with the current
+ * value of the encoding search path.
*
* Scan the directories on the encoding search path, find the
* *.enc files, and store the found pathnames in a map associated
@@ -462,8 +464,8 @@
*---------------------------------------------------------------------------
*/
-static Tcl_Obj *
-MakeFileMap()
+void
+FillEncodingFileMap()
{
int i, numDirs = 0;
Tcl_Obj *map, *searchPath;
@@ -505,33 +507,6 @@
Tcl_DecrRefCount(directory);
}
Tcl_DecrRefCount(searchPath);
- return map;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * FillEncodingFileMap --
- *
- * Called to bring the encoding file map in sync with the current
- * value of the encoding search path.
- *
- * TODO: Check the callers of this routine to see if it's called
- * too frequently.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Entries are added to the encoding file map.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-FillEncodingFileMap()
-{
- Tcl_Obj *map = MakeFileMap();
TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
Tcl_DecrRefCount(map);
}
@@ -1395,6 +1370,104 @@
/*
*---------------------------------------------------------------------------
*
+ * OpenEncodingFileChannel --
+ *
+ * Open the file believed to hold data for the encoding, "name".
+ *
+ * Results:
+ * Returns the readable Tcl_Channel from opening the file, or NULL
+ * if the file could not be successfully opened. If NULL was
+ * returned, an error message is left in interp's result object,
+ * unless interp was NULL.
+ *
+ * Side effects:
+ * Channel may be opened. Information about the filesystem may be
+ * cached to speed later calls.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+OpenEncodingFileChannel(interp, name)
+ Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
+ CONST char *name; /* The name of the encoding file on disk
+ * and also the name for new encoding. */
+{
+ Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
+ Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
+ Tcl_Obj *searchPath = Tcl_DuplicateObj(TclGetEncodingSearchPath());
+ Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
+ Tcl_Obj **dir, *path, *directory = NULL;
+ Tcl_Channel chan = NULL;
+ int i, numDirs;
+
+ Tcl_ListObjGetElements(NULL, searchPath, &numDirs, &dir);
+ Tcl_IncrRefCount(nameObj);
+ Tcl_AppendToObj(fileNameObj, ".enc", -1);
+ Tcl_IncrRefCount(fileNameObj);
+ Tcl_DictObjGet(NULL, map, nameObj, &directory);
+
+ /* Check that any cached directory is still on the encoding search path */
+ if (NULL != directory) {
+ int verified = 0;
+
+ for (i=0; i<numDirs && !verified; i++) {
+ if (dir[i] == directory) {
+ verified = 1;
+ }
+ }
+ if (!verified) {
+ CONST char *dirString = Tcl_GetString(directory);
+ for (i=0; i<numDirs && !verified; i++) {
+ if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
+ verified = 1;
+ }
+ }
+ }
+ if (!verified) {
+ /* Directory no longer on the search path. Remove from cache */
+ map = Tcl_DuplicateObj(map);
+ Tcl_DictObjRemove(NULL, map, nameObj);
+ TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+ directory = NULL;
+ }
+ }
+
+ if (NULL != directory) {
+ /* Got a directory from the cache. Try to use it first */
+ Tcl_IncrRefCount(directory);
+ path = Tcl_FSJoinToPath(directory, 1, &fileNameObj);
+ Tcl_IncrRefCount(path);
+ Tcl_DecrRefCount(directory);
+ chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
+ Tcl_DecrRefCount(path);
+ }
+
+ /* Scan the search path until we find it. */
+ for (i=0; i<numDirs && (chan == NULL); i++) {
+ path = Tcl_FSJoinToPath(dir[i], 1, &fileNameObj);
+ Tcl_IncrRefCount(path);
+ chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
+ Tcl_DecrRefCount(path);
+ if (chan != NULL) {
+ /* Save directory in the cache */
+ map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
+ Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
+ TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+ }
+ }
+ if ((NULL == chan) && (interp != NULL)) {
+ Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+ }
+ Tcl_DecrRefCount(fileNameObj);
+ Tcl_DecrRefCount(nameObj);
+ Tcl_DecrRefCount(searchPath);
+ return chan;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* LoadEncodingFile --
*
* Read a file that describes an encoding and create a new Encoding
@@ -1418,44 +1491,13 @@
CONST char *name; /* The name of the encoding file on disk
* and also the name for new encoding. */
{
- Tcl_Channel chan;
- Tcl_Encoding encoding;
- Tcl_Obj *map, *path, *directory = NULL;
- Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
- int ch, scanned = 0;
+ Tcl_Channel chan = NULL;
+ Tcl_Encoding encoding = NULL;
+ int ch;
-
- Tcl_IncrRefCount(nameObj);
- while (1) {
- map = TclGetProcessGlobalValue(&encodingFileMap);
- Tcl_DictObjGet(NULL, map, nameObj, &directory);
- if (scanned || (NULL != directory)) {
- break;
- }
-scan:
- FillEncodingFileMap();
- scanned = 1;
- }
- if (NULL == directory) {
- Tcl_DecrRefCount(nameObj);
- goto unknown;
- }
-
- /* Construct $directory/$encoding.enc path name */
- Tcl_IncrRefCount(directory);
- Tcl_AppendToObj(nameObj, ".enc", -1);
- path = Tcl_FSJoinToPath(directory, 1, &nameObj);
- Tcl_DecrRefCount(directory);
- Tcl_DecrRefCount(nameObj);
- Tcl_IncrRefCount(path);
- chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
- Tcl_DecrRefCount(path);
-
- if (NULL == chan) {
- if (!scanned) {
- goto scan;
- }
- goto unknown;
+ chan = OpenEncodingFileChannel(interp, name);
+ if (chan == NULL) {
+ return NULL;
}
Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
@@ -1472,7 +1514,6 @@
}
}
- encoding = NULL;
switch (ch) {
case 'S': {
encoding = LoadTableEncoding(name, ENCODING_SINGLEBYTE, chan);
@@ -1496,12 +1537,6 @@
}
Tcl_Close(NULL, chan);
return encoding;
-
- unknown:
- if (interp != NULL) {
- Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
- }
- return NULL;
}
/*
@@ -3185,43 +3220,3 @@
memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1);
Tcl_DecrRefCount(searchPath);
}
-
-/*
- *-------------------------------------------------------------------------
- *
- * InitializeEncodingFileMap --
- *
- * This is the fallback routine that fills the encoding data
- * file map if the application has not set up an encoding
- * search path by the first time the file map is needed to
- * load encoding data.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Fills the encoding data file map.
- *
- *-------------------------------------------------------------------------
- */
-
-void
-InitializeEncodingFileMap(valuePtr, lengthPtr, encodingPtr)
- char **valuePtr;
- int *lengthPtr;
- Tcl_Encoding *encodingPtr;
-{
- char *bytes;
- int numBytes;
- Tcl_Obj *map = MakeFileMap();
-
- *encodingPtr = encodingSearchPath.encoding;
- if (*encodingPtr) {
- ((Encoding *)(*encodingPtr))->refCount++;
- }
- bytes = Tcl_GetStringFromObj(map, &numBytes);
- *lengthPtr = numBytes;
- *valuePtr = ckalloc((unsigned int) numBytes + 1);
- memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1);
- Tcl_DecrRefCount(map);
-}
Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.55
diff -u -r1.55 tclInterp.c
--- generic/tclInterp.c 16 Dec 2004 19:36:34 -0000 1.55
+++ generic/tclInterp.c 12 Apr 2005 20:16:37 -0000
@@ -466,8 +466,8 @@
if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
code = Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
if (code == TCL_ERROR) {
- Tcl_Panic("system encoding \"", Tcl_DStringValue(&encodingName),
- "\" not available");
+ Tcl_Panic("system encoding \"%s\" not available",
+ Tcl_DStringValue(&encodingName));
}
}
Tcl_DStringFree(&encodingName);
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.54
diff -u -r1.54 tclUtil.c
--- generic/tclUtil.c 5 Apr 2005 16:56:30 -0000 1.54
+++ generic/tclUtil.c 12 Apr 2005 20:16:37 -0000
@@ -2745,14 +2745,14 @@
/* If no thread has set the shared value, call the initializer */
Tcl_MutexLock(&pgvPtr->mutex);
- if (NULL == pgvPtr->value) {
- if (pgvPtr->proc) {
- pgvPtr->epoch++;
- (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
- &pgvPtr->encoding);
- Tcl_CreateExitHandler(FreeProcessGlobalValue,
- (ClientData) pgvPtr);
+ if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
+ pgvPtr->epoch++;
+ (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
+ &pgvPtr->encoding);
+ if (pgvPtr->value == NULL) {
+ Tcl_Panic("PGV Initializer did not initialize.");
}
+ Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
}
/* Store a copy of the shared value in our epoch-indexed cache */
