From 93a473b9ee7e8c4bf201f503714515b25984b7ef Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Jun 2012 13:41:27 +0000 Subject: Locale guessing of msgcat fails on (some) Windows 7 --- ChangeLog | 7 +++++++ library/msgcat/msgcat.tcl | 34 ++++++++++++++++++++++++++++++++-- library/msgcat/pkgIndex.tcl | 2 +- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 5 files changed, 44 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3e35779..128e36a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-06-?? Harald Oehlmann + + * library/msgcat/msgcat.tcl: [Bug 3536888] Locale guessing of msgcat + * library/msgcat/pkgIndex.tcl: fails on (some) Windows 7. Bump to 1.4.5 + * unix/Makefile.in + * win/Makefile.in + 2012-06-21 Jan Nijtmans * win/tclWinReg.c: [Bug #3362446]: registry keys command fails diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 369ed52..0b12dea 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -13,7 +13,7 @@ package require Tcl 8.5 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. -package provide msgcat 1.4.4 +package provide msgcat 1.4.5 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ @@ -464,10 +464,40 @@ proc msgcat::Init {} { # if {[catch { package require registry + }]} { + mclocale C + return + } + + # First check registry value LocalName present from Windows Vista + # which contains the local string as RFC5646, composed of: + # [a-z]{2,3} : language + # -[a-z]{4} : script (optional, not used) + # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used) + # (-.*)* : variant, extension, private use (optional, not used) + # Those are translated to local strings. + # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs, es-419 -> es + # + if {([registry values $key "LocaleName"] ne "") + && [regexp {^([a-z]{2,3})(?:-[a-z]{4})?(?:-([a-z]{2}))?(?:-.+)?$}\ + [string tolower [registry get $key "LocaleName"]] match locale\ + territory]} { + if {"" ne $territory} { + append locale _ $territory + } + if {![catch { + mclocale [ConvertLocale $locale] + }]} { + return + } + } + + # then check key locale which contains a numerical language ID + if {[catch { set key {HKEY_CURRENT_USER\Control Panel\International} set locale [registry get $key "locale"] }]} { - mclocale C + mclocale C return } # diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 17ad5db..60c2d3c 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded msgcat 1.4.4 [list source [file join $dir msgcat.tcl]] +package ifneeded msgcat 1.4.5 [list source [file join $dir msgcat.tcl]] diff --git a/unix/Makefile.in b/unix/Makefile.in index 883a379..a527bf0 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -781,8 +781,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; - @echo "Installing package msgcat 1.4.4 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm; + @echo "Installing package msgcat 1.4.5 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.5.tm; @echo "Installing package tcltest 2.3.4 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.4.tm; diff --git a/win/Makefile.in b/win/Makefile.in index 17bb1aa..a06cc3f 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -644,8 +644,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.4.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm; + @echo "Installing package msgcat 1.4.5 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.5.tm; @echo "Installing package tcltest 2.3.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm; @echo "Installing package platform 1.0.10 as a Tcl Module"; -- cgit v0.12 From 58bfc878552abf56614cd68e7c64ff5bd4be0352 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 27 Jun 2012 12:49:12 +0000 Subject: fix bug in cygwin's [info nameofexecutable] install dde and registry dll for cygwin --- unix/Makefile.in | 28 +++++++++++++++++++++++----- unix/configure | 2 +- unix/tcl.m4 | 2 +- unix/tclConfig.sh.in | 2 +- unix/tclUnixFile.c | 2 +- 5 files changed, 27 insertions(+), 9 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index aa771cc..04e8629 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -580,7 +580,7 @@ valgrindshell: tclsh topDirName: @cd $(TOP_DIR); pwd -# The following target generates the file generic/tclDate.c +# The following target generates the file generic/tclDate.c # from the yacc grammar found in generic/tclGetDate.y. This is # only run by hand as yacc is not available in all environments. # The name of the .c file is different than the name of the .y file @@ -619,7 +619,7 @@ install-strip: # possible (e.g. if installing as root). install-binaries: binaries - @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \ + @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ @@ -647,10 +647,28 @@ install-binaries: binaries echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \ @INSTALL_STUB_LIB@ ; \ fi + @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\ + for i in dde1.2 reg1.1; do \ + if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ + echo "Making directory $(LIB_INSTALL_DIR)/$$i";\ + mkdir -p $(LIB_INSTALL_DIR)/$$i;\ + chmod 755 $(LIB_INSTALL_DIR)/$$i;\ + else true;\ + fi;\ + done;\ + echo "Installing tcldde12.dll";\ + $(INSTALL_DATA) "$(TOP_DIR)/library/dde/pkgIndex.tcl" "$(LIB_INSTALL_DIR)/dde1.2";\ + $(INSTALL_LIBRARY) "$(TOP_DIR)/win/tcldde12.dll" "$(LIB_INSTALL_DIR)/dde1.2";\ + chmod 555 "$(LIB_INSTALL_DIR)/dde1.2/tcldde12.dll";\ + echo "Installing tclreg11.dll";\ + $(INSTALL_DATA) "$(TOP_DIR)/library/reg/pkgIndex.tcl" "$(LIB_INSTALL_DIR)/reg1.1";\ + $(INSTALL_LIBRARY) "$(TOP_DIR)/win/tclreg11.dll" "$(LIB_INSTALL_DIR)/reg1.1";\ + chmod 555 "$(LIB_INSTALL_DIR)/reg1.1/tclreg11.dll";\ + fi @EXTRA_INSTALL_BINARIES@ install-libraries: libraries - @for i in $(INCLUDE_INSTALL_DIR) $(SCRIPT_INSTALL_DIR); \ + @for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \ do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ @@ -1443,7 +1461,7 @@ machtml: # # Targets to build Solaris package of the distribution for the current # architecture. To build stream packages for both sun4 and i86pc -# architectures: +# architectures: # # On the sun4 machine, execute the following: # make distclean; ./configure @@ -1497,7 +1515,7 @@ package-common: # Build and install the architecture specific files in the dist directory. # -package-binaries: +package-binaries: cd $(DISTDIR)/unix/`arch`; \ $(MAKE); \ $(MAKE) install-binaries prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \ diff --git a/unix/configure b/unix/configure index 3830e1b..8d7cc20 100755 --- a/unix/configure +++ b/unix/configure @@ -4452,7 +4452,7 @@ fi INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' else MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd $(LIB_INSTALL_DIR) ; $(RANLIB) $(LIB_FILE))' + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' fi fi diff --git a/unix/tcl.m4 b/unix/tcl.m4 index c86a3f2..ac9b3bf 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2224,7 +2224,7 @@ dnl # preprocessing tests use only CPPFLAGS. INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' else MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd $(LIB_INSTALL_DIR) ; $(RANLIB) $(LIB_FILE))' + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' fi fi diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index e3509df..07a524f 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -1,5 +1,5 @@ # tclConfig.sh -- -# +# # This shell script (for sh) is generated automatically by Tcl's # configure script. It will create shell variables for most of # the configuration options discovered by the configure script. diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 73237c5..2616eda 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -70,7 +70,7 @@ TclpFindExecutable(argv0) } tclNativeExecutableName = (char *) ckalloc(length + 1); memcpy(tclNativeExecutableName, name, length); - buf[length] = '\0'; + tclNativeExecutableName[length] = '\0'; #else if (argv0 == NULL) { return NULL; -- cgit v0.12 From a6843cfc1761412086c9714d78dcc8c18606f792 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 28 Jun 2012 20:21:47 +0000 Subject: Simplify tclFileSystem.h. Define structs where used. --- generic/tclFileSystem.h | 43 +------------------------------- generic/tclIOUtil.c | 65 +++++++++++++++++++++++++++++++++++++++++-------- generic/tclPathObj.c | 22 ++++++++--------- 3 files changed, 66 insertions(+), 64 deletions(-) diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 828e81d..02cb424 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -16,45 +16,6 @@ #include "tcl.h" /* - * struct FilesystemRecord -- - * - * A filesystem record is used to keep track of each filesystem currently - * registered with the core, in a linked list. Pointers to these structures - * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the - * number of such references. - */ - -typedef struct FilesystemRecord { - ClientData clientData; /* Client specific data for the new filesystem - * (can be NULL) */ - Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch table. */ - struct FilesystemRecord *nextPtr; - /* The next filesystem registered to Tcl, or - * NULL if no more. */ - struct FilesystemRecord *prevPtr; - /* The previous filesystem registered to Tcl, - * or NULL if no more. */ -} FilesystemRecord; - -/* - * This structure holds per-thread private copy of the current directory - * maintained by the global cwdPathPtr. This structure holds per-thread - * private copies of some global data. This way we avoid most of the - * synchronization calls which boosts performance, at cost of having to update - * this information each time the corresponding epoch counter changes. - */ - -typedef struct ThreadSpecificData { - int initialized; - int cwdPathEpoch; - int filesystemEpoch; - Tcl_Obj *cwdPathPtr; - ClientData cwdClientData; - FilesystemRecord *filesystemList; - int claims; -} ThreadSpecificData; - -/* * The internal TclFS API provides routines for handling and manipulating * paths efficiently, taking direct advantage of the "path" Tcl_Obj type. * @@ -62,8 +23,6 @@ typedef struct ThreadSpecificData { */ MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr); -MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp, - Tcl_Obj *pathPtr); MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt); MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, @@ -74,13 +33,13 @@ MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); +MODULE_SCOPE int TclFSEpoch(void); /* * Private shared variables for use by tclIOUtil.c and tclPathObj.c */ MODULE_SCOPE Tcl_Filesystem tclNativeFilesystem; -MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey; /* * Private shared functions for use by tclIOUtil.c, tclPathObj.c and diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index b1b8961..6cf87ad 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -28,6 +28,43 @@ #include "tclFileSystem.h" /* + * struct FilesystemRecord -- + * + * A filesystem record is used to keep track of each filesystem currently + * registered with the core, in a linked list. + */ + +typedef struct FilesystemRecord { + ClientData clientData; /* Client specific data for the new filesystem + * (can be NULL) */ + Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch table. */ + struct FilesystemRecord *nextPtr; + /* The next filesystem registered to Tcl, or + * NULL if no more. */ + struct FilesystemRecord *prevPtr; + /* The previous filesystem registered to Tcl, + * or NULL if no more. */ +} FilesystemRecord; + +/* + * This structure holds per-thread private copy of the current directory + * maintained by the global cwdPathPtr. This structure holds per-thread + * private copies of some global data. This way we avoid most of the + * synchronization calls which boosts performance, at cost of having to update + * this information each time the corresponding epoch counter changes. + */ + +typedef struct ThreadSpecificData { + int initialized; + int cwdPathEpoch; + int filesystemEpoch; + Tcl_Obj *cwdPathPtr; + ClientData cwdClientData; + FilesystemRecord *filesystemList; + int claims; +} ThreadSpecificData; + +/* * Prototypes for functions defined later in this file. */ @@ -430,7 +467,7 @@ static int cwdPathEpoch = 0; static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) -Tcl_ThreadDataKey tclFsDataKey; +static Tcl_ThreadDataKey fsDataKey; /* * One of these structures is used each time we successfully load a file from @@ -489,7 +526,7 @@ FsThrExitProc( int TclFSCwdIsNative(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->cwdClientData != NULL) { return 1; @@ -523,7 +560,7 @@ int TclFSCwdPointerEquals( Tcl_Obj** pathPtrPtr) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); Tcl_MutexLock(&cwdMutex); if (tsdPtr->cwdPathPtr == NULL @@ -585,7 +622,7 @@ TclFSCwdPointerEquals( static void FsRecacheFilesystemList(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list; /* @@ -649,7 +686,7 @@ FsRecacheFilesystemList(void) static FilesystemRecord * FsGetFirstFilesystem(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0) && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) { FsRecacheFilesystemList(); @@ -672,16 +709,24 @@ TclFSEpochOk( static void Claim() { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); tsdPtr->claims++; } static void Disclaim() { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); tsdPtr->claims--; } + +int +TclFSEpoch() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + return tsdPtr->filesystemEpoch; +} + /* * If non-NULL, clientData is owned by us and must be freed later. @@ -694,7 +739,7 @@ FsUpdateCwd( { int len; char *str = NULL; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { str = Tcl_GetStringFromObj(cwdObj, &len); @@ -2624,7 +2669,7 @@ Tcl_Obj * Tcl_FSGetCwd( Tcl_Interp *interp) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (TclFSCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; @@ -2965,7 +3010,7 @@ Tcl_FSChdir( * instead. This should be examined by someone on Unix. */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); ClientData cd; ClientData oldcd = tsdPtr->cwdClientData; diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 2e91922..ac9df3a 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -27,6 +27,8 @@ static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); +static int MakePathFromNormalized(Tcl_Interp *interp, + Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths @@ -431,7 +433,7 @@ TclFSNormalizeAbsolutePath( * object into an FsPath for greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal); + MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. @@ -1525,7 +1527,7 @@ TclFSMakePathRelative( /* *--------------------------------------------------------------------------- * - * TclFSMakePathFromNormalized -- + * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. @@ -1539,13 +1541,12 @@ TclFSMakePathRelative( *--------------------------------------------------------------------------- */ -int -TclFSMakePathFromNormalized( +static int +MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -1587,7 +1588,7 @@ TclFSMakePathFromNormalized( fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; /* Remember the epoch under which we decided pathPtr was normalized */ - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; @@ -1629,7 +1630,6 @@ Tcl_FSNewNativePath( Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); @@ -1665,7 +1665,7 @@ Tcl_FSNewNativePath( fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; @@ -2268,7 +2268,6 @@ TclFSSetPathDetails( Tcl_Filesystem *fsPtr, ClientData clientData) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); FsPath *srcFsPathPtr; /* @@ -2284,7 +2283,7 @@ TclFSSetPathDetails( srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; - srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* @@ -2373,7 +2372,6 @@ SetFsPathFromAny( FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -2530,7 +2528,7 @@ SetFsPathFromAny( if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); /* Redo translation when $env(HOME) changes */ - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = TclFSEpoch(); } else { fsPathPtr->filesystemEpoch = 0; } -- cgit v0.12 From 000c4e19b196e7fbb12c6cf38589f7b90b8d4127 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Jun 2012 21:22:35 +0000 Subject: only expect tcldde.dll when --enable-shared --- unix/configure | 2 +- unix/tcl.m4 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unix/configure b/unix/configure index 8d7cc20..8d7b7f7 100755 --- a/unix/configure +++ b/unix/configure @@ -2884,7 +2884,7 @@ echo "$ac_t""$ac_cv_cygwin" 1>&6 if test "x${TCL_THREADS}" = "x0"; then { echo "configure: error: CYGWIN compile is only supported with --enable-threads" 1>&2; exit 1; } fi - if test ! -f "../win/tcldde12.dll" -a ! -f "../win/tk84.dll"; then + if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde12.dll" -a ! -f "../win/tk84.dll"; then { echo "configure: error: Please configure and make the ../win directory first." 1>&2; exit 1; } fi ;; diff --git a/unix/tcl.m4 b/unix/tcl.m4 index ac9b3bf..2dc6576 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1229,7 +1229,7 @@ dnl AC_CHECK_TOOL(AR, ar) if test "x${TCL_THREADS}" = "x0"; then AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads]) fi - if test ! -f "../win/tcldde12.dll" -a ! -f "../win/tk84.dll"; then + if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde12.dll" -a ! -f "../win/tk84.dll"; then AC_MSG_ERROR([Please configure and make the ../win directory first.]) fi ;; -- cgit v0.12 From f77bac107650fae2f845367734e42baf68b190a6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Jun 2012 08:18:56 +0000 Subject: suggestions from Harald --- library/msgcat/msgcat.tcl | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 204de9c..3757ec6 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -451,23 +451,18 @@ proc msgcat::Init {} { } } # - # The rest of this routine is special processing for Windows; - # all other platforms, get out now. + # The rest of this routine is special processing for Windows or + # Cygwin. All other platforms, get out now. # - if {[info sharedlibextension] ne ".dll"} { + if {([info sharedlibextension] ne ".dll") + || [catch {package require registry}]} { mclocale C return } # - # On Windows, try to set locale depending on registry settings, - # or fall back on locale of "C". + # On Windows or Cygwin, try to set locale depending on registry + # settings, or fall back on locale of "C". # - if {[catch { - package require registry - }]} { - mclocale C - return - } # First check registry value LocalName present from Windows Vista # which contains the local string as RFC5646, composed of: -- cgit v0.12 From 1bacfee38ca9ec1cb380f01206190a06f9413609 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 29 Jun 2012 08:43:55 +0000 Subject: Reinforced the description of the requirement for the tables of names for Tcl_GetIndexFromObj to index over to be static, following posting to tcl-core by Brian Griffin about a bug caused by not obeying this rule correctly. --- ChangeLog | 8 ++++++++ doc/GetIndex.3 | 10 ++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 28ff688..a39e72d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-06-29 Donal K. Fellows + + * doc/GetIndex.3: Reinforced the description of the requirement for + the tables of names to index over to be static, following posting to + tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying + this rule correctly. This does not represent a functionality change, + merely a clearer documentation of a long-standing constraint. + 2012-06-23 Jan Nijtmans * unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index e47f89b..54ac034 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -34,10 +34,16 @@ table entry. .AP "CONST char" **tablePtr in An array of null-terminated strings. The end of the array is marked by a NULL string pointer. +Note that references to the \fItablePtr\fR may be retained in the +internal representation of \fIobjPtr\fR, so this should represent the +address of a statically-allocated array. .AP "CONST VOID" *structTablePtr in An array of arbitrary type, typically some \fBstruct\fP type. The first member of the structure must be a null-terminated string. The size of the structure is given by \fIoffset\fP. +Note that references to the \fIstructTablePtr\fR may be retained in the +internal representation of \fIobjPtr\fR, so this should represent the +address of a statically-allocated array of structures. .VS .AP int offset in The offset to add to structTablePtr to get to the next entry. @@ -56,10 +62,10 @@ The index of the string in \fItablePtr\fR that matches the value of .SH DESCRIPTION .PP -This procedure provides an efficient way for looking up keywords, +These procedures provide an efficient way for looking up keywords, switch names, option names, and similar things where the value of an object must be one of a predefined set of values. -\fIObjPtr\fR is compared against each of +\fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of the strings in \fItablePtr\fR to find a match. A match occurs if \fIobjPtr\fR's string value is identical to one of the strings in \fItablePtr\fR, or if it is a non-empty unique abbreviation -- cgit v0.12 From eb57e9b4301023a8a734e2d802a7e2c1f122bce1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Jun 2012 11:34:53 +0000 Subject: Add tn, ro_MO and ru_MO to msgcat. Make it work on cygwin (backported) Bump msgcat to 1.3.5 --- ChangeLog | 5 +++++ doc/msgcat.n | 2 +- library/msgcat/msgcat.tcl | 55 ++++++++++++++++++++++++--------------------- library/msgcat/pkgIndex.tcl | 2 +- tests/msgcat.test | 12 +++++----- 5 files changed, 42 insertions(+), 34 deletions(-) diff --git a/ChangeLog b/ChangeLog index a39e72d..a2b3649 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-06-29 Jan Nijtmans + + * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat. Make it + * library/msgcat/pkgIndex.tcl: work on cygwin. Bump to 1.3.5 + 2012-06-29 Donal K. Fellows * doc/GetIndex.3: Reinforced the description of the requirement for diff --git a/doc/msgcat.n b/doc/msgcat.n index e6e08b5..6fdc31a 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -13,7 +13,7 @@ msgcat \- Tcl message catalog .SH SYNOPSIS \fBpackage require Tcl 8.2\fR .sp -\fBpackage require msgcat 1.3.4\fR +\fBpackage require msgcat 1.3.5\fR .sp \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? .sp diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 7e663cf..3327bc6 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -13,7 +13,7 @@ package require Tcl 8.2 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. -package provide msgcat 1.3.4 +package provide msgcat 1.3.5 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ @@ -31,7 +31,7 @@ namespace eval msgcat { array set Msgs {} # Map of language codes used in Windows registry to those of ISO-639 - if { [string equal $::tcl_platform(platform) windows] } { + if {[info sharedlibextension] eq ".dll"} { array set WinRegToISO639 { 01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ 1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY @@ -65,8 +65,8 @@ namespace eval msgcat { 15 pl 0415 pl_PL 16 pt 0416 pt_BR 0816 pt_PT 17 rm 0417 rm_CH - 18 ro 0418 ro_RO - 19 ru + 18 ro 0418 ro_RO 0818 ro_MO + 19 ru 0819 ru_MO 1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic 1b sk 041b sk_SK 1c sq 041c sq_AL @@ -91,6 +91,7 @@ namespace eval msgcat { 2f mk 042f mk_MK 30 bnt 0430 bnt_TZ 31 ts 0431 ts_ZA + 32 tn 33 ven 0433 ven_ZA 34 xh 0434 xh_ZA 35 zu 0435 zu_ZA @@ -174,7 +175,7 @@ namespace eval msgcat { # args Args to pass to the format command # # Results: -# Returns the translatd string. Propagates errors thrown by the +# Returns the translated string. Propagates errors thrown by the # format command. proc msgcat::mc {src args} { @@ -186,7 +187,7 @@ proc msgcat::mc {src args} { variable Locale set ns [uplevel 1 [list ::namespace current]] - + while {$ns != ""} { foreach loc $Loclist { if {[info exists Msgs($loc,$ns,$src)]} { @@ -278,7 +279,7 @@ proc msgcat::mcload {langdir} { incr x set fid [open $langfile "r"] fconfigure $fid -encoding utf-8 - uplevel 1 [read $fid] + uplevel 1 [read $fid] close $fid } } @@ -301,7 +302,7 @@ proc msgcat::mcload {langdir} { proc msgcat::mcset {locale src {dest ""}} { variable Msgs if {[llength [info level 0]] == 3} { ;# dest not specified - set dest $src + set dest $src } set ns [uplevel 1 [list ::namespace current]] @@ -328,14 +329,14 @@ proc msgcat::mcmset {locale pairs } { if {$length % 2} { error {bad translation list: should be "mcmset locale {src dest ...}"} } - + set locale [string tolower $locale] set ns [uplevel 1 [list ::namespace current]] - + foreach {src dest} $pairs { - set Msgs($locale,$ns,$src) $dest + set Msgs($locale,$ns,$src) $dest } - + return $length } @@ -344,7 +345,7 @@ proc msgcat::mcmset {locale pairs } { # This routine is called by msgcat::mc if a translation cannot # be found for a string. This routine is intended to be replaced # by an application specific routine for error reporting -# purposes. The default behavior is to return the source string. +# purposes. The default behavior is to return the source string. # If additional args are specified, the format command will be used # to work them into the traslated string. # @@ -366,7 +367,7 @@ proc msgcat::mcunknown {locale src args} { # msgcat::mcmax -- # -# Calculates the maximun length of the translated strings of the given +# Calculates the maximum length of the translated strings of the given # list. # # Arguments: @@ -379,10 +380,10 @@ proc msgcat::mcmax {args} { set max 0 foreach string $args { set translated [uplevel 1 [list [namespace origin mc] $string]] - set len [string length $translated] - if {$len>$max} { - set max $len - } + set len [string length $translated] + if {$len>$max} { + set max $len + } } return $max } @@ -418,13 +419,15 @@ proc msgcat::ConvertLocale {value} { # Initialize the default locale proc msgcat::Init {} { + global env + # # set default locale, try to get from environment # foreach varName {LC_ALL LC_MESSAGES LANG} { - if {[info exists ::env($varName)] - && ![string equal "" $::env($varName)]} { - if {![catch {mclocale [ConvertLocale $::env($varName)]}]} { + if {[info exists env($varName)] + && ![string equal "" $env($varName)]} { + if {![catch {mclocale [ConvertLocale $env($varName)]}]} { return } } @@ -444,18 +447,18 @@ proc msgcat::Init {} { # The rest of this routine is special processing for Windows; # all other platforms, get out now. # - if { ![string equal $::tcl_platform(platform) windows] } { + if {![string equal [info sharedlibextension] .dll]} { mclocale C return } # - # On Windows, try to set locale depending on registry settings, - # or fall back on locale of "C". + # On Windows or Cygwin, try to set locale depending on registry + # settings, or fall back on locale of "C". # set key {HKEY_CURRENT_USER\Control Panel\International} if {[catch {package require registry}] \ || [catch {registry get $key "locale"} locale]} { - mclocale C + mclocale C return } # @@ -470,7 +473,7 @@ proc msgcat::Init {} { variable WinRegToISO639 set locale [string tolower $locale] while {[string length $locale]} { - if {![catch {mclocale [ConvertLocale $WinRegToISO639($locale)]}]} { + if {![catch {mclocale [ConvertLocale $WinRegToISO639($locale)]}]} { return } set locale [string range $locale 1 end] diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 5888ddb..280b8d2 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded msgcat 1.3.4 [list source [file join $dir msgcat.tcl]] +package ifneeded msgcat 1.3.5 [list source [file join $dir msgcat.tcl]] diff --git a/tests/msgcat.test b/tests/msgcat.test index 53b7c52..237a482 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -17,8 +17,8 @@ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return } -if {[catch {package require msgcat 1.3.4}]} { - puts stderr "Skipping tests in [info script]. No msgcat 1.3.4 found to test." +if {[catch {package require msgcat 1.3.5}]} { + puts stderr "Skipping tests in [info script]. No msgcat 1.3.5 found to test." return } @@ -49,7 +49,7 @@ namespace eval ::msgcat::test { variable body variable result variable setVars - foreach setVars [PowerSet $envVars] { + foreach setVars [PowerSet $envVars] { set result [string tolower [lindex $setVars 0]] if {[string length $result] == 0} { if {[info exists ::tcl::mac::locale]} { @@ -83,7 +83,7 @@ namespace eval ::msgcat::test { incr count } catch {unset result} - + # Could add tests of initialization from Windows registry here. # Use a fake registry package. @@ -472,7 +472,7 @@ namespace eval ::msgcat::test { # Tests msgcat-6.*: [mcset], [mc] namespace inheritance # # Test mcset and mc, ensuring that resolution for messages -# proceeds from the current ns to its parent and so on to the +# proceeds from the current ns to its parent and so on to the # global ns. # # Do this for the 12 permutations of @@ -516,7 +516,7 @@ namespace eval ::msgcat::test { ::msgcat::mcset foo ov3 "ov3_foo_bar_baz" } } - + } variable locale [mclocale] mclocale foo -- cgit v0.12 From c38be115fffee7a1c6a0d6124943df31892e7c54 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Jun 2012 19:27:28 +0000 Subject: translate script parameters for msgcat update msgcat doc --- doc/msgcat.n | 15 +++++++++------ library/msgcat/msgcat.tcl | 20 ++++++++++++-------- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/doc/msgcat.n b/doc/msgcat.n index 00141ad..c2c0abd 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -13,7 +13,7 @@ msgcat \- Tcl message catalog .SH SYNOPSIS \fBpackage require Tcl 8.5\fR .sp -\fBpackage require msgcat 1.4.2\fR +\fBpackage require msgcat 1.4.5\fR .sp \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? .sp @@ -165,11 +165,14 @@ to extract its parts. The initial locale is then set by calling .CS language[_country][_modifier] .CE -On Windows, if none of those environment variables is set, msgcat will -attempt to extract locale information from the -registry. If all these attempts to discover an initial locale -from the user's environment fail, msgcat defaults to an initial -locale of +On Windows and Cygwin, if none of those environment variables is set, +msgcat will attempt to extract locale information from the registry. +From Windows Vista on, the RFC4747 locale name "lang-script-country-options" +is transformed to the locale as "lang_country_script" (Example: +sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is +transformed analoguously (Example: 0c1a -> sr_yu_cyrillic). +If all these attempts to discover an initial locale from the user's +environment fail, msgcat defaults to an initial locale of .QW C . .PP When a locale is specified by the user, a diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index f6c62a3..3377b47 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -342,7 +342,7 @@ proc msgcat::mcmset {locale pairs } { set ns [uplevel 1 [list ::namespace current]] foreach {src dest} $pairs { - dict set Msgs $locale $ns $src $dest + dict set Msgs $locale $ns $src $dest } return $length @@ -388,10 +388,10 @@ proc msgcat::mcmax {args} { set max 0 foreach string $args { set translated [uplevel 1 [list [namespace origin mc] $string]] - set len [string length $translated] - if {$len>$max} { + set len [string length $translated] + if {$len>$max} { set max $len - } + } } return $max } @@ -468,20 +468,24 @@ proc msgcat::Init {} { # First check registry value LocalName present from Windows Vista # which contains the local string as RFC5646, composed of: # [a-z]{2,3} : language - # -[a-z]{4} : script (optional, not used) + # -[a-z]{4} : script (optional, translated by table Latn->latin) # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used) # (-.*)* : variant, extension, private use (optional, not used) # Those are translated to local strings. - # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs, es-419 -> es + # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es # set key {HKEY_CURRENT_USER\Control Panel\International} if {([registry values $key "LocaleName"] ne "") - && [regexp {^([a-z]{2,3})(?:-[a-z]{4})?(?:-([a-z]{2}))?(?:-.+)?$}\ + && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\ [string tolower [registry get $key "LocaleName"]] match locale\ - territory]} { + script territory]} { if {"" ne $territory} { append locale _ $territory } + set modifierDict [dict create latn latin cyrl cyrillic] + if {[dict exists $modifierDict $script]} { + append locale @ [dict get $modifierDict $script] + } if {![catch { mclocale [ConvertLocale $locale] }]} { -- cgit v0.12 From d180ccb164a74d2660ac36e7f56863c9b4fbd6f0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 1 Jul 2012 19:39:03 +0000 Subject: add TclUnixCopyFile to stub table for Cygwin --- generic/tclInt.decls | 5 +++++ generic/tclIntPlatDecls.h | 15 ++++++++++++--- generic/tclStubInit.c | 3 ++- 3 files changed, 19 insertions(+), 4 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 0459e8c..102d04b 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1034,6 +1034,11 @@ declare 16 win { # declare 17 win { # char *TclpGetTZName(void) # } +# new for 8.5.12+ Cygwin only +declare 17 win { + int TclUnixCopyFile(const char *src, const char *dst, + const Tcl_StatBuf *statBufPtr, int dontCopyAtts) +} declare 18 win { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 5c610fa..34a23a4 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -236,7 +236,13 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, /* 16 */ EXTERN int TclpIsAtty(int fd); #endif -/* Slot 17 is reserved */ +#ifndef TclUnixCopyFile_TCL_DECLARED +#define TclUnixCopyFile_TCL_DECLARED +/* 17 */ +EXTERN int TclUnixCopyFile(CONST char *src, CONST char *dst, + CONST Tcl_StatBuf *statBufPtr, + int dontCopyAtts); +#endif #ifndef TclpMakeFile_TCL_DECLARED #define TclpMakeFile_TCL_DECLARED /* 18 */ @@ -479,7 +485,7 @@ typedef struct TclIntPlatStubs { int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ - VOID *reserved17; + int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ @@ -687,7 +693,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #endif -/* Slot 17 is reserved */ +#ifndef TclUnixCopyFile +#define TclUnixCopyFile \ + (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ +#endif #ifndef TclpMakeFile #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ca21efb..7b73ee3 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -77,6 +77,7 @@ MODULE_SCOPE TclTomMathStubs tclTomMathStubs; #ifdef __WIN32__ # define TclUnixWaitForFile 0 +# define TclUnixCopyFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) @@ -509,7 +510,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ - NULL, /* 17 */ + TclUnixCopyFile, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ -- cgit v0.12 From a70bdc9ec1f2e2009feff998bb7ceb63dd28cb90 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 2 Jul 2012 15:11:56 +0000 Subject: NRInterpCoroutine -> TclNRInterpCoroutine make NRCommand static make TalInstructionTable static const --- generic/tclAssembly.c | 6 +++--- generic/tclBasic.c | 12 +++++++----- generic/tclCompile.h | 3 +-- generic/tclNamesp.c | 4 ++-- 4 files changed, 13 insertions(+), 12 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 02144a1..83f4fe9 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -265,7 +265,7 @@ static int CheckStrictlyPositive(Tcl_Interp*, int); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, - TalInstDesc*); + const TalInstDesc*); static int DefineLabel(AssemblyEnv* envPtr, const char* label); static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void DupAssembleCodeInternalRep(Tcl_Obj* src, @@ -350,7 +350,7 @@ static const Tcl_ObjType assembleCodeType = { * Source instructions recognized in the Tcl Assembly Language (TAL) */ -TalInstDesc TalInstructionTable[] = { +static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ {"push", ASSEM_PUSH, (INST_PUSH1<<8 | INST_PUSH4), 0, 1}, @@ -1768,7 +1768,7 @@ static void CompileEmbeddedScript( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */ - TalInstDesc* instPtr) /* Instruction that determines whether + const TalInstDesc* instPtr) /* Instruction that determines whether * the script is 'expr' or 'eval' */ { CompileEnv* envPtr = assemEnvPtr->envPtr; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0b02d0d..216e667 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -134,6 +134,8 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, static Tcl_NRPostProc NRCoroutineActivateCallback; static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; +static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); + static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc NRTailcallEval; static Tcl_ObjCmdProc OldMathFuncProc; @@ -4363,7 +4365,7 @@ TclNRRunCallbacks( return result; } -int +static int NRCommand( ClientData data[], Tcl_Interp *interp, @@ -8593,7 +8595,7 @@ RewindCoroutine( corPtr->eePtr->rewind = 1; TclNRAddCallback(interp, RewindCoroutineCallback, state, NULL, NULL, NULL); - return NRInterpCoroutine(corPtr, interp, 0, NULL); + return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void @@ -8820,7 +8822,7 @@ NRCoroInjectObjCmd( } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); - if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) { + if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_AppendResult(interp, "can only inject a command into a coroutine", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", @@ -8849,7 +8851,7 @@ NRCoroInjectObjCmd( } int -NRInterpCoroutine( +TclNRInterpCoroutine( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -8976,7 +8978,7 @@ TclNRCoroutineObjCmd( Tcl_DStringAppend(&ds, procName, -1); cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), - /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine); + /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); Tcl_DStringFree(&ds); corPtr->cmdPtr = cmdPtr; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 58663fd..e74da0a 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -866,8 +866,7 @@ typedef struct { *---------------------------------------------------------------- */ -MODULE_SCOPE Tcl_NRPostProc NRCommand; -MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine; +MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* *---------------------------------------------------------------- diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 73bc644..46ff6da 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -24,7 +24,7 @@ */ #include "tclInt.h" -#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */ +#include "tclCompile.h" /* for TclLogCommandInfo visibility */ /* * Thread-local storage used to avoid having a global lock on data that is not @@ -916,7 +916,7 @@ Tcl_DeleteNamespace( for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { cmdPtr = Tcl_GetHashValue(entryPtr); - if (cmdPtr->nreProc == NRInterpCoroutine) { + if (cmdPtr->nreProc == TclNRInterpCoroutine) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); -- cgit v0.12 From 365f431b636ec6b553ea127587a92b9956003f0a Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 2 Jul 2012 16:22:18 +0000 Subject: 1189293 Make '<<' redirects binary safe. Don't use strlen() (or equivalent) to find end of written data bytes. --- unix/tclUnixPipe.c | 2 +- win/tclWinPipe.c | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 3a4005c..829a4a6 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -213,7 +213,7 @@ TclpCreateTempFile(contents) if (contents != NULL) { native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); - if (write(fd, native, strlen(native)) == -1) { + if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) { close(fd); Tcl_DStringFree(&dstring); return NULL; diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4c530e3..3a55abb 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -691,13 +691,15 @@ TclpCreateTempFile(contents) if (contents != NULL) { DWORD result, length; CONST char *p; + int toCopy; /* * Convert the contents from UTF to native encoding */ native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); - for (p = native; *p != '\0'; p++) { + toCopy = Tcl_DStringLength(&dstring); + for (p = native; toCopy > 0; p++, toCopy--) { if (*p == '\n') { length = p - native; if (length > 0) { -- cgit v0.12 From 08bec1c1e8e4aae5cb45d4c68a2ab5d9bd73470e Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 3 Jul 2012 14:52:55 +0000 Subject: Factor out a number of common patterns of use of Tcl_DStringAppend. --- ChangeLog | 9 +++++++++ generic/tclBasic.c | 6 +++--- generic/tclCmdAH.c | 4 ++-- generic/tclCompCmds.c | 4 ++-- generic/tclCompCmdsSZ.c | 3 +-- generic/tclCompExpr.c | 2 +- generic/tclCompile.c | 19 ++++++------------- generic/tclCompile.h | 10 ++++++++++ generic/tclConfig.c | 4 ++-- generic/tclEncoding.c | 4 ++-- generic/tclEnsemble.c | 16 ++++++++-------- generic/tclFileName.c | 32 +++++++++++++++----------------- generic/tclIO.c | 8 +++----- generic/tclIORChan.c | 11 +++++------ generic/tclIOUtil.c | 2 +- generic/tclInt.h | 19 +++++++++++++++++++ generic/tclLoad.c | 30 +++++++++++++++--------------- generic/tclNamesp.c | 13 ++++++------- generic/tclOO.c | 6 +++--- generic/tclOOBasic.c | 2 +- generic/tclPkg.c | 6 +++--- generic/tclProc.c | 2 +- generic/tclTrace.c | 22 +++++++++++----------- generic/tclUtil.c | 37 ++++++++++++++++++++++++++++++++++--- generic/tclZlib.c | 12 ++++-------- unix/tclLoadDl.c | 2 +- unix/tclLoadDyld.c | 2 +- unix/tclLoadShl.c | 6 +++--- unix/tclUnixChan.c | 4 ++-- unix/tclUnixFCmd.c | 14 +++++++------- unix/tclUnixFile.c | 11 +++++------ win/tclWinFCmd.c | 4 ++-- win/tclWinFile.c | 14 +++++++------- win/tclWinLoad.c | 2 +- win/tclWinPipe.c | 14 +++++++------- win/tclWinReg.c | 8 +++----- win/tclWinSock.c | 8 ++++---- 37 files changed, 210 insertions(+), 162 deletions(-) diff --git a/ChangeLog b/ChangeLog index fe75ef4..d1a2d6a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2012-07-03 Donal K. Fellows + + * generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString): + * generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear): + * generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make + common cases of appending to Tcl_DStrings simpler to write. Prompted + by looking at [FRQ 1357401] (these are an _internal_ implementation of + that FRQ). + 2012-06-29 Jan Nijtmans * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 216e667..537750e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2612,7 +2612,7 @@ TclRenameCommand( Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { - Tcl_DStringAppend(&newFullName, "::", 2); + TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; @@ -3470,7 +3470,7 @@ Tcl_CreateMathFunc( data->clientData = clientData; Tcl_DStringInit(&bigName); - Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1); + TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); Tcl_DStringAppend(&bigName, name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), @@ -8973,7 +8973,7 @@ TclNRCoroutineObjCmd( Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 6dfc705..f09ee70 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1045,9 +1045,9 @@ TclMakeFileCommandSafe( Tcl_DString oldBuf, newBuf; Tcl_DStringInit(&oldBuf); - Tcl_DStringAppend(&oldBuf, "::tcl::file::", -1); + TclDStringAppendLiteral(&oldBuf, "::tcl::file::"); Tcl_DStringInit(&newBuf); - Tcl_DStringAppend(&newBuf, "tcl:file:", -1); + TclDStringAppendLiteral(&newBuf, "tcl:file:"); for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { if (unsafeInfo[i].unsafe) { const char *oldName, *newName; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 5b7e0a5..3540716 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -820,7 +820,7 @@ TclCompileDictForCmd( */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size); + TclDStringAppendToken(&buffer, &varsTokenPtr[1]); if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); @@ -1961,7 +1961,7 @@ TclCompileForeachCmd( */ Tcl_DStringInit(&varList); - Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size); + TclDStringAppendToken(&varList, &tokenPtr[1]); code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b950e21..8ed3a95 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1558,8 +1558,7 @@ IssueSwitchJumpTable( */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, bodyToken[i]->start, - bodyToken[i]->size); + TclDStringAppendToken(&buffer, bodyToken[i]); hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, Tcl_DStringValue(&buffer), &isNew); if (isNew) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 4212b6d..890d518 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2296,7 +2296,7 @@ CompileExprTree( int length; Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); + TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = TclGetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1d88e11..d4ca284 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1661,8 +1661,8 @@ TclCompileScript( * have side effects that rely on the unmodified string. */ - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size); + TclDStringClear(&ds); + TclDStringAppendToken(&ds, &tokenPtr[1]); cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), @@ -2044,7 +2044,7 @@ TclCompileTokens( for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: - Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size); + TclDStringAppendToken(&textBuffer, tokenPtr); TclAdvanceLines(&envPtr->line, tokenPtr->start, tokenPtr->start + tokenPtr->size); break; @@ -2091,9 +2091,7 @@ TclCompileTokens( */ if (Tcl_DStringLength(&textBuffer) > 0) { - int literal = TclRegisterNewLiteral(envPtr, - Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); + int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; @@ -2120,9 +2118,7 @@ TclCompileTokens( if (Tcl_DStringLength(&textBuffer) > 0) { int literal; - literal = TclRegisterNewLiteral(envPtr, - Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); + literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); @@ -2145,13 +2141,10 @@ TclCompileTokens( */ if (Tcl_DStringLength(&textBuffer) > 0) { - int literal; + int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); - literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); TclEmitPush(literal, envPtr); numObjsToConcat++; - if (numCL) { TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, numCL, clPosition); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index e74da0a..ba78c36 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1364,6 +1364,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) /* + * Macros for making it easier to deal with tokens and DStrings. + */ + +#define TclDStringAppendToken(dsPtr, tokenPtr) \ + Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size) +#define TclRegisterDStringLiteral(envPtr, dsPtr) \ + TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \ + Tcl_DStringLength(dsPtr), /*flags*/ 0) + +/* * DTrace probe macros (NOPs if DTrace support is not enabled). */ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index b4735e8..dea487a 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -155,7 +155,7 @@ Tcl_RegisterConfig( */ Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "::", -1); + TclDStringAppendLiteral(&cmdName, "::"); Tcl_DStringAppend(&cmdName, pkgName, -1); /* @@ -173,7 +173,7 @@ Tcl_RegisterConfig( } } - Tcl_DStringAppend(&cmdName, "::pkgconfig", -1); + TclDStringAppendLiteral(&cmdName, "::pkgconfig"); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) { diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 49418c9..0fa6661 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1872,9 +1872,9 @@ LoadTableEncoding( * Read lines from the encoding until EOF. */ - for (Tcl_DStringSetLength(&lineString, 0); + for (TclDStringClear(&lineString); (len = Tcl_Gets(chan, &lineString)) >= 0; - Tcl_DStringSetLength(&lineString, 0)) { + TclDStringClear(&lineString)) { const unsigned char *p; int to, from; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 1e1a901..754e480 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1425,9 +1425,9 @@ TclMakeEnsemble( Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); - Tcl_DStringAppend(&hiddenBuf, "tcl:", -1); + TclDStringAppendLiteral(&hiddenBuf, "tcl:"); Tcl_DStringAppend(&hiddenBuf, name, -1); - Tcl_DStringAppend(&hiddenBuf, ":", -1); + TclDStringAppendLiteral(&hiddenBuf, ":"); hiddenLen = Tcl_DStringLength(&hiddenBuf); if (name[0] == ':' && name[1] == ':') { /* @@ -1443,14 +1443,14 @@ TclMakeEnsemble( * multi-word list differently to a single word. */ - Tcl_DStringAppend(&buf, "::tcl", -1); + TclDStringAppendLiteral(&buf, "::tcl"); if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) { Tcl_Panic("invalid ensemble name '%s'", name); } for (i = 0; i < nameCount; ++i) { - Tcl_DStringAppend(&buf, "::", 2); + TclDStringAppendLiteral(&buf, "::"); Tcl_DStringAppend(&buf, nameParts[i], -1); } } @@ -1485,7 +1485,7 @@ TclMakeEnsemble( Tcl_Obj *mapDict, *fromObj, *toObj; Command *cmdPtr; - Tcl_DStringAppend(&buf, "::", 2); + TclDStringAppendLiteral(&buf, "::"); TclNewObj(mapDict); for (i=0 ; map[i].name != NULL ; i++) { fromObj = Tcl_NewStringObj(map[i].name, -1); @@ -1615,10 +1615,10 @@ NsEnsembleImplementationCmdNR( Tcl_Panic("List of ensemble parameters is not a list"); } for (; len>0; len--,elemPtrs++) { - Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1); - Tcl_DStringAppend(&buf, " ", -1); + TclDStringAppendObj(&buf, *elemPtrs); + TclDStringAppendLiteral(&buf, " "); } - Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1); + TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf)); Tcl_DStringFree(&buf); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 48c5454..63faa6d 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -72,9 +72,9 @@ SetResultLength( { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { - Tcl_DStringAppend(resultPtr, "//?/UNC/", 8); + TclDStringAppendLiteral(resultPtr, "//?/UNC/"); } else if (extended == 1) { - Tcl_DStringAppend(resultPtr, "//?/", 4); + TclDStringAppendLiteral(resultPtr, "//?/"); } } @@ -131,7 +131,7 @@ ExtractWinRoot( if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[1]; } host = &path[2]; @@ -161,7 +161,7 @@ ExtractWinRoot( */ *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[2]; } SetResultLength(resultPtr, offset, extended); @@ -180,9 +180,9 @@ ExtractWinRoot( break; } } - Tcl_DStringAppend(resultPtr, "//", 2); + TclDStringAppendLiteral(resultPtr, "//"); Tcl_DStringAppend(resultPtr, host, hlen); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; @@ -221,7 +221,7 @@ ExtractWinRoot( *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return tail; } @@ -1057,7 +1057,7 @@ Tcl_TranslateFileName( } Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); + TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); @@ -1413,7 +1413,7 @@ Tcl_GlobObjCmd( search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); - Tcl_DStringAppend(&prefix, "\\", 1); + TclDStringAppendLiteral(&prefix, "\\"); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { @@ -1592,11 +1592,9 @@ Tcl_GlobObjCmd( for (i = 0; i < objc; i++) { Tcl_DStringInit(&str); if (dir == PATH_GENERAL) { - Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix), - Tcl_DStringLength(&prefix)); + TclDStringAppendDString(&str, &prefix); } - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&str, string, length); + TclDStringAppendObj(&str, objv[i]); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; @@ -2401,9 +2399,9 @@ DoGlob( if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } @@ -2412,9 +2410,9 @@ DoGlob( case TCL_PLATFORM_UNIX: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } break; diff --git a/generic/tclIO.c b/generic/tclIO.c index a76aba3..ea6c2d7 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4431,14 +4431,12 @@ Tcl_Gets( * for managing the storage. */ { Tcl_Obj *objPtr; - int charsStored, length; - const char *string; + int charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); if (charsStored > 0) { - string = TclGetStringFromObj(objPtr, &length); - Tcl_DStringAppend(lineRead, string, length); + TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); return charsStored; @@ -7550,7 +7548,7 @@ Tcl_BadChannelOption( Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 938def2..6fec40a 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -1947,7 +1947,7 @@ ReflectGetOption( */ if (optionObj != NULL) { - Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1); + TclDStringAppendObj(dsPtr, resObj); goto ok; } @@ -1982,7 +1982,7 @@ ReflectGetOption( const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(dsPtr, " ", 1); + TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; @@ -3207,8 +3207,7 @@ ForwardProc( if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { - Tcl_DStringAppend(paramPtr->getOpt.value, - TclGetString(resObj), -1); + TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); @@ -3233,7 +3232,7 @@ ForwardProc( Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { + &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); @@ -3253,7 +3252,7 @@ ForwardProc( const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1); + TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bea1897..41a5aac 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -405,7 +405,7 @@ Tcl_GetCwd( return NULL; } Tcl_DStringInit(cwdPtr); - Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1); + TclDStringAppendObj(cwdPtr, cwd); Tcl_DecrRefCount(cwd); return Tcl_DStringValue(cwdPtr); } diff --git a/generic/tclInt.h b/generic/tclInt.h index 9068dfb..53a88d6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2920,6 +2920,10 @@ MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); +MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, + Tcl_Obj *objPtr); +MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); @@ -4452,6 +4456,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- + * Convenience macros for DStrings. + * The ANSI C "prototypes" for these macros are: + * + * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr, + * const char *sLiteral); + * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); + */ + +#define TclDStringAppendLiteral(dsPtr, sLiteral) \ + Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) +#define TclDStringClear(dsPtr) \ + Tcl_DStringSetLength((dsPtr), 0) + +/* + *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: * diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 008a99d..ce4d6a4 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -198,9 +198,9 @@ Tcl_LoadObjCmd( if (packageName == NULL) { namesMatch = 0; } else { - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); - Tcl_DStringSetLength(&tmp, 0); + TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); @@ -211,7 +211,7 @@ Tcl_LoadObjCmd( namesMatch = 0; } } - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { @@ -329,7 +329,7 @@ Tcl_LoadObjCmd( code = TCL_ERROR; goto done; } - Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); + Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); } } @@ -348,14 +348,14 @@ Tcl_LoadObjCmd( * package name. */ - Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&initName, "_Init", 5); - Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); - Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&unloadName, "_Unload", 7); - Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11); + TclDStringAppendDString(&initName, &pkgName); + TclDStringAppendLiteral(&initName, "_Init"); + TclDStringAppendDString(&safeInitName, &pkgName); + TclDStringAppendLiteral(&safeInitName, "_SafeInit"); + TclDStringAppendDString(&unloadName, &pkgName); + TclDStringAppendLiteral(&unloadName, "_Unload"); + TclDStringAppendDString(&safeUnloadName, &pkgName); + TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload"); /* * Call platform-specific code to load the package and find the two @@ -623,9 +623,9 @@ Tcl_UnloadObjCmd( if (packageName == NULL) { namesMatch = 0; } else { - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); - Tcl_DStringSetLength(&tmp, 0); + TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); @@ -636,7 +636,7 @@ Tcl_UnloadObjCmd( namesMatch = 0; } } - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 46ff6da..6a241f0 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -803,10 +803,9 @@ Tcl_CreateNamespace( if (ancestorPtr != globalNsPtr) { register Tcl_DString *tempPtr = namePtr; - Tcl_DStringAppend(buffPtr, "::", 2); + TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); - Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr), - Tcl_DStringLength(namePtr)); + TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous @@ -814,7 +813,7 @@ Tcl_CreateNamespace( * very wrong (and strange). */ - Tcl_DStringSetLength(namePtr, 0); + TclDStringClear(namePtr); /* * Now swap the buffer pointers so that we build in the other @@ -1667,7 +1666,7 @@ DoImport( Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, cmdName, -1); @@ -2241,7 +2240,7 @@ TclGetNamespaceForQualName( * qualName since it may be a string constant. */ - Tcl_DStringSetLength(&buffer, 0); + TclDStringClear(&buffer); Tcl_DStringAppend(&buffer, start, len); nsName = Tcl_DStringValue(&buffer); } @@ -2916,7 +2915,7 @@ NamespaceChildrenCmd( } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); } Tcl_DStringAppend(&buffer, name, -1); pattern = Tcl_DStringValue(&buffer); diff --git a/generic/tclOO.c b/generic/tclOO.c index 26e6d75..821befd 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -356,14 +356,14 @@ InitFoundation( Tcl_DStringInit(&buffer); for (i=0 ; defineCmds[i].name ; i++) { - Tcl_DStringAppend(&buffer, "::oo::define::", 14); + TclDStringAppendLiteral(&buffer, "::oo::define::"); Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i=0 ; objdefCmds[i].name ; i++) { - Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17); + TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); @@ -657,7 +657,7 @@ AllocObject( Tcl_DStringInit(&buffer); Tcl_DStringAppend(&buffer, Tcl_GetCurrentNamespace(interp)->fullName, -1); - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, nameStr, -1); oPtr->command = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL); diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 5e983fc..35ad1eb 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1190,7 +1190,7 @@ TclOOCopyObjectCmd( Tcl_DStringAppend(&buffer, iPtr->varFramePtr->nsPtr->fullName, -1); } - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, name, -1); name = Tcl_DStringValue(&buffer); } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index fdaea57..382ffe3 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1712,11 +1712,11 @@ AddRequirementsToDString( int i; for (i = 0; i < reqc; i++) { - Tcl_DStringAppend(dsPtr, " ", 1); - Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1); + TclDStringAppendLiteral(dsPtr, " "); + TclDStringAppendObj(dsPtr, reqv[i]); } } else { - Tcl_DStringAppend(dsPtr, " 0-", -1); + TclDStringAppendLiteral(dsPtr, " 0-"); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index 7b0af3a..537008c 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -194,7 +194,7 @@ Tcl_ProcObjCmd( Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 25abdff..529c38a 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1298,9 +1298,9 @@ TraceCommandProc( Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { - Tcl_DStringAppend(&cmd, " rename", 7); + TclDStringAppendLiteral(&cmd, " rename"); } else if (flags & TCL_TRACE_DELETE) { - Tcl_DStringAppend(&cmd, " delete", 7); + TclDStringAppendLiteral(&cmd, " delete"); } /* @@ -1994,24 +1994,24 @@ TraceVarProc( #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { - Tcl_DStringAppend(&cmd, " a", 2); + TclDStringAppendLiteral(&cmd, " a"); } else if (flags & TCL_TRACE_READS) { - Tcl_DStringAppend(&cmd, " r", 2); + TclDStringAppendLiteral(&cmd, " r"); } else if (flags & TCL_TRACE_WRITES) { - Tcl_DStringAppend(&cmd, " w", 2); + TclDStringAppendLiteral(&cmd, " w"); } else if (flags & TCL_TRACE_UNSETS) { - Tcl_DStringAppend(&cmd, " u", 2); + TclDStringAppendLiteral(&cmd, " u"); } } else { #endif if (flags & TCL_TRACE_ARRAY) { - Tcl_DStringAppend(&cmd, " array", 6); + TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { - Tcl_DStringAppend(&cmd, " read", 5); + TclDStringAppendLiteral(&cmd, " read"); } else if (flags & TCL_TRACE_WRITES) { - Tcl_DStringAppend(&cmd, " write", 6); + TclDStringAppendLiteral(&cmd, " write"); } else if (flags & TCL_TRACE_UNSETS) { - Tcl_DStringAppend(&cmd, " unset", 6); + TclDStringAppendLiteral(&cmd, " unset"); } #ifndef TCL_REMOVE_OBSOLETE_TRACES } @@ -2577,7 +2577,7 @@ TclCallVarTraces( char *newPart1; Tcl_DStringInit(&nameCopy); - Tcl_DStringAppend(&nameCopy, part1, (p-part1)); + Tcl_DStringAppend(&nameCopy, part1, p-part1); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index d5a3b94..3379f6c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2438,6 +2438,37 @@ Tcl_DStringAppend( /* *---------------------------------------------------------------------- * + * TclDStringAppendObj, TclDStringAppendDString -- + * + * Simple wrappers round Tcl_DStringAppend that make it easier to append + * from particular sources of strings. + * + *---------------------------------------------------------------------- + */ + +char * +TclDStringAppendObj( + Tcl_DString *dsPtr, + Tcl_Obj *objPtr) +{ + int length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + + return Tcl_DStringAppend(dsPtr, bytes, length); +} + +char * +TclDStringAppendDString( + Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr) +{ + return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr), + Tcl_DStringLength(toAppendPtr)); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DStringAppendElement -- * * Append a list element to the current value of a dynamic string. @@ -2793,9 +2824,9 @@ Tcl_DStringStartSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { - Tcl_DStringAppend(dsPtr, " {", -1); + TclDStringAppendLiteral(dsPtr, " {"); } else { - Tcl_DStringAppend(dsPtr, "{", -1); + TclDStringAppendLiteral(dsPtr, "{"); } } @@ -2821,7 +2852,7 @@ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { - Tcl_DStringAppend(dsPtr, "}", -1); + TclDStringAppendLiteral(dsPtr, "}"); } /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index b970b3d..a799639 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -573,9 +573,8 @@ Tcl_ZlibStreamInit( goto error; } Tcl_DStringInit(&cmdname); - Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1); - Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)), - -1); + TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); + TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname), &cmdinfo) == 1) { Tcl_SetResult(interp, @@ -2695,10 +2694,7 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { - int len; - const char *str = Tcl_GetStringFromObj(tmpObj, &len); - - Tcl_DStringAppend(dsPtr, str, len); + TclDStringAppendObj(dsPtr, tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; } @@ -3022,7 +3018,7 @@ ResultCopy( */ memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); - Tcl_DStringSetLength(&cd->decompressed, 0); + TclDStringClear(&cd->decompressed); return have; } } diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 96f0717..d86e7fd 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -168,7 +168,7 @@ FindSymbol( proc = dlsym(handle, native); /* INTL: Native. */ if (proc == NULL) { Tcl_DStringInit(&newName); - Tcl_DStringAppend(&newName, "_", 1); + TclDStringAppendLiteral(&newName, "_"); native = Tcl_DStringAppend(&newName, native, -1); proc = dlsym(handle, native); /* INTL: Native. */ Tcl_DStringFree(&newName); diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 3fba3a5..31d15b2 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -393,7 +393,7 @@ FindSymbol( */ Tcl_DStringInit(&newName); - Tcl_DStringAppend(&newName, "_", 1); + TclDStringAppendLiteral(&newName, "_"); native = Tcl_DStringAppend(&newName, native, -1); if (dyldLoadHandle->dyldLibHeader) { nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader, diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index 9656983..eddd80a 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -146,7 +146,7 @@ FindSymbol( if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, (void *) &proc) != 0) { Tcl_DStringInit(&newName); - Tcl_DStringAppend(&newName, "_", 1); + TclDStringAppendLiteral(&newName, "_"); Tcl_DStringAppend(&newName, symbol, -1); if (shl_findsym(&handle, Tcl_DStringValue(&newName), (short) TYPE_PROCEDURE, (void *) &proc) != 0) { @@ -156,8 +156,8 @@ FindSymbol( } if (proc == NULL && interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "cannot find symbol\"", symbol, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_AppendResult(interp, "cannot find symbol\"", symbol, "\": ", + Tcl_PosixError(interp), NULL); } return proc; } diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index b05a9f2..3845c44 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -733,7 +733,7 @@ TtySetOptionProc( Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds); iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds); - Tcl_DStringSetLength(&ds, 0); + TclDStringClear(&ds); Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds); iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds); @@ -916,7 +916,7 @@ TtyGetOptionProc( Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); - Tcl_DStringSetLength(&ds, 0); + TclDStringClear(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index fce071f..a695e9c 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -967,11 +967,11 @@ TraverseUnixTree( return result; } - Tcl_DStringAppend(sourcePtr, "/", 1); + TclDStringAppendLiteral(sourcePtr, "/"); sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { - Tcl_DStringAppend(targetPtr, "/", 1); + TclDStringAppendLiteral(targetPtr, "/"); targetLen = Tcl_DStringLength(targetPtr); } @@ -2125,24 +2125,24 @@ TclpOpenTemporaryFile( Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ } - Tcl_DStringAppend(&template, "/", -1); + TclDStringAppendLiteral(&template, "/"); if (basenameObj) { string = Tcl_GetStringFromObj(basenameObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &tmp); - Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1); + TclDStringAppendDString(&template, &tmp); Tcl_DStringFree(&tmp); } else { - Tcl_DStringAppend(&template, "tcl", -1); + TclDStringAppendLiteral(&template, "tcl"); } - Tcl_DStringAppend(&template, "_XXXXXX", -1); + TclDStringAppendLiteral(&template, "_XXXXXX"); #ifdef HAVE_MKSTEMPS if (extensionObj) { string = Tcl_GetStringFromObj(extensionObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &tmp); - Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1); + TclDStringAppendDString(&template, &tmp); fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index e676215..c213050 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -105,11 +105,11 @@ TclpFindExecutable( while ((*p != ':') && (*p != 0)) { p++; } - Tcl_DStringSetLength(&buffer, 0); + TclDStringClear(&buffer); if (p != name) { Tcl_DStringAppend(&buffer, name, p - name); if (p[-1] != '/') { - Tcl_DStringAppend(&buffer, "/", 1); + TclDStringAppendLiteral(&buffer, "/"); } } name = Tcl_DStringAppend(&buffer, argv0, -1); @@ -174,11 +174,10 @@ TclpFindExecutable( Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), Tcl_DStringLength(&cwd), &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { - Tcl_DStringAppend(&buffer, "/", 1); + TclDStringAppendLiteral(&buffer, "/"); } Tcl_DStringFree(&cwd); - Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString), - Tcl_DStringLength(&nameString)); + TclDStringAppendDString(&buffer, &nameString); Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); @@ -288,7 +287,7 @@ TclpMatchInDirectory( */ if (dirName[dirLength-1] != '/') { - dirName = Tcl_DStringAppend(&dsOrig, "/", 1); + dirName = TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 9d0131e..77a5b82 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1125,9 +1125,9 @@ DoRemoveJustDirectory( len = strlen(path); find = Tcl_DStringAppend(&buffer, path, len); if ((len > 0) && (find[len - 1] != '\\')) { - Tcl_DStringAppend(&buffer, "\\", 1); + TclDStringAppendLiteral(&buffer, "\\"); } - find = Tcl_DStringAppend(&buffer, "*.*", 3); + find = TclDStringAppendLiteral(&buffer, "*.*"); handle = FindFirstFileA(find, &data); if (handle != INVALID_HANDLE_VALUE) { while (1) { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 4a49b6c..1f56060 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -996,7 +996,7 @@ TclpMatchInDirectory( lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { - Tcl_DStringAppend(&dsOrig, "/", 1); + TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); @@ -1016,7 +1016,7 @@ TclpMatchInDirectory( dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { - dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); + dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } native = Tcl_WinUtfToTChar(dirName, -1, &ds); @@ -1467,7 +1467,7 @@ TclpGetUserHome( GetWindowsDirectoryW(buf, MAX_PATH); Tcl_UniCharToUtfDString(buf, 2, bufferPtr); - Tcl_DStringAppend(bufferPtr, "/users/default", -1); + TclDStringAppendLiteral(bufferPtr, "/users/default"); } result = Tcl_DStringValue(bufferPtr); NetApiBufferFree((void *) uiPtr); @@ -2076,7 +2076,7 @@ NativeDev( * won't work. */ - fullPath = Tcl_DStringAppend(&ds, "\\", 1); + fullPath = TclDStringAppendLiteral(&ds, "\\"); p = fullPath + Tcl_DStringLength(&ds); } else { p++; @@ -2536,7 +2536,7 @@ TclpObjNormalizePath( * string. */ - Tcl_DStringAppend(&dsNorm,"/", 1); + TclDStringAppendLiteral(&dsNorm, "/"); } else { char *nativeName; @@ -2546,8 +2546,8 @@ TclpObjNormalizePath( nativeName = fData.cAlternateFileName; } FindClose(handle); - Tcl_DStringAppend(&dsNorm,"/", 1); - Tcl_DStringAppend(&dsNorm,nativeName,-1); + TclDStringAppendLiteral(&dsNorm, "/"); + Tcl_DStringAppend(&dsNorm, nativeName, -1); } } } diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index e5b927d..b59ccba 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -184,7 +184,7 @@ FindSymbol( const char *sym2; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, "_", 1); + TclDStringAppendLiteral(&ds, "_"); sym2 = Tcl_DStringAppend(&ds, symbol, -1); proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index fd195c4..65d4d06 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1115,7 +1115,7 @@ TclpCreateProcess( startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; - Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1); + TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); } else { createFlags = DETACHED_PROCESS; } @@ -1465,9 +1465,9 @@ BuildCommandLine( * Prime the path. Add a space separator if we were primed with something. */ - Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1); + TclDStringAppendDString(&ds, linePtr); if (Tcl_DStringLength(linePtr) > 0) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } for (i = 0; i < argc; i++) { @@ -1475,7 +1475,7 @@ BuildCommandLine( arg = executable; } else { arg = argv[i]; - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); } quote = 0; @@ -1494,7 +1494,7 @@ BuildCommandLine( } } if (quote) { - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } start = arg; for (special = arg; ; ) { @@ -1523,7 +1523,7 @@ BuildCommandLine( } if (*special == '"') { Tcl_DStringAppend(&ds, start, (int) (special - start)); - Tcl_DStringAppend(&ds, "\\\"", 2); + TclDStringAppendLiteral(&ds, "\\\""); start = special + 1; } if (*special == '\0') { @@ -1533,7 +1533,7 @@ BuildCommandLine( } Tcl_DStringAppend(&ds, start, (int) (special - start)); if (quote) { - Tcl_DStringAppend(&ds, "\"", 1); + TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index c508fdf..10437e6 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -889,8 +889,7 @@ GetValueNames( resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, - (int) (MAX_KEY_LENGTH*sizeof(TCHAR))); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); index = 0; result = TCL_OK; @@ -1192,8 +1191,7 @@ RecursiveDeleteKey( } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, - (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { @@ -1318,7 +1316,7 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); + TclDStringAppendObj(&data, objv[i]); /* * Add a null character to separate this value from the next. We diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 166fdfd..ca49d22 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2590,11 +2590,11 @@ InitializeHostName( Tcl_DStringInit(&inDs); Tcl_DStringSetLength(&inDs, 255); if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_DStringSetLength(&ds, 0); + Tcl_DStringLength(&inDs)) == 0) { + TclDStringClear(&ds); } else { - Tcl_ExternalToUtfDString(NULL, - Tcl_DStringValue(&inDs), -1, &ds); + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, + &ds); } Tcl_DStringFree(&inDs); } -- cgit v0.12 From afcb6fb00b921c929e09627a60fbcd16d77ac565 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 4 Jul 2012 00:07:51 +0000 Subject: missed a spot --- generic/tclFileName.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 63faa6d..edb6581 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1575,8 +1575,7 @@ Tcl_GlobObjCmd( Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&prefix, string, length); + TclDStringAppendObj(&prefix, objv[i]); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } -- cgit v0.12 From ea8dfc429f89bd1332ea57a3494d9dde638296fa Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 4 Jul 2012 13:41:14 +0000 Subject: only use public API in loaded packages; oops\! --- win/tclWinReg.c | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 10437e6..565188c 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -1316,16 +1316,15 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - TclDStringAppendObj(&data, objv[i]); + const char *bytes = Tcl_GetStringFromObj(objv[i], &length); + + Tcl_DStringAppend(&data, bytes, length); /* - * Add a null character to separate this value from the next. We - * accomplish this by growing the string by one byte. Since the - * DString always tacks on an extra null byte, the new byte will - * already be set to null. + * Add a null character to separate this value from the next. */ - Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); + Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, -- cgit v0.12 From 20266f1569a02073d42b92dc82be9bb625932f25 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 5 Jul 2012 07:45:35 +0000 Subject: protect Tcl_GetIndexFromObjStruct from empty strings in table --- generic/tclIndexObj.c | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 79fc262..1076e32 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -207,6 +207,10 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, entryPtr = NEXT_ENTRY(entryPtr, offset), i++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { + if (p1 == key) { + /* empty keys never match */ + continue; + } index = i; goto done; } @@ -260,24 +264,29 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, /* * Produce a fancy error message. */ - int count; + int count = 0; TclNewObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); + entryPtr = tablePtr; + while ((*entryPtr != NULL) && !**entryPtr) { + entryPtr = NEXT_ENTRY(entryPtr, offset); + } Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) && !(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", - key, "\": must be ", STRING_AT(tablePtr,offset,0), (char*)NULL); - for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; - *entryPtr != NULL; - entryPtr = NEXT_ENTRY(entryPtr, offset), count++) { + key, "\": must be ", *entryPtr, (char*)NULL); + entryPtr = NEXT_ENTRY(entryPtr, offset); + while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0) ? ", or " : " or ", *entryPtr, (char *) NULL); - } else { + } else if (**entryPtr) { Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, (char *) NULL); + count++; } + entryPtr = NEXT_ENTRY(entryPtr, offset); } } return TCL_ERROR; -- cgit v0.12 From 7976f45d25a13d51281a508362c232fa5bc770f1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 8 Jul 2012 10:23:47 +0000 Subject: add TCL_I_MODIFIER and use it in the correct places --- win/tclWinChan.c | 2 +- win/tclWinConsole.c | 2 +- win/tclWinInt.h | 6 ++++++ win/tclWinPipe.c | 2 +- win/tclWinSerial.c | 2 +- win/tclWinSock.c | 8 ++++---- 6 files changed, 14 insertions(+), 8 deletions(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 0f17834..a20cb8f 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -1337,7 +1337,7 @@ TclWinOpenFileChannel( infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - wsprintfA(channelName, "file%lx", PTR2INT(infoPtr)); + sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, (ClientData) infoPtr, permissions); diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 8be8e09..a86608c 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -1362,7 +1362,7 @@ TclWinOpenConsoleChannel( * for instance). */ - wsprintfA(channelName, "file%lx", PTR2INT(infoPtr)); + sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, (ClientData) infoPtr, permissions); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index a76865d..2f6659c 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -35,6 +35,12 @@ #define VER_PLATFORM_WIN32_CE 3 #endif +#ifdef _WIN64 +# define TCL_I_MODIFIER "I" +#else +# define TCL_I_MODIFIER "" +#endif + /* * The following structure keeps track of whether we are using the * multi-byte or the wide-character interfaces to the operating system. diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 0ef8d19..9a529d2 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1707,7 +1707,7 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - wsprintfA(channelName, "file%lx", infoPtr); + sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, (ClientData) infoPtr, infoPtr->validMask); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index fb092ff..1417c9c 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1499,7 +1499,7 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - wsprintfA(channelName, "file%lx", PTR2INT(infoPtr)); + sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, (ClientData) infoPtr, permissions); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 9591163..0560bbe 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1273,7 +1273,7 @@ Tcl_OpenTcpClient( return NULL; } - wsprintfA(channelName, "sock%d", infoPtr->socket); + sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); @@ -1338,7 +1338,7 @@ Tcl_MakeTcpClientChannel( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); - wsprintfA(channelName, "sock%d", infoPtr->socket); + sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); @@ -1391,7 +1391,7 @@ Tcl_OpenTcpServer( infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; - wsprintfA(channelName, "sock%d", infoPtr->socket); + sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) infoPtr, 0); @@ -1497,7 +1497,7 @@ TcpAccept( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) newInfoPtr); - wsprintfA(channelName, "sock%d", newInfoPtr->socket); + sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)newInfoPtr->socket); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", -- cgit v0.12 From 144e5850fb84e5be697789d2c35577a63f0b12dd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 8 Jul 2012 10:26:20 +0000 Subject: and don't forget the % --- win/tclWinChan.c | 2 +- win/tclWinConsole.c | 2 +- win/tclWinSerial.c | 2 +- win/tclWinSock.c | 8 ++++---- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index a20cb8f..8aa2772 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -1337,7 +1337,7 @@ TclWinOpenFileChannel( infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, (ClientData) infoPtr, permissions); diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index a86608c..ea295fe 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -1362,7 +1362,7 @@ TclWinOpenConsoleChannel( * for instance). */ - sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName, (ClientData) infoPtr, permissions); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 1417c9c..62eafda 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1499,7 +1499,7 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, (ClientData) infoPtr, permissions); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 0560bbe..18afb01 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1273,7 +1273,7 @@ Tcl_OpenTcpClient( return NULL; } - sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); @@ -1338,7 +1338,7 @@ Tcl_MakeTcpClientChannel( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr); - sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); @@ -1391,7 +1391,7 @@ Tcl_OpenTcpServer( infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; - sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)infoPtr->socket); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) infoPtr, 0); @@ -1497,7 +1497,7 @@ TcpAccept( SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) newInfoPtr); - sprintf(channelName, "sock" TCL_I_MODIFIER "u", (size_t)newInfoPtr->socket); + sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t)newInfoPtr->socket); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, (ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", -- cgit v0.12 From abeb1a6a1e7d636379b0071d7a33a4395b6ec707 Mon Sep 17 00:00:00 2001 From: max Date: Sun, 8 Jul 2012 10:55:49 +0000 Subject: Add fix and test for URLs that contain literal IPv6 addresses. [Bug 3531209] --- ChangeLog | 5 +++++ library/http/http.tcl | 7 +++++-- tests/http.test | 7 +++++++ 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 72c588d..68e7f70 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-08 Reinhard Max + + * library/http/http.tcl: Add fix and test for URLs that contain + * tests/http.test: literal IPv6 addresses. [Bug 3531209] + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/library/http/http.tcl b/library/http/http.tcl index b5ce82b..2653c3e 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -419,7 +419,6 @@ proc http::geturl {url args} { # Note that the RE actually combines the user and password parts, as # recommended in RFC 3986. Indeed, that RFC states that putting passwords # in URLs is a Really Bad Idea, something with which I would agree utterly. - # Also note that we do not currently support IPv6 addresses. # # From a validation perspective, we need to ensure that the parts of the # URL that are going to the server are correctly encoded. This is only @@ -434,7 +433,10 @@ proc http::geturl {url args} { [^@/\#?]+ # ) @ )? - ( [^/:\#?]+ ) # + ( # + [^/:\#?]+ | # host name or IPv4 address + \[ [^/\#?]+ \] # IPv6 address in square brackets + ) (?: : (\d+) )? # )? ( / [^\#]*)? # (including query) @@ -448,6 +450,7 @@ proc http::geturl {url args} { return -code error "Unsupported URL: $url" } # Phase two: validate + set host [string trim $host {[]}]; # strip square brackets from IPv6 address if {$host eq ""} { # Caller has to provide a host name; we do not have a "default host" # that would enable us to handle relative URLs. diff --git a/tests/http.test b/tests/http.test index 37d4a05..fe44b47 100644 --- a/tests/http.test +++ b/tests/http.test @@ -135,6 +135,7 @@ set fullurl http://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost +set ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] http::data $token @@ -390,6 +391,12 @@ Connection close Content-Type {text/plain;charset=utf-8} Accept-Encoding .* Content-Length 5} +test http-3.29 "http::geturl $ipv6url" -body { + set token [http::geturl $ipv6url -validate 1] + http::code $token +} -cleanup { + http::cleanup $token +} -result "HTTP/1.0 200 OK" test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] -- cgit v0.12 From fd5b9630b9a19d7acec452b7812d9b5d2edbaf42 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 10 Jul 2012 11:03:23 +0000 Subject: * win/tclWinSock.c (InitializeHostName): Corrected logic that extracted the name of the computer from the gethostname call so that it would use the name on success, not failure. Also ensured that the buffer size is exactly that recommended by Microsoft. --- ChangeLog | 7 +++++++ win/tclWinSock.c | 16 ++++++---------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index dbf9e2e..1d3ba82 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-07-10 Donal K. Fellows + + * win/tclWinSock.c (InitializeHostName): Corrected logic that + extracted the name of the computer from the gethostname call so that + it would use the name on success, not failure. Also ensured that the + buffer size is exactly that recommended by Microsoft. + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 18afb01..63f166d 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2431,22 +2431,18 @@ InitializeHostName( Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { /* - * Buffer length of 255 copied slavishly from previous version of - * this routine. Presumably there's a more "correct" macro value - * for a properly sized buffer for a gethostname() call. - * Maintainers are welcome to supply it. + * The buffer size of 256 is recommended by the MSDN page that + * documents gethostname() as being always adequate. */ Tcl_DString inDs; Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 255); + Tcl_DStringSetLength(&inDs, 256); if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_DStringSetLength(&ds, 0); - } else { - Tcl_ExternalToUtfDString(NULL, - Tcl_DStringValue(&inDs), -1, &ds); + Tcl_DStringLength(&inDs)) == 0) { + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, + &ds); } Tcl_DStringFree(&inDs); } -- cgit v0.12 From 1986497dc33675f9e32672bfb453c46abf7bccb9 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 10 Jul 2012 18:21:33 +0000 Subject: Update changes, repair ChangeLog --- ChangeLog | 107 ++++++++++++++++++++++++++++++++------------------------------ changes | 72 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 127 insertions(+), 52 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1d3ba82..8b8e49a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -98,9 +98,9 @@ 2012-05-25 Jan Nijtmans - * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent, - now for XTYP_EXECUTE as well as XTYP_REQUEST. - * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX + * win/tclWinDde.c: [Bug 473946] special characters not correctly + * win/Makefile.in: sent, now for XTYP_EXECUTE as well as + XTYP_REQUEST. Fix "make genstubs" when cross-compiling on UNIX 2012-05-24 Jan Nijtmans @@ -149,22 +149,23 @@ 2012-05-13 Jan Nijtmans - * win/tclWinDde.c: Protect against receiving strings without ending \0, - as external applications (or Tcl with TIP #106) could generate that. + * win/tclWinDde.c: Protect against receiving strings without + ending \0, as external applications (or Tcl with TIP #106) could + generate that. 2012-05-10 Jan Nijtmans - * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent - * library/dde/pkgIndex.tcl Increase version to 1.3.3 + * win/tclWinDde.c: [Bug 473946] special characters not + * library/dde/pkgIndex.tcl: correctly sent. Bump to 1.3.3 2012-05-02 Jan Nijtmans - * generic/configure.in: Better detection and implementation for cpuid - * generic/configure: instruction on Intel-derived processors, both - * generic/tclUnixCompat.c: 32-bit and 64-bit. - * generic/tclTest.c: Move cpuid testcase from win-specific to generic - * win/tclWinTest.c: tests, as it should work on all Intel-related - * tests/platform.test: platforms now + * generic/configure.in: Better detection and implementation for + * generic/configure: cpuid instruction on Intel-derived + * generic/tclUnixCompat.c: processors, both 32-bit and 64-bit. + * generic/tclTest.c: Move cpuid testcase from win-specific + * win/tclWinTest.c: to generic tests, as it should work on + * tests/platform.test: all Intel-related platforms now 2012-04-27 Jan Nijtmans @@ -188,10 +189,10 @@ 2012-04-24 Jan Nijtmans - * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh - * generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt, TclWinGetServByName - * generic/tclStubInit.c: and TclWinCPUID for Cygwin - * generic/tclUnixCompat.c: + * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin + * generic/tclIntPlatDecls.h: tclsh Implement TclWinGetSockOpt, + * generic/tclStubInit.c: TclWinGetServByName and TclWinCPUID + * generic/tclUnixCompat.c: for Cygwin. * unix/configure.in: * unix/configure: * unix/tclUnixCompat.c: @@ -213,7 +214,7 @@ 2012-04-11 Jan Nijtmans - * win/tclWinInit.c: [Bug 3448512]: clock scan "1958-01-01" fails only + * win/tclWinInit.c: [Bug 3448512] [clock scan 1958-01-01] fails * win/tcl.m4: in debug compilation. * win/configure: * unix/tcl.m4: Use NDEBUG consistantly meaning: no debugging. @@ -221,25 +222,26 @@ 2012-04-04 Jan Nijtmans - * win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs plat imp - * generic/tclIOSock.c: + * win/tclWinSock.c: [Bug 510001] TclSockMinimumBuffers needs + * generic/tclIOSock.c: platform implementation. * generic/tclInt.decls: * generic/tclIntDecls.h: * generic/tclStubInit.c: 2012-04-03 Jan Nijtmans - * generic/tclStubInit.c Remove the TclpGetTZName implementation for - * generic/tclIntDecls.h: Cygwin (from previous commit) , re-generated - * generic/tclIntPlatDecls.h: - * generic/tcl.decls: cleanup unnecessary "generic" argument + * generic/tclStubInit.c: Remove the TclpGetTZName implementation + * generic/tclIntDecls.h: for Cygwin (from previous commit) , + * generic/tclIntPlatDecls.h: re-generated + * generic/tcl.decls: cleanup unnecessary "generic" argument 2012-03-30 Jan Nijtmans - * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh - * generic/tclIntPlatDecls.h: Implement TclWinGetTclInstance, TclpGetTZName, - * generic/tclStubInit.c: and various more win32-specific internal functions for - Cygwin, so win32 extensions using those can be loaded in the cygwin version of tclsh. + * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin + * generic/tclIntPlatDecls.h: tclsh. Implement TclWinGetTclInstance, + * generic/tclStubInit.c: TclpGetTZName, and various more + win32-specific internal functions for Cygwin, so win32 extensions + using those can be loaded in the cygwin version of tclsh. 2012-03-30 Jan Nijtmans @@ -252,38 +254,40 @@ 2012-03-27 Jan Nijtmans - * generic/tcl.h: [Bug 3508771] Wrong Tcl_StatBuf used on MinGW - * generic/tclFCmd.c: [Bug 2015723] duplicate inodes from file stat on - windows (but now for cygwin as well) + * generic/tcl.h: [Bug 3508771] Wrong Tcl_StatBuf used on MinGW + * generic/tclFCmd.c: [Bug 2015723] duplicate inodes from file stat + on windows (but now for cygwin as well) 2012-03-25 Jan Nijtmans - * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh - * generic/tclIntPlatDecls.h: Implement TclWinConvertError, TclWinConvertWSAError, - * generic/tclStubInit.c: and various more win32-specific internal functions for - * unix/Makefile.in: Cygwin, so win32 extensions using those can be - * unix/tcl.m4: loaded in the cygwin version of tclsh. - * unix/configure: - * win/tclWinError.c: + * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin + * generic/tclIntPlatDecls.h: tclsh. Implement TclWinConvertError, + * generic/tclStubInit.c: TclWinConvertWSAError, and various more + * unix/Makefile.in: win32-specific internal functions for + * unix/tcl.m4: Cygwin, so win32 extensions using those + * unix/configure: can be loaded in the cygwin version + * win/tclWinError.c: of tclsh. 2012-03-23 Jan Nijtmans - * generic/tclInt.decls Revert some cygwin-related signature changes from - * generic/tclIntPlatDecls.h [835f8e1e9d] (2010-02-01). They were an attempt to - * win/tclWinError.c make the cygwin port compile again, but since cygwin - is based on unix this serves no purpose any more. - * unix/Makefile.in Add tclWinError.c to the CYGWIN build. - * unix/tcl.m4 - * unix/configure + * generic/tclInt.decls: Revert some cygwin-related signature + * generic/tclIntPlatDecls.h: changes from [835f8e1e9d] (2010-02-01). + * win/tclWinError.c: They were an attempt to make the cygwin + port compile again, but since cygwin is based on unix this serves no + purpose any more. + + * unix/Makefile.in: Add tclWinError.c to the CYGWIN build. + * unix/tcl.m4: + * unix/configure: 2012-03-20 Jan Nijtmans - * generic/tcl.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh - * generic/tclInt.decls: Implement TclWinGetPlatformId, Tcl_WinUtfToTChar, - * generic/tclIntPlatDecls.h: Tcl_WinTCharToUtf (and a dummy TclWinCPUID) for - * generic/tclPlatDecls.h: Cygwin, so win32 extensions using those can be - * generic/tclStubInit.c: loaded in the cygwin version of tclsh. - * unix/tclUnixCompat.c: + * generic/tcl.decls: [Bug 3508771] load tclreg.dll in cygwin + * generic/tclInt.decls: tclsh. Implement TclWinGetPlatformId, + * generic/tclIntPlatDecls.h: Tcl_WinUtfToTChar, Tcl_WinTCharToUtf + * generic/tclPlatDecls.h: (and a dummy TclWinCPUID) for Cygwin, + * generic/tclStubInit.c: so win32 extensions using those can be + * unix/tclUnixCompat.c: loaded in the cygwin version of tclsh. 2012-03-19 Venkat Iyer @@ -505,7 +509,6 @@ * library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work when tclsh is compiled without using the setargv() function on mingw. - (no need to incr the version, since 2.2.10 is never released) 2011-11-29 Jan Nijtmans diff --git a/changes b/changes index 0442b3a..e2d04d2 100644 --- a/changes +++ b/changes @@ -7581,3 +7581,75 @@ like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter) 2011-10-15 tzdata updated to Olson's tzdata2011l (iyer) --- Released 8.5.11, November 4, 2011 --- See ChangeLog for details --- + +2011-11-22 (bug fix)[2935503] Win: [file mtime] sets wrong time (nijtmans) + +2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans) +=> tcltest 2.3.4 + +2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans) + +2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans) + +2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans) + +2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny) + +2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows) +=> http 2.7.8 + +2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres) + +2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows) + +2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter) + +2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix +problems where [file *able] would return false results on Win/Samba (porter) + +2012-02-02 (update)[3464401] Support Unicode 6.1 (nijtmans) + +2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer) + +2012-02-09 (bug fix)[3484402] mem corrupt OBOE in unicode append (porter) + +2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows) + +2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans) + +2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans) + +2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries) +=> http 2.7.9 + +2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans) + +2012-04-18 tzdata updated to Olson's tzdata2012c (kenny) + +2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans) + +2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans) +=> dde 1.3.3 + +2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows) + +2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows) + *** POTENTIAL INCOMPATIBILITY *** + +2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans) +=> registry 1.2.2 + +2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows) + +2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system] +and Tcl_FSMountsChanged(). (porter) + +2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans) +=> msgcat 1.4.5 + +2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) + +Many revisions to better support a Cygwin environment (nijtmans) + +--- Released 8.5.12, July 16, 2011 --- See ChangeLog for details --- + -- cgit v0.12 From 46bc5ba547cd8ffb93338b768173ce8ba5dc4a72 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 10 Jul 2012 18:28:48 +0000 Subject: [Bug 3541646] Don't panic on triggerPipe overrun --- ChangeLog | 4 ++++ unix/tclUnixNotfy.c | 10 +++++----- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8b8e49a..704fd06 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-07-10 Jan Nijtmans + + * unix/tclUnixNotfy.c: [Bug 3541646] Don't panic on triggerPipe overrun + 2012-07-10 Donal K. Fellows * win/tclWinSock.c (InitializeHostName): Corrected logic that diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 904c9db..42cc7be 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -340,7 +340,7 @@ Tcl_FinalizeNotifier( */ if (write(triggerPipe, "q", 1) != 1) { - Tcl_Panic("Tcl_FinalizeNotifier: unable to write q to triggerPipe"); + Tcl_Panic("Tcl_FinalizeNotifier: unable to write q to triggerPipe"); } close(triggerPipe); while(triggerPipe >= 0) { @@ -879,8 +879,8 @@ Tcl_WaitForEvent( waitingListPtr = tsdPtr; tsdPtr->onList = 1; - if (write(triggerPipe, "", 1) != 1) { - Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); + if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); } } @@ -942,8 +942,8 @@ Tcl_WaitForEvent( } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; - if (write(triggerPipe, "", 1) != 1) { - Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); + if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); } } -- cgit v0.12 From 2f637c7fa9b533921164f3f424359d35ae2ae3ed Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 Jul 2012 15:54:20 +0000 Subject: Update changes for 8.6b3. --- changes | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 52 insertions(+), 10 deletions(-) diff --git a/changes b/changes index 9628937..11d196a 100644 --- a/changes +++ b/changes @@ -7976,20 +7976,24 @@ Many more Tcl built-in command errors now set an -errorcode. like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter) *** POTENTIAL INCOMPATIBILITY *** +2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows) + 2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter) 2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter) 2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows) -=> http 2.7.7 +=> http 2.8.3 + +2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans) -2011-09-16 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows) +2011-10-06 (enhancement) bytecode compile [dict with] (fellows) 2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans) -2011-10-15 tzdata updated to Olson's tzdata2011l (iyer) +2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows) ---- Released 8.6b3, November 20, 2011 --- See ChangeLog for details --- +2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter) 2011-11-22 (bug fix)[2935503] Win: [file mtime] sets wrong time (nijtmans) @@ -8005,14 +8009,17 @@ like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter) 2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny) 2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows) -=> http 2.7.8 2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres) 2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows) +2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows) + 2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter) +2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows) + 2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix problems where [file *able] would return false results on Win/Samba (porter) @@ -8020,31 +8027,64 @@ problems where [file *able] would return false results on Win/Samba (porter) 2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer) -2012-02-09 (bug fix)[3484402] mem corrupt OBOE in unicode append (porter) - 2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows) +2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows) + 2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans) 2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans) 2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries) -=> http 2.7.9 + +2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows) + *** POTENTIAL INCOMPATIBILITY *** + +2012-03-27 (TIP 397) method to extend [oo::copy] (fellows) + *** POTENTIAL INCOMPATIBILITY *** + +2012-03-27 (TIP 395) New subcommand [string is entier] (fellows) + +2012-04-02 (TIP 396) New command [yieldto] (fellows) + +2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows) + +2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows) + +2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows) 2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans) +2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows) + 2012-04-18 tzdata updated to Olson's tzdata2012c (kenny) +2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux) + *** POTENTIAL INCOMPATIBILITY *** + 2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans) +2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter) + +2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux) + 2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans) => dde 1.3.3 +2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows) + 2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows) 2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows) *** POTENTIAL INCOMPATIBILITY *** +2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann) + +2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event] +(fellows,ferrieux,kupries) + +2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows) + 2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans) => registry 1.2.2 @@ -8058,7 +8098,9 @@ and Tcl_FSMountsChanged(). (porter) 2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) -Many revisions to better support a Cygwin environment (nijtmans) +2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max) +=> http 2.8.4 ---- Released 8.5.12, July 16, 2011 --- See ChangeLog for details --- +Many revisions to better support a Cygwin environment (nijtmans) +--- Released 8.6b3, July 30, 2012 --- See ChangeLog for details --- -- cgit v0.12 From 28049f564d31e4cc25a6b185b016563d4e2726c0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 11 Jul 2012 19:24:12 +0000 Subject: [Bug #3362446]: registry keys command fails with 8.5/8.6. Follow Microsofts example better in order to prevent problems when using HKEY_PERFORMANCE_DATA. Forgot one important '%' --- ChangeLog | 6 ++++++ win/tclWinPipe.c | 2 +- win/tclWinReg.c | 2 +- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 704fd06..aecbf9c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-11 Jan Nijtmans + + * win/tclWinReg.c: [Bug #3362446]: registry keys command fails + with 8.5/8.6. Follow Microsofts example better in order to prevent + problems when using HKEY_PERFORMANCE_DATA. + 2012-07-10 Jan Nijtmans * unix/tclUnixNotfy.c: [Bug 3541646] Don't panic on triggerPipe overrun diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 9a529d2..b6764d4 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1707,7 +1707,7 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, (ClientData) infoPtr, infoPtr->validMask); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 343a22f..a6ce2ce 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -794,7 +794,7 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length *= 2; + length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2); Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); -- cgit v0.12 From f83bfff6e15b6245f0a1f51a13d7896d76b4fc98 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 11 Jul 2012 20:18:53 +0000 Subject: versions of dde and registry packages in "changes" file not correct --- changes | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/changes b/changes index 11d196a..7e3acf2 100644 --- a/changes +++ b/changes @@ -8069,7 +8069,6 @@ problems where [file *able] would return false results on Win/Samba (porter) 2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux) 2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans) -=> dde 1.3.3 2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows) @@ -8079,6 +8078,7 @@ problems where [file *able] would return false results on Win/Samba (porter) *** POTENTIAL INCOMPATIBILITY *** 2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann) +=> dde 1.4.0 2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event] (fellows,ferrieux,kupries) @@ -8086,7 +8086,7 @@ problems where [file *able] would return false results on Win/Samba (porter) 2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows) 2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans) -=> registry 1.2.2 +=> registry 1.3.0 2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows) -- cgit v0.12 From 4a91c94dd796861f32308f5536459fa37498e132 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 12 Jul 2012 08:09:29 +0000 Subject: dde version: 1.4.0b1 --- library/dde/pkgIndex.tcl | 4 ++-- win/tclWinDde.c | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index fef4f24..fc5b973 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,7 +1,7 @@ if {![package vsatisfies [package provide Tcl] 8.5]} return if {[info sharedlibextension] ne ".dll"} return if {[::tcl::pkgconfig get debug]} { - package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde] + package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14g.dll] dde] } else { - package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde] + package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14.dll] dde] } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index e40e114..183fe02 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -90,7 +90,7 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.4.0" +#define TCL_DDE_VERSION "1.4.0b1" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME TEXT("TclEval") #define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") -- cgit v0.12 From ad3c0d8addcd132eb23ae96bcc21ce59458cb67a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Jul 2012 08:09:59 +0000 Subject: Make registry 1.3 package dynamically loadable when ::tcl::pkgconfig is available --- ChangeLog | 5 +++++ library/reg/pkgIndex.tcl | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index e5c2dc7..198756f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-16 Jan Nijtmans + + * library/reg/pkgIndex.tcl: Make registry 1.3 package dynamically + loadable in Tcl 8.4.20. + 2012-07-11 Jan Nijtmans * win/tclWinReg.c: [Bug #3362446]: registry keys command fails diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index f71b09f..55af4b3 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,5 +1,5 @@ -if {![package vsatisfies [package provide Tcl] 8.5]} return -if {[info sharedlibextension] ne ".dll"} return +if {([info commands ::tcl::pkgconfig] eq "") + || ([info sharedlibextension] ne ".dll")} return if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.0 \ [list load [file join $dir tclreg13g.dll] registry] -- cgit v0.12