Attachment "1077262.patch" to
ticket [1077262fff]
added by
dgp
2005-04-09 02:57:23.
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.58
diff -u -r1.58 tclCmdAH.c
--- generic/tclCmdAH.c 21 Jan 2005 17:42:12 -0000 1.58
+++ generic/tclCmdAH.c 8 Apr 2005 19:54:56 -0000
@@ -455,24 +455,21 @@
switch ((enum options) index) {
case ENC_CONVERTTO:
case ENC_CONVERTFROM: {
- char *name;
Tcl_Obj *data;
if (objc == 3) {
- name = NULL;
+ encoding = Tcl_GetEncoding(interp, NULL);
data = objv[2];
} else if (objc == 4) {
- name = TclGetString(objv[2]);
+ if (TclGetEncodingFromObj(interp, objv[2], &encoding)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
data = objv[3];
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
return TCL_ERROR;
}
- encoding = Tcl_GetEncoding(interp, name);
- if (!encoding) {
- return TCL_ERROR;
- }
-
if ((enum options) index == ENC_CONVERTFROM) {
/*
* Treat the string as binary data.
Index: generic/tclEncoding.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEncoding.c,v
retrieving revision 1.32
diff -u -r1.32 tclEncoding.c
--- generic/tclEncoding.c 13 Dec 2004 22:11:35 -0000 1.32
+++ generic/tclEncoding.c 8 Apr 2005 19:54:56 -0000
@@ -200,6 +200,8 @@
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
int *dstCharsPtr));
+static void DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr));
static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
CONST char *src, int srcLen, int flags,
@@ -213,6 +215,7 @@
int *dstCharsPtr));
static void FillEncodingFileMap ();
static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
+static void FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static Encoding * GetTableEncoding _ANSI_ARGS_((
EscapeEncodingData *dataPtr, int state));
static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
@@ -260,6 +263,89 @@
int *srcReadPtr, int *dstWrotePtr,
int *dstCharsPtr));
+/*
+ * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep.
+ * This should help the lifetime of encodings be more useful.
+ * See concerns raised in [Bug 1077262].
+ */
+
+static Tcl_ObjType EncodingType = {
+ "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetEncodingFromObj --
+ *
+ * Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr),
+ * if possible, and returns TCL_OK. If no such encoding exists,
+ * TCL_ERROR is returned, and if interp is non-NULL, an error message
+ * is written there.
+ *
+ * Results:
+ * Standard Tcl return code.
+ *
+ * Side effects:
+ * Caches the Tcl_Encoding value as the internal rep of (*objPtr).
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclGetEncodingFromObj(interp, objPtr, encodingPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ Tcl_Encoding *encodingPtr;
+{
+ CONST char *name = Tcl_GetString(objPtr);
+ if (objPtr->typePtr != &EncodingType) {
+ Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
+
+ if (encoding == NULL) {
+ return TCL_ERROR;
+ }
+ TclFreeIntRep(objPtr);
+ objPtr->internalRep.otherValuePtr = (VOID *) encoding;
+ objPtr->typePtr = &EncodingType;
+ }
+ *encodingPtr = Tcl_GetEncoding(NULL, name);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEncodingIntRep --
+ *
+ * The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeEncodingIntRep(objPtr)
+ Tcl_Obj *objPtr;
+{
+ Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupEncodingIntRep --
+ *
+ * The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DupEncodingIntRep(srcPtr, dupPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *dupPtr;
+{
+ dupPtr->internalRep.otherValuePtr = (VOID *)
+ Tcl_GetEncoding(NULL, srcPtr->bytes);
+}
/*
*----------------------------------------------------------------------
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.220
diff -u -r1.220 tclInt.h
--- generic/tclInt.h 5 Apr 2005 16:19:09 -0000 1.220
+++ generic/tclInt.h 8 Apr 2005 19:54:56 -0000
@@ -1884,6 +1884,8 @@
MODULE_SCOPE int TclFSFileAttrIndex _ANSI_ARGS_((Tcl_Obj *pathPtr,
CONST char *attributeName, int *indexPtr));
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp));
+MODULE_SCOPE int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr));
MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_((
Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Namespace **nsPtrPtr));
