From c43b4e2fb3dc24ce531f8c61a781d35d8f6c3617 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 10 Jul 2012 14:00:46 +0000 Subject: Release candidate branch for Tcl 8.5.12. --- README | 2 +- generic/tcl.h | 4 ++-- library/init.tcl | 2 +- tools/tcl.wse.in | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- unix/tclConfig.h.in | 13 ++++++++----- win/configure | 2 +- win/configure.in | 2 +- 10 files changed, 18 insertions(+), 15 deletions(-) diff --git a/README b/README index b3bbc2e..f7cf68c 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.5.11 source distribution. + This is the Tcl 8.5.12 source distribution. http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. diff --git a/generic/tcl.h b/generic/tcl.h index ec6f9b0..29a95a8 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -58,10 +58,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 5 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 11 +#define TCL_RELEASE_SERIAL 12 #define TCL_VERSION "8.5" -#define TCL_PATCH_LEVEL "8.5.11" +#define TCL_PATCH_LEVEL "8.5.12" /* * The following definitions set up the proper options for Windows compilers. diff --git a/library/init.tcl b/library/init.tcl index 28689ab..f6dfdba 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.5.11 +package require -exact Tcl 8.5.12 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in index 69690a8..1baddfe 100644 --- a/tools/tcl.wse.in +++ b/tools/tcl.wse.in @@ -12,7 +12,7 @@ item: Global Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 - Disk Label=tcl8.5.11 + Disk Label=tcl8.5.12 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 diff --git a/unix/configure b/unix/configure index 0603bfc..753f7c0 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".11" +TCL_PATCH_LEVEL=".12" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index 5f0fe0b..8bab86e 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".11" +TCL_PATCH_LEVEL=".12" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index a91a53b..265cca4 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.5.11 +Version: 8.5.12 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 1f1513d..9774ce9 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -19,8 +19,8 @@ /* Define to 1 if the system has the type `blkcnt_t'. */ #undef HAVE_BLKCNT_T -/* Do we have BSDgettimeofday()? */ -#undef HAVE_BSDGETTIMEOFDAY +/* Defined when compiler supports casting to union type. */ +#undef HAVE_CAST_TO_UNION /* Define to 1 if you have the `chflags' function. */ #undef HAVE_CHFLAGS @@ -34,6 +34,9 @@ /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION +/* Is the cpuid instruction usable? */ +#undef HAVE_CPUID + /* Do we have fts functions? */ #undef HAVE_FTS @@ -256,6 +259,9 @@ /* Default libtommath precision. */ #undef MP_PREC +/* Is no debugging enabled? */ +#undef NDEBUG + /* Is Darwin CoreFoundation unavailable for 64-bit? */ #undef NO_COREFOUNDATION_64 @@ -340,9 +346,6 @@ /* What encoding should be used for embedded configuration info? */ #undef TCL_CFGVAL_ENCODING -/* Is debugging enabled? */ -#undef NDEBUG - /* Is this a 64-bit build? */ #undef TCL_CFG_DO64BIT diff --git a/win/configure b/win/configure index b74dd39..4f73e97 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".11" +TCL_PATCH_LEVEL=".12" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 diff --git a/win/configure.in b/win/configure.in index 955ba29..71e677d 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".11" +TCL_PATCH_LEVEL=".12" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 -- cgit v0.12 From 5cb86aa574bf8ab539797a9b908bb87db6e5b91e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Jul 2012 08:03:17 +0000 Subject: Make registry 1.3 package (and possibly others) dynamically loadable in Tcl 8.4 Reverted. No good reason to partially hack 8.5 features into (only one patch release of) 8.4. If you need to support Tcl 8.4, just don't use [tcl::pkgconfig]. If you're set on moving to [tcl::pkgconfig], then that's an 8.5 features and you're choosing to drop 8.4 support. --- ChangeLog | 5 +++++ library/init.tcl | 58 +++++++++++++++++++++++++++++++++++++------------------- tests/init.test | 9 ++++++--- 3 files changed, 50 insertions(+), 22 deletions(-) diff --git a/ChangeLog b/ChangeLog index de29b61..8ad896e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-16 Jan Nijtmans + + * library/init.tcl: Make registry 1.3 package (and possibly others) + * tests/init.test: dynamically loadable in Tcl 8.4. + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/library/init.tcl b/library/init.tcl index f2f85e1..4c4b6db 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -66,7 +66,7 @@ namespace eval tcl { } } } - + # Windows specific end of initialization if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} { @@ -187,7 +187,7 @@ proc unknown args { # may get modified if caught errors occur below. The variables will # be restored just before re-executing the missing command. - # Safety check in case something unsets the variables + # Safety check in case something unsets the variables # ::errorInfo or ::errorCode. [Bug 1063707] if {![info exists errorCode]} { set errorCode "" @@ -222,7 +222,7 @@ proc unknown args { if {$code == 1} { # # Compute stack trace contribution from the [uplevel]. - # Note the dependence on how Tcl_AddErrorInfo, etc. + # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # set cinfo $args @@ -340,7 +340,7 @@ proc unknown args { # library file to create the procedure. Returns 1 if it successfully # loaded the procedure, 0 otherwise. # -# Arguments: +# Arguments: # cmd - Name of the command to find and load. # namespace (optional) The namespace where the command is being used - must be # a canonical namespace as returned [namespace current] @@ -364,7 +364,7 @@ proc auto_load {cmd {namespace {}}} { # info commands $name # Unfortunately, if the name has glob-magic chars in it like * # or [], it may not match. For our purposes here, a better - # route is to use + # route is to use # namespace which -command $name if {[namespace which -command $name] ne ""} { return 1 @@ -395,7 +395,7 @@ proc auto_load {cmd {namespace {}}} { # of available commands. Returns 1 if the index is loaded, and 0 if # the index is already loaded and up to date. # -# Arguments: +# Arguments: # None. proc auto_load_index {} { @@ -424,7 +424,7 @@ proc auto_load_index {} { eval [read $f] } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { - if {[string index $line 0] eq "#" + if {[string index $line 0] eq "#" || ([llength $line] != 2)} { continue } @@ -484,7 +484,7 @@ proc auto_qualify {cmd namespace} { return [list [string range $cmd 2 end]] } } - + # Potentially returning 2 elements to try : # (if the current namespace is not the global one) @@ -542,13 +542,13 @@ proc auto_import {pattern} { # auto_execok -- # -# Returns string that indicates name of program to execute if +# Returns string that indicates name of program to execute if # name corresponds to a shell builtin or an executable in the -# Windows search path, or "" otherwise. Builds an associative -# array auto_execs that caches information about previous checks, +# Windows search path, or "" otherwise. Builds an associative +# array auto_execs that caches information about previous checks, # for speed. # -# Arguments: +# Arguments: # name - Name of a command. if {$tcl_platform(platform) eq "windows"} { @@ -603,7 +603,7 @@ proc auto_execok name { set path "[file dirname [info nameof]];.;" if {[info exists env(WINDIR)]} { - set windir $env(WINDIR) + set windir $env(WINDIR) } if {[info exists windir]} { if {$tcl_platform(os) eq "Windows NT"} { @@ -668,13 +668,13 @@ proc auto_execok name { # This procedure is called by Tcl's core when attempts to call the # filesystem's copydirectory function fail. The semantics of the call # are that 'dest' does not yet exist, i.e. dest should become the exact -# image of src. If dest does exist, we throw an error. -# +# image of src. If dest does exist, we throw an error. +# # Note that making changes to this procedure can change the results # of running Tcl's tests. # -# Arguments: -# action - "renaming" or "copying" +# Arguments: +# action - "renaming" or "copying" # src - source directory # dest - destination directory proc tcl::CopyDirectory {action src dest} { @@ -729,12 +729,12 @@ proc tcl::CopyDirectory {action src dest} { # Have to be careful to capture both visible and hidden files. # We will also be more generous to the file system and not # assume the hidden and non-hidden lists are non-overlapping. - # + # # On Unix 'hidden' files begin with '.'. On other platforms # or filesystems hidden files may have other interpretations. set filelist [concat [glob -nocomplain -directory $src *] \ [glob -nocomplain -directory $src -types hidden *]] - + foreach s [lsort -unique $filelist] { if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { file copy $s [file join $dest [file tail $s]] @@ -742,3 +742,23 @@ proc tcl::CopyDirectory {action src dest} { } return } + +# ::tcl::pkgconfig -- +# +# This procedure is undocumented. It is meant to make the dde +# and registry packages distributed with Tcl 8.6 and the Thread +# 2.7 package (and possibly others) dynamically loadable in Tcl 8.4. +# +# Arguments: +# action - "get" +# key - "debug" or "threaded" +proc tcl::pkgconfig {{action {}} {key {}} args} { + if {$action eq "get"} { + if {$key eq "debug"} { + return [info exists ::tcl_platform(debug)] + } elseif {$key eq "threaded"} { + return [info exists ::tcl_platform(threaded)] + } + } + error {invalid command name "::tcl::pkgconfig"} +} diff --git a/tests/init.test b/tests/init.test index 79142c4..c46ba48 100644 --- a/tests/init.test +++ b/tests/init.test @@ -117,13 +117,11 @@ test init-2.6 {load setLogCmd from safe:: - stage 1} { rename ::safe::setLogCmd {} ; # should not fail } {} -test init-2.7 {oad setLogCmd from safe:: - stage 2} { +test init-2.7 {load setLogCmd from safe:: - stage 2} { namespace eval safe setLogCmd rename ::safe::setLogCmd {} ; # should not fail } {} - - test init-2.8 {load tcl::HistAdd} -setup { auto_reset catch {rename ::tcl::HistAdd {}} @@ -134,6 +132,11 @@ test init-2.8 {load tcl::HistAdd} -setup { rename ::tcl::HistAdd {} ; } -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}} +test init-2.9 {undocumented tcl::pkgconfig} -setup { +} -body { + list [catch {::tcl::pkgconfig} error] $error + } -cleanup { +} -result {1 {invalid command name "::tcl::pkgconfig"}} test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { -- cgit v0.12 From 799c4229bbacec663e81638c968ec14cfe8c12d5 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 16 Jul 2012 22:28:49 +0000 Subject: Fix mostly-harmless minor buffer overrun. --- ChangeLog | 6 ++++++ generic/tclUtil.c | 4 ++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 198756f..a76590b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-16 Donal K. Fellows + + * generic/tclUtil.c (UpdateStringOfEndOffset): [Bug 3544658]: Stop + 1-byte overrun in memcpy, that object placement rules made harmless + but which still caused compiler complaints. + 2012-07-16 Jan Nijtmans * library/reg/pkgIndex.tcl: Make registry 1.3 package dynamically diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 3379f6c..63c9fb2 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3426,10 +3426,10 @@ static void UpdateStringOfEndOffset( register Tcl_Obj *objPtr) { - char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1]; + char buffer[TCL_INTEGER_SPACE + 5]; register int len; - memcpy(buffer, "end", sizeof("end") + 1); + memcpy(buffer, "end", 4); len = sizeof("end") - 1; if (objPtr->internalRep.longValue != 0) { buffer[len++] = '-'; -- cgit v0.12 From cea9be24359eda18e04e8b95f9674a376a016675 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 16 Jul 2012 22:40:10 +0000 Subject: [Bug 3544683]: Backport of reentrancy fix for super-POSIX correctness of the passwd/group access functions. --- ChangeLog | 9 ++ unix/tclUnixCompat.c | 270 ++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 225 insertions(+), 54 deletions(-) diff --git a/ChangeLog b/ChangeLog index aecbf9c..ae28d4f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2012-07-16 Donal K. Fellows + + * unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam) + (TclpGetGrGid): [Bug 3544683]: Use the elaborate memory management + scheme outlined on http://www.opengroup.org/austin/docs/austin_328.txt + to handle Tcl's use of standard reentrant versions of the passwd/group + access functions so that everything can work on all BSDs. Problem + identified by Stuart Cassoff. + 2012-07-11 Jan Nijtmans * win/tclWinReg.c: [Bug #3362446]: registry keys command fails diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index f582c0c..8b067af 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -13,8 +13,10 @@ #include #include -/* See also: SC_BLOCKING_STYLE in unix/tcl.m4 +/* + * See also: SC_BLOCKING_STYLE in unix/tcl.m4 */ + #ifdef USE_FIONBIO # ifdef HAVE_SYS_FILIO_H # include /* For FIONBIO. */ @@ -23,39 +25,6 @@ # include # endif #endif /* USE_FIONBIO */ - -/* - *--------------------------------------------------------------------------- - * - * TclUnixSetBlockingMode -- - * - * Set the blocking mode of a file descriptor. - * - * Results: - * - * 0 on success, -1 (with errno set) on error. - * - *--------------------------------------------------------------------------- - */ -int -TclUnixSetBlockingMode( - int fd, /* File descriptor */ - int mode) /* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */ -{ -#ifndef USE_FIONBIO - int flags = fcntl(fd, F_GETFL); - - if (mode == TCL_MODE_BLOCKING) { - flags &= ~O_NONBLOCK; - } else { - flags |= O_NONBLOCK; - } - return fcntl(fd, F_SETFL, flags); -#else /* USE_FIONBIO */ - int state = (mode == TCL_MODE_NONBLOCKING); - return ioctl(fd, FIONBIO, &state); -#endif /* !USE_FIONBIO */ -} /* * Used to pad structures at size'd boundaries @@ -82,10 +51,22 @@ TclUnixSetBlockingMode( typedef struct ThreadSpecificData { struct passwd pwd; +#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5) +#define NEED_PW_CLEANER 1 + char *pbuf; + int pbuflen; +#else char pbuf[2048]; +#endif struct group grp; +#if defined(HAVE_GETGRNAM_R_5) || defined(HAVE_GETGRGID_R_5) +#define NEED_GR_CLEANER 1 + char *gbuf; + int gbuflen; +#else char gbuf[2048]; +#endif #if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR) struct hostent hent; @@ -124,14 +105,57 @@ static int CopyGrp(struct group *tgtPtr, char *buf, int buflen); static int CopyHostent(struct hostent *tgtPtr, char *buf, int buflen); static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen); -static int CopyString(CONST char *src, char *buf, int buflen); +static int CopyString(const char *src, char *buf, int buflen); #endif + +#ifdef NEED_PW_CLEANER +static void FreePwBuf(ClientData ignored); +#endif +#ifdef NEED_GR_CLEANER +static void FreeGrBuf(ClientData ignored); +#endif #endif /* TCL_THREADS */ /* *--------------------------------------------------------------------------- * + * TclUnixSetBlockingMode -- + * + * Set the blocking mode of a file descriptor. + * + * Results: + * + * 0 on success, -1 (with errno set) on error. + * + *--------------------------------------------------------------------------- + */ + +int +TclUnixSetBlockingMode( + int fd, /* File descriptor */ + int mode) /* Either TCL_MODE_BLOCKING or + * TCL_MODE_NONBLOCKING. */ +{ +#ifndef USE_FIONBIO + int flags = fcntl(fd, F_GETFL); + + if (mode == TCL_MODE_BLOCKING) { + flags &= ~O_NONBLOCK; + } else { + flags |= O_NONBLOCK; + } + return fcntl(fd, F_SETFL, flags); +#else /* USE_FIONBIO */ + int state = (mode == TCL_MODE_NONBLOCKING); + + return ioctl(fd, FIONBIO, &state); +#endif /* !USE_FIONBIO */ +} + +/* + *--------------------------------------------------------------------------- + * * TclpGetPwNam -- * * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more @@ -158,8 +182,33 @@ TclpGetPwNam( #if defined(HAVE_GETPWNAM_R_5) struct passwd *pwPtr = NULL; - return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), - &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->pbuf == NULL) { + tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); + if (tsdPtr->pbuflen < 1) { + tsdPtr->pbuflen = 1024; + } + tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen); + Tcl_CreateThreadExitHandler(FreePwBuf, NULL); + } + while (1) { + int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, + &pwPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->pbuflen *= 2; + tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + } + return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWNAM_R_4) return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); @@ -214,8 +263,33 @@ TclpGetPwUid( #if defined(HAVE_GETPWUID_R_5) struct passwd *pwPtr = NULL; - return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), - &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->pbuf == NULL) { + tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX); + if (tsdPtr->pbuflen < 1) { + tsdPtr->pbuflen = 1024; + } + tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen); + Tcl_CreateThreadExitHandler(FreePwBuf, NULL); + } + while (1) { + int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen, + &pwPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->pbuflen *= 2; + tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + } + return (pwPtr != NULL ? &tsdPtr->pwd : NULL); #elif defined(HAVE_GETPWUID_R_4) return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); @@ -244,6 +318,29 @@ TclpGetPwUid( /* *--------------------------------------------------------------------------- * + * FreePwBuf -- + * + * Helper that is used to dispose of space allocated and referenced from + * the ThreadSpecificData for user entries. (Darn that baroque POSIX + * reentrant interface.) + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_PW_CLEANER +static void +FreePwBuf( + ClientData ignored) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + ckfree(tsdPtr->pbuf); +} +#endif /* NEED_PW_CLEANER */ + +/* + *--------------------------------------------------------------------------- + * * TclpGetGrNam -- * * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more @@ -267,11 +364,36 @@ TclpGetGrNam( #else ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); -#if defined(HAVE_GETGRNAM_R_5) +#ifdef HAVE_GETGRNAM_R_5 struct group *grPtr = NULL; - return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), - &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->gbuf == NULL) { + tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); + if (tsdPtr->gbuflen < 1) { + tsdPtr->gbuflen = 1024; + } + tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen); + Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); + } + while (1) { + int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, + &grPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->gbuflen *= 2; + tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + } + return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRNAM_R_4) return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); @@ -326,8 +448,33 @@ TclpGetGrGid( #if defined(HAVE_GETGRGID_R_5) struct group *grPtr = NULL; - return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), - &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; + /* + * How to allocate a buffer of the right initial size. If you want the + * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt + * and weep. + */ + + if (tsdPtr->gbuf == NULL) { + tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX); + if (tsdPtr->gbuflen < 1) { + tsdPtr->gbuflen = 1024; + } + tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen); + Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); + } + while (1) { + int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen, + &grPtr); + + if (e == 0) { + break; + } else if (e != ERANGE) { + return NULL; + } + tsdPtr->gbuflen *= 2; + tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + } + return (grPtr != NULL ? &tsdPtr->grp : NULL); #elif defined(HAVE_GETGRGID_R_4) return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); @@ -356,6 +503,29 @@ TclpGetGrGid( /* *--------------------------------------------------------------------------- * + * FreeGrBuf -- + * + * Helper that is used to dispose of space allocated and referenced from + * the ThreadSpecificData for group entries. (Darn that baroque POSIX + * reentrant interface.) + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_GR_CLEANER +static void +FreeGrBuf( + ClientData ignored) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + ckfree(tsdPtr->gbuf); +} +#endif /* NEED_GR_CLEANER */ + +/* + *--------------------------------------------------------------------------- + * * TclpGetHostByName -- * * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for @@ -769,7 +939,7 @@ CopyArray( #ifdef NEED_COPYSTRING static int CopyString( - CONST char *src, /* String to copy. */ + const char *src, /* String to copy. */ char *buf, /* Buffer to copy into. */ int buflen) /* Size of buffer. */ { @@ -788,14 +958,6 @@ CopyString( #endif /* NEED_COPYSTRING */ /* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - -/* *------------------------------------------------------------------------ * * TclWinCPUID -- @@ -831,7 +993,7 @@ TclWinCPUID( #endif return status; } - + /* * Local Variables: * mode: c -- cgit v0.12 From c3d3a271c991bac38669fea56c178afd0f5ce7c5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jul 2012 09:03:29 +0000 Subject: [Bug 3544943]: Version mismatch in rules.vc --- win/rules.vc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index f2ee135..3fbaaaf 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -598,7 +598,7 @@ TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib" COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" @@ -611,7 +611,7 @@ TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib" COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" -- cgit v0.12 From 65cd3b085a130ef32fbef6644dbdabe61dc096ca Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jul 2012 12:47:45 +0000 Subject: [Bug 3544932]: Visual studio compiler check fails --- ChangeLog | 4 ++++ win/makefile.vc | 7 +++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index de29b61..3c74475 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-07-17 Jan Nijtmans + + * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/win/makefile.vc b/win/makefile.vc index 426c907..d7845d3 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,10 +12,9 @@ # Copyright (c) 2001-2002 David Gravereaux. #------------------------------------------------------------------------------ -# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) -# or with the MS Platform SDK (MSSDK). Visual Studio .NET 2003 and 2005 define -# VCINSTALLDIR instead. -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(MSSDK) && !defined(VCINSTALLDIR) +# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or +# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) +!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WindowsSDKDir) MSG = ^ You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ Platform SDK first to setup the environment. Jump to this line to read^ -- cgit v0.12 From f8adb1ae9d512c8553f84f3ce489b2d90d6ee8ea Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 17 Jul 2012 13:07:07 +0000 Subject: should be uppercase --- win/makefile.vc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/makefile.vc b/win/makefile.vc index d7845d3..94a585b 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -14,7 +14,7 @@ # Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or # VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) -!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WindowsSDKDir) +!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) MSG = ^ You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ Platform SDK first to setup the environment. Jump to this line to read^ -- cgit v0.12 From 04a43cfcc84bbb38fb5ef52dd5dc736d7157549a Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 17 Jul 2012 17:08:30 +0000 Subject: Release note tidiness --- ChangeLog | 17 +++++++++++++++++ changes | 6 +++++- 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 9545bc9..ba8e126 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2012-07-17 Don Porter + + *** 8.5.12 TAGGED FOR RELEASE *** + + * generic/tcl.h: Bump to 8.5.12 for release. + * library/init.tcl: + * tools/tcl.wse.in: + * unix/configure.in: + * unix/tcl.spec: + * win/configure.in: + * README: + + * unix/configure: autoconf-2.59 + * win/configure: + + * changes: Update for 8.5.12 release. + 2012-07-17 Jan Nijtmans * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails diff --git a/changes b/changes index e2d04d2..201ca16 100644 --- a/changes +++ b/changes @@ -7649,7 +7649,11 @@ and Tcl_FSMountsChanged(). (porter) 2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) +2012-07-11 (bug fix)[3362446] [registry keys] failure (nijtmans) + +2012-07-16 (bug fix)[3544683] reentrant syscalls on BSD (cassoff,fellows) + Many revisions to better support a Cygwin environment (nijtmans) ---- Released 8.5.12, July 16, 2011 --- See ChangeLog for details --- +--- Released 8.5.12, July 20, 2011 --- See ChangeLog for details --- -- cgit v0.12 From b5337487d63c70b72986da7d9c35648f6a1e3b41 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 18 Jul 2012 06:36:09 +0000 Subject: FRQ-3544967: Missing objectfiles in static lib --- win/makefile.vc | 14 ++++++++++---- win/tclWinReg.c | 5 ++--- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 5183504..6bdcc07 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -83,8 +83,8 @@ the build instructions. # msvcrt(d). This is useful for static embedding # support. # staticpkg = Affects the static option only to switch -# tclshXX.exe to have the dde and reg extension linked -# inside it. +# tclXX.lib and tclshXX.exe to have the dde and +# reg extension linked inside it. # nothreads = Turns off full multithreading support. # thrdalloc = Use the thread allocator (shared global free pool) # This is the default on threaded builds. @@ -231,10 +231,12 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ @@ -243,10 +245,12 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\testMain.obj COREOBJS = \ @@ -428,11 +432,13 @@ PLATFORMOBJS = \ $(TMP_DIR)\tclWinSock.obj \ $(TMP_DIR)\tclWinThrd.obj \ $(TMP_DIR)\tclWinTime.obj \ -!if !$(STATIC_BUILD) +!if $(STATIC_BUILD) + $(TMP_DIR)\tclWinReg.obj \ + $(TMP_DIR)\tclWinDde.obj \ +!else $(TMP_DIR)\tcl.res !endif - TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index d2f233e..9c08b0c 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -13,9 +13,8 @@ */ #undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif +#undef USE_TCL_STUBS +#define USE_TCL_STUBS #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") -- cgit v0.12 From f88311f6c16e0304e81f8aad277697533fa2bbe6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 18 Jul 2012 08:42:24 +0000 Subject: same fore Makefile.in --- win/Makefile.in | 32 ++++++-------------------------- win/makefile.vc | 45 +++++++++++++++++++++++++-------------------- 2 files changed, 31 insertions(+), 46 deletions(-) diff --git a/win/Makefile.in b/win/Makefile.in index d5a335d..9d3ee7c 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -131,13 +131,13 @@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX} REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} +REG_LIB_FILE = @LIBPREFIX@tclreg$(DDEVER)${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} ZLIB_DLL_FILE = zlib1.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ -STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} TCLTEST = tcltest${EXEEXT} @@ -440,9 +440,9 @@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ -${TCL_LIB_FILE}: ${TCL_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} + @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ # assume GNU make @@ -451,31 +451,11 @@ ${TCL_LIB_FILE}: ${TCL_OBJS} # targets have to depend on tcl.lib, this ensures that linking of tcl.dll # does not execute concurrently with the renaming and recompiling of tcl.lib -${DDE_DLL_FILE}: ${DDE_OBJS} ${DDE_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${DDE_DLL_FILE} ${DDE_LIB_FILE}.sav - @-$(COPY) ${DDE_LIB_FILE} ${DDE_LIB_FILE}.sav +${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${DDE_LIB_FILE} - @-$(COPY) ${DDE_LIB_FILE}.sav ${DDE_LIB_FILE} - @-$(RM) ${DDE_LIB_FILE}.sav -${DDE_LIB_FILE}: ${DDE_OBJS} - @$(RM) ${DDE_LIB_FILE} - @MAKE_LIB@ ${DDE_OBJS} - @POST_MAKE_LIB@ - -${REG_DLL_FILE}: ${REG_OBJS} ${REG_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${REG_DLL_FILE} ${REG_LIB_FILE}.sav - @-$(COPY) ${REG_LIB_FILE} ${REG_LIB_FILE}.sav +${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${REG_LIB_FILE} - @-$(COPY) ${REG_LIB_FILE}.sav ${REG_LIB_FILE} - @-$(RM) ${REG_LIB_FILE}.sav - -${REG_LIB_FILE}: ${REG_OBJS} - @$(RM) ${REG_LIB_FILE} - @MAKE_LIB@ ${REG_OBJS} - @POST_MAKE_LIB@ ${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} diff --git a/win/makefile.vc b/win/makefile.vc index 6bdcc07..e4ca2b8 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -71,57 +71,62 @@ the build instructions. # Sets where to install Tcl from the built binaries. # C:\Progra~1\Tcl is assumed when not specified. # -# OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,unchecked,pdbs,none +# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # -# static = Builds a static library of the core instead of a -# dll. The shell will be static (and large), as well. +# loimpact = Adds a flag for how NT treats the heap to keep memory +# in use, low. This is said to impact alloc performance. # msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. -# staticpkg = Affects the static option only to switch -# tclXX.lib and tclshXX.exe to have the dde and -# reg extension linked inside it. # nothreads = Turns off full multithreading support. +# pdbs = Build detached symbols for release builds. +# profile = Adds profiling hooks. Map file is assumed. +# static = Builds a static library of the core instead of a +# dll. The static library will contain the dde and reg +# extensions. External applications who want to use +# this, need to link with the stub library as well as +# the static Tcl library.The shell will be static (and +# large), as well. +# staticpkg = Affects the static option only to switch +# tclshXX.exe to have the dde and reg extension linked +# inside it. +# symbols = Debug build. Links to the debug C runtime, disables +# optimizations and creates pdb symbols files. # thrdalloc = Use the thread allocator (shared global free pool) # This is the default on threaded builds. # tclalloc = Use the old non-thread allocator -# symbols = Debug build. Links to the debug C runtime, disables -# optimizations and creates pdb symbols files. -# pdbs = Build detached symbols for release builds. -# profile = Adds profiling hooks. Map file is assumed. -# loimpact = Adds a flag for how NT treats the heap to keep memory -# in use, low. This is said to impact alloc performance. # unchecked = Allows a symbols build to not use the debug # enabled runtime (msvcrt.dll not msvcrtd.dll # or libcmt.lib not libcmtd.lib). # -# STATS=memdbg,compdbg,none +# STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added # to the core. The default is for none. Any combination of the # above may be used (comma separated). 'none' will over-ride # everything to nothing. # -# memdbg = Enables the debugging memory allocator. # compdbg = Enables byte compilation logging. +# memdbg = Enables the debugging memory allocator. # -# CHECKS=nodep,fullwarn,64bit,none +# CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatability. # -# nodep = Turns off compatability macros to ensure the core -# isn't being built with deprecated functions. +# 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. -# 64bit = Enable 64bit portability warnings (if available) +# nodep = Turns off compatability macros to ensure the core +# isn't being built with deprecated functions. # # MACHINE=(IX86|IA64|AMD64|ALPHA) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default -# when not specified. +# when not specified. If the CPU environment variable has been +# set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR= # OUT_DIR= @@ -178,7 +183,7 @@ Please `cd` to its location first. !error $(MSG) !endif -PROJECT = tcl +PROJECT = tcl !include "rules.vc" STUBPREFIX = $(PROJECT)stub -- cgit v0.12 From 5d25eb85519189a6b1c66fb159cc39b7b753aa50 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 18 Jul 2012 11:12:43 +0000 Subject: better formatting of "configure --help" --- win/tcl.m4 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tcl.m4 b/win/tcl.m4 index 9320d89..2f2964b 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -211,7 +211,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, - [ --enable-shared build and link with shared libraries [--enable-shared]], + [ --enable-shared build and link with shared libraries (default: on)], [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then @@ -250,7 +250,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) - AC_ARG_ENABLE(threads, [ --enable-threads build with threads], + AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: off)], [tcl_ok=$enableval], [tcl_ok=no]) if test "$tcl_ok" = "yes"; then @@ -297,7 +297,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) - AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no]) + AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols (default: off)], [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. if test "$tcl_ok" = "no"; then CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)' @@ -1059,7 +1059,7 @@ AC_DEFUN([SC_BUILD_TCLSH], [ #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CFG_ENCODING], [ - AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) + AC_ARG_WITH(encoding, [ --with-encoding encoding for configuration values], with_tcencoding=${withval}) if test x"${with_tcencoding}" != x ; then AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}") -- cgit v0.12 From 684b78c255ef4acae3ec98ecc3219b7b61827f0e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 19 Jul 2012 09:18:45 +0000 Subject: fix fCmd-6.19 testcase on win32 (can't read "tmpspace": no such variable) --- tests/fCmd.test | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/fCmd.test b/tests/fCmd.test index 00147bb..96ab2d5 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -27,6 +27,7 @@ testConstraint notNetworkFilesystem 0 testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] testConstraint 2000orNewer [expr {![testConstraint 95or98]}] +set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that # require Unix groups. testConstraint foundGroup [expr {![testConstraint unix]}] -- cgit v0.12 From 4844d11a8c1213bf54dcfe78ae20c01dd5a49c7e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 19 Jul 2012 13:34:33 +0000 Subject: fix bug [3545366]: Win32 link normalization test failures --- tests/fileSystem.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 9950dde..64f4d45 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -305,7 +305,7 @@ test filesystem-1.39 {file normalisation with volume relative} -setup { file norm [string range $drv 0 1] } -cleanup { cd $old -} -match glob -result {*[^/]} +} -match regexp -result {.*[^/]} test filesystem-1.40 {file normalisation with repeated separators} { testPathEqual [file norm foo////bar] [file norm foo/bar] } ok -- cgit v0.12 From ce1d17821fa4d5f332ec9806f0c525d1241a8354 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 19 Jul 2012 13:41:08 +0000 Subject: Remove surplus parens --- generic/tclUtil.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 5119456..866b6ae 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2328,7 +2328,7 @@ TclStringMatchObj( trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ - if ((strObj->typePtr == &tclStringType)) { + if (strObj->typePtr == &tclStringType) { Tcl_UniChar *udata, *uptn; udata = Tcl_GetUnicodeFromObj(strObj, &length); -- cgit v0.12 From 30d6749651567f00c44c014361435942165bf372 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Thu, 19 Jul 2012 17:36:59 +0000 Subject: [Bug 3544685]: Missing mutex-lock in TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart Cassoff for spotting it. --- ChangeLog | 6 ++++++ generic/tclTest.c | 3 +++ 2 files changed, 9 insertions(+) diff --git a/ChangeLog b/ChangeLog index 9545bc9..2f4b307 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-19 Alexandre Ferrieux + + * generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in + TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart + Cassoff for spotting it. + 2012-07-17 Jan Nijtmans * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails diff --git a/generic/tclTest.c b/generic/tclTest.c index ab0c6cb..56ea232 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -821,6 +821,7 @@ TestasyncCmd( Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { + Tcl_MutexLock(&asyncTestMutex); while (firstHandler != NULL) { asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; @@ -828,6 +829,7 @@ TestasyncCmd( ckfree(asyncPtr->command); ckfree((char *) asyncPtr); } + Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; } if (argc != 3) { @@ -836,6 +838,7 @@ TestasyncCmd( if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } + Tcl_MutexLock(&asyncTestMutex); for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL; prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id != id) { -- cgit v0.12 From 3c3496770b84df1308f6cbd90ced02d636cedc04 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 19 Jul 2012 22:37:05 +0000 Subject: autoconf-2.59 --- win/configure | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/configure b/win/configure index b74dd39..3609a02 100755 --- a/win/configure +++ b/win/configure @@ -840,18 +840,18 @@ if test -n "$ac_init_help"; then Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --enable-threads build with threads - --enable-shared build and link with shared libraries --enable-shared + --enable-threads build with threads (default: off) + --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) - --enable-symbols build with debugging symbols --disable-symbols + --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --with-encoding encoding for configuration values + --with-encoding encoding for configuration values --with-celib=DIR use Windows/CE support library from DIR Some influential environment variables: -- cgit v0.12 From b21d13ee199f28daaeb3a66120cdd34791b860da Mon Sep 17 00:00:00 2001 From: Joe Mistachkin Date: Fri, 20 Jul 2012 01:47:48 +0000 Subject: Fix several more missing mutex-locks in TestasyncCmd. --- ChangeLog | 5 +++++ generic/tclTest.c | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/ChangeLog b/ChangeLog index 2f4b307..964c8e2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-19 Joe Mistachkin + + * generic/tclTest.c: Fix several more missing mutex-locks in + TestasyncCmd. + 2012-07-19 Alexandre Ferrieux * generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in diff --git a/generic/tclTest.c b/generic/tclTest.c index 56ea232..8dd315f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -863,6 +863,7 @@ TestasyncCmd( || (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) { return TCL_ERROR; } + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -870,6 +871,7 @@ TestasyncCmd( break; } } + Tcl_MutexUnlock(&asyncTestMutex); Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE); return code; #ifdef TCL_THREADS @@ -880,6 +882,7 @@ TestasyncCmd( if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -888,11 +891,13 @@ TestasyncCmd( (ClientData) INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { Tcl_SetResult(interp, "can't create thread", TCL_STATIC); + Tcl_MutexUnlock(&asyncTestMutex); return TCL_ERROR; } break; } } + Tcl_MutexUnlock(&asyncTestMutex); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, int, mark, or marklater", NULL); -- cgit v0.12 From 52e1c8fe0029c68ee9452e14b28ed1dc86c9a377 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Jul 2012 08:23:33 +0000 Subject: Add instrunctions how to (cross-)compile win32/win64 binaries on Linux, Darwin or Cygwin --- win/README | 44 ++++++++++++++++++++++++++++++++++++-------- 1 file changed, 36 insertions(+), 8 deletions(-) diff --git a/win/README b/win/README index 5e3d00f..36537ba 100644 --- a/win/README +++ b/win/README @@ -24,7 +24,28 @@ In order to compile Tcl for Windows, you need the following: or - Msys + Mingw [http://www.mingw.org/download.shtml] + Linux + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) + + or + + Cygwin + MinGW-w64 [http://cygwin.com/install.html] + (win32 or win64) + + or + + Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) + + or + + Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/] + (win32 or win64) + + or + + Msys + MinGW [http://www.mingw.org/download.shtml] + (win32 only) In practice, this release is built with Visual C++ 6.0 and the TEA @@ -40,19 +61,26 @@ using it, are in the comments of "makefile.vc". A quick example would be: There is also a Developer Studio workspace and project file, too, if you would like to use them. -If you are building with Msys, you can use the configure script that lives -in the win subdirectory. The Msys based configure/build process works just -like the UNIX one, so you will want to refer to ../unix/README for -available configure options. An error will be generated by the configure -script if you try to compile Tcl with the Cygwin version of gcc instead of -the Mingw version. Check your PATH if you get this error. +If you are building with Linux, Cygwin or Msys, you can use the configure +script that lives in the win subdirectory. The Linux/Cygwin/Msys based +configure/build process works just like the UNIX one, so you will want +to refer to ../unix/README for available configure options. + +If you want 64-bit executables (x86_64), you need to configure using +the --enable-64bit option. Make sure that the x86_64-w64-mingw32 +compiler is present. For Cygwin this compiler can be found in the +"mingw64-x86_64-gcc-core" package, which can be installed through +the normal Cygwin install process. If you only want 32-bit executables, +the "mingw64-i686-gcc-core" package is what you need. For Linux, Darwin +and Msys, you can download a suitable win32 or win64 compiler from +[https://sourceforge.net/projects/mingw-w64/files/] Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. Note that in order to run tclsh84.exe, you must ensure that tcl84.dll -and tclpip84.dll are on your path, in the system directory, or in the +and tclpip84.dll are on your path, in the system directory, or in the directory containing tclsh84.exe. Note: Tcl no longer provides support for Win32s. -- cgit v0.12 From 821b59510a1cc1f459d8f7bbbed21d937e750493 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Jul 2012 08:41:38 +0000 Subject: backport [e393e41a8d]: Fix several more missing mutex-locks in TestasyncCmd --- generic/tclTest.c | 33 ++++++++++++++++++++++++++++----- 1 file changed, 28 insertions(+), 5 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 588aff2..3bf4b58 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -65,6 +65,8 @@ typedef struct TestAsyncHandler { struct TestAsyncHandler *nextPtr; /* Next is list of handlers. */ } TestAsyncHandler; +TCL_DECLARE_MUTEX(asyncTestMutex); + static TestAsyncHandler *firstHandler = NULL; /* @@ -799,18 +801,20 @@ TestasyncCmd(dummy, interp, argc, argv) goto wrongNumArgs; } asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler)); + asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1)); + strcpy(asyncPtr->command, argv[2]); + Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; nextId++; asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, - (ClientData) asyncPtr); - asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1)); - strcpy(asyncPtr->command, argv[2]); + (ClientData) asyncPtr->id); asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; TclFormatInt(buf, asyncPtr->id); Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { + Tcl_MutexLock(&asyncTestMutex); while (firstHandler != NULL) { asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; @@ -818,6 +822,7 @@ TestasyncCmd(dummy, interp, argc, argv) ckfree(asyncPtr->command); ckfree((char *) asyncPtr); } + Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; } if (argc != 3) { @@ -826,6 +831,7 @@ TestasyncCmd(dummy, interp, argc, argv) if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } + Tcl_MutexLock(&asyncTestMutex); for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL; prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id != id) { @@ -841,6 +847,7 @@ TestasyncCmd(dummy, interp, argc, argv) ckfree((char *) asyncPtr); break; } + Tcl_MutexUnlock(&asyncTestMutex); } else if (strcmp(argv[1], "mark") == 0) { if (argc != 5) { goto wrongNumArgs; @@ -849,6 +856,7 @@ TestasyncCmd(dummy, interp, argc, argv) || (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) { return TCL_ERROR; } + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -856,6 +864,7 @@ TestasyncCmd(dummy, interp, argc, argv) break; } } + Tcl_MutexUnlock(&asyncTestMutex); Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE); return code; } else { @@ -869,15 +878,29 @@ TestasyncCmd(dummy, interp, argc, argv) static int AsyncHandlerProc(clientData, interp, code) - ClientData clientData; /* Pointer to TestAsyncHandler structure. */ + ClientData clientData; /* Id of TestAsyncHandler structure. + * in global list. */ Tcl_Interp *interp; /* Interpreter in which command was * executed, or NULL. */ int code; /* Current return code from command. */ { - TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData; + TestAsyncHandler *asyncPtr; + int id = (int)clientData; CONST char *listArgv[4], *cmd; char string[TCL_INTEGER_SPACE]; + Tcl_MutexLock(&asyncTestMutex); + for (asyncPtr = firstHandler; asyncPtr != NULL; + asyncPtr = asyncPtr->nextPtr) { + if (asyncPtr->id == id) break; + } + Tcl_MutexUnlock(&asyncTestMutex); + + if (!asyncPtr) { + /* Woops - this one was deleted between the AsyncMark and now */ + return TCL_OK; + } + TclFormatInt(string, code); listArgv[0] = asyncPtr->command; listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp)); -- cgit v0.12 From 19783d89c658745b7ae9c7bf9cfe5073233c7165 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 23 Jul 2012 14:20:15 +0000 Subject: Bug #3547593: fcmd test failures on Windows 7 WOW64 --- tests/winFCmd.test | 58 +++++++++--------------------------------------------- 1 file changed, 9 insertions(+), 49 deletions(-) diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 58a1b11..4e816a8 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -17,8 +17,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Initialise the test constraints -testConstraint win2000orXP 0 -testConstraint winOlderThan2000 0 testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testfile [llength [info commands testfile]] testConstraint testchmod [llength [info commands testchmod]] @@ -52,15 +50,6 @@ proc cleanup {args} { } } -if {[testConstraint winOnly]} { - if {[testConstraint nt] && [string index $tcl_platform(osVersion) 0]==5} { - # Warning: Win 6 will break this! - testConstraint win2000orXP 1 - } else { - testConstraint winOlderThan2000 1 - } -} - # find a CD-ROM so we can test read-only filesystems. proc findfile {dir} { @@ -188,18 +177,10 @@ test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {win testfile} { close $fd set msg } {1 EACCES} -test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {win win2000orXP testfile} { +test winFCmd-1.13 {TclpRenameFile: errno: EINVAL|EACCES|ENOENT} -constraints {win testfile} -body { cleanup list [catch {testfile mv nul tf1} msg] $msg -} {1 EINVAL} -test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} {win nt winOlderThan2000 testfile} { - cleanup - list [catch {testfile mv nul tf1} msg] $msg -} {1 EACCES} -test winFCmd-1.13.2 {TclpRenameFile: errno: ENOENT} {win 95 testfile} { - cleanup - list [catch {testfile mv nul tf1} msg] $msg -} {1 ENOENT} +} -match regexp -result {1 (EINVAL|EACCES|ENOENT)} test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {win 95 testfile} { cleanup createfile tf1 @@ -224,18 +205,10 @@ test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {win testfile} { cleanup list [catch {testfile mv tf1 tf2} msg] $msg } {1 ENOENT} -test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {win win2000orXP testfile} { - cleanup - list [catch {testfile mv nul tf1} msg] $msg -} {1 EINVAL} -test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} {win nt winOlderThan2000 testfile} { - cleanup - list [catch {testfile mv nul tf1} msg] $msg -} {1 EACCES} -test winFCmd-1.19.2 {TclpRenameFile: errno == ENOENT} {win 95 testfile} { +test winFCmd-1.19 {TclpRenameFile: errno == EINVAL|EACCES|ENOENT} -constraints {win testfile} -body { cleanup list [catch {testfile mv nul tf1} msg] $msg -} {1 ENOENT} +} -match regexp -result {1 (EINVAL|EACCES|ENOENT)} test winFCmd-1.20 {TclpRenameFile: src is dir} {win nt testfile} { # under 95, this would actually succeed and move the current dir out from # under the current process! @@ -377,18 +350,10 @@ test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {win 95 testfile} { close $fd set msg } {1 EACCES} -test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {win win2000orXP testfile} { - cleanup - list [catch {testfile cp nul tf1} msg] $msg -} {1 EINVAL} -test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} {win nt winOlderThan2000 testfile} { +test winFCmd-2.8 {TclpCopyFile: errno: EINVAL|EACCES|ENOENT} -constraints {win testfile} -body { cleanup list [catch {testfile cp nul tf1} msg] $msg -} {1 EACCES} -test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {win 95 testfile} { - cleanup - list [catch {testfile cp nul tf1} msg] $msg -} {1 ENOENT} +} -match regexp -result {1 (EINVAL|EACCES|ENOENT)} test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {win testfile} { cleanup createfile tf1 tf1 @@ -741,17 +706,12 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {win testfi createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 -} {tf1} -test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {win 95 testfile} { - cleanup - file mkdir td1 - list [catch {testfile cpdir td1 /} msg] $msg -} {1 {/ EEXIST}} -test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {win nt testfile} { +} {tf1} +test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -constraints {win testfile} -body { cleanup file mkdir td1 list [catch {testfile cpdir td1 /} msg] $msg -} {1 {/ EACCES}} +} -match regexp -result {1 {/ EEXIST|EACCES}} test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {win testfile} { cleanup file mkdir td1 -- cgit v0.12 From 28d0e97048a0a5b72d187f1effaca560640d69e3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 23 Jul 2012 14:45:19 +0000 Subject: use backslash and braces in regexp --- tests/winFCmd.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 4e816a8..ef1c4e7 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -711,7 +711,7 @@ test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -constraint cleanup file mkdir td1 list [catch {testfile cpdir td1 /} msg] $msg -} -match regexp -result {1 {/ EEXIST|EACCES}} +} -match regexp -result {1 \{/ (EEXIST|EACCES)\}} test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {win testfile} { cleanup file mkdir td1 -- cgit v0.12 From 52a0980ad1493619e824df3e4e9dea91c375bd74 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Mon, 23 Jul 2012 18:50:05 +0000 Subject: [Bug 3545365]: Never try a bg-flush on a dead channel, just like before 2011-08-17. --- ChangeLog | 5 +++++ generic/tclIO.c | 5 ++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 5c8c50a..1175302 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-23 Alexandre Ferrieux + + * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead + channel, just like before 2011-08-17. + 2012-07-19 Joe Mistachkin * generic/tclTest.c: Fix several more missing mutex-locks in diff --git a/generic/tclIO.c b/generic/tclIO.c index ea6c2d7..87d5727 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -427,7 +427,10 @@ TclFinalizeIOSubsystem(void) statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; - if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD) + if (GotFlag(statePtr, CHANNEL_DEAD)) { + continue; + } + if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; -- cgit v0.12 From b6beba7a55d8c9961e696f77bc85fdbf0af964ab Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 Jul 2012 20:14:23 +0000 Subject: Preserve the chanPtr so that script evaluation cannot invalidate it when we plan to use it again. --- generic/tclIO.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tclIO.c b/generic/tclIO.c index b9fa18d..eeca41b 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8347,6 +8347,7 @@ TclChannelEventScriptInvoker( */ Tcl_Preserve(interp); + Tcl_Preserve(chanPtr); result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL); /* @@ -8363,6 +8364,7 @@ TclChannelEventScriptInvoker( } TclBackgroundException(interp, result); } + Tcl_Release(chanPtr); Tcl_Release(interp); } -- cgit v0.12 From 58515791c8e55bf546d15634a8caef7f41cf3d26 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 Jul 2012 20:18:35 +0000 Subject: Preserve the chanPtr so that script evaluation cannot invalidate it when we plan to use it again. --- generic/tclIO.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tclIO.c b/generic/tclIO.c index a1d5447..b9cd30c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7540,6 +7540,7 @@ TclChannelEventScriptInvoker(clientData, mask) */ Tcl_Preserve((ClientData) interp); + Tcl_Preserve((ClientData) chanPtr); result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL); /* @@ -7556,6 +7557,7 @@ TclChannelEventScriptInvoker(clientData, mask) } Tcl_BackgroundError(interp); } + Tcl_Release((ClientData) chanPtr); Tcl_Release((ClientData) interp); } -- cgit v0.12 From 435ea67469544d205ef22229b350e6dca6917357 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 25 Jul 2012 08:10:19 +0000 Subject: sync with TEA, fix some comments --- unix/configure.in | 12 ++++++------ unix/install-sh | 4 ++-- win/configure | 8 ++++---- win/configure.in | 2 +- 4 files changed, 13 insertions(+), 13 deletions(-) diff --git a/unix/configure.in b/unix/configure.in index 79a546d..c8f0bc6 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -220,7 +220,7 @@ AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])]) SC_TCL_IPV6 -#-------------------------------------------------------------------- +#-------------------------------------------------------------------- # Look for thread-safe variants of some library functions. #-------------------------------------------------------------------- @@ -398,7 +398,7 @@ AC_CHECK_TYPE([intptr_t], [ for tcl_cv_intptr_t in "int" "long" "long long" none; do if test "$tcl_cv_intptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], - [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], + [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) @@ -414,7 +414,7 @@ AC_CHECK_TYPE([uintptr_t], [ none; do if test "$tcl_cv_uintptr_t" != none; then AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], - [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], + [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])], [tcl_ok=yes], [tcl_ok=no]) test "$tcl_ok" = yes && break; fi done]) @@ -681,7 +681,7 @@ AC_ARG_WITH(tzdata, # Any directories that get added here must also be added to the # search path in ::tcl::clock::Initialize (library/clock.tcl). # -case $tcl_ok in +case $tcl_ok in no) AC_MSG_RESULT([supplied by OS vendor]) ;; @@ -708,7 +708,7 @@ case $tcl_ok in fi ;; *) - AC_MSG_ERROR([invalid argument: $tcl_ok]) + AC_MSG_ERROR([invalid argument: $tcl_ok]) ;; esac if test $tcl_ok = yes @@ -782,7 +782,7 @@ TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX} eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}" # tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed -# since on some platforms TCL_LIB_FILE contains shell escapes. +# since on some platforms TCL_LIB_FILE contains shell escapes. # (See also: TCL_TRIM_DOTS). eval "TCL_LIB_FILE=${TCL_LIB_FILE}" diff --git a/unix/install-sh b/unix/install-sh index c68581d..7c34c3f 100755 --- a/unix/install-sh +++ b/unix/install-sh @@ -156,8 +156,8 @@ while test $# -ne 0; do -s) stripcmd=$stripprog;; - -S) stripcmd="$stripprog $2" - shift;; + -S) stripcmd="$stripprog $2" + shift;; -t) dst_arg=$2 shift;; diff --git a/win/configure b/win/configure index dcaef24..f5a23fe 100755 --- a/win/configure +++ b/win/configure @@ -840,7 +840,7 @@ if test -n "$ac_init_help"; then Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --enable-threads build with threads (default: off) + --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) @@ -3068,8 +3068,8 @@ else fi; if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + echo "$as_me:$LINENO: result: yes (default)" >&5 +echo "${ECHO_T}yes (default)" >&6 TCL_THREADS=1 cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 @@ -3598,8 +3598,8 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" - extra_ldflags="$extra_ldflags -pipe" extra_cflags="$extra_cflags -pipe" + extra_ldflags="$extra_ldflags -pipe" if test "${SHARED_BUILD}" = "0" ; then # static diff --git a/win/configure.in b/win/configure.in index 2377938..d17f815 100644 --- a/win/configure.in +++ b/win/configure.in @@ -219,7 +219,7 @@ if test "$tcl_cv_intrinsics" = "yes"; then [Defined when the compilers supports intrinsics]) fi -# See if the header file is present +# See if the header file is present AC_CACHE_CHECK(for wspiapi.h, tcl_cv_wspiapi_h, -- cgit v0.12 From bfff3b18a0b4f5b7cfa4e431e3901a149016e1c1 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Wed, 25 Jul 2012 09:57:03 +0000 Subject: [Bug 3547994]: Abandon the synchronous Windows pipe driver to its fate when needed to honour TIP#398. --- ChangeLog | 5 +++++ win/tclWinPipe.c | 26 ++++++++++++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1175302..0eb99af 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-25 Alexandre Ferrieux + + * win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows + pipe driver to its fate when needed to honour TIP#398. + 2012-07-23 Alexandre Ferrieux * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index cc696a2..f36f797 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1875,12 +1875,26 @@ PipeClose2Proc( && (pipePtr->writeFile != NULL)) { if (pipePtr->writeThread) { /* - * Wait for the writer thread to finish the current buffer, then - * terminate the thread and close the handles. If the channel is - * nonblocking, there should be no pending write operations. + * Wait for the writer thread to finish the current buffer, then + * terminate the thread and close the handles. If the channel is + * nonblocking but blocked during exit, bail out since the worker + * thread is not interruptible and we want TIP#398-fast-exit. */ + if (TclInExit() + && (pipePtr->flags & PIPE_ASYNC)) { - WaitForSingleObject(pipePtr->writable, INFINITE); + /* give it a chance to leave honorably */ + SetEvent(pipePtr->stopWriter); + + if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) { + return EAGAIN; + } + + } else { + + WaitForSingleObject(pipePtr->writable, INFINITE); + + } /* * The thread may already have closed on it's own. Check its exit @@ -2945,6 +2959,10 @@ PipeWriterThread( * an error, so exit. */ + if (waitResult == WAIT_OBJECT_0) { + SetEvent(infoPtr->writable); + } + break; } -- cgit v0.12 From b9396412d1de53f593f45c1e8255723da954c9cd Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 Jul 2012 14:34:36 +0000 Subject: :q! --- library/init.tcl | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index f2f85e1..02bce3b 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -618,11 +618,14 @@ proc auto_execok name { } } - foreach dir [split $path {;}] { - # Skip already checked directories - if {[info exists checked($dir)] || $dir eq {}} { continue } - set checked($dir) {} - foreach ext $execExtensions { + foreach ext $execExtensions { + unset -nocomplain checked + foreach dir [split $path {;}] { + # Skip already checked directories + if {[info exists checked($dir)] || $dir eq {}} { + continue + } + set checked($dir) {} set file [file join $dir ${name}${ext}] if {[file exists $file] && ![file isdirectory $file]} { return [set auto_execs($name) [list $file]] -- cgit v0.12 From 3b6f6e4d4166d6ba00d2886efd6136f30e906f82 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 Jul 2012 14:56:49 +0000 Subject: update changes --- changes | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/changes b/changes index e2d04d2..ba08980 100644 --- a/changes +++ b/changes @@ -7649,7 +7649,11 @@ and Tcl_FSMountsChanged(). (porter) 2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) +2012-07-24 (bug fix) stop mem corruption in stacked channel events (max,porter) + +2012-07-25 (bug fix)[3546275] [auto_execok] search match [exec] (danckaert) + Many revisions to better support a Cygwin environment (nijtmans) ---- Released 8.5.12, July 16, 2011 --- See ChangeLog for details --- +--- Released 8.5.12, July 27, 2011 --- See ChangeLog for details --- -- cgit v0.12 From 951791b64cbd1a79f2c1fe704f3ce406e83d5dce Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 26 Jul 2012 22:17:03 +0000 Subject: use forward slashes in $ROOT, whenever the path is handled by tclsh/tcltest fix TCL_LIBRARY value in "test-core" rule --- win/makefile.vc | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 5183504..4c93069 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -564,15 +564,15 @@ install: install-binaries install-libraries install-docs install-pkgs test: test-core test-pkgs test-core: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT:\=/)/../library + set TCL_LIBRARY=$(ROOT:\=/)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" - $(DEBUGGER) $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << + $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << set ::ddelib [file normalize $(TCLDDELIB:\=/)] set ::reglib [file normalize $(TCLREGLIB:\=/)] << !else @echo Please wait while the tests are collected... - $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log + $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log set ::ddelib [file normalize $(TCLDDELIB:\=/)] set ::reglib [file normalize $(TCLREGLIB:\=/)] << @@ -580,11 +580,11 @@ test-core: setup $(TCLTEST) dlls $(CAT32) !endif runtest: setup $(TCLTEST) dlls $(CAT32) - set TCL_LIBRARY=$(ROOT)/library + set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) $(SCRIPT) runshell: setup $(TCLSH) dlls - set TCL_LIBRARY=$(ROOT)/library + set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLSH) $(SCRIPT) setup: @@ -819,7 +819,6 @@ install-docs: @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\" !endif -#" #--------------------------------------------------------------------- # Build tclConfig.sh for the TEA build system. #--------------------------------------------------------------------- @@ -1158,15 +1157,15 @@ install-libraries: tclConfig install-msgs install-tzdata install-tzdata: @echo Installing time zone data - @set TCL_LIBRARY=$(ROOT)/library - @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \ - "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + @set TCL_LIBRARY=$(ROOT:\=/)/library + @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ + "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" install-msgs: @echo Installing message catalogs - @set TCL_LIBRARY=$(ROOT)/library - @$(TCLSH_NATIVE) "$(ROOT)/tools/installData.tcl" \ - "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" + @set TCL_LIBRARY=$(ROOT:\=/)/library + @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \ + "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" #--------------------------------------------------------------------- # Clean up -- cgit v0.12 From 4a52037c93838a968824b5e2f3d4f9b2f8034c34 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 27 Jul 2012 21:45:12 +0000 Subject: Support Unicode 6.2 (Add Turkish lira sign) --- ChangeLog | 5 +++++ generic/regc_locale.c | 2 +- generic/tclUniData.c | 2 +- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3c74475..3052221 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-27 Jan Nijtmans + + * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign) + * generic/regc_locale.c: + 2012-07-17 Jan Nijtmans * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 6c421d7..6fd831d 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -617,7 +617,7 @@ static CONST crange graphRangeTable[] = { {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, - {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20b9}, {0x20d0, 0x20f0}, + {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20ba}, {0x20d0, 0x20f0}, {0x2100, 0x2189}, {0x2190, 0x23f3}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x26ff}, {0x2701, 0x2b4c}, {0x2b50, 0x2b59}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, diff --git a/generic/tclUniData.c b/generic/tclUniData.c index 5218f48..bbe1204 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -882,7 +882,7 @@ static CONST unsigned char groupMap[] = { 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -- cgit v0.12 From fac7c80aed10356b5116daca1d8b8a160aa1d18d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 28 Jul 2012 14:52:43 +0000 Subject: [Bug 3549770] Multiple test failures running tcltest outside build tree --- ChangeLog | 6 ++++++ tests/clock.test | 4 ++-- tests/registry.test | 11 +++++------ tests/winDde.test | 19 ++++++++++--------- 4 files changed, 23 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4918ede..14cb0b2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-28 Jan Nijtmans + + * tests/clock.test: [Bug 3549770] Multiple test failures running tcltest + * tests/registry.test: outside build tree + * tests/winDde.test: + 2012-07-27 Jan Nijtmans * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign) diff --git a/tests/clock.test b/tests/clock.test index 42675a5..5db6273 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -17,8 +17,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } if {[testConstraint win]} { - if {[catch {package require registry 1.1}] - && [catch {load {} Registry}] + if {[catch {load {} Registry}] + && [catch {package require registry}] && [catch { ::tcltest::loadTestedCommands load $::reglib Registry diff --git a/tests/registry.test b/tests/registry.test index f90f602..cda914f 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -17,13 +17,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint reg 0 if {[testConstraint win]} { - catch { - # Is the registry extension already static to this shell? - if [catch {load {} Registry; set ::reglib {}}] { - # try the location given to use on the commandline to tcltest + if {![catch {load {} Registry}] + || ![catch {package require registry}] + || ![catch { ::tcltest::loadTestedCommands load $::reglib Registry - } + }]} { testConstraint reg 1 } } @@ -460,7 +459,7 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba r baz" -test registry-6.21 {GetValue: very long value names and values} {pcOnly} { +test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} { registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 199] [string repeat x 199] multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 199]] registry delete HKEY_CURRENT_USER\\TclFoobar diff --git a/tests/winDde.test b/tests/winDde.test index 9c777c3..b684394 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -15,17 +15,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +testConstraint dde 0 if {[testConstraint win]} { - if [catch { - # Is the dde extension already static to this shell? - if [catch {load {} Dde; set ::ddelib {}}] { - # try the location given to use on the commandline to tcltest + if {![catch {load {} Dde; set ::ddelib {}}] + || ![catch { + package require dde + set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}] + || ![catch { ::tcltest::loadTestedCommands - load $::ddelib Dde - } + load $::ddelib Dde}]} { testConstraint dde 1 - }] { - testConstraint dde 0 } } @@ -41,8 +40,10 @@ proc createChildProcess { ddeServerName {handler {}}} { set f [open $::scriptName w+] puts $f [list set ddeServerName $ddeServerName] - if {$::ddelib != ""} { + if {[info exists ::ddelib]} { puts $f [list load $::ddelib Dde] + } else { + puts $f [list package require dde] } puts $f { # DDE child server - -- cgit v0.12 From a8b104c3b5ef5cf3721b20a37d48360b90f77a10 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 28 Jul 2012 22:54:19 +0000 Subject: Bug [3549770]: Multiple test failures running tcltest outside build tree --- tests/clock.test | 6 ++---- tests/registry.test | 6 ++---- tests/winDde.test | 17 +++++------------ win/Makefile.in | 8 ++++---- win/makefile.vc | 8 ++++---- 5 files changed, 17 insertions(+), 28 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 5db6273..fea1fc9 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -17,11 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } if {[testConstraint win]} { - if {[catch {load {} Registry}] - && [catch {package require registry}] - && [catch { + if {[catch { ::tcltest::loadTestedCommands - load $::reglib Registry + package require registry }]} { namespace eval ::tcl::clock {variable NoRegistry {}} } diff --git a/tests/registry.test b/tests/registry.test index cda914f..cbca4fd 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -17,11 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint reg 0 if {[testConstraint win]} { - if {![catch {load {} Registry}] - || ![catch {package require registry}] - || ![catch { + if {![catch { ::tcltest::loadTestedCommands - load $::reglib Registry + package require registry }]} { testConstraint reg 1 } diff --git a/tests/winDde.test b/tests/winDde.test index b684394..f0ef56c 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -17,13 +17,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint dde 0 if {[testConstraint win]} { - if {![catch {load {} Dde; set ::ddelib {}}] - || ![catch { - package require dde - set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}] - || ![catch { + if {![catch { ::tcltest::loadTestedCommands - load $::ddelib Dde}]} { + package require dde + set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}]} { testConstraint dde 1 } } @@ -35,16 +32,12 @@ if {[testConstraint win]} { set scriptName [makeFile {} script1.tcl] -proc createChildProcess { ddeServerName {handler {}}} { +proc createChildProcess {ddeServerName {handler {}}} { file delete -force $::scriptName set f [open $::scriptName w+] puts $f [list set ddeServerName $ddeServerName] - if {[info exists ::ddelib]} { - puts $f [list load $::ddelib Dde] - } else { - puts $f [list package require dde] - } + puts $f [list load $::ddelib dde] puts $f { # DDE child server - # diff --git a/win/Makefile.in b/win/Makefile.in index a06cc3f..8e01818 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -696,14 +696,14 @@ install-private-headers: libraries test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32) + -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT) + ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` diff --git a/win/makefile.vc b/win/makefile.vc index e453df1..5db8143 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -527,14 +527,14 @@ test: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry] << !else @echo Please wait while the tests are collected... $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry] << type tests.log | more !endif -- cgit v0.12 From e14b7fdff9f29b4251760d69f301abf129265921 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 29 Jul 2012 16:23:27 +0000 Subject: No longer build tcltest.exe to run the tests,but use tclsh86.exe in combination with tcltest86.dll to do that (Windows only) --- ChangeLog | 6 ++++++ tests/assocd.test | 3 +++ tests/async.test | 3 +++ tests/basic.test | 3 +++ tests/chanio.test | 3 +++ tests/cmdAH.test | 3 +++ tests/cmdIL.test | 3 +++ tests/cmdInfo.test | 3 +++ tests/compExpr-old.test | 3 +++ tests/compExpr.test | 3 +++ tests/compile.test | 3 +++ tests/coroutine.test | 3 +++ tests/dcall.test | 3 +++ tests/dstring.test | 3 +++ tests/encoding.test | 3 +++ tests/event.test | 3 +++ tests/execute.test | 3 +++ tests/expr-old.test | 3 +++ tests/expr.test | 3 +++ tests/fCmd.test | 3 +++ tests/fileName.test | 3 +++ tests/fileSystem.test | 3 +++ tests/get.test | 3 +++ tests/indexObj.test | 3 +++ tests/info.test | 3 +++ tests/interp.test | 3 +++ tests/io.test | 4 ++++ tests/ioCmd.test | 3 +++ tests/ioTrans.test | 3 +++ tests/iogt.test | 4 ++++ tests/lindex.test | 3 +++ tests/link.test | 3 +++ tests/listObj.test | 3 +++ tests/load.test | 3 +++ tests/lset.test | 3 +++ tests/misc.test | 3 +++ tests/namespace.test | 3 +++ tests/notify.test | 3 +++ tests/nre.test | 3 +++ tests/obj.test | 3 +++ tests/parse.test | 3 +++ tests/parseExpr.test | 3 +++ tests/parseOld.test | 3 +++ tests/platform.test | 3 +++ tests/reg.test | 3 +++ tests/rename.test | 3 +++ tests/resolver.test | 3 +++ tests/result.test | 3 +++ tests/set.test | 3 +++ tests/string.test | 3 +++ tests/stringComp.test | 3 +++ tests/stringObj.test | 3 +++ tests/tailcall.test | 3 +++ tests/thread.test | 3 +++ tests/trace.test | 3 +++ tests/unixFCmd.test | 3 +++ tests/unixFile.test | 3 +++ tests/unload.test | 3 +++ tests/upvar.test | 3 +++ tests/utf.test | 3 +++ tests/util.test | 3 +++ tests/var.test | 3 +++ tests/winFCmd.test | 3 +++ tests/winFile.test | 3 +++ tests/winNotify.test | 3 +++ tests/winTime.test | 3 +++ win/Makefile.in | 22 +++++++++------------- 67 files changed, 212 insertions(+), 13 deletions(-) diff --git a/ChangeLog b/ChangeLog index c7312dd..0212deb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-29 Jan Nijtmans + + * win/Makefile.in: No longer build tcltest.exe to run the tests, + but use tclsh86.exe in combination with tcltest86.dll to do that. + * tests/*.test: load tcltest86.dll if necessary. + 2012-07-28 Jan Nijtmans * tests/clock.test: [Bug 3549770] Multiple test failures running tcltest diff --git a/tests/assocd.test b/tests/assocd.test index 1ca1c9b..d1489b3 100644 --- a/tests/assocd.test +++ b/tests/assocd.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testgetassocdata [llength [info commands testgetassocdata]] testConstraint testsetassocdata [llength [info commands testsetassocdata]] testConstraint testdelassocdata [llength [info commands testdelassocdata]] diff --git a/tests/async.test b/tests/async.test index 35dda88..cb67cc2 100644 --- a/tests/async.test +++ b/tests/async.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testasync [llength [info commands testasync]] testConstraint threaded [::tcl::pkgconfig get threaded] diff --git a/tests/basic.test b/tests/basic.test index e072bea..7435571 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -18,6 +18,9 @@ package require tcltest 2 namespace import -force ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testevalex [llength [info commands testevalex]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] testConstraint testcreatecommand [llength [info commands testcreatecommand]] diff --git a/tests/chanio.test b/tests/chanio.test index fbc9854..9bb11f7 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -29,6 +29,9 @@ namespace eval ::tcl::test::io { variable msg variable expected + ::tcltest::loadTestedCommands + catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testchannel [llength [info commands testchannel]] testConstraint exec [llength [info commands exec]] testConstraint openpipe 1 diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 291df8d..2ecf626 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -15,6 +15,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 4b1002a..efb0bce 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -13,6 +13,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index 86aa6e1..69d7171 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.test @@ -18,6 +18,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testcmdinfo [llength [info commands testcmdinfo]] testConstraint testcmdtoken [llength [info commands testcmdtoken]] diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bb19151..bae26a0 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { testConstraint testmathfunctions 0 } else { diff --git a/tests/compExpr.test b/tests/compExpr.test index 8e27f1f..14c875d 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -13,6 +13,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { testConstraint testmathfunctions 0 } else { diff --git a/tests/compile.test b/tests/compile.test index d6048be..4d91940 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -14,6 +14,9 @@ package require tcltest 2 namespace import -force ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint exec [llength [info commands exec]] testConstraint memory [llength [info commands memory]] testConstraint testevalex [llength [info commands testevalex]] diff --git a/tests/coroutine.test b/tests/coroutine.test index 7f40a7b..8272717 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -14,6 +14,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testnrelevels [llength [info commands testnrelevels]] testConstraint memory [llength [info commands memory]] diff --git a/tests/dcall.test b/tests/dcall.test index 8977c31..3df0ac8 100644 --- a/tests/dcall.test +++ b/tests/dcall.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testdcall [llength [info commands testdcall]] test dcall-1.1 {deletion callbacks} testdcall { diff --git a/tests/dstring.test b/tests/dstring.test index bcc304d..06121a3 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -16,6 +16,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testdstring [llength [info commands testdstring]] if {[testConstraint testdstring]} { testdstring free diff --git a/tests/encoding.test b/tests/encoding.test index b4ee7c3..47bb81e 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -15,6 +15,9 @@ namespace eval ::tcl::test::encoding { namespace import -force ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + proc toutf {args} { variable x lappend x "toutf $args" diff --git a/tests/event.test b/tests/event.test index 0ee7558..6da43a5 100644 --- a/tests/event.test +++ b/tests/event.test @@ -12,6 +12,9 @@ package require tcltest 2 namespace import -force ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] testConstraint testfilewait [llength [info commands testfilewait]] diff --git a/tests/execute.test b/tests/execute.test index 012b3a7..94af158 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -19,6 +19,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} catch {unset x} diff --git a/tests/expr-old.test b/tests/expr-old.test index c05a925..4f3cb2e 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -18,6 +18,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testexprlong [llength [info commands testexprlong]] testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] diff --git a/tests/expr.test b/tests/expr.test index 6679569..6ad7208 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testmathfunctions [expr { ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"}) }] diff --git a/tests/fCmd.test b/tests/fCmd.test index 72b7da9..325b374 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -15,6 +15,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + cd [temporaryDirectory] testConstraint testsetplatform [llength [info commands testsetplatform]] diff --git a/tests/fileName.test b/tests/fileName.test index 251f12c..19503f8 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -15,6 +15,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] testConstraint linkDirectory 1 diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 64f4d45..638c427 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -19,6 +19,9 @@ namespace eval ::tcl::test::fileSystem { file delete -force [file join dir.dir linkinside.file] } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] diff --git a/tests/get.test b/tests/get.test index 40ec98f..d51ec6d 100644 --- a/tests/get.test +++ b/tests/get.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testgetint [llength [info commands testgetint]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] diff --git a/tests/indexObj.test b/tests/indexObj.test index 479cc3b..646cb02 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -13,6 +13,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testindexobj [llength [info commands testindexobj]] testConstraint testparseargs [llength [info commands testparseargs]] diff --git a/tests/info.test b/tests/info.test index 3323281..2ce9ecc 100644 --- a/tests/info.test +++ b/tests/info.test @@ -20,6 +20,9 @@ if {{::tcltest} ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. diff --git a/tests/interp.test b/tests/interp.test index ab91f77..0af9887 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -15,6 +15,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testinterpdelete [llength [info commands testinterpdelete]] set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload} diff --git a/tests/io.test b/tests/io.test index f3c39f4..9621138 100644 --- a/tests/io.test +++ b/tests/io.test @@ -17,6 +17,10 @@ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return } + +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + namespace eval ::tcl::test::io { namespace import ::tcltest::* diff --git a/tests/ioCmd.test b/tests/ioCmd.test index cf913ff..5eb0206 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -18,6 +18,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Custom constraints used in this file testConstraint fcopy [llength [info commands fcopy]] testConstraint testchannel [llength [info commands testchannel]] diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 7da4329..db9a2cb 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}] diff --git a/tests/iogt.test b/tests/iogt.test index 60d7ab8..d4c31d2 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -14,6 +14,10 @@ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." return } + +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + namespace eval ::tcl::test::iogt { namespace import ::tcltest::* diff --git a/tests/lindex.test b/tests/lindex.test index 07abff8..b86e2e0 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + set minus - testConstraint testevalex [llength [info commands testevalex]] diff --git a/tests/link.test b/tests/link.test index 60d0799..00e490c 100644 --- a/tests/link.test +++ b/tests/link.test @@ -16,6 +16,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testlink [llength [info commands testlink]] foreach i {int real bool string} { diff --git a/tests/listObj.test b/tests/listObj.test index 53017b1..8b24aa9 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testobj [llength [info commands testobj]] catch {unset x} diff --git a/tests/load.test b/tests/load.test index b7c1a59..22d6803 100644 --- a/tests/load.test +++ b/tests/load.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { diff --git a/tests/lset.test b/tests/lset.test index 3f4914d..1c1300b 100644 --- a/tests/lset.test +++ b/tests/lset.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + proc failTrace {name1 name2 op} { error "trace failed" } diff --git a/tests/misc.test b/tests/misc.test index fe19ebe..6ddc718 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testhashsystemhash [llength [info commands testhashsystemhash]] test misc-1.1 {error in variable ref. in command in array reference} { diff --git a/tests/namespace.test b/tests/namespace.test index f07d8cf..1d46bf0 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -16,6 +16,9 @@ package require tcltest 2 namespace import -force ::tcltest::* testConstraint memory [llength [info commands memory]] +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # # REMARK: the tests for 'namespace upvar' are not done here. They are to be # found in the file 'upvar.test'. diff --git a/tests/notify.test b/tests/notify.test index ba52c50..d2b9123 100755 --- a/tests/notify.test +++ b/tests/notify.test @@ -18,6 +18,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testevent [llength [info commands testevent]] test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \ diff --git a/tests/nre.test b/tests/nre.test index 295f02e..b8ef2e0 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -14,6 +14,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testnrelevels [llength [info commands testnrelevels]] # diff --git a/tests/obj.test b/tests/obj.test index 126d5ca..71a39b4 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] diff --git a/tests/parse.test b/tests/parse.test index 3523975..0f76d64 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -16,6 +16,9 @@ if {[catch {package require tcltest 2.0.2}]} { namespace eval ::tcl::test::parse { namespace import ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testparser [llength [info commands testparser]] testConstraint testevalobjv [llength [info commands testevalobjv]] testConstraint testevalex [llength [info commands testevalex]] diff --git a/tests/parseExpr.test b/tests/parseExpr.test index cd0342a..7910974 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -13,6 +13,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Note that the Tcl expression parser (tclCompExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands diff --git a/tests/parseOld.test b/tests/parseOld.test index 132481c..0edcbf0 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -18,6 +18,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testwordend [llength [info commands testwordend]] # Save the argv value for restoration later diff --git a/tests/platform.test b/tests/platform.test index 92ca7ab..aab7c78 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -14,6 +14,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testCPUID [llength [info commands testcpuid]] test platform-1.1 {TclpSetVariables: tcl_platform} { diff --git a/tests/reg.test b/tests/reg.test index abfc9ca..a0ea850 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -13,6 +13,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # All tests require the testregexp command, return if this # command doesn't exist diff --git a/tests/rename.test b/tests/rename.test index 9ac49b4..1fa0441 100644 --- a/tests/rename.test +++ b/tests/rename.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testdel [llength [info commands testdel]] # Must eliminate the "unknown" command while the test is running, especially diff --git a/tests/resolver.test b/tests/resolver.test index bb9f59d..e73ea50 100644 --- a/tests/resolver.test +++ b/tests/resolver.test @@ -15,6 +15,9 @@ if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testinterpresolver [llength [info commands testinterpresolver]] test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup { diff --git a/tests/result.test b/tests/result.test index f080654..3391ce1 100644 --- a/tests/result.test +++ b/tests/result.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Some tests require the testsaveresult command testConstraint testsaveresult [llength [info commands testsaveresult]] diff --git a/tests/set.test b/tests/set.test index 9e0ddc0..1d88553 100644 --- a/tests/set.test +++ b/tests/set.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testset2 [llength [info commands testset2]] catch {unset x} diff --git a/tests/string.test b/tests/string.test index b3326ae..8cacd07 100644 --- a/tests/string.test +++ b/tests/string.test @@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] diff --git a/tests/stringComp.test b/tests/stringComp.test index ff18819..56fb69d 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -20,6 +20,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] diff --git a/tests/stringObj.test b/tests/stringObj.test index d93bb82..6f331d3 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testobj [llength [info commands testobj]] testConstraint testdstring [llength [info commands testdstring]] diff --git a/tests/tailcall.test b/tests/tailcall.test index e9ec188..2d04f82 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -14,6 +14,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testnrelevels [llength [info commands testnrelevels]] # diff --git a/tests/thread.test b/tests/thread.test index 44789fa..f2735da 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Some tests require the testthread command testConstraint testthread [expr {[info commands testthread] != {}}] diff --git a/tests/trace.test b/tests/trace.test index 693dbad..0f48dcf 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testcmdtrace [llength [info commands testcmdtrace]] testConstraint testevalobjv [llength [info commands testevalobjv]] diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index e8148e9..2453e01 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -14,6 +14,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testchmod [llength [info commands testchmod]] # These tests really need to be run from a writable directory, which diff --git a/tests/unixFile.test b/tests/unixFile.test index 0ea0ec1..8147f48 100644 --- a/tests/unixFile.test +++ b/tests/unixFile.test @@ -14,6 +14,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testfindexecutable [llength [info commands testfindexecutable]] set oldpwd [pwd] diff --git a/tests/unload.test b/tests/unload.test index a103cc5..5a374c4 100644 --- a/tests/unload.test +++ b/tests/unload.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { diff --git a/tests/upvar.test b/tests/upvar.test index cd78c31..e2c9ffd 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -16,6 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testupvar [llength [info commands testupvar]] test upvar-1.1 {reading variables with upvar} { diff --git a/tests/utf.test b/tests/utf.test index fcd2a73..c41cfe3 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -13,6 +13,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + catch {unset x} test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} { diff --git a/tests/util.test b/tests/util.test index 1da533c..0e50483 100644 --- a/tests/util.test +++ b/tests/util.test @@ -12,6 +12,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint controversialNaN 1 testConstraint testdstring [llength [info commands testdstring]] testConstraint testconcatobj [llength [info commands testconcatobj]] diff --git a/tests/var.test b/tests/var.test index f2923de..ed7e930 100644 --- a/tests/var.test +++ b/tests/var.test @@ -19,6 +19,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] diff --git a/tests/winFCmd.test b/tests/winFCmd.test index b49356d..28a0e9f 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Initialise the test constraints testConstraint winVista 0 diff --git a/tests/winFile.test b/tests/winFile.test index ad34624..fba9bcb 100644 --- a/tests/winFile.test +++ b/tests/winFile.test @@ -16,6 +16,9 @@ if {[catch {package require tcltest 2.0.2}]} { } namespace import -force ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint notNTFS 0 testConstraint win2000 0 diff --git a/tests/winNotify.test b/tests/winNotify.test index f9c75a3..3e9aa29 100644 --- a/tests/winNotify.test +++ b/tests/winNotify.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testeventloop [expr {[info commands testeventloop] != {}}] # There is no explicit test for InitNotifier or NotifierExitHandler diff --git a/tests/winTime.test b/tests/winTime.test index 278db32..add8f98 100644 --- a/tests/winTime.test +++ b/tests/winTime.test @@ -15,6 +15,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testwinclock [llength [info commands testwinclock]] # The next two tests will crash on Windows if the check for negative diff --git a/win/Makefile.in b/win/Makefile.in index 62a5553..63a01db 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -140,7 +140,6 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} -TCLTEST = tcltest${EXEEXT} CAT32 = cat32$(EXEEXT) MAN2TCL = man2tcl$(EXEEXT) @@ -403,7 +402,7 @@ TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n] all: binaries libraries doc packages -tcltest: $(TCLTEST) +tcltest: $(TCLSH) $(TEST_DLL_FILE) binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(TCLSH) @@ -416,11 +415,6 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ -$(TCLTEST): testMain.$(OBJEXT) ${TEST_DLL_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES) - $(CC) $(CFLAGS) testMain.$(OBJEXT) ${TEST_LIB_FILE} $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) - @VC_MANIFEST_EMBED_EXE@ - cat32.$(OBJEXT): cat.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) @@ -719,16 +713,18 @@ install-private-headers: libraries test: test-tcl test-packages -test-tcl: binaries $(TCLTEST) +test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) $(DDE_DLL_FILE) $(REG_DLL_FILE) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ + -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... -runtest: binaries $(TCLTEST) +runtest: binaries $(TCLSH) $(TEST_DLL_FILE) $(DDE_DLL_FILE) $(REG_DLL_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ + package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via @@ -753,7 +749,7 @@ cleanhelp: clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out - $(RM) $(TCLSH) $(TCLTEST) $(CAT32) + $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb distclean: distclean-packages clean -- cgit v0.12 From c432e7b332d9321812099c3ec7bb1891165dd257 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 29 Jul 2012 21:11:07 +0000 Subject: fix some comments --- win/makefile.vc | 3 ++- win/rules.vc | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 0fbfc2c..6c8a5e3 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -121,7 +121,8 @@ the build instructions. # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default -# when not specified. +# when not specified. If the CPU environment variable has been +# set (ie: recent Platform SDK) then MACHINE is set from CPU. # # TMP_DIR= # OUT_DIR= diff --git a/win/rules.vc b/win/rules.vc index 3fbaaaf..f09e2ea 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -8,7 +8,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # Copyright (c) 2001-2003 David Gravereaux. -# Copyright (c) 2003-2007 Patrick Thoyts +# Copyright (c) 2003-2008 Patrick Thoyts #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -243,9 +243,9 @@ TCL_USE_STATIC_PACKAGES = 1 TCL_USE_STATIC_PACKAGES = 0 !endif !if [nmakehlp -f $(OPTS) "nothreads"] +!message *** Compile explicitly for non-threaded tcl TCL_THREADS = 0 !else -!message *** Doing threads TCL_THREADS = 1 USE_THREAD_ALLOC= 1 !endif @@ -287,7 +287,7 @@ LOIMPACT = 0 USE_THREAD_ALLOC = 1 !endif !if [nmakehlp -f $(OPTS) "tclalloc"] -!message *** Doing thrdalloc +!message *** Doing tclalloc USE_THREAD_ALLOC = 0 !endif !if [nmakehlp -f $(OPTS) "unchecked"] -- cgit v0.12 From 578b0e8089d87e37268eaa1f52627d7e51b3ceab Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 09:27:36 +0000 Subject: fix info.test tests --- tests/info.test | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/tests/info.test b/tests/info.test index 2ce9ecc..7dd63b7 100644 --- a/tests/info.test +++ b/tests/info.test @@ -234,7 +234,6 @@ test info-6.11 {info default option} { } } {0 {} 1 27} - test info-7.1 {info exists option} -body { set value foo info exists value @@ -734,8 +733,6 @@ proc etrace {} { return $res } -## - test info-22.0 {info frame, levels} {!singleTestInterp} { info frame } 7 @@ -766,7 +763,7 @@ test info-22.7 {info frame, global, absolute} {!singleTestInterp} { } {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0} test info-22.8 {info frame, basic trace} -match glob -body { join [lrange [etrace] 0 2] \n -} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest} * {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}} unset -nocomplain msg @@ -806,7 +803,7 @@ test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body { test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body { set script {etrace} join [lrange [eval $script] 0 2] \n -} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 1 cmd etrace proc ::tcltest::RunTest} * {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}} @@ -1321,7 +1318,7 @@ test info-37.0 {eval pure list, single line} -match glob -body { }] eval $cmd return $res -} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 2 cmd etrace proc ::tcltest::RunTest} * {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c} @@ -1362,7 +1359,7 @@ test info-38.1 {location information for uplevel, dv, direct-var} -match glob -b etrace } join [lrange [uplevel \#0 $script] 0 2] \n -} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::tcltest::RunTest} * {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y} @@ -1381,7 +1378,7 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g etrace } join [lrange [control y $script] 0 3] \n -} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::control} * {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y} @@ -1398,7 +1395,7 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body { join [lrange [datav] 0 4] \n -} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::control} * {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1} @@ -1415,7 +1412,7 @@ test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glo testConstraint testevalex [llength [info commands testevalex]] test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body { join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n -} -result {* {type source line 728 file info.test cmd {info frame \$level} proc ::etrace level 0} +} -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0} * {type eval line 1 cmd etrace proc ::tcltest::RunTest} * {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest} * {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}} -- cgit v0.12 From 4409afbad7d1d65061c9ae270c3cd589c7230ebb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 10:44:39 +0000 Subject: Add checks whether we are testing the right dll's --- tests/registry.test | 3 +++ tests/winDde.test | 5 ++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/tests/registry.test b/tests/registry.test index 71d1fad..7881e82 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -31,6 +31,9 @@ testConstraint english [expr { && [string match "English*" [testlocale all ""]] }] +test registry-1.0 {check if we are testing the right dll} {win reg} { + package versions registry +} {1.3.0} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} diff --git a/tests/winDde.test b/tests/winDde.test index b73f665..a5b9a9f 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -19,7 +19,7 @@ testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require dde 1.4.0b1 + package require -exact dde 1.4.0b1 set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1]}]} { testConstraint dde 1 } @@ -101,6 +101,9 @@ proc createChildProcess {ddeServerName args} { } # ------------------------------------------------------------------------- +test winDde-1.0 {check if we are testing the right dll} {win dde} { + package versions dde +} {1.4.0b1} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] -- cgit v0.12 From 6f401c3e624c251bbe6f116a38dc1ac035318c29 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 11:42:26 +0000 Subject: Fix various test when run outside of the build environment [3549770] --- generic/tclTest.c | 16 ++++++++++++++-- tests/encoding.test | 8 ++++++-- tests/fileSystem.test | 16 +++++++++------- tests/registry.test | 2 +- 4 files changed, 30 insertions(+), 12 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index bf75a0f..680e360 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -313,11 +313,13 @@ static int TestexitmainloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestpanicCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); +#ifndef _WIN32 static int TestfinexitObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +#endif /* _WIN32 */ +static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int TestparserObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -638,7 +640,9 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, NULL); Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); +#ifndef _WIN32 Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL); +#endif /* _WIN32 */ Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, NULL, NULL); @@ -4559,6 +4563,11 @@ TestpanicCmd( * * Calls a variant of [exit] including the full finalization path. * + * On Win32, the test suite is run with all Tcltest funcions in a dll, + * but TclpExit cannot be called from inside a dynamically loaded dll. + * It would mean that the dll is terminated, while there is still a + * function on the stack which belong to the dll. + * * Results: * Error, or doesn't return. * @@ -4568,6 +4577,7 @@ TestpanicCmd( *---------------------------------------------------------------------- */ +#ifndef _WIN32 static int TestfinexitObjCmd( ClientData dummy, /* Not used. */ @@ -4592,6 +4602,8 @@ TestfinexitObjCmd( /*NOTREACHED*/ return TCL_ERROR; /* Better not ever reach this! */ } +#endif /* _WIN32 */ + static int TestfileCmd( diff --git a/tests/encoding.test b/tests/encoding.test index 47bb81e..30aada0 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -15,8 +15,11 @@ namespace eval ::tcl::test::encoding { namespace import -force ::tcltest::* -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] +catch { + ::tcltest::loadTestedCommands + package require -exact Tcltest [info patchlevel] + set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] +} proc toutf {args} { variable x @@ -406,6 +409,7 @@ cd [workingDirectory] # Code to make the next few tests more intelligible; the code being tested # should be in the body of the test! proc runInSubprocess {contents {filename iso2022.tcl}} { + set contents "load $::tcltestlib Tcltest\n$contents" set theFile [makeFile $contents $filename] try { exec [interpreter] $theFile diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 638c427..3348b7b 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -19,8 +19,12 @@ namespace eval ::tcl::test::fileSystem { file delete -force [file join dir.dir linkinside.file] } -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] +catch { + ::tcltest::loadTestedCommands + package require -exact Tcltest [info patchlevel] + set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1] + set ::reglib [lindex [package ifneeded registry 1.3.0] 1] +} # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] @@ -507,10 +511,9 @@ test filesystem-7.1.1 {load from vfs} -setup { } -constraints {win testsimplefilesystem} -body { # This may cause a crash on exit cd [file dirname [info nameof]] - set dde [lindex [glob *dde*[info sharedlib]] 0] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation - load simplefs:/$dde dde + load simplefs:/$::ddelib dde testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. @@ -522,11 +525,10 @@ test filesystem-7.1.2 {load from vfs, and then unload again} -setup { } -constraints {win testsimplefilesystem} -body { # This may cause a crash on exit cd [file dirname [info nameof]] - set reg [lindex [glob tclreg*[info sharedlib]] 0] testsimplefilesystem 1 # This loads reg via a complex copy-to-temp operation - load simplefs:/$reg Registry - unload simplefs:/$reg + load simplefs:/$::reglib Registry + unload simplefs:/$::reglib testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. diff --git a/tests/registry.test b/tests/registry.test index 7881e82..8f8aa98 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -19,7 +19,7 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require registry + package require -exact registry 1.3.0 }]} { testConstraint reg 1 } -- cgit v0.12 From 27673e171bb63ae5c243d55c936522a3913cbcc8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 12:51:38 +0000 Subject: Less strictness about exactly which dll versions are tested --- tests/fileSystem.test | 6 ++++-- tests/registry.test | 4 ++-- tests/winDde.test | 6 +++--- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 3348b7b..ae84843 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -22,8 +22,10 @@ namespace eval ::tcl::test::fileSystem { catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] - set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1] - set ::reglib [lindex [package ifneeded registry 1.3.0] 1] + set ::ddever [lindex [lsort [package versions dde]] end] + set ::ddelib [lindex [package ifneeded dde $::ddever] 1] + set ::regver [lindex [lsort [package versions registry]] end] + set ::reglib [lindex [package ifneeded registry $::regver] 1] } # Test for commands defined in Tcltest executable diff --git a/tests/registry.test b/tests/registry.test index 8f8aa98..77588e3 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -19,7 +19,7 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require -exact registry 1.3.0 + set ::regver [package require registry 1.3.0] }]} { testConstraint reg 1 } @@ -32,7 +32,7 @@ testConstraint english [expr { }] test registry-1.0 {check if we are testing the right dll} {win reg} { - package versions registry + set ::regver } {1.3.0} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg diff --git a/tests/winDde.test b/tests/winDde.test index a5b9a9f..9e0b20a 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -19,8 +19,8 @@ testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require -exact dde 1.4.0b1 - set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1]}]} { + set ::ddever [package require dde 1.4.0b1] + set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} { testConstraint dde 1 } } @@ -102,7 +102,7 @@ proc createChildProcess {ddeServerName args} { # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { - package versions dde + set ::ddever } {1.4.0b1} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { -- cgit v0.12 From f9cd2ed03e8854ac2ce1e7c4c4af3a113428a7f3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 13:15:18 +0000 Subject: fix load-9.1 test case, when testing using tcltest86.dll --- tests/load.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/load.test b/tests/load.test index 22d6803..78bf64c 100644 --- a/tests/load.test +++ b/tests/load.test @@ -200,7 +200,7 @@ test load-9.1 {Tcl_StaticPackage, load already-loaded package into another inter [child1 eval { info loaded {} }] \ [child2 eval { info loaded {} }] } \ - -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \ + -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \ -cleanup { interp delete child1 ; interp delete child2 } test load-10.1 {load from vfs} \ -- cgit v0.12 From b06638a31cb3fb6d6671424bb6a96145d3c214bc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 14:06:17 +0000 Subject: eliminate the "testfinexit" command. We have the TCL_FINALIZE_ON_EXIT environment variable now, which makes "exit" do the same thing. --- generic/tclTest.c | 57 ----------------------------------------------------- tests/encoding.test | 7 +++---- win/Makefile.in | 6 +++--- 3 files changed, 6 insertions(+), 64 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 680e360..b4192b2 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -313,11 +313,6 @@ static int TestexitmainloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestpanicCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); -#ifndef _WIN32 -static int TestfinexitObjCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -#endif /* _WIN32 */ static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestparserObjCmd(ClientData dummy, @@ -640,9 +635,6 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, NULL); Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); -#ifndef _WIN32 - Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL); -#endif /* _WIN32 */ Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, NULL, NULL); @@ -4556,55 +4548,6 @@ TestpanicCmd( return TCL_OK; } -/* - *---------------------------------------------------------------------- - * - * TestfinexitObjCmd -- - * - * Calls a variant of [exit] including the full finalization path. - * - * On Win32, the test suite is run with all Tcltest funcions in a dll, - * but TclpExit cannot be called from inside a dynamically loaded dll. - * It would mean that the dll is terminated, while there is still a - * function on the stack which belong to the dll. - * - * Results: - * Error, or doesn't return. - * - * Side effects: - * Exits application. - * - *---------------------------------------------------------------------- - */ - -#ifndef _WIN32 -static int -TestfinexitObjCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - int value; - - if ((objc != 1) && (objc != 2)) { - Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?"); - return TCL_ERROR; - } - - if (objc == 1) { - value = 0; - } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) { - return TCL_ERROR; - } - Tcl_Finalize(); - TclpExit(value); - /*NOTREACHED*/ - return TCL_ERROR; /* Better not ever reach this! */ -} -#endif /* _WIN32 */ - - static int TestfileCmd( ClientData dummy, /* Not used. */ diff --git a/tests/encoding.test b/tests/encoding.test index 30aada0..306dd6d 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -37,7 +37,6 @@ proc runtests {} { testConstraint testencoding [llength [info commands testencoding]] testConstraint exec [llength [info commands exec]] testConstraint testgetdefenc [llength [info commands testgetdefenc]] -testConstraint testfinexit [llength [info commands testfinexit]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -409,7 +408,6 @@ cd [workingDirectory] # Code to make the next few tests more intelligible; the code being tested # should be in the body of the test! proc runInSubprocess {contents {filename iso2022.tcl}} { - set contents "load $::tcltestlib Tcltest\n$contents" set theFile [makeFile $contents $filename] try { exec [interpreter] $theFile @@ -425,13 +423,14 @@ test encoding-24.1 {EscapeFreeProc on open channels} exec { gets $f } } {} -test encoding-24.2 {EscapeFreeProc on open channels} {exec testfinexit} { +test encoding-24.2 {EscapeFreeProc on open channels} {exec} { # Bug #524674 output viewable [runInSubprocess { encoding system cp1252; # Bug #2891556 crash revelator fconfigure stdout -encoding iso2022-jp puts ab\u4e4e\u68d9g - testfinexit + set env(TCL_FINALIZE_ON_EXIT) 1 + exit }] } "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)" test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { diff --git a/win/Makefile.in b/win/Makefile.in index 63a01db..bb9a830 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -713,15 +713,15 @@ install-private-headers: libraries test: test-tcl test-packages -test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) $(DDE_DLL_FILE) $(REG_DLL_FILE) +test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) -# Useful target to launch a built tcltest with the proper path,... -runtest: binaries $(TCLSH) $(TEST_DLL_FILE) $(DDE_DLL_FILE) $(REG_DLL_FILE) +# Useful target to launch a built tclsh with the proper path,... +runtest: binaries $(TCLSH) $(TEST_DLL_FILE) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \ package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ -- cgit v0.12 From 3b740f47d77f695e1c75771c2350823c3abe5f65 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 14:09:03 +0000 Subject: unneeded variable --- tests/encoding.test | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/encoding.test b/tests/encoding.test index 306dd6d..0374e2d 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -18,7 +18,6 @@ namespace import -force ::tcltest::* catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] - set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] } proc toutf {args} { -- cgit v0.12 From ffdffbb7b2d35e999050978c6f79e90c7021ea76 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 15:03:43 +0000 Subject: fix filesystem-7.1.x tests in install environment [3549770], as suggested by Twylite temporary workaround for winPipe failing tests (still work to do) --- tests/fileSystem.test | 20 +++++++++++--------- tests/winPipe.test | 9 +++++---- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index ae84843..9469af0 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -19,13 +19,15 @@ namespace eval ::tcl::test::fileSystem { file delete -force [file join dir.dir linkinside.file] } +testConstraint loaddll 0 catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] - set ::ddever [lindex [lsort [package versions dde]] end] + set ::ddever [package require dde] set ::ddelib [lindex [package ifneeded dde $::ddever] 1] - set ::regver [lindex [lsort [package versions registry]] end] + set ::regver [package require registry] set ::reglib [lindex [package ifneeded registry $::regver] 1] + testConstraint loaddll 0 } # Test for commands defined in Tcltest executable @@ -510,12 +512,12 @@ if {[testConstraint testfilesystem]} { test filesystem-7.1.1 {load from vfs} -setup { set dir [pwd] -} -constraints {win testsimplefilesystem} -body { +} -constraints {win testsimplefilesystem loaddll} -body { # This may cause a crash on exit - cd [file dirname [info nameof]] + cd [file dirname $::reglib] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation - load simplefs:/$::ddelib dde + load simplefs:/[file tail $::ddelib] dde testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. @@ -524,13 +526,13 @@ test filesystem-7.1.1 {load from vfs} -setup { } -result ok test filesystem-7.1.2 {load from vfs, and then unload again} -setup { set dir [pwd] -} -constraints {win testsimplefilesystem} -body { +} -constraints {win testsimplefilesystem loaddll} -body { # This may cause a crash on exit - cd [file dirname [info nameof]] + cd [file dirname $::reglib] testsimplefilesystem 1 # This loads reg via a complex copy-to-temp operation - load simplefs:/$::reglib Registry - unload simplefs:/$::reglib + load simplefs:/[file tail $::reglib] Registry + unload simplefs:/[file tail $::reglib] testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. diff --git a/tests/winPipe.test b/tests/winPipe.test index 62d7d0d..637ae99 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -23,6 +23,7 @@ testConstraint exec [llength [info commands exec]] testConstraint cat32 [file exists $cat32] testConstraint AllocConsole [catch {puts console1 ""}] testConstraint RealConsole [expr {![testConstraint AllocConsole]}] +testConstraint testexcept 0; # TODO: fix this set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n append big $big @@ -190,28 +191,28 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { vwait x list $result $x [contents $path(stderr)] } "{$big} 1 stderr32" -test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec} { +test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept float_underflow" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGFPE} -test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec} { +test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept access_violation" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGSEGV} -test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec} { +test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept illegal_instruction" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGILL} -test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec} { +test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept ctrl+c" -- cgit v0.12 From 87982ab2fe141bd44b9d9173f28a0d85e6f54d57 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 15:13:36 +0000 Subject: fix event-tests running with tcltest86.dll --- tests/event.test | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/tests/event.test b/tests/event.test index 6da43a5..8ab239d 100644 --- a/tests/event.test +++ b/tests/event.test @@ -12,8 +12,12 @@ package require tcltest 2 namespace import -force ::tcltest::* -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] +catch { + ::tcltest::loadTestedCommands + package require -exact Tcltest [info patchlevel] + set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] +} + testConstraint testfilehandler [llength [info commands testfilehandler]] testConstraint testexithandler [llength [info commands testexithandler]] @@ -430,6 +434,7 @@ catch {rename bgerror {}} test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] + puts $child "load $::tcltestlib Tcltest" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; exit" flush $child @@ -443,6 +448,7 @@ odd 41 test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] + puts $child "load $::tcltestlib Tcltest" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 41" puts $child "testexithandler create 16; exit" @@ -456,6 +462,7 @@ even 4 } test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] + puts $child "load $::tcltestlib Tcltest" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 4" puts $child "testexithandler create 16; exit" @@ -469,6 +476,7 @@ odd 41 } test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] + puts $child "load $::tcltestlib Tcltest" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 6" puts $child "testexithandler create 16; exit" @@ -482,6 +490,7 @@ odd 41 } test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] + puts $child "load $::tcltestlib Tcltest" puts $child "testexithandler create 41; testexithandler delete 41" puts $child "testexithandler create 16; exit" flush $child -- cgit v0.12 From 89c07686f7863d7ca8549097fcef32fc1e6ff336 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 15:33:36 +0000 Subject: fix winPipe.test tests, when running with tcltest86.dll --- tests/winPipe.test | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index 637ae99..d2e804d 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -16,6 +16,12 @@ package require tcltest namespace import -force ::tcltest::* unset -nocomplain path +catch { + ::tcltest::loadTestedCommands + package require -exact Tcltest [info patchlevel] + set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] +} + set bindir [file join [pwd] [file dirname [info nameofexecutable]]] set cat32 [file join $bindir cat32.exe] @@ -23,7 +29,8 @@ testConstraint exec [llength [info commands exec]] testConstraint cat32 [file exists $cat32] testConstraint AllocConsole [catch {puts console1 ""}] testConstraint RealConsole [expr {![testConstraint AllocConsole]}] -testConstraint testexcept 0; # TODO: fix this +testConstraint testexcept [llength [info commands testexcept]] + set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n append big $big @@ -194,6 +201,7 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] + puts $f "load $::tcltestlib Tcltest" puts $f "testexcept float_underflow" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] @@ -201,6 +209,7 @@ test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec test test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] + puts $f "load $::tcltestlib Tcltest" puts $f "testexcept access_violation" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] @@ -208,6 +217,7 @@ test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec tes test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] + puts $f "load $::tcltestlib Tcltest" puts $f "testexcept illegal_instruction" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] @@ -215,6 +225,7 @@ test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec test test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] + puts $f "load $::tcltestlib Tcltest" puts $f "testexcept ctrl+c" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] -- cgit v0.12 From 39c08858dbc5163b84133fda955512d0495e04b2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 30 Jul 2012 18:56:31 +0000 Subject: event tests should continue to work with static Tcltest package --- tests/event.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/event.test b/tests/event.test index 8ab239d..0d1b06c 100644 --- a/tests/event.test +++ b/tests/event.test @@ -434,7 +434,7 @@ catch {rename bgerror {}} test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "load $::tcltestlib Tcltest" + puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; exit" flush $child @@ -448,7 +448,7 @@ odd 41 test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "load $::tcltestlib Tcltest" + puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 41" puts $child "testexithandler create 16; exit" @@ -462,7 +462,7 @@ even 4 } test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "load $::tcltestlib Tcltest" + puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 4" puts $child "testexithandler create 16; exit" @@ -476,7 +476,7 @@ odd 41 } test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "load $::tcltestlib Tcltest" + puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler create 4" puts $child "testexithandler create 6; testexithandler delete 6" puts $child "testexithandler create 16; exit" @@ -490,7 +490,7 @@ odd 41 } test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} { set child [open |[list [interpreter]] r+] - puts $child "load $::tcltestlib Tcltest" + puts $child "catch {load $::tcltestlib Tcltest}" puts $child "testexithandler create 41; testexithandler delete 41" puts $child "testexithandler create 16; exit" flush $child -- cgit v0.12 From 517621a49a33a09a8f3e0a4519624b3f0af770fd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Jul 2012 10:29:17 +0000 Subject: Backport nmakehlp.c from Tcl 8.6, but add -Q option from sampleextension --- ChangeLog | 5 + win/nmakehlp.c | 327 ++++++++++++++++++++++++++++++++++++++++++++++----------- win/rules.vc | 10 -- 3 files changed, 272 insertions(+), 70 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3052221..b92cc9b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-31 Jan Nijtmans + + * win/nmakehlp.c: Backport from Tcl 8.6, but add -Q option from + sampleextension. + 2012-07-27 Jan Nijtmans * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 4657c81..2868857 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -5,21 +5,33 @@ * This is used to fix limitations within nmake and the environment. * * Copyright (c) 2002 by David Gravereaux. + * Copyright (c) 2006 by Pat Thoyts * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #define _CRT_SECURE_NO_DEPRECATE #include +#define NO_SHLWAPI_GDI +#define NO_SHLWAPI_STREAM +#define NO_SHLWAPI_REG +#include #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") +#pragma comment (lib, "shlwapi.lib") #include #include + +/* + * This library is required for x64 builds with _some_ versions of MSVC + */ #if defined(_M_IA64) || defined(_M_AMD64) +#if _MSC_VER >= 1400 && _MSC_VER < 1500 #pragma comment(lib, "bufferoverflowU") #endif +#endif /* ISO hack for dumb VC++ */ #ifdef _MSC_VER @@ -30,11 +42,13 @@ /* protos */ -int CheckForCompilerFeature(const char *option); -int CheckForLinkerFeature(const char *option); -int IsIn(const char *string, const char *substring); -int GrepForDefine(const char *file, const char *string); -DWORD WINAPI ReadFromPipe(LPVOID args); +static int CheckForCompilerFeature(const char *option); +static int CheckForLinkerFeature(const char *option); +static int IsIn(const char *string, const char *substring); +static int SubstituteFile(const char *substs, const char *filename); +static int QualifyPath(const char *path); +static const char *GetVersionFromFile(const char *filename, const char *match); +static DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ @@ -116,22 +130,46 @@ main( } else { return IsIn(argv[2], argv[3]); } - case 'g': + case 's': if (argc == 2) { chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -g \n" - "grep for a #define\n" - "exitcodes: integer of the found string (no decimals)\n", + "usage: %s -s \n" + "Perform a set of string map type substutitions on a file\n" + "exitcodes: 0\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } - return GrepForDefine(argv[2], argv[3]); + return SubstituteFile(argv[2], argv[3]); + case 'V': + if (argc != 4) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -V filename matchstring\n" + "Extract a version from a file:\n" + "eg: pkgIndex.tcl \"package ifneeded http\"", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 0; + } + printf("%s\n", GetVersionFromFile(argv[2], argv[3])); + return 0; + case 'Q': + if (argc != 3) { + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -Q path\n" + "Emit the fully qualified path\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return QualifyPath(argv[2]); } } chars = snprintf(msg, sizeof(msg) - 1, - "usage: %s -c|-l|-f ...\n" + "usage: %s -c|-f|-l|-Q|-s|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); @@ -139,7 +177,7 @@ main( return 2; } -int +static int CheckForCompilerFeature( const char *option) { @@ -190,7 +228,7 @@ CheckForCompilerFeature( * Base command line. */ - lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X "); + lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch "); /* * Append our option for testing @@ -268,10 +306,12 @@ CheckForCompilerFeature( return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL || strstr(Out.buffer, "D9002") != NULL - || strstr(Err.buffer, "D9002") != NULL); + || strstr(Err.buffer, "D9002") != NULL + || strstr(Out.buffer, "D2021") != NULL + || strstr(Err.buffer, "D2021") != NULL); } -int +static int CheckForLinkerFeature( const char *option) { @@ -391,12 +431,12 @@ CheckForLinkerFeature( */ return !(strstr(Out.buffer, "LNK1117") != NULL || - strstr(Err.buffer, "LNK1117") != NULL || - strstr(Out.buffer, "LNK4044") != NULL || - strstr(Err.buffer, "LNK4044") != NULL); + strstr(Err.buffer, "LNK1117") != NULL || + strstr(Out.buffer, "LNK4044") != NULL || + strstr(Err.buffer, "LNK4044") != NULL); } -DWORD WINAPI +static DWORD WINAPI ReadFromPipe( LPVOID args) { @@ -421,7 +461,7 @@ ReadFromPipe( return 0; /* makes the compiler happy */ } -int +static int IsIn( const char *string, const char *substring) @@ -430,58 +470,225 @@ IsIn( } /* - * Find a specified #define by name. - * - * If the line is '#define TCL_VERSION "8.5"', it returns 85 as the result. + * GetVersionFromFile -- + * Looks for a match string in a file and then returns the version + * following the match where a version is anything acceptable to + * package provide or package ifneeded. */ -int -GrepForDefine( - const char *file, - const char *string) +static const char * +GetVersionFromFile( + const char *filename, + const char *match) { - FILE *f; - char s1[51], s2[51], s3[51]; - int r = 0; - double d1; + size_t cbBuffer = 100; + static char szBuffer[100]; + char *szResult = NULL; + FILE *fp = fopen(filename, "rt"); - f = fopen(file, "rt"); - if (f == NULL) { - return 0; - } + if (fp != NULL) { + /* + * Read data until we see our match string. + */ - do { - r = fscanf(f, "%50s", s1); - if (r == 1 && !strcmp(s1, "#define")) { - /* - * Get next two words. - */ - - r = fscanf(f, "%50s %50s", s2, s3); - if (r != 2) { - continue; - } + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + LPSTR p, q; - /* - * Is the first word what we're looking for? - */ + p = strstr(szBuffer, match); + if (p != NULL) { + /* + * Skip to first digit. + */ - if (!strcmp(s2, string)) { - fclose(f); + while (*p && !isdigit(*p)) { + ++p; + } /* - * Add 1 past first double quote char. "8.5" + * Find ending whitespace. */ - d1 = atof(s3 + 1); /* 8.5 */ - while (floor(d1) != d1) { - d1 *= 10.0; + q = p; + while (*q && (isalnum(*q) || *q == '.')) { + ++q; } - return ((int) d1); /* 85 */ + + memcpy(szBuffer, p, q - p); + szBuffer[q-p] = 0; + szResult = szBuffer; + break; } } - } while (!feof(f)); + fclose(fp); + } + return szResult; +} + +/* + * List helpers for the SubstituteFile function + */ + +typedef struct list_item_t { + struct list_item_t *nextPtr; + char * key; + char * value; +} list_item_t; - fclose(f); +/* insert a list item into the list (list may be null) */ +static list_item_t * +list_insert(list_item_t **listPtrPtr, const char *key, const char *value) +{ + list_item_t *itemPtr = malloc(sizeof(list_item_t)); + if (itemPtr) { + itemPtr->key = strdup(key); + itemPtr->value = strdup(value); + itemPtr->nextPtr = NULL; + + while(*listPtrPtr) { + listPtrPtr = &(*listPtrPtr)->nextPtr; + } + *listPtrPtr = itemPtr; + } + return itemPtr; +} + +static void +list_free(list_item_t **listPtrPtr) +{ + list_item_t *tmpPtr, *listPtr = *listPtrPtr; + while (listPtr) { + tmpPtr = listPtr; + listPtr = listPtr->nextPtr; + free(tmpPtr->key); + free(tmpPtr->value); + free(tmpPtr); + } +} + +/* + * SubstituteFile -- + * As windows doesn't provide anything useful like sed and it's unreliable + * to use the tclsh you are building against (consider x-platform builds - + * eg compiling AMD64 target from IX86) we provide a simple substitution + * option here to handle autoconf style substitutions. + * The substitution file is whitespace and line delimited. The file should + * consist of lines matching the regular expression: + * \s*\S+\s+\S*$ + * + * Usage is something like: + * nmakehlp -S << $** > $@ + * @PACKAGE_NAME@ $(PACKAGE_NAME) + * @PACKAGE_VERSION@ $(PACKAGE_VERSION) + * << + */ + +static int +SubstituteFile( + const char *substitutions, + const char *filename) +{ + size_t cbBuffer = 1024; + static char szBuffer[1024], szCopy[1024]; + char *szResult = NULL; + list_item_t *substPtr = NULL; + FILE *fp, *sp; + + fp = fopen(filename, "rt"); + if (fp != NULL) { + + /* + * Build a list of substutitions from the first filename + */ + + sp = fopen(substitutions, "rt"); + if (sp != NULL) { + while (fgets(szBuffer, cbBuffer, sp) != NULL) { + char *ks, *ke, *vs, *ve; + ks = szBuffer; + while (ks && *ks && isspace(*ks)) ++ks; + ke = ks; + while (ke && *ke && !isspace(*ke)) ++ke; + vs = ke; + while (vs && *vs && isspace(*vs)) ++vs; + ve = vs; + while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; + *ke = 0, *ve = 0; + list_insert(&substPtr, ks, vs); + } + fclose(sp); + } + + /* debug: dump the list */ +#ifdef _DEBUG + { + int n = 0; + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { + fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); + } + } +#endif + + /* + * Run the substitutions over each line of the input + */ + + while (fgets(szBuffer, cbBuffer, fp) != NULL) { + list_item_t *p = NULL; + for (p = substPtr; p != NULL; p = p->nextPtr) { + char *m = strstr(szBuffer, p->key); + if (m) { + char *cp, *op, *sp; + cp = szCopy; + op = szBuffer; + while (op != m) *cp++ = *op++; + sp = p->value; + while (sp && *sp) *cp++ = *sp++; + op += strlen(p->key); + while (*op) *cp++ = *op++; + *cp = 0; + memcpy(szBuffer, szCopy, sizeof(szCopy)); + } + } + printf(szBuffer); + } + + list_free(&substPtr); + } + fclose(fp); + return 0; +} + +/* + * QualifyPath -- + * + * This composes the current working directory with a provided path + * and returns the fully qualified and normalized path. + * Mostly needed to setup paths for testing. + */ + +static int +QualifyPath( + const char *szPath) +{ + char szCwd[MAX_PATH + 1]; + char szTmp[MAX_PATH + 1]; + char *p; + GetCurrentDirectory(MAX_PATH, szCwd); + while ((p = strchr(szPath, '/')) && *p) + *p = '\\'; + PathCombine(szTmp, szCwd, szPath); + PathCanonicalize(szCwd, szTmp); + printf("%s\n", szCwd); return 0; } + +/* + * Local variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * indent-tabs-mode: t + * tab-width: 8 + * End: + */ diff --git a/win/rules.vc b/win/rules.vc index 4efbad7..425f5fb 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -469,16 +469,6 @@ Failed to find tcl.h. The TCLDIR macro does not appear correct. !endif !endif -### TODO: add a command to nmakehlp.c to grep for Tcl's version from tcl.h. -### Because nmake can't return a string, we'll need to play games with return -### codes. It might look something like this: -#!if [nmakehlp -g $(TCL.H)] == 81 -#TCL_DOTVERSION = 8.1 -#!elseif [nmakehlp -g $(TCL.H)] == 82 -#TCL_DOTVERSION = 8.2 -#... -#!endif - TCL_DOTVERSION = 8.4 TCL_VERSION = $(TCL_DOTVERSION:.=) -- cgit v0.12 From e9c4df38ad5b45c6e4ee30e7f1d9ac343d0e6610 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 31 Jul 2012 12:19:34 +0000 Subject: import small refactoring from TclOO package codebase --- generic/tclOO.c | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 821befd..df7d49d 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -81,6 +81,7 @@ static void ObjectRenamedTrace(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); +static inline void SquelchCachedName(Object *oPtr); static void SquelchedNsFirst(ClientData clientData); static int PublicObjectCmd(ClientData clientData, @@ -704,6 +705,27 @@ AllocObject( /* * ---------------------------------------------------------------------- * + * SquelchCachedName -- + * + * Encapsulates how to throw away a cached object name. Called from + * object rename traces and at object destruction. + * + * ---------------------------------------------------------------------- + */ + +static inline void +SquelchCachedName( + Object *oPtr) +{ + if (oPtr->cachedNameObj) { + Tcl_DecrRefCount(oPtr->cachedNameObj); + oPtr->cachedNameObj = NULL; + } +} + +/* + * ---------------------------------------------------------------------- + * * MyDeleted -- * * This callback is triggered when the object's [my] command is deleted @@ -778,10 +800,7 @@ ObjectRenamedTrace( */ if (flags & TCL_TRACE_RENAME) { - if (oPtr->cachedNameObj) { - TclDecrRefCount(oPtr->cachedNameObj); - oPtr->cachedNameObj = NULL; - } + SquelchCachedName(oPtr); return; } @@ -1138,10 +1157,7 @@ ObjectNamespaceDeleted( TclOODeleteChainCache(oPtr->chainCache); } - if (oPtr->cachedNameObj) { - TclDecrRefCount(oPtr->cachedNameObj); - oPtr->cachedNameObj = NULL; - } + SquelchCachedName(oPtr); if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; -- cgit v0.12 From 442f90b526732f9a4d6cc2164cb8f2fe3b5f8dc7 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 31 Jul 2012 12:46:14 +0000 Subject: small cosmetic fixes --- ChangeLog | 364 +++++++++++++++++++++++++++++++------------------------------- 1 file changed, 182 insertions(+), 182 deletions(-) diff --git a/ChangeLog b/ChangeLog index 26d262c..89ae798 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,7 @@ 2012-07-31 Jan Nijtmans * win/nmakehlp.c: Add -Q option from sampleextension. - * win/Makefile.in: [Frq 3544967] Missing objectfiles in static lib + * win/Makefile.in: [FRQ 3544967]: Missing objectfiles in static lib * win/makefile.vc: (Thanks to Jos Decoster). 2012-07-29 Jan Nijtmans @@ -12,7 +12,7 @@ 2012-07-28 Jan Nijtmans - * tests/clock.test: [Bug 3549770] Multiple test failures running + * tests/clock.test: [Bug 3549770]: Multiple test failures running * tests/registry.test: tcltest outside build tree * tests/winDde.test: @@ -28,7 +28,7 @@ 2012-07-23 Alexandre Ferrieux - * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead + * generic/tclIO.c: [Bug 3545365]: Never try a bg-flush on a dead channel, just like before 2011-08-17. 2012-07-19 Joe Mistachkin @@ -59,13 +59,14 @@ 2012-07-11 Jan Nijtmans - * win/tclWinReg.c: [Bug #3362446]: registry keys command fails + * 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 + * unix/tclUnixNotfy.c: [Bug 3541646]: Don't panic on triggerPipe + overrun. 2012-07-10 Donal K. Fellows @@ -76,12 +77,12 @@ 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] + * library/http/http.tcl: [Bug 3531209]: Add fix and test for URLs that + * tests/http.test: contain literal IPv6 addresses. 2012-07-05 Don Porter - * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. + * unix/tclUnixPipe.c: [Bug 1189293]: Make "<<" binary safe. * win/tclWinPipe.c: 2012-07-03 Donal K. Fellows @@ -99,10 +100,10 @@ 2012-06-29 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 + * library/msgcat/msgcat.tcl: [Bug 3536888]: Locale guessing of + * library/msgcat/pkgIndex.tcl: msgcat fails on (some) Windows 7. Bump + * unix/Makefile.in: to 1.4.5 + * win/Makefile.in: 2012-06-29 Donal K. Fellows @@ -126,7 +127,7 @@ 2012-06-25 Don Porter - * generic/tclFileSystem.h: [Bug 3024359] Make sure that the + * generic/tclFileSystem.h: [Bug 3024359]: Make sure that the * generic/tclIOUtil.c: per-thread cache of the list of file systems * generic/tclPathObj.c: currently registered is only updated at times when no active loops are traversing it. Also reduce the amount of @@ -340,17 +341,17 @@ 2012-05-09 Andreas Kupries - * generic/tclIORChan.c [Bug 3522560]: Fixed the crash, enabled the - test case. Modified [chan postevent] to properly inject the - event(s) into the owner thread's event queue for execution in the - correct context. Renamed the ForwardOpTo...Thread() function to - match with our terminology. + * generic/tclIORChan.c: [Bug 3522560]: Fixed the crash, enabled the + test case. Modified [chan postevent] to properly inject the event(s) + into the owner thread's event queue for execution in the correct + context. Renamed the ForwardOpTo...Thread() function to match with our + terminology. - * tests/ioCmd.test [Bug 3522560]: Added a test which crashes the - core if it were not disabled as knownBug. For a reflected channel + * tests/ioCmd.test: [Bug 3522560]: Added a test which crashes the core + if it were not disabled as knownBug. For a reflected channel transfered to a different thread the [chan postevent] run in the - handler thread tries to execute the owner threads's fileevent - scripts by itself, wrongly reaching across thread boundaries. + handler thread tries to execute the owner threads's fileevent scripts + by itself, wrongly reaching across thread boundaries. 2012-04-28 Alexandre Ferrieux @@ -406,11 +407,11 @@ 2012-04-26 Jan Nijtmans - * generic/tclStubInit.c: get rid of _ANSI_ARGS_ and CONST - * generic/tclIO.c - * generic/tclIOCmd.c - * generic/tclTest.c - * unix/tclUnixChan.c + * generic/tclStubInit.c: Get rid of _ANSI_ARGS_ and CONST + * generic/tclIO.c: + * generic/tclIOCmd.c: + * generic/tclTest.c: + * unix/tclUnixChan.c: 2012-04-25 Donal K. Fellows @@ -475,8 +476,8 @@ * unix/tcl.m4: Use NDEBUG consistantly meaning: no debugging. * unix/configure: * generic/tclBasic.c: - * library/dde/pkgIndex.tcl Use [::tcl::pkgconfig get debug] instead - * library/reg/pkgIndex.tcl of [info exists ::tcl_platform(debug)] + * library/dde/pkgIndex.tcl: Use [::tcl::pkgconfig get debug] instead + * library/reg/pkgIndex.tcl: of [info exists ::tcl_platform(debug)] 2012-04-10 Donal K. Fellows @@ -566,7 +567,7 @@ * generic/tclCmdAH.c: on windows (but now for cygwin as well). * generic/tclOODefineCmds.c: minor gcc warning * win/tclWinPort.h: Use lower numbers, preventing integer overflow. - Remove the workaround for mingw-w64 [bug 3407992]. It's long fixed. + Remove the workaround for mingw-w64 [Bug 3407992]. It's long fixed. 2012-03-27 Donal K. Fellows @@ -641,31 +642,31 @@ 2012-03-19 Venkat Iyer * library/tzdata/America/Atikokan: Update to tzdata2012b. - * library/tzdata/America/Blanc-Sablon - * library/tzdata/America/Dawson_Creek - * library/tzdata/America/Edmonton - * library/tzdata/America/Glace_Bay - * library/tzdata/America/Goose_Bay - * library/tzdata/America/Halifax - * library/tzdata/America/Havana - * library/tzdata/America/Moncton - * library/tzdata/America/Montreal - * library/tzdata/America/Nipigon - * library/tzdata/America/Rainy_River - * library/tzdata/America/Regina - * library/tzdata/America/Santiago - * library/tzdata/America/St_Johns - * library/tzdata/America/Swift_Current - * library/tzdata/America/Toronto - * library/tzdata/America/Vancouver - * library/tzdata/America/Winnipeg - * library/tzdata/Antarctica/Casey - * library/tzdata/Antarctica/Davis - * library/tzdata/Antarctica/Palmer - * library/tzdata/Asia/Yerevan - * library/tzdata/Atlantic/Stanley - * library/tzdata/Pacific/Easter - * library/tzdata/Pacific/Fakaofo + * library/tzdata/America/Blanc-Sablon: + * library/tzdata/America/Dawson_Creek: + * library/tzdata/America/Edmonton: + * library/tzdata/America/Glace_Bay: + * library/tzdata/America/Goose_Bay: + * library/tzdata/America/Halifax: + * library/tzdata/America/Havana: + * library/tzdata/America/Moncton: + * library/tzdata/America/Montreal: + * library/tzdata/America/Nipigon: + * library/tzdata/America/Rainy_River: + * library/tzdata/America/Regina: + * library/tzdata/America/Santiago: + * library/tzdata/America/St_Johns: + * library/tzdata/America/Swift_Current: + * library/tzdata/America/Toronto: + * library/tzdata/America/Vancouver: + * library/tzdata/America/Winnipeg: + * library/tzdata/Antarctica/Casey: + * library/tzdata/Antarctica/Davis: + * library/tzdata/Antarctica/Palmer: + * library/tzdata/Asia/Yerevan: + * library/tzdata/Atlantic/Stanley: + * library/tzdata/Pacific/Easter: + * library/tzdata/Pacific/Fakaofo: * library/tzdata/America/Creston: (new) 2012-03-19 Reinhard Max @@ -679,11 +680,11 @@ 2012-03-15 Jan Nijtmans * generic/tcl.h: [Bug 3288345]: Wrong Tcl_StatBuf used on Cygwin - * unix/tclUnixFile.c - * unix/tclUnixPort.h + * unix/tclUnixFile.c: + * unix/tclUnixPort.h: * win/cat.c: Remove cygwin stuff no longer needed - * win/tclWinFile.c - * win/tclWinPort.h + * win/tclWinFile.c: + * win/tclWinPort.h: 2012-03-12 Jan Nijtmans @@ -727,7 +728,7 @@ * generic/tclIOUtil.c: [Bug 3466099]: BOM in Unicode * generic/tclEncoding.c: - * tests/source.test + * tests/source.test: 2012-02-23 Donal K. Fellows @@ -881,13 +882,13 @@ 2011-12-30 Venkat Iyer - * library/tzdata/America/Bahia : Update to Olson's tzdata2011n - * library/tzdata/America/Havana - * library/tzdata/Europe/Kiev - * library/tzdata/Europe/Simferopol - * library/tzdata/Europe/Uzhgorod - * library/tzdata/Europe/Zaporozhye - * library/tzdata/Pacific/Fiji + * library/tzdata/America/Bahia: Update to Olson's tzdata2011n + * library/tzdata/America/Havana: + * library/tzdata/Europe/Kiev: + * library/tzdata/Europe/Simferopol: + * library/tzdata/Europe/Uzhgorod: + * library/tzdata/Europe/Zaporozhye: + * library/tzdata/Pacific/Fiji: 2011-12-23 Jan Nijtmans @@ -1026,9 +1027,9 @@ 2011-10-15 Venkat Iyer - * library/tzdata/America/Sitka : Update to Olson's tzdata2011l - * library/tzdata/Pacific/Fiji - * library/tzdata/Asia/Hebron (New) + * library/tzdata/America/Sitka: Update to Olson's tzdata2011l + * library/tzdata/Pacific/Fiji: + * library/tzdata/Asia/Hebron: (New) 2011-10-11 Jan Nijtmans @@ -1062,16 +1063,16 @@ 2011-10-03 Venkat Iyer * library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k - * library/tzdata/Africa/Kampala - * library/tzdata/Africa/Nairobi - * library/tzdata/Asia/Gaza - * library/tzdata/Europe/Kaliningrad - * library/tzdata/Europe/Kiev - * library/tzdata/Europe/Minsk - * library/tzdata/Europe/Simferopol - * library/tzdata/Europe/Uzhgorod - * library/tzdata/Europe/Zaporozhye - * library/tzdata/Pacific/Apia + * library/tzdata/Africa/Kampala: + * library/tzdata/Africa/Nairobi: + * library/tzdata/Asia/Gaza: + * library/tzdata/Europe/Kaliningrad: + * library/tzdata/Europe/Kiev: + * library/tzdata/Europe/Minsk: + * library/tzdata/Europe/Simferopol: + * library/tzdata/Europe/Uzhgorod: + * library/tzdata/Europe/Zaporozhye: + * library/tzdata/Pacific/Apia: 2011-09-29 Donal K. Fellows @@ -1170,15 +1171,15 @@ IMPLEMENTATION OF TIP #388 - * doc/Tcl.n - * doc/re_syntax.n - * generic/regc_lex.c - * generic/regcomp.c - * generic/regcustom.h - * generic/tcl.h - * generic/tclParse.c - * tests/reg.test - * tests/utf.test + * doc/Tcl.n: + * doc/re_syntax.n: + * generic/regc_lex.c: + * generic/regcomp.c: + * generic/regcustom.h: + * generic/tcl.h: + * generic/tclParse.c: + * tests/reg.test: + * tests/utf.test: 2011-09-16 Donal K. Fellows @@ -1257,8 +1258,8 @@ 2011-09-06 Jan Nijtmans * generic/tcl.h: [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx()) - * generic/tclDecls.h - * generic/tclMain.c + * generic/tclDecls.h: + * generic/tclMain.c: 2011-09-02 Don Porter @@ -1329,8 +1330,8 @@ 2011-08-18 Jan Nijtmans * generic/tclUniData.c: [Bug 3393714]: Overflow in toupper delta - * tools/uniParse.tcl - * tests/utf.test + * tools/uniParse.tcl: + * tests/utf.test: 2011-08-17 Alexandre Ferrieux @@ -1367,8 +1368,8 @@ * generic/tclPosixStr.c: [Bug 3388350]: mingw64 compiler warnings * win/tclWinPort.h: - * win/configure.in - * win/configure + * win/configure.in: + * win/configure: 2011-08-14 Jan Nijtmans @@ -1406,9 +1407,9 @@ 2011-08-09 Jan Nijtmans * win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings - * win/tclWinDde.c - * win/tclWinPipe.c - * win/tclWinSerial.c + * win/tclWinDde.c: + * win/tclWinPipe.c: + * win/tclWinSerial.c: 2011-08-09 Jan Nijtmans @@ -1734,8 +1735,8 @@ * library/msgcat/msgcat.tcl: Bump to msgcat 1.4.4. * library/msgcat/pkgIndex.tcl: - * unix/Makefile.in - * win/Makefile.in + * unix/Makefile.in: + * win/Makefile.in: 2011-05-25 Donal K. Fellows @@ -2141,7 +2142,7 @@ 2011-03-21 Jan Nijtmans - * unix/tclLoadDl.c: [Bug #3216070]: Loading extension libraries + * unix/tclLoadDl.c: [Bug 3216070]: Loading extension libraries * unix/tclLoadDyld.c: from embedded Tcl applications. ***POTENTIAL INCOMPATIBILITY*** For extensions which rely on symbols from other extensions being @@ -2418,20 +2419,20 @@ * win/tclWinChan.c: Fix various gcc-4.5.2 64-bit warning * win/tclWinConsole.c: messages, e.g. by using full 64-bits for * win/tclWinDde.c: socket fd's - * win/tclWinPipe.c - * win/tclWinReg.c - * win/tclWinSerial.c - * win/tclWinSock.c - * win/tclWinThrd.c + * win/tclWinPipe.c: + * win/tclWinReg.c: + * win/tclWinSerial.c: + * win/tclWinSock.c: + * win/tclWinThrd.c: 2011-01-19 Jan Nijtmans - * tools/genStubs.tcl: [Enh #3159920]: Tcl_ObjPrintf() crashes with + * tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with * generic/tcl.decls bad format specifier. - * generic/tcl.h - * generic/tclDecls.h + * generic/tcl.h: + * generic/tclDecls.h: -2011-01-18 Donal K. Fellows 3159920 +2011-01-18 Donal K. Fellows * generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make sure that the cmdPtr field of the procPtr is correct and relevant at @@ -2444,10 +2445,10 @@ * generic/tclBasic.c: Various mismatches between Tcl_Panic * generic/tclCompCmds.c: format string and its arguments, * generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920] - * generic/tclCompExpr.c - * generic/tclEnsemble.c - * generic/tclPreserve.c - * generic/tclTest.c + * generic/tclCompExpr.c: + * generic/tclEnsemble.c: + * generic/tclPreserve.c: + * generic/tclTest.c: 2011-01-17 Jan Nijtmans @@ -2690,7 +2691,7 @@ * generic/tclBinary.c: [Bug 3129448]: Possible over-allocation on * generic/tclCkalloc.c: 64-bit platforms. - * generic/tclTrace.c + * generic/tclTrace.c: 2010-12-05 Jan Nijtmans @@ -2826,7 +2827,7 @@ * win/cat.c: to reality. See for what's missing: * win/tcl.m4: * win/configure: (re-generated) - * win/tclWinPort.h: [Bug #3110161]: Extensions using TCHAR don't + * win/tclWinPort.h: [Bug 3110161]: Extensions using TCHAR don't compile on VS2005 SP1 2010-11-15 Andreas Kupries @@ -6980,9 +6981,9 @@ * unix/tclUnixChan.c: TclUnixWaitForFile(): use FD_* macros * macosx/tclMacOSXNotify.c: to manipulate select masks (Cassoff). - [Freq 1960647] [Bug 3486554] + [FRQ 1960647] [Bug 3486554] - * unix/tclLoadDyld.c: use RTLD_GLOBAL instead of RTLD_LOCAL. + * unix/tclLoadDyld.c: Use RTLD_GLOBAL instead of RTLD_LOCAL. [Bug 1961211] * macosx/tclMacOSXNotify.c: revise CoreFoundation notifier to allow @@ -7178,9 +7179,8 @@ 2009-03-15 Joe Mistachkin - * generic/tclThread.c: Modify fix for TSD leak to match Tcl 8.5 - * generic/tclThreadStorage.c: (and prior) allocation semantics. [Bug - 2687952] + * generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match + * generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics 2009-03-15 Donal K. Fellows @@ -7268,10 +7268,10 @@ 2009-02-20 Don Porter - * generic/tclPathObj.c: Fixed mistaken logic in TclFSGetPathType() - * tests/fileName.test: that assumed (not "absolute" => "relative"). - This is a false assumption on Windows, where "volumerelative" is - another possibility. [Bug 2571597] + * generic/tclPathObj.c: [Bug 2571597]: Fixed mistaken logic in + * tests/fileName.test: TclFSGetPathType() that assumed (not + "absolute") => "relative". This is a false assumption on Windows, + where "volumerelative" is another possibility. 2009-02-18 Don Porter @@ -7325,23 +7325,23 @@ 2009-02-16 Jan Nijtmans - * generic/tclZlib.c: hack needed for official zlib1.dll build. + * generic/tclZlib.c: Hack needed for official zlib1.dll build. * win/configure.in: fix [Feature Request 2605263] use official * win/Makefile.in: zlib build. * win/configure: (regenerated) * compat/zlib/zdll.lib: new files * compat/zlib/zlib1.dll: - * win/Makefile.in: fix [Bug 2605232] tdbc doesn't build when - Tcl is compiled with --disable-shared. + * win/Makefile.in: [Bug 2605232]: tdbc doesn't build when Tcl is + compiled with --disable-shared. 2009-02-15 Don Porter - * generic/tclStringObj.c: Added protections from invalid memory - * generic/tclTestObj.c: accesses when we append (some part of) - * tests/stringObj.test: a Tcl_Obj to itself. Added the - appendself and appendself2 subcommands to the [teststringobj] testing - command and added tests to the test suite. [Bug 2603158] + * generic/tclStringObj.c: [Bug 2603158]: Added protections from + * generic/tclTestObj.c: invalid memory accesses when we append + * tests/stringObj.test: (some part of) a Tcl_Obj to itself. + Added the appendself and appendself2 subcommands to the + [teststringobj] testing command and added tests to the test suite. * generic/tclStringObj.c: Factor out duplicate code from Tcl_AppendObjToObj. @@ -7477,7 +7477,7 @@ 2009-02-09 Jan Nijtmans - * generic/tclCompile.c: fix [Bug 2555129] const compiler warning (as + * generic/tclCompile.c: [Bug 2555129]: const compiler warning (as error) in tclCompile.c 2009-02-07 Donal K. Fellows @@ -7489,8 +7489,8 @@ 2009-02-05 Joe Mistachkin - * generic/tclInterp.c: Fix argument checking for [interp cancel]. [Bug - 2544618] + * generic/tclInterp.c: [Bug 2544618]: Fix argument checking for + [interp cancel]. * unix/Makefile.in: Fix build issue with zlib on FreeBSD (and possibly other platforms). @@ -7512,12 +7512,12 @@ 2009-02-04 Don Porter - * generic/tclStringObj.c: Added overflow protections to the - AppendUtfToUtfRep routine to either avoid invalid arguments and - crashes, or to replace them with controlled panics. [Bug 2561794] + * generic/tclStringObj.c: [Bug 2561794]: Added overflow protections to + the AppendUtfToUtfRep routine to either avoid invalid arguments and + crashes, or to replace them with controlled panics. - * generic/tclCmdMZ.c: Prevent crashes due to int overflow of the - length of the result of [string repeat]. [Bug 2561746] + * generic/tclCmdMZ.c: [Bug 2561746]: Prevent crashes due to int + overflow of the length of the result of [string repeat]. 2009-02-03 Jan Nijtmans @@ -7549,9 +7549,9 @@ 2009-02-03 Don Porter - * generic/tclStringObj.c (SetUnicodeObj): Corrected failure of - Tcl_SetUnicodeObj() to panic on a shared object. [Bug 2561488]. Also - factored out common code to reduce duplication. + * generic/tclStringObj.c (SetUnicodeObj): [Bug 2561488]: + Corrected failure of Tcl_SetUnicodeObj() to panic on a shared object. + Also factored out common code to reduce duplication. * generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication. @@ -7626,19 +7626,19 @@ 2009-01-26 Alexandre Ferrieux - * generic/tclInt.h: Fix [Bug 1028264]: WSACleanup() too early. - * generic/tclEvent.c: The fix introduces "late exit handlers" - * win/tclWinSock.c: for similar late process-wide cleanups. + * generic/tclInt.h: [Bug 1028264]: WSACleanup() too early. + * generic/tclEvent.c: The fix introduces "late exit handlers" for + * win/tclWinSock.c: similar late process-wide cleanups. 2009-01-26 Alexandre Ferrieux - * win/tclWinSock.c: Fix [Bug 2446662]: resync Win behavior on RST - with that of unix (EOF). + * win/tclWinSock.c: [Bug 2446662]: Resync Win behavior on RST with + that of unix (EOF). 2009-01-26 Donal K. Fellows - * generic/tclZlib.c (ChanClose): Only generate error messages in the - interpreter when the thread is not being closed down. [Bug 2536400] + * generic/tclZlib.c (ChanClose): [Bug 2536400]: Only generate error + messages in the interpreter when the thread is not being closed down. 2009-01-23 Donal K. Fellows @@ -7665,7 +7665,7 @@ 2009-01-21 Andreas Kupries - * generic/tclIORChan.c (ReflectClose): Fix for [Bug 2458202]. + * generic/tclIORChan.c (ReflectClose): [Bug 2458202]: * generic/tclIORTrans.c (ReflectClose): Closing a channel may supply NULL for the 'interp'. Test for finalization needs to be different, and one place has to pull the interp out of the channel instead. @@ -7677,12 +7677,12 @@ 2009-01-19 Kevin B. Kenny - * unix/Makefile.in: Added a CONFIG_INSTALL_DIR parameter so that - * unix/tcl.m4: distributors can control where tclConfig.sh goes. - Made the installation of 'ldAix' conditional upon actually being on an - AIX system. Allowed for downstream packagers to customize - SHLIB_VERSION on BSD-derived systems. Thanks to Stuart Cassoff for - [Patch 907924]. + * unix/Makefile.in: [Patch 907924]:Added a CONFIG_INSTALL_DIR + * unix/tcl.m4: parameter so that distributors can control where + tclConfig.sh goes. Made the installation of 'ldAix' conditional upon + actually being on an AIX system. Allowed for downstream packagers to + customize SHLIB_VERSION on BSD-derived systems. Thanks to Stuart + Cassoff for his help. * unix/configure: Autoconf 2.59 2009-01-19 David Gravereaux @@ -7719,8 +7719,8 @@ 2009-01-13 Jan Nijtmans - * unix/tcl.m4: fix [tcl-Bug 2502365] Building of head on HPUX is - broken when using the native CC. + * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when + using the native CC. * unix/configure (autoconf-2.59) 2009-01-13 Donal K. Fellows @@ -7743,20 +7743,20 @@ 2009-01-09 Don Porter - * generic/tclStringObj.c (STRING_SIZE): Corrected failure to limit - memory allocation requests to the sizes that can be supported by Tcl's - memory allocation routines. [Bug 2494093] + * generic/tclStringObj.c (STRING_SIZE): [Bug 2494093]: Corrected + failure to limit memory allocation requests to the sizes that can be + supported by Tcl's memory allocation routines. 2009-01-09 Donal K. Fellows - * generic/tclNamesp.c (NamespaceEnsembleCmd): Error out when someone - gives wrong # of args to [namespace ensemble create]. [Bug 1558654] + * generic/tclNamesp.c (NamespaceEnsembleCmd): [Bug 1558654]: Error out + when someone gives wrong # of args to [namespace ensemble create]. 2009-01-08 Don Porter - * generic/tclStringObj.c (STRING_UALLOC): Added missing parens - required to get correct results out of things like - STRING_UALLOC(num + append). [Bug 2494093] + * generic/tclStringObj.c (STRING_UALLOC): [Bug 2494093]: Added missing + parens required to get correct results out of things like + STRING_UALLOC(num + append). 2009-01-08 Donal K. Fellows @@ -7768,7 +7768,7 @@ 2009-01-07 Donal K. Fellows - * doc/dict.n: Added more examples. [Tk Bug 2491235] + * doc/dict.n: [Tk Bug 2491235]: Added more examples. * tests/oo.test (oo-22.1): Adjusted test to be less dependent on the specifics of how [info frame] reports general frame information, and @@ -7787,20 +7787,20 @@ * generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals of dictionaries so that literals can't get destroyed. - * tests/expr.test: Eliminate non-ASCII char. [Bug 2006879] + * tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char. - * generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd): Only - delete pointers that were actually allocated! [Bug 2489836] + * generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd): + [Bug 2489836]: Only delete pointers that were actually allocated! * generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance): - Perform search for existing commands in right context. [Bug 2481109] + [Bug 2481109]: Perform search for existing commands in right context. 2009-01-05 Donal K. Fellows - * generic/tclCmdMZ.c (TclNRSourceObjCmd): Make implementation of the - * generic/tclIOUtil.c (TclNREvalFile): [source] command be NRE - enabled so that [yield] inside a script sourced in a coroutine can - work. [Bug 2412068] + * generic/tclCmdMZ.c (TclNRSourceObjCmd): [Bug 2412068]: Make + * generic/tclIOUtil.c (TclNREvalFile): implementation of the + [source] command be NRE enabled so that [yield] inside a script + sourced in a coroutine can work. 2009-01-04 Donal K. Fellows @@ -7815,12 +7815,12 @@ 2009-01-02 Donal K. Fellows - * unix/tcl.m4 (SC_CONFIG_CFLAGS): Force the use of the compatibility - version of mkstemp() on IRIX. [Bug 878333] + * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the + compatibility version of mkstemp() on IRIX. * unix/configure.in, unix/Makefile.in (mkstemp.o): - * compat/mkstemp.c (new file): Added a compatibility implementation of - the mkstemp() function, which is apparently needed on some platforms. - [Bug 741967] + * compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility + implementation of the mkstemp() function, which is apparently needed + on some platforms. ****************************************************************** *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" *** -- cgit v0.12 From ae22e88dbd7dad273ac8679a6f743fdd401279a8 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 31 Jul 2012 14:35:01 +0000 Subject: Purge use of Tcl_AppendElement, and corrected conversion of PIDs to integer objects. --- ChangeLog | 8 ++++++++ generic/tclInterp.c | 8 +++++--- unix/tclUnixPipe.c | 20 +++++++++++--------- win/tclWinPipe.c | 21 +++++++++++---------- 4 files changed, 35 insertions(+), 22 deletions(-) diff --git a/ChangeLog b/ChangeLog index 89ae798..dfe776c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-07-31 Donal K. Fellows + + * generic/tclInterp.c (Tcl_GetInterpPath): + * unix/tclUnixPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd): + * win/tclWinPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd): + Purge use of Tcl_AppendElement, and corrected conversion of PIDs to + integer objects. + 2012-07-31 Jan Nijtmans * win/nmakehlp.c: Add -Q option from sampleextension. diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 5b6d14f..5bae041 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -2154,17 +2154,19 @@ Tcl_GetInterpPath( InterpInfo *iiPtr; if (targetInterp == askingInterp) { + Tcl_SetObjResult(askingInterp, Tcl_NewObj()); return TCL_OK; } if (targetInterp == NULL) { return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo; - if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) { + if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){ return TCL_ERROR; } - Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&iiPtr->master.slaveTable, - iiPtr->slave.slaveEntryPtr)); + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp), + Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable, + iiPtr->slave.slaveEntryPtr), -1)); return TCL_OK; } diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index a505bef..377b84b 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -874,8 +874,8 @@ TclGetAndDetachPids( { PipeState *pipePtr; const Tcl_ChannelType *chanTypePtr; + Tcl_Obj *pidsObj; int i; - char buf[TCL_INTEGER_SPACE]; /* * Punt if the channel is not a command channel. @@ -886,12 +886,14 @@ TclGetAndDetachPids( return; } - pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan); + pipePtr = Tcl_GetChannelInstanceData(chan); + TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - TclFormatInt(buf, (long) TclpGetPid(pipePtr->pidPtr[i])); - Tcl_AppendElement(interp, buf); - Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); + Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj( + PTR2INT(pipePtr->pidPtr[i]))); + Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } + Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; @@ -1275,7 +1277,7 @@ Tcl_PidObjCmd( Tcl_Channel chan; PipeState *pipePtr; int i; - Tcl_Obj *resultPtr, *longObjPtr; + Tcl_Obj *resultPtr; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); @@ -1301,11 +1303,11 @@ Tcl_PidObjCmd( * Extract the process IDs from the pipe structure. */ - pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan); + pipePtr = Tcl_GetChannelInstanceData(chan); resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { - longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i])); - Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, + Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); } Tcl_SetObjResult(interp, resultPtr); } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index f36f797..db462f8 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1711,8 +1711,8 @@ TclGetAndDetachPids( { PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; + Tcl_Obj *pidsObj; int i; - char buf[TCL_INTEGER_SPACE]; /* * Punt if the channel is not a command channel. @@ -1723,12 +1723,15 @@ TclGetAndDetachPids( return; } - pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); + pipePtr = Tcl_GetChannelInstanceData(chan); + TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); - Tcl_AppendElement(interp, buf); - Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); + Tcl_ListObjAppendElement(NULL, pidsObj, + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); + Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } + Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; @@ -2642,15 +2645,13 @@ Tcl_PidObjCmd( PipeInfo *pipePtr; int i; Tcl_Obj *resultPtr; - char buf[TCL_INTEGER_SPACE]; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { - wsprintfA(buf, "%lu", (unsigned long) getpid()); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); @@ -2665,9 +2666,9 @@ Tcl_PidObjCmd( pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, - Tcl_NewStringObj(buf, -1)); + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } -- cgit v0.12 From c0fcd16b065d4046af7c3b389b9f7c14c5c91383 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Jul 2012 14:41:05 +0000 Subject: add thread to coffbase.txt, so the thread extensions can use it --- win/coffbase.txt | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/win/coffbase.txt b/win/coffbase.txt index 35dac3d..63c5ec3 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -22,4 +22,20 @@ itk 0x10580000 0x00080000 bltlite 0x10600000 0x00080000 blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 -tls 0x10780000 0x00080000 +tls 0x10780000 0x00100000 +winico 0x10880000 0x00010000 +tile 0x10900000 0x00080000 +memchan 0x109D0000 0x00010000 +tdom 0x109E0000 0x00080000 +tclvfs 0x10A70000 0x00010000 +tkvideo 0x10B00000 0x00010000 +tclsdl 0x10B20000 0x00080000 +vqtcl 0x10C00000 0x00010000 +tdbc 0x10C40000 0x00010000 +thread 0x10C80000 0x00010000 +; +; insert new packages here +; +snack 0x1E000000 0x00400000 +sound 0x1E400000 0x00400000 +snackogg 0x1E800000 0x00200000 -- cgit v0.12 From 29b6c3f7cac984e55492f6a9e7f4719b84646150 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Jul 2012 15:16:28 +0000 Subject: oops --- win/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/Makefile.in b/win/Makefile.in index e1f5c9e..84dcaf7 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -131,7 +131,7 @@ TCL_LIB_FILE = @TCL_LIB_FILE@ DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${LIBSUFFIX} REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX} -REG_LIB_FILE = @LIBPREFIX@tclreg$(DDEVER)${LIBSUFFIX} +REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} ZLIB_DLL_FILE = zlib1.dll -- cgit v0.12 From bd5e5382ea4fcf3f03ca5c9ffac094df06956808 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 31 Jul 2012 23:24:28 +0000 Subject: add coffbase for sample --- win/coffbase.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/win/coffbase.txt b/win/coffbase.txt index 63c5ec3..bdf5506 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -24,6 +24,7 @@ blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 tls 0x10780000 0x00100000 winico 0x10880000 0x00010000 +sample 0x108B0000 0x00010000 tile 0x10900000 0x00080000 memchan 0x109D0000 0x00010000 tdom 0x109E0000 0x00080000 @@ -32,7 +33,7 @@ tkvideo 0x10B00000 0x00010000 tclsdl 0x10B20000 0x00080000 vqtcl 0x10C00000 0x00010000 tdbc 0x10C40000 0x00010000 -thread 0x10C80000 0x00010000 +thread 0x10C80000 0x00020000 ; ; insert new packages here ; -- cgit v0.12 From e557e3df44d60bf5754cbc2e8a1a1225322dd5dd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 1 Aug 2012 14:53:14 +0000 Subject: Fix Bug #3545367: DDE test failures --- win/tclWinDde.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 183fe02..da583da 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1503,7 +1503,7 @@ DdeObjCmd( } else { Tcl_Obj *returnObjPtr; ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINUNICODE); + CP_WINANSI); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, CF_TEXT, XTYP_REQUEST, 5000, NULL); -- cgit v0.12 From 3546e128c0c379f71d6fdf6678ad19cd9d0a0265 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 Aug 2012 09:54:22 +0000 Subject: Fix Bug #3545367: DDE test failures It turns out that "dde poke" had the same bug, unfortunately we cannot make a test-case for that. Also modified more test-cases to use unicode variable names, so we can more reliably detect this --- tests/winDde.test | 30 +++++++++++++++--------------- win/tclWinDde.c | 16 +++++++++++++--- 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/tests/winDde.test b/tests/winDde.test index 9e0b20a..01fb54c 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -139,25 +139,25 @@ test winDde-3.2 {DDE execute -async locally} -constraints dde -body { set \xe1 } -result foo test winDde-3.3 {DDE request locally} -constraints dde -body { - set a "" - dde execute TclEval self [list set a foo] - dde request TclEval self a + set \xe1 "" + dde execute TclEval self [list set \xe1 foo] + dde request TclEval self \xe1 } -result foo test winDde-3.4 {DDE eval locally} -constraints dde -body { set \xe1 "" dde eval self set \xe1 foo } -result foo test winDde-3.5 {DDE request locally} -constraints dde -body { - set a "" - dde execute TclEval self [list set a foo] - dde request -binary TclEval self a + set \xe1 "" + dde execute TclEval self [list set \xe1 foo] + dde request -binary TclEval self \xe1 } -result "foo\x00" # Set variable a to A with diaeresis (unicode C4) by relying on the fact # that utf8 is sent (e.g. "c3 84" on the wire) test winDde-3.6 {DDE request utf8} -constraints dde -body { - set a "not set" - dde execute TclEval self "set a \xc4" - scan $a %c + set \xe1 "not set" + dde execute TclEval self "set \xe1 \xc4" + scan [set \xe1] %c } -result 196 # Set variable a to A with diaeresis (unicode C4) using binary execute # and compose utf-8 (e.g. "c3 84" ) manualy @@ -189,23 +189,23 @@ test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body { set \xe1 } -result "" test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body { - set a "" + set \xe1 "" set name ch\xEDld-4.3 set child [createChildProcess $name] dde execute TclEval $name [list set a foo] - set a [dde request TclEval $name a] + set \xe1 [dde request TclEval $name a] dde execute TclEval $name {set done 1} update - set a + set \xe1 } -result foo test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body { - set a "" + set \xe1 "" set name ch\xEDld-4.4 set child [createChildProcess $name] - set a [dde eval $name set a foo] + set \xe1 [dde eval $name set a foo] dde execute TclEval $name {set done 1} update - set a + set \xe1 } -result foo # ------------------------------------------------------------------------- diff --git a/win/tclWinDde.c b/win/tclWinDde.c index da583da..1cd6c46 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1483,8 +1483,13 @@ DdeObjCmd( break; } case DDE_REQUEST: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); +#endif if (length == 0) { Tcl_SetObjResult(interp, @@ -1503,7 +1508,7 @@ DdeObjCmd( } else { Tcl_Obj *returnObjPtr; ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINANSI); + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, CF_TEXT, XTYP_REQUEST, 5000, NULL); @@ -1537,8 +1542,13 @@ DdeObjCmd( break; } case DDE_POKE: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); +#endif BYTE *dataString; if (length == 0) { -- cgit v0.12