diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 15 | ||||
| -rw-r--r-- | generic/tclEncoding.c | 90 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 |
4 files changed, 104 insertions, 11 deletions
@@ -1,5 +1,11 @@ 2005-07-05 Don Porter <dgp@users.sourceforge.net> + * generic/tclCmdAH.c New "encoding" Tcl_ObjType (not registered) + * generic/tclEncoding.c that permits longer lifetimes of the + * generic/tclInt.h Tcl_Encoding values kept as intreps of + Tcl_Obj's. Reduces the need for repeated reading of encoding + definition files from the filesystem. [Bug 1077262] + * generic/tclNamesp.c: Allow for [namespace import] of a command * tests/namespace.test: over a previous [namespace import] of itself without throwing an error. [RFE 1230597] diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 9c9fe7e..545af15 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.27.2.12 2005/06/17 23:26:20 dkf Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.13 2005/07/05 21:18:23 dgp Exp $ */ #include "tclInt.h" @@ -440,24 +440,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 = Tcl_GetString(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 d35cd4c..efe5905 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.16.2.6 2004/11/12 23:42:00 hobbs Exp $ + * RCS: @(#) $Id: tclEncoding.c,v 1.16.2.7 2005/07/05 21:18:23 dgp Exp $ */ #include "tclInt.h" @@ -178,6 +178,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, @@ -190,6 +192,7 @@ static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)); 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, @@ -239,6 +242,91 @@ static int UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData, int *dstCharsPtr)); static int TclFindEncodings _ANSI_ARGS_((CONST char *argv0)); +/* + * 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; + } + if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { + objPtr->typePtr->freeIntRepProc(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 115866d..d3f1ce1 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.118.2.15 2005/06/24 18:21:40 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.118.2.16 2005/07/05 21:18:23 dgp Exp $ */ #ifndef _TCLINT @@ -1668,6 +1668,8 @@ EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void)); EXTERN void TclFinalizePreserve _ANSI_ARGS_((void)); EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void)); EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void)); +EXTERN int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr)); EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData* types)); |