diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdAH.c | 15 | ||||
| -rw-r--r-- | generic/tclEncoding.c | 88 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 |
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)); |