* generic/tclInt.h (TclGetEncodingFromObj): New function to

        * generic/tclEncoding.c (TclGetEncodingFromObj): retrieve a
        Tcl_Encoding value, as well as cache it in the internal rep
        of a new "encoding" Tcl_ObjType.
        * generic/tclCmdAH.c (Tcl_EncodingObjCmd):      Updated to call
        new function so that Tcl_Encoding's used by [encoding convert*]
        routines are not freed too quickly.  [Bug 1077262]

3 files changed, 96 insertions, 11 deletions

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 8a76602..1ef0dcf 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.58 2005/01/21 17:42:12 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.59 2005/04/08 20:04:03 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -455,24 +455,21 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
     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.
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 11cf425..0c23850 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEncoding.c,v 1.32 2004/12/13 22:11:35 dgp Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.33 2005/04/08 20:04:04 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -200,6 +200,8 @@ static int		BinaryProc _ANSI_ARGS_((ClientData clientData,
 			    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 @@ static int		EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
 			    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 @@ static int		UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
 			    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);
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6efa576..b8f5871 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.220 2005/04/05 16:19:09 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.221 2005/04/08 20:04:04 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -1884,6 +1884,8 @@ MODULE_SCOPE void	TclFinalizeThreadData _ANSI_ARGS_((void));
 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));