From aa4274da58363cc82765a9eba3e5f3a957573041 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Nov 2012 15:25:30 +0000 Subject: Create Tcl 8.6.0 release branch --- README | 2 +- generic/tcl.h | 6 +++--- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.in | 2 +- 8 files changed, 10 insertions(+), 10 deletions(-) diff --git a/README b/README index 56f7e38..f8965b4 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6b3 source distribution. + This is the Tcl 8.6.0 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 5f6146e..d765967 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -55,11 +55,11 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 -#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -#define TCL_RELEASE_SERIAL 3 +#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE +#define TCL_RELEASE_SERIAL 0 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6b3" +#define TCL_PATCH_LEVEL "8.6.0" /* *---------------------------------------------------------------------------- diff --git a/library/init.tcl b/library/init.tcl index 3ec78af..e836df9 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.6b3 +package require -exact Tcl 8.6.0 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/unix/configure b/unix/configure index cbb10b4..f778a7b 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index f4b695d..087bb05 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index 0c42aa4..27f7189 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6b3 +Version: 8.6.0 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index 0258898..03a20b4 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.in b/win/configure.in index 0426bb1..b0c007a 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From ad8ed66c0296f8baa6364cb9704835ca44b83138 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Nov 2012 15:43:45 +0000 Subject: Declare TclOO portion of the Tcl API to be stable -> TclOO 1.0 --- generic/tclOO.h | 2 +- tests/oo.test | 2 +- tests/ooNext2.test | 2 +- unix/tclooConfig.sh | 2 +- win/tclooConfig.sh | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclOO.h b/generic/tclOO.h index 280481c..cf253b1 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -39,7 +39,7 @@ extern const char *TclOOInitializeStubs( * win/tclooConfig.sh */ -#define TCLOO_VERSION "0.7" +#define TCLOO_VERSION "1.0" #define TCLOO_PATCHLEVEL TCLOO_VERSION /* diff --git a/tests/oo.test b/tests/oo.test index 540cdf3..5d34077 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require -exact TclOO 0.7 ;# Must match value in generic/tclOO.h +package require TclOO 1.0 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/tests/ooNext2.test b/tests/ooNext2.test index e78e0d0..d77e8d1 100644 --- a/tests/ooNext2.test +++ b/tests/ooNext2.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require -exact TclOO 0.7 ;# Must match value in configure.in +package require TclOO 1.0 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh index dce540a..d2be8dd 100644 --- a/unix/tclooConfig.sh +++ b/unix/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS=-DUSE_TCLOO_STUBS -TCLOO_VERSION=0.7 +TCLOO_VERSION=1.0 diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh index dce540a..d2be8dd 100644 --- a/win/tclooConfig.sh +++ b/win/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS=-DUSE_TCLOO_STUBS -TCLOO_VERSION=0.7 +TCLOO_VERSION=1.0 -- cgit v0.12 From 3c5b4af0d42e9175d48a6e114ec5f3ec05e1b915 Mon Sep 17 00:00:00 2001 From: max Date: Mon, 26 Nov 2012 17:40:29 +0000 Subject: Factor out creation of the -sockname and -peername lists from TcpGetOptionProc() to TcpHostPortList(). Make it robust against implementations of getnameinfo() that error out if reverse mapping fails instead of falling back to the numeric representation. --- ChangeLog | 8 ++++ unix/tclUnixSock.c | 118 +++++++++++++++++++++++++++++++---------------------- 2 files changed, 78 insertions(+), 48 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9b4772c..c9d3cb3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-11-26 Reinhard Max + + * unix/tclUnixSock.c: Factor out creation of the -sockname and + -peername lists from TcpGetOptionProc() to TcpHostPortList(). + Make it robust against implementations of getnameinfo() that error + out if reverse mapping fails instead of falling back to the + numeric representation. + 2012-11-20 Donal K. Fellows * generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 102c620..31daa62 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -627,6 +627,74 @@ TcpClose2Proc( /* *---------------------------------------------------------------------- * + * TcpHostPortList -- + * + * This function is called by the -gethostname and -getpeername + * switches of TcpGetOptionProc() to add three list elements + * with the textual representation of the given address to the + * given DString. + * + * Results: + * None. + * + * Side effects: + * Adds three elements do dsPtr + * + *---------------------------------------------------------------------- + */ +static void +TcpHostPortList( + Tcl_Interp *interp, + Tcl_DString *dsPtr, + address addr, + socklen_t salen) +{ +#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" + char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV]; + int flags = 0; + + getnameinfo(&addr.sa, salen, + nhost, sizeof(nhost), nport, sizeof(nport), + NI_NUMERICHOST | NI_NUMERICSERV); + Tcl_DStringAppendElement(dsPtr, nhost); + /* + * We don't want to resolve INADDR_ANY and sin6addr_any; they + * can sometimes cause problems (and never have a name). + */ + if (addr.sa.sa_family == AF_INET) { + if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { + flags |= NI_NUMERICHOST; + } +#ifndef NEED_FAKE_RFC2553 + } else if (addr.sa.sa_family == AF_INET6) { + if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr, + &in6addr_any)) + || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) && + addr.sa6.sin6_addr.s6_addr[12] == 0 && + addr.sa6.sin6_addr.s6_addr[13] == 0 && + addr.sa6.sin6_addr.s6_addr[14] == 0 && + addr.sa6.sin6_addr.s6_addr[15] == 0)) { + flags |= NI_NUMERICHOST; + } +#endif /* NEED_FAKE_RFC2553 */ + } + /* Check if reverse DNS has been switched off globally */ + if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { + flags |= NI_NUMERICHOST; + } + if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) { + /* Reverse mapping worked */ + Tcl_DStringAppendElement(dsPtr, host); + } else { + /* Reverse mappong failed - use the numeric rep once more */ + Tcl_DStringAppendElement(dsPtr, nhost); + } + Tcl_DStringAppendElement(dsPtr, nport); +} + +/* + *---------------------------------------------------------------------- + * * TcpGetOptionProc -- * * Computes an option value for a TCP socket based channel, or a list of @@ -656,10 +724,7 @@ TcpGetOptionProc( * initialized by caller. */ { TcpState *statePtr = instanceData; - char host[NI_MAXHOST], port[NI_MAXSERV]; size_t len = 0; - int reverseDNS = 0; -#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" if (optionName != NULL) { len = strlen(optionName); @@ -686,10 +751,6 @@ TcpGetOptionProc( return TCL_OK; } - if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { - reverseDNS = NI_NUMERICHOST; - } - if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { address peername; @@ -700,14 +761,7 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } - - getnameinfo(&peername.sa, size, host, sizeof(host), NULL, 0, - NI_NUMERICHOST); - Tcl_DStringAppendElement(dsPtr, host); - getnameinfo(&peername.sa, size, host, sizeof(host), port, - sizeof(port), reverseDNS | NI_NUMERICSERV); - Tcl_DStringAppendElement(dsPtr, host); - Tcl_DStringAppendElement(dsPtr, port); + TcpHostPortList(interp, dsPtr, peername, size); if (len) { return TCL_OK; } @@ -745,40 +799,8 @@ TcpGetOptionProc( for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { size = sizeof(sockname); if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) { - int flags = reverseDNS; - found = 1; - getnameinfo(&sockname.sa, size, host, sizeof(host), NULL, 0, - NI_NUMERICHOST); - Tcl_DStringAppendElement(dsPtr, host); - - /* - * We don't want to resolve INADDR_ANY and sin6addr_any; they - * can sometimes cause problems (and never have a name). - */ - - flags |= NI_NUMERICSERV; - if (sockname.sa.sa_family == AF_INET) { - if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) { - flags |= NI_NUMERICHOST; - } -#ifndef NEED_FAKE_RFC2553 - } else if (sockname.sa.sa_family == AF_INET6) { - if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr, - &in6addr_any)) - || (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr) && - sockname.sa6.sin6_addr.s6_addr[12] == 0 && - sockname.sa6.sin6_addr.s6_addr[13] == 0 && - sockname.sa6.sin6_addr.s6_addr[14] == 0 && - sockname.sa6.sin6_addr.s6_addr[15] == 0)) { - flags |= NI_NUMERICHOST; - } -#endif /* NEED_FAKE_RFC2553 */ - } - getnameinfo(&sockname.sa, size, host, sizeof(host), port, - sizeof(port), flags); - Tcl_DStringAppendElement(dsPtr, host); - Tcl_DStringAppendElement(dsPtr, port); + TcpHostPortList(interp, dsPtr, sockname, size); } } if (found) { -- cgit v0.12 From 9652ccdb2f5dbc810445ea5431b278cf4417a9c1 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 28 Nov 2012 00:04:31 +0000 Subject: [3590483]: Some compilers cannot initialize with complex non-constants. --- ChangeLog | 8 +++++++- generic/tclZlib.c | 51 +++++++++++++++++++++++++++------------------------ 2 files changed, 34 insertions(+), 25 deletions(-) diff --git a/ChangeLog b/ChangeLog index c9d3cb3..6f8c8ae 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-11-28 Donal K. Fellows + + * generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism + for complex option resolution that has fewer problems with more + finicky compilers. + 2012-11-26 Reinhard Max * unix/tclUnixSock.c: Factor out creation of the -sockname and @@ -5,7 +11,7 @@ Make it robust against implementations of getnameinfo() that error out if reverse mapping fails instead of falling back to the numeric representation. - + 2012-11-20 Donal K. Fellows * generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 11490f1..c63c306 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -2177,29 +2177,35 @@ ZlibStreamSubcmd( FMT_INFLATE }; int i, format, mode = 0, option, level; + enum objIndices { + OPT_COMPRESSION_DICTIONARY = 0, + OPT_GZIP_HEADER = 1, + OPT_COMPRESSION_LEVEL = 2 + }; + Tcl_Obj *obj[3] = { NULL, NULL, NULL }; +#define compDictObj obj[OPT_COMPRESSION_DICTIONARY] +#define gzipHeaderObj obj[OPT_GZIP_HEADER] +#define levelObj obj[OPT_COMPRESSION_LEVEL] typedef struct { const char *name; - Tcl_Obj **valueVar; + enum objIndices offset; } OptDescriptor; - Tcl_Obj *compDictObj = NULL; - Tcl_Obj *gzipHeaderObj = NULL; - Tcl_Obj *levelObj = NULL; - const OptDescriptor compressionOpts[] = { - { "-dictionary", &compDictObj }, - { "-level", &levelObj }, - { NULL, NULL } + static const OptDescriptor compressionOpts[] = { + { "-dictionary", OPT_COMPRESSION_DICTIONARY }, + { "-level", OPT_COMPRESSION_LEVEL }, + { NULL, 0 } }; - const OptDescriptor gzipOpts[] = { - { "-header", &gzipHeaderObj }, - { "-level", &levelObj }, - { NULL, NULL } + static const OptDescriptor gzipOpts[] = { + { "-header", OPT_GZIP_HEADER }, + { "-level", OPT_COMPRESSION_LEVEL }, + { NULL, 0 } }; - const OptDescriptor expansionOpts[] = { - { "-dictionary", &compDictObj }, - { NULL, NULL } + static const OptDescriptor expansionOpts[] = { + { "-dictionary", OPT_COMPRESSION_DICTIONARY }, + { NULL, 0 } }; - const OptDescriptor gunzipOpts[] = { - { NULL, NULL } + static const OptDescriptor gunzipOpts[] = { + { NULL, 0 } }; const OptDescriptor *desc = NULL; Tcl_ZlibStream zh; @@ -2262,13 +2268,7 @@ ZlibStreamSubcmd( sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } - *desc[option].valueVar = objv[i+1]; - - /* - * Drop the cache on the option name; table address not constant. - */ - - TclFreeIntRep(objv[i]); + obj[desc[option].offset] = objv[i+1]; } /* @@ -2300,6 +2300,9 @@ ZlibStreamSubcmd( } Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh)); return TCL_OK; +#undef compDictObj +#undef gzipHeaderObj +#undef levelObj } /* -- cgit v0.12 From da12d58e11aba7b3a5f30364766ee0d5f30ce00b Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 28 Nov 2012 08:52:00 +0000 Subject: Silence some (unimportant) warnings from the MIPSpro compiler. --- generic/tclZlib.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index c63c306..8fbe049 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -2180,7 +2180,8 @@ ZlibStreamSubcmd( enum objIndices { OPT_COMPRESSION_DICTIONARY = 0, OPT_GZIP_HEADER = 1, - OPT_COMPRESSION_LEVEL = 2 + OPT_COMPRESSION_LEVEL = 2, + OPT_END = -1 }; Tcl_Obj *obj[3] = { NULL, NULL, NULL }; #define compDictObj obj[OPT_COMPRESSION_DICTIONARY] @@ -2193,19 +2194,19 @@ ZlibStreamSubcmd( static const OptDescriptor compressionOpts[] = { { "-dictionary", OPT_COMPRESSION_DICTIONARY }, { "-level", OPT_COMPRESSION_LEVEL }, - { NULL, 0 } + { NULL, OPT_END } }; static const OptDescriptor gzipOpts[] = { { "-header", OPT_GZIP_HEADER }, { "-level", OPT_COMPRESSION_LEVEL }, - { NULL, 0 } + { NULL, OPT_END } }; static const OptDescriptor expansionOpts[] = { { "-dictionary", OPT_COMPRESSION_DICTIONARY }, - { NULL, 0 } + { NULL, OPT_END } }; static const OptDescriptor gunzipOpts[] = { - { NULL, 0 } + { NULL, OPT_END } }; const OptDescriptor *desc = NULL; Tcl_ZlibStream zh; -- cgit v0.12 From 665a380e86877529932a05da6d253011e8065642 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 13:15:36 +0000 Subject: silence compiler warning --- generic/tclCompCmdsSZ.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index be63e0e..9c93fb2 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1224,12 +1224,7 @@ TclCompileSwitchCmd( if (TCL_OK != TclFindElement(NULL, bytes, numBytes, &(bodyTokenArray[numWords].start), &bytes, &(bodyTokenArray[numWords].size), &literal) || !literal) { - abort: - ckfree((char *) bodyToken); - ckfree((char *) bodyTokenArray); - ckfree((char *) bodyLines); - ckfree((char *) bodyContLines); - return TCL_ERROR; + goto abort; } bodyTokenArray[numWords].type = TCL_TOKEN_TEXT; @@ -1254,7 +1249,12 @@ TclCompileSwitchCmd( numWords++; } if (numWords % 2) { - goto abort; + abort: + ckfree((char *) bodyToken); + ckfree((char *) bodyTokenArray); + ckfree((char *) bodyLines); + ckfree((char *) bodyContLines); + return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { /* -- cgit v0.12 From 8bdf6a3cdd5c1ace4435d972fd5f183ce4f3e18c Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Nov 2012 14:47:12 +0000 Subject: 3588687 When detecting incompatibility during stubs initialization, the error message has always assumed a stubs-disabled 8.0 interp to be the cause. That's no longer a good assumption. More suitable error message committed. --- generic/tclStubLib.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 1ab7ff3..7bf04a0 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -47,7 +47,7 @@ HasStubSupport (interp) if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } - interp->result = "This interpreter does not support stubs-enabled extensions."; + interp->result = "interpreter uses an incompatible stubs mechanism"; interp->freeProc = TCL_STATIC; return NULL; -- cgit v0.12 From c85fd541529c09d23c1091969ad8f96012bb68ec Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 30 Nov 2012 09:16:16 +0000 Subject: Inform the HTML builder about the TDBC drivers. --- pkgs/package.list.txt | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt index 5020506..f12111d 100644 --- a/pkgs/package.list.txt +++ b/pkgs/package.list.txt @@ -19,3 +19,8 @@ thread Thread tdbc TDBC Tdbc TDBC TDBC TDBC +# Drivers for TDBC +tdbcmysql tdbc::mysql +tdbcodbc tdbc::odbc +tdbcpostgres tdbc::postgres +tdbcsqlite3- tdbc::sqlite3 -- cgit v0.12 From 06d38df148ae4415dd9b1ed7afff6d74a5482345 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 2 Dec 2012 14:35:03 +0000 Subject: Allow http, msgcat and tcltest to be loaded by Tcl 9 as well. I think that this should be included in tcl8.6.0: Those 3 packages are so widely used, we don't want to introduce Tcl-level incompatibilities in Tcl9 such that those packages wouldn't work any more. Moved to branch novem-support. For now, novem is a playground. The trunk is not. By all means lets track what we need for migration, but hold back committing to them until we commit more meaningfully to where we're going. --- library/http/http.tcl | 2 +- library/http/pkgIndex.tcl | 2 +- library/msgcat/msgcat.tcl | 2 +- library/msgcat/pkgIndex.tcl | 2 +- library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index d57e3ce..c3290c9 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.5 diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 303d3bd..828c860 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.6]} {return} +if {![package vsatisfies [package provide Tcl] 8.6-]} {return} package ifneeded http 2.8.5 [list tclPkgSetup $dir http 2.8.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 112507a..5f8e1e9 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 +package require Tcl 8.5- # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.5.0 diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 832bf81..a5b6499 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 0e4568d..3769155 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded tcltest 2.3.4 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 02da62f..12692bb 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -package require Tcl 8.5 ;# -verbose line uses [info frame] +package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, -- cgit v0.12 From 8ef61c13e0df3175cac5b314840f726f7407b6f8 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 3 Dec 2012 14:33:17 +0000 Subject: Post-header reform (long long ago now) Tcl headers take care of their own protection from EXTERN definitions. --- unix/tclLoadShl.c | 9 --------- 1 file changed, 9 deletions(-) diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index c9e4e27..8aaefda 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -12,15 +12,6 @@ */ #include - -/* - * On some HP machines, dl.h defines EXTERN; remove that definition. - */ - -#ifdef EXTERN -# undef EXTERN -#endif - #include "tclInt.h" /* -- cgit v0.12 From b222d2f2b2dbf7666e44385dc825b59b5045b3f2 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 3 Dec 2012 19:14:32 +0000 Subject: Disable the legacy configuration setting from $::argv only when a setting call to [configure] is made. Queries should not disturb that support. Bump to tcltest 2.2.11. --- library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index e569fa5..eb5859e 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.3]} {return} -package ifneeded tcltest 2.2.10 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.2.11 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 4ae1480c..5d89748 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.2.10 + variable Version 2.2.11 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -601,7 +601,9 @@ namespace eval tcltest { } } proc configure args { - RemoveAutoConfigureTraces + if {[llength $args] > 1} { + RemoveAutoConfigureTraces + } set code [catch {eval Configure $args} msg] return -code $code $msg } -- cgit v0.12 From ae09e66da466ea68e269fc388798ca6ce2cd1c4c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 4 Dec 2012 13:39:07 +0000 Subject: MODULE_SCOPE symbol names are suppoted to start with 'tcl' (data) or 'Tcl' (code) --- generic/tclParse.c | 2 +- generic/tclParse.h | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclParse.c b/generic/tclParse.c index 309e232..08615a7 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -42,7 +42,7 @@ * TYPE_BRACE - Character is a curly brace (either left or right). */ -const char charTypeTable[] = { +const char tclCharTypeTable[] = { /* * Negative character values, from -128 to -1: */ diff --git a/generic/tclParse.h b/generic/tclParse.h index be1ab15..20c609c 100644 --- a/generic/tclParse.h +++ b/generic/tclParse.h @@ -12,6 +12,6 @@ #define TYPE_CLOSE_BRACK 0x20 #define TYPE_BRACE 0x40 -#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)] +#define CHAR_TYPE(c) (tclCharTypeTable+128)[(int)(c)] -MODULE_SCOPE const char charTypeTable[]; +MODULE_SCOPE const char tclCharTypeTable[]; -- cgit v0.12 From b1e66e34704ff978d2dbacea83cc81ae8650a6d0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Dec 2012 13:31:22 +0000 Subject: Fix gcc warning in cygwin build: implicitely declared function TclUnixOpenTemporaryFile. Move the function to slot 30, and define it (as 0) for win32 as well. --- generic/tclInt.decls | 19 +++++++++---------- generic/tclIntPlatDecls.h | 41 +++++++++++++++++++++++++++-------------- generic/tclStubInit.c | 8 ++++++-- 3 files changed, 42 insertions(+), 26 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8f8b992..f215d32 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1148,9 +1148,6 @@ declare 27 win { declare 28 win { void TclWinResetInterfaces(void) } -declare 29 win { - int TclWinCPUID(unsigned int index, unsigned int *regs) -} ################################ # Unix specific functions @@ -1219,12 +1216,6 @@ declare 14 unix { const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } -# Added in 8.6; core of TclpOpenTemporaryFile -declare 20 unix { - int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, - Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) -} - ################################ # Mac OS X specific functions @@ -1248,9 +1239,17 @@ declare 18 macosx { declare 19 macosx { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } -declare 29 unix { + +declare 29 {win unix} { int TclWinCPUID(unsigned int index, unsigned int *regs) } +# Added in 8.6; core of TclpOpenTemporaryFile +declare 30 {win unix} { + int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, + Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) +} + + # Local Variables: # mode: tcl diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index f265e7e..dcf1753 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -84,10 +84,7 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst, /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ -/* 20 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, - Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, - Tcl_Obj *resultingNameObj); +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -98,6 +95,10 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ @@ -169,6 +170,10 @@ EXTERN void TclWinFlushDirtyChannels(void); EXTERN void TclWinResetInterfaces(void); /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ @@ -228,10 +233,7 @@ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); -/* 20 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, - Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, - Tcl_Obj *resultingNameObj); +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -242,6 +244,10 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); #endif /* MACOSX */ typedef struct TclIntPlatStubs { @@ -269,7 +275,7 @@ typedef struct TclIntPlatStubs { void (*reserved17)(void); void (*reserved18)(void); void (*reserved19)(void); - int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 20 */ + void (*reserved20)(void); void (*reserved21)(void); void (*reserved22)(void); void (*reserved23)(void); @@ -279,6 +285,7 @@ typedef struct TclIntPlatStubs { void (*reserved27)(void); void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ @@ -311,6 +318,7 @@ typedef struct TclIntPlatStubs { void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*tclWinResetInterfaces) (void); /* 28 */ int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ @@ -333,7 +341,7 @@ typedef struct TclIntPlatStubs { int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ - int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 20 */ + void (*reserved20)(void); void (*reserved21)(void); void (*reserved22)(void); void (*reserved23)(void); @@ -343,6 +351,7 @@ typedef struct TclIntPlatStubs { void (*reserved27)(void); void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* MACOSX */ } TclIntPlatStubs; @@ -395,8 +404,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ -#define TclUnixOpenTemporaryFile \ - (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 20 */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -407,6 +415,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ @@ -467,6 +477,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define TclGetAndDetachPids \ @@ -508,8 +520,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ -#define TclUnixOpenTemporaryFile \ - (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 20 */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -520,6 +531,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0bede56..88ada19 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -65,6 +65,7 @@ static unsigned short TclWinNToHS(unsigned short ns) { #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 +# define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) @@ -465,7 +466,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { 0, /* 17 */ 0, /* 18 */ 0, /* 19 */ - TclUnixOpenTemporaryFile, /* 20 */ + 0, /* 20 */ 0, /* 21 */ 0, /* 22 */ 0, /* 23 */ @@ -475,6 +476,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { 0, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ + TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ @@ -507,6 +509,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclWinFlushDirtyChannels, /* 27 */ TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ + TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ TclGetAndDetachPids, /* 0 */ @@ -529,7 +532,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclUnixOpenTemporaryFile, /* 20 */ + 0, /* 20 */ 0, /* 21 */ 0, /* 22 */ 0, /* 23 */ @@ -539,6 +542,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { 0, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ + TclUnixOpenTemporaryFile, /* 30 */ #endif /* MACOSX */ }; -- cgit v0.12 From 80f5d8964ac592076e2adbb83d4402382d01914d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Dec 2012 14:42:48 +0000 Subject: use Tcl_PkgProvideEx everywhere (again, for testing purposes) --- generic/tclTest.c | 2 +- generic/tclTestProcBodyObj.c | 2 +- generic/tclZlib.c | 2 +- unix/dltest/pkga.c | 2 +- unix/dltest/pkgb.c | 4 ++-- unix/dltest/pkgc.c | 4 ++-- unix/dltest/pkgd.c | 4 ++-- unix/dltest/pkgua.c | 2 +- win/tclWinDde.c | 2 +- win/tclWinReg.c | 2 +- 10 files changed, 13 insertions(+), 13 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index a8b27fb..b112e2d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -544,7 +544,7 @@ Tcltest_Init( } /* TIP #268: Full patchlevel instead of just major.minor */ - if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index a3f89f6..7b33895 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -185,7 +185,7 @@ ProcBodyTestInitInternal( } } - return Tcl_PkgProvide(interp, packageName, packageVersion); + return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); } /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 8fbe049..c85123b 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3884,7 +3884,7 @@ TclZlibInit( * Formally provide the package as a Tcl built-in. */ - return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); + return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL); } /* diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index 901f4c9..8d40758 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -134,7 +134,7 @@ Pkga_Init( if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkga", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkga", "1.0", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index b00d4e5..f6f7bbb 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -124,7 +124,7 @@ Pkgb_Init( if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { return code; } @@ -161,7 +161,7 @@ Pkgb_SafeInit( if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index e5678dc..a70f929 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -124,7 +124,7 @@ Pkgc_Init( if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } @@ -161,7 +161,7 @@ Pkgc_SafeInit( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 877489c..e6538cd 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -124,7 +124,7 @@ Pkgd_Init( if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } @@ -161,7 +161,7 @@ Pkgd_SafeInit( if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 18a1cac..87df4a0 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -219,7 +219,7 @@ Pkgua_Init( PkguaInitTokensHashTable(); - code = Tcl_PkgProvide(interp, "Pkgua", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkgua", "1.0", NULL); if (code != TCL_OK) { return code; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 13e1f18..4df308b 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -170,7 +170,7 @@ Dde_Init( #endif Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); + return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 8bb14d0..8b13afb 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -172,7 +172,7 @@ Registry_Init( cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.0"); + return Tcl_PkgProvideEx(interp, "registry", "1.3.0", NULL); } /* -- cgit v0.12 From 6a27e83c7193e742481d954eddb39a02586b54bf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Dec 2012 22:38:20 +0000 Subject: do some Tcl_EvalEx, for test-purposes, demonstrating a crash --- unix/dltest/pkgb.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index f6f7bbb..772b239 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -93,8 +93,7 @@ Pkgb_UnsafeObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); - return TCL_OK; + return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); } /* -- cgit v0.12 From 92b20ad57f4d24e7d2d915c6059e0decb570276d Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Dec 2012 21:03:22 +0000 Subject: Tcl_InitStubs("8.5",1) would succeed in an "8.50" interp. Fixed. --- generic/tclStubLib.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 871d7ea..9774731 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -118,7 +118,7 @@ Tcl_InitStubs( while (*p && (*p == *q)) { p++; q++; } - if (*p) { + if (*p || isDigit(*q)) { /* Construct error message */ Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; -- cgit v0.12 From 99bda89c0b6500e673ecacd280527492c780b562 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Dec 2012 14:53:40 +0000 Subject: Extended test of [load]ing Tcl 8 compiled extension into Tcl 9 interp. --- unix/dltest/pkgb.c | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 02bd233..9c199ca 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -30,6 +30,8 @@ static int Pkgb_SubObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int Pkgb_UnsafeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int Pkgb_DemoObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -95,6 +97,17 @@ Pkgb_UnsafeObjCmd( { return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); } + +static int +Pkgb_DemoObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + const char *foo = Tcl_GetDefaultEncodingDir(); + return TCL_OK; +} /* *---------------------------------------------------------------------- @@ -128,8 +141,8 @@ Pkgb_Init( return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, - NULL); + Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL); return TCL_OK; } -- cgit v0.12 From fa2a03a1bf7c810f5d6fb14da98de6d4526339af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 Dec 2012 15:51:25 +0000 Subject: add proper runtime-detection to pkgb.so --- unix/dltest/pkgb.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 9c199ca..1a362ef 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -98,6 +98,11 @@ Pkgb_UnsafeObjCmd( return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); } +#if (TCL_MAJOR_VERSION > 8) +# define Tcl_GetDefaultEncodingDir ((const char *(*)(void)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[341])) +#endif + static int Pkgb_DemoObjCmd( ClientData dummy, /* Not used. */ @@ -105,7 +110,11 @@ Pkgb_DemoObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *foo = Tcl_GetDefaultEncodingDir(); + if(!Tcl_GetDefaultEncodingDir) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("not supported", -1)); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1)); return TCL_OK; } -- cgit v0.12 From ef331c2b06dede42238295f9b0fbaedb83f668b2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 Dec 2012 15:53:29 +0000 Subject: fix failing test --- tests/load.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/load.test b/tests/load.test index eef677f..cded85d 100644 --- a/tests/load.test +++ b/tests/load.test @@ -188,7 +188,7 @@ test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] { load [file join $testDir pkgb$ext] pkgb list [info loaded {}] [lsort [info commands pkgb_*]] -} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}] +} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}] interp delete child test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \ -- cgit v0.12 From a4a99b73219c5f30bd18f6349427c834691b2c46 Mon Sep 17 00:00:00 2001 From: mig Date: Fri, 7 Dec 2012 15:56:13 +0000 Subject: small correction in doc/NRE.3 --- doc/NRE.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/NRE.3 b/doc/NRE.3 index be2c58b..4ad78b3 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -295,7 +295,7 @@ int int result) { /* \fIdata[0] .. data[3]\fR are the four words of data - * passed to \fBTcl_NREvalObj\fR */ + * passed to \fBTcl_NRAddCallback\fR */ \fI... postprocessing ...\fR -- cgit v0.12 From cee1ce03b712770dc55c7c3b4b65c5026546d53f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Dec 2012 17:03:39 +0000 Subject: Source compat, rather than stubs compat demo. --- unix/dltest/pkgb.c | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 1a362ef..9884a64 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -99,8 +99,19 @@ Pkgb_UnsafeObjCmd( } #if (TCL_MAJOR_VERSION > 8) -# define Tcl_GetDefaultEncodingDir ((const char *(*)(void)) \ - ((&(tclStubsPtr->tcl_PkgProvideEx))[341])) +const char *Tcl_GetDefaultEncodingDir(void) +{ + int numDirs; + Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); + + Tcl_ListObjLength(NULL, searchPath, &numDirs); + if (numDirs == 0) { + return NULL; + } + Tcl_ListObjIndex(NULL, searchPath, 0, &first); + + return Tcl_GetString(first); +} #endif static int @@ -110,10 +121,6 @@ Pkgb_DemoObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if(!Tcl_GetDefaultEncodingDir) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("not supported", -1)); - return TCL_ERROR; - } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1)); return TCL_OK; } -- cgit v0.12 From 6d6c732492789c16c16f822a7b3ae1421261b86d Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Dec 2012 18:07:18 +0000 Subject: 3593703 Don't crash on bad input to Tcl_PkgRequire*(). --- generic/tclPkg.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index aed80c0..b3396e6 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -353,6 +353,10 @@ PkgRequireCore( char *script, *pkgVersionI; Tcl_DString command; + if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) { + return NULL; + } + /* * It can take up to three passes to find the package: one pass to run the * "package unknown" script, one to run the "package ifneeded" script for -- cgit v0.12 From e76d16d3eba7f034fc003f1061736c298b03c74f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 Dec 2012 21:28:49 +0000 Subject: only set tclStubsPtr if all version checks pass. Backported from tcl 8.5. --- generic/tclStubLib.c | 105 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 62 insertions(+), 43 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 7bf04a0..39e94c8 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -1,45 +1,26 @@ -/* +/* * tclStubLib.c -- * - * Stub object that will be statically linked into extensions that wish + * Stub object that will be statically linked into extensions that want * to access Tcl. * * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 1998 Paul Duffin. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -/* - * We need to ensure that we use the stub macros so that this file contains - * no references to any of the stub functions. This will make it possible - * to build an extension that references Tcl_InitStubs but doesn't end up - * including the rest of the stub functions. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifndef USE_TCL_STUBS -#define USE_TCL_STUBS -#endif -#undef USE_TCL_STUB_PROCS - #include "tclInt.h" #include "tclPort.h" -/* - * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub - * functions should be built as non-exported symbols. - */ - TclStubs *tclStubsPtr = NULL; TclPlatStubs *tclPlatStubsPtr = NULL; TclIntStubs *tclIntStubsPtr = NULL; TclIntPlatStubs *tclIntPlatStubsPtr = NULL; -static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp)); - static TclStubs * -HasStubSupport (interp) +HasStubSupport(interp) Tcl_Interp *interp; { Interp *iPtr = (Interp *) interp; @@ -49,57 +30,87 @@ HasStubSupport (interp) } interp->result = "interpreter uses an incompatible stubs mechanism"; interp->freeProc = TCL_STATIC; - return NULL; } /* + * Use our own isdigit to avoid linking to libc on windows + */ + +static int isDigit(const int c) +{ + return (c >= '0' && c <= '9'); +} + +/* *---------------------------------------------------------------------- * * Tcl_InitStubs -- * - * Tries to initialise the stub table pointers and ensures that - * the correct version of Tcl is loaded. + * Tries to initialise the stub table pointers and ensures that the + * correct version of Tcl is loaded. * * Results: - * The actual version of Tcl that satisfies the request, or - * NULL to indicate that an error occurred. + * The actual version of Tcl that satisfies the request, or NULL to + * indicate that an error occurred. * * Side effects: * Sets the stub table pointers. * *---------------------------------------------------------------------- */ - -#ifdef Tcl_InitStubs #undef Tcl_InitStubs -#endif - CONST char * -Tcl_InitStubs (interp, version, exact) +Tcl_InitStubs(interp, version, exact) Tcl_Interp *interp; CONST char *version; int exact; { CONST char *actualVersion = NULL; - ClientData pkgData = NULL; + TclStubs *stubsPtr; /* - * We can't optimize this check by caching tclStubsPtr because - * that prevents apps from being able to load/unload Tcl dynamically - * multiple times. [Bug 615304] + * We can't optimize this check by caching tclStubsPtr because that + * prevents apps from being able to load/unload Tcl dynamically multiple + * times. [Bug 615304] */ - tclStubsPtr = HasStubSupport(interp); - if (!tclStubsPtr) { + stubsPtr = HasStubSupport(interp); + if (!stubsPtr) { return NULL; } - actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData); + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, NULL); if (actualVersion == NULL) { return NULL; } - tclStubsPtr = (TclStubs*)pkgData; + if (exact) { + CONST char *p = version; + int count = 0; + + while (*p) { + count += !isDigit(*p++); + } + if (count == 1) { + CONST char *q = actualVersion; + + p = version; + while (*p && (*p == *q)) { + p++; q++; + } + if (*p || isDigit(*q)) { + /* Construct error message */ + stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + return NULL; + } + } else { + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + if (actualVersion == NULL) { + return NULL; + } + } + } + tclStubsPtr = stubsPtr; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; @@ -110,6 +121,14 @@ Tcl_InitStubs (interp, version, exact) tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; } - + return actualVersion; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ -- cgit v0.12 From 8ea32cad84602b02b1eab7b2ca01bf583bd1c9db Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 Dec 2012 22:14:26 +0000 Subject: just lost one MODULE_SCOPE in the merge --- generic/tclStubLib.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 5a122dd..b8979df 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -64,7 +64,7 @@ static int isDigit(const int c) *---------------------------------------------------------------------- */ #undef Tcl_InitStubs -const char * +MODULE_SCOPE const char * Tcl_InitStubs( Tcl_Interp *interp, const char *version, -- cgit v0.12 From 5ab4d052c526754eca52cbec0aea41c6a61d7fb6 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sat, 8 Dec 2012 17:13:03 +0000 Subject: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT when there are unflushed nonblocking channels. Thanks Miguel for spotting. --- ChangeLog | 5 +++++ generic/tclIO.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 37c3e2e..c1a3ff7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-12-08 Alexandre Ferrieux + * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT + when there are unflushed nonblocking channels. Thanks Miguel for + spotting. + 2012-12-07 Jan Nijtmans * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test diff --git a/generic/tclIO.c b/generic/tclIO.c index 0cb9fa9..715c1ef 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2472,7 +2472,7 @@ FlushChannel( * it's a tty channel (dup'ed underneath) */ - if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) { SetFlag(statePtr, BG_FLUSH_SCHEDULED); UpdateInterest(chanPtr); } -- cgit v0.12 From ff12195b2b7d3b9d0f8f4441bd3ec0c991ba742b Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sun, 9 Dec 2012 11:52:04 +0000 Subject: Clean up unwanted eofchar side-effect of chan-4.6 leading to a spurious "'" at end of chan.test under certain conditions (see [Bug 3389289] and [Bug 3389251]). --- ChangeLog | 5 +++++ tests/chan.test | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index c1a3ff7..aeb6a62 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-12-09 Alexandre Ferrieux + * tests/chan.test: Clean up unwanted eofchar side-effect of + chan-4.6 leading to a spurious "'" at end of chan.test under + certain conditions (see [Bug 3389289] and [Bug 3389251]). + 2012-12-08 Alexandre Ferrieux * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT when there are unflushed nonblocking channels. Thanks Miguel for diff --git a/tests/chan.test b/tests/chan.test index da44ffd..d8390e2 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -61,7 +61,7 @@ test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { } -returnCodes error -match glob -result {bad value for -eofchar:*} test chan-4.6 {chan command: check no inValue, valid outValue} -body { chan configure stdout -eofchar [list {} \x27] -} -returnCodes ok -result {} +} -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]} test chan-5.1 {chan command: copy subcommand} -body { chan copy foo -- cgit v0.12 From a68a31f4bff004ca60d9cf17cb74a9fc8b94d2ed Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sun, 9 Dec 2012 19:44:57 +0000 Subject: [Bug 3594188] Clarifications about commas. --- ChangeLog | 1 + doc/expr.n | 16 ++++++++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index aeb6a62..9c42929 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,7 @@ * tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6 leading to a spurious "'" at end of chan.test under certain conditions (see [Bug 3389289] and [Bug 3389251]). + * doc/expr.n: [Bug 3594188] Clarifications about commas. 2012-12-08 Alexandre Ferrieux * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT diff --git a/doc/expr.n b/doc/expr.n index 6d965fb..8698f5c 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -39,9 +39,9 @@ additional operators not found in C. .SS OPERANDS .PP A Tcl expression consists of a combination of operands, operators, -and parentheses. +parentheses and commas. White space may be used between the operands and operators and -parentheses; it is ignored by the expression's instructions. +parentheses (or commas); it is ignored by the expression's instructions. Where possible, operands are interpreted as integer values. Integer values may be specified in decimal (the normal case), in binary (if the first two characters of the operand are \fB0b\fR), in octal @@ -283,6 +283,18 @@ rules for resolving functions in namespaces. Either current]::tcl::mathfunc::sin\fR will satisfy the request, and others may as well (depending on the current \fBnamespace path\fR setting). .PP +Some mathematical functions have several arguments, separated by commas like in C. Thus: +.PP +.CS +\fBexpr\fR {hypot($x,$y)} +.CE +.PP +ends up as +.PP +.CS +tcl::mathfunc::hypot $x $y +.CE +.PP See the \fBmathfunc\fR(n) manual page for the math functions that are available by default. .SS "TYPES, OVERFLOW, AND PRECISION" -- cgit v0.12 From e595fefe85b468cabc5e2cbebb030a525b46228f Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Dec 2012 14:08:59 +0000 Subject: Restore the initialization of tclStubsPtr from the "Tcl" package clientData so that we don't close off a potential avenue of future innovations. --- generic/tclStubLib.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 39e94c8..ceee8f3 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -67,6 +67,7 @@ Tcl_InitStubs(interp, version, exact) int exact; { CONST char *actualVersion = NULL; + ClientData pkgData = NULL; TclStubs *stubsPtr; /* @@ -80,7 +81,7 @@ Tcl_InitStubs(interp, version, exact) return NULL; } - actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, NULL); + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); if (actualVersion == NULL) { return NULL; } @@ -110,7 +111,7 @@ Tcl_InitStubs(interp, version, exact) } } } - tclStubsPtr = stubsPtr; + tclStubsPtr = (TclStubs *)pkgData; if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; -- cgit v0.12 From 005010e14da826074d8b45810962d7eee6fe8c36 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 10 Dec 2012 23:23:50 +0000 Subject: Improve the generation of HTML documentation in 8.6, allowing for contributed packages whose non-version name parts are prefixes of others. Also ensure that documentation builds are complete after distribution, and that we generate a better error message when using the wrong tclsh version to do the build. --- ChangeLog | 29 ++++++++++++++++++++--------- tools/tcltk-man2html.tcl | 22 +++++++++++++++------- unix/Makefile.in | 3 ++- 3 files changed, 37 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9c42929..9beccc7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,12 +1,23 @@ +2012-12-10 Donal K. Fellows + + * tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of + version number detection code to deal with packages whose names are + prefixes of other packages. + * unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution + builds to ensure that 'make html' will work better. + 2012-12-09 Alexandre Ferrieux - * tests/chan.test: Clean up unwanted eofchar side-effect of - chan-4.6 leading to a spurious "'" at end of chan.test under - certain conditions (see [Bug 3389289] and [Bug 3389251]). - * doc/expr.n: [Bug 3594188] Clarifications about commas. + + * tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6 + leading to a spurious "'" at end of chan.test under certain conditions + (see [Bug 3389289] and [Bug 3389251]). + + * doc/expr.n: [Bug 3594188]: Clarifications about commas. 2012-12-08 Alexandre Ferrieux + * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT - when there are unflushed nonblocking channels. Thanks Miguel for + when there are unflushed nonblocking channels. Thanks Miguel for spotting. 2012-12-07 Jan Nijtmans @@ -24,10 +35,10 @@ 2012-11-26 Reinhard Max * unix/tclUnixSock.c: Factor out creation of the -sockname and - -peername lists from TcpGetOptionProc() to TcpHostPortList(). - Make it robust against implementations of getnameinfo() that error - out if reverse mapping fails instead of falling back to the - numeric representation. + -peername lists from TcpGetOptionProc() to TcpHostPortList(). Make it + robust against implementations of getnameinfo() that error out if + reverse mapping fails instead of falling back to the numeric + representation. 2012-11-20 Donal K. Fellows diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 665a1d4..270a774 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,6 +1,12 @@ #!/usr/bin/env tclsh -package require Tcl 8.6 +if {[catch {package require Tcl 8.6} msg]} { + puts stderr "ERROR: $msg" + puts stderr "If running this script from 'make html', set the\ + NATIVE_TCLSH environment\nvariable to point to an installed\ + tclsh8.6 (or the equivalent tclsh86.exe\non Windows)." + exit 1 +} # Convert Ousterhout format man pages into highly crosslinked hypertext. # @@ -16,7 +22,7 @@ package require Tcl 8.6 # Copyright (c) 1995-1997 Roger E. Critchlow Jr # Copyright (c) 2004-2010 Donal K. Fellows -regexp {\d+\.\d+} {$Revision: 1.49 $} ::Version +set ::Version "50/8.6" set ::CSSFILE "docs.css" ## @@ -454,16 +460,18 @@ proc plus-pkgs {type args} { } if {!$build_tcl} return set result {} + set pkgsdir $tcltkdir/$tcldir/pkgs foreach {dir name} $args { - set globpat $tcltkdir/$tcldir/pkgs/$dir*/doc/*.$type - if {![llength [glob -nocomplain $globpat]]} { + set globpat $pkgsdir/{$dir,$dir\[0-9\]*}/doc/*.$type + if {![llength [glob -type f -nocomplain $globpat]]} { # Fallback for manpages generated using doctools - set globpat $tcltkdir/$tcldir/pkgs/$dir*/doc/man/*.$type - if {![llength [glob -nocomplain $globpat]]} { + set globpat $pkgsdir/{$dir,$dir\[0-9\]*}/doc/man/*.$type + if {![llength [glob -type f -nocomplain $globpat]]} { continue } } - regexp "pkgs/${dir}(.*)/doc$" [glob $tcltkdir/$tcldir/pkgs/$dir*/doc] \ + regexp "pkgs/${dir}(.*)/doc$" \ + [lindex [glob -type d $pkgsdir/{$dir,$dir\[0-9\]*}/doc] 0] \ -> version switch $type { n { diff --git a/unix/Makefile.in b/unix/Makefile.in index df05759..680d4ce 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2019,7 +2019,8 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ $(DISTDIR)/libtommath mkdir $(DISTDIR)/pkgs - cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/README $(TOP_DIR)/pkgs/package.list.txt \ + $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done -- cgit v0.12 From 1f1d7f55107bdc5a370bd404c4e35e171a0f2eea Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 11 Dec 2012 21:19:11 +0000 Subject: update changes --- changes | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/changes b/changes index 0ced7a1..b517cec 100644 --- a/changes +++ b/changes @@ -8117,11 +8117,45 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows) --- Released 8.6b3, September 18, 2012 --- See ChangeLog for details --- +2012-09-20 (enhancement) full Unicode support (nijtmans) +=> dde 1.4.0 + +2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans) + 2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter) 2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans) +2012-10-16 (TIP 400) New [zlib] options to set compression dict (fellows) + +2012-10-16 (TIP 405) New commands [lmap] and [dict map] (fellows) + +2012-10-24 (enhancement) [dict unset] now bytecompiled (fellows) + +2012-11-05 (TIP 413) Revisions to default [string trim*] trimset (nijtmans) + *** POTENTIAL INCOMPATIBILITY *** + +2012-11-05 (enhancement) Now bytecompiled: [array exists], [array set], +[array unset], [dict create], [dict exists], [dict merge], [format], +[info commands], [info coroutine], [info level], [info object], +[namespace current], [namespace code], [namespace qualifiers], [namespace tail], +[namespace which], [regsub], [self], [string first], [string last], +[string map], [string range], [tailcall], [yield]. (fellows) + 2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows) => http 2.8.5 ---- Released 8.6.0, ??? ??, 2012 --- See ChangeLog for details --- +2012-11-07 tzdata updated to Olson's tzdata2012i (kenny) + +2012-11-13 (bug fix)[3567063] thread fp settings from master (mistachkin) + +2012-11-14 (bug fix)[2933003] tempfile creation in $TMPDIR (fellows) + +2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans) + +2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth) + +2012-12-03 (bug fix) [configure] query broke init from argv (porter) +=> tcltest 2.3.5 + +--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- -- cgit v0.12 From 55ceb591d7bd0c530c73961be1c05996e8cc5920 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Dec 2012 20:16:13 +0000 Subject: Prefer to extract package data from the *contents* not the directory name. --- pkgs/package.list.txt | 2 +- tools/tcltk-man2html.tcl | 57 +++++++++++++++++++++++++++++++++++++++++------- unix/Makefile.in | 3 +-- 3 files changed, 51 insertions(+), 11 deletions(-) diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt index f12111d..a13b0fb 100644 --- a/pkgs/package.list.txt +++ b/pkgs/package.list.txt @@ -23,4 +23,4 @@ TDBC TDBC tdbcmysql tdbc::mysql tdbcodbc tdbc::odbc tdbcpostgres tdbc::postgres -tdbcsqlite3- tdbc::sqlite3 +tdbcsqlite3 tdbc::sqlite3 diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 270a774..f392bce 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -461,18 +461,15 @@ proc plus-pkgs {type args} { if {!$build_tcl} return set result {} set pkgsdir $tcltkdir/$tcldir/pkgs - foreach {dir name} $args { - set globpat $pkgsdir/{$dir,$dir\[0-9\]*}/doc/*.$type + foreach {dir name version} $args { + set globpat $pkgsdir/$dir/doc/*.$type if {![llength [glob -type f -nocomplain $globpat]]} { # Fallback for manpages generated using doctools - set globpat $pkgsdir/{$dir,$dir\[0-9\]*}/doc/man/*.$type + set globpat $pkgsdir/$dir/doc/man/*.$type if {![llength [glob -type f -nocomplain $globpat]]} { continue } } - regexp "pkgs/${dir}(.*)/doc$" \ - [lindex [glob -type d $pkgsdir/{$dir,$dir\[0-9\]*}/doc] 0] \ - -> version switch $type { n { set title "$name Package Commands" @@ -650,6 +647,42 @@ try { append appdir "$tkdir" } + + # When building docs for Tcl, try to build docs for bundled packages too + set packageBuildList {} + if {$build_tcl} { + set pkgsDir [file join $tcltkdir $tcldir pkgs] + set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *] + + foreach dir [lsort $subdirs] { + # Parse the subdir name into (name, version) as fallback... + set description [split $dir -] + if {2 != [llength $description]} { + regexp {([^0-9]*)(.*)} $dir -> n v + set description [list $n $v] + } + + # ... but try to extract (name, version) from subdir contents + try { + set f [open [file join $pkgsDir $dir configure.in]] + foreach line [split [read $f] \n] { + if {2 == [scan $line \ + { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} { + set description [list $n $v] + break + } + } + } finally { + catch {close $f; unset f} + } + + if {[file exists [file join $pkgsDir $dir configure]]} { + # Looks like a package, record our best extraction attempt + lappend packageBuildList $dir {*}$description + } + } + } + # Get the list of packages to try, and what their human-readable names # are. Note that the package directory list should be version-less. try { @@ -674,6 +707,14 @@ try { } } + # Convert to human readable names, if applicable + for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} { + lassign [lrange $packageBuildList $idx $idx+2] d n v + if {[dict exists $packageDirNameMap $n]} { + lset packageBuildList $idx+1 [dict get $packageDirNameMap $n] + } + } + # # Invoke the scraper/converter engine. # @@ -684,12 +725,12 @@ try { "The commands which the tclsh interpreter implements."] \ [plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \ "The additional commands which the wish interpreter implements."] \ - {*}[plus-pkgs n {*}$packageDirNameMap] \ + {*}[plus-pkgs n {*}$packageBuildList] \ [plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \ "The C functions which a Tcl extended C program may use."] \ [plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \ "The additional C functions which a Tk extended C program may use."] \ - {*}[plus-pkgs 3 {*}$packageDirNameMap] + {*}[plus-pkgs 3 {*}$packageBuildList] } on error {msg opts} { # On failure make sure we show what went wrong. We're not supposed # to get here though; it represents a bug in the script. diff --git a/unix/Makefile.in b/unix/Makefile.in index 680d4ce..df05759 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2019,8 +2019,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ $(DISTDIR)/libtommath mkdir $(DISTDIR)/pkgs - cp $(TOP_DIR)/pkgs/README $(TOP_DIR)/pkgs/package.list.txt \ - $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done -- cgit v0.12 From b8f7032b2378ad5140908f50da466efe081d0afb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Dec 2012 10:48:04 +0000 Subject: Fix Tcl_DecrRefCount macro, not to refer to its objPtr parameter twice. --- generic/tcl.h | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 36077e6..48fe062 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -810,9 +810,7 @@ typedef struct Tcl_Obj { * Note: clients should use Tcl_DecrRefCount() when they are finished using * an object, and should never call TclFreeObj() directly. TclFreeObj() is * only defined and made public in tcl.h to support Tcl_DecrRefCount's macro - * definition. Note also that Tcl_DecrRefCount() refers to the parameter - * "obj" twice. This means that you should avoid calling it with an - * expression that is expensive to compute or has side effects. + * definition. */ void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); @@ -833,7 +831,12 @@ int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr)); * http://c2.com/cgi/wiki?TrivialDoWhileLoop */ # define Tcl_DecrRefCount(objPtr) \ - do { if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr); } while(0) + do { \ + Tcl_Obj *obj = (objPtr); \ + if ((obj)->refCount-- < 2) { \ + TclFreeObj(obj); \ + } \ + } while(0) # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) #endif -- cgit v0.12 From e30259f5920c3e4e6a6ff76d6c7d80bdbfd5ac32 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Dec 2012 12:03:51 +0000 Subject: Changelog entry, and change macro variable to not conflict with possible outside variable names --- ChangeLog | 5 +++++ generic/tcl.h | 6 +++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index ef04907..092d5f9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-12-13 Jan Nijtmans + + * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it + doesn't access its objPtr parameter twice any more. + 2012-11-14 Donal K. Fellows * unix/tclUnixPipe.c (DefaultTempDir): [Bug 2933003]: Allow overriding diff --git a/generic/tcl.h b/generic/tcl.h index 48fe062..bf9b446 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -832,9 +832,9 @@ int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr)); */ # define Tcl_DecrRefCount(objPtr) \ do { \ - Tcl_Obj *obj = (objPtr); \ - if ((obj)->refCount-- < 2) { \ - TclFreeObj(obj); \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- < 2) { \ + TclFreeObj(_objPtr); \ } \ } while(0) # define Tcl_IsShared(objPtr) \ -- cgit v0.12 From 86ced50657a467a7e29470be90d1d13061b84a2d Mon Sep 17 00:00:00 2001 From: mig Date: Thu, 13 Dec 2012 13:37:19 +0000 Subject: Fix for [Bug 3595576], found by andrewsh --- ChangeLog | 7 +++++++ generic/tclCmdAH.c | 3 ++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 87f0260..13fcaf8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-11-13 Miguel Sofer + + * generic/tclCmdAH.c (CatchObjCmdCallback): do not decrRefCount + the newValuePtr sent to Tcl_ObjSetVar2: TOSV2 is 'fire and + forget', it decrs on its own. Fix for [Bug 3595576], found by + andrewsh. + 2012-12-13 Jan Nijtmans * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 14951e4..133a61b 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -361,7 +361,8 @@ CatchObjCmdCallback( if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, TCL_LEAVE_ERR_MSG)) { - Tcl_DecrRefCount(options); + /* Do not decrRefCount 'options', it was already done by + * Tcl_ObjSetVar2 */ return TCL_ERROR; } } -- cgit v0.12 From 7cf0ac1eafc58e6473a6f2d2e2c0480628ac626c Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Dec 2012 15:59:51 +0000 Subject: 3595576 Tests/fix for mem corruption: [catch] fails to store options in a var. --- generic/tclCmdAH.c | 1 - tests/cmdAH.test | 6 ++++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 8e32389..44f08a3 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -273,7 +273,6 @@ Tcl_CatchObjCmd( Tcl_Obj *options = Tcl_GetReturnOptions(interp, result); if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, 0)) { - Tcl_DecrRefCount(options); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't save return options in variable", NULL); diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 2e94d7d..fb0fefc 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -46,6 +46,12 @@ test cmdAH-1.2 {Tcl_CatchObjCmd, errors} { test cmdAH-1.3 {Tcl_CatchObjCmd, errors} { list [catch {catch foo bar baz spaz} msg] $msg } {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}} +test cmdAH-1.4 {Bug 3595576} { + catch {catch {} -> noSuchNs::var} +} 1 +test cmdAH-1.5 {Bug 3595576} { + catch {catch error -> noSuchNs::var} +} 1 test cmdAH-2.1 {Tcl_CdObjCmd} { list [catch {cd foo bar} msg] $msg -- cgit v0.12 From 990ca78bafc3a3a4363dbdaca20c2c3f78b8ee83 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Dec 2012 16:11:07 +0000 Subject: Restore clarity to macro test. --- generic/tcl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index bf9b446..9dd6ff0 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -833,7 +833,7 @@ int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr)); # define Tcl_DecrRefCount(objPtr) \ do { \ Tcl_Obj *_objPtr = (objPtr); \ - if (_objPtr->refCount-- < 2) { \ + if (--(_objPtr)->refCount <= 0) { \ TclFreeObj(_objPtr); \ } \ } while(0) -- cgit v0.12 From 73eeb5f121c51edba58ed7deaa273a7381110e26 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Dec 2012 19:43:43 +0000 Subject: Simplify the [info object] and [info class] additions. --- generic/tclOOInfo.c | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index e09ee4e..3f37a6d 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -114,21 +114,15 @@ TclOOInitInfo( infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) { - Tcl_Obj *mapDict, *objectObj, *classObj; + Tcl_Obj *mapDict; Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); if (mapDict != NULL) { - objectObj = Tcl_NewStringObj("object", -1); - classObj = Tcl_NewStringObj("class", -1); - Tcl_IncrRefCount(objectObj); - Tcl_IncrRefCount(classObj); - Tcl_DictObjPut(NULL, mapDict, objectObj, + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), Tcl_NewStringObj("::oo::InfoObject", -1)); - Tcl_DictObjPut(NULL, mapDict, classObj, + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), Tcl_NewStringObj("::oo::InfoClass", -1)); - Tcl_DecrRefCount(objectObj); - Tcl_DecrRefCount(classObj); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } } -- cgit v0.12 From 4eaff43e124f523dca05591bc760fa9f32eb7672 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Dec 2012 20:20:46 +0000 Subject: TIP 400 suffered from the same segfaulting flaw as 3595576. Segfaulting test and fix committed. --- generic/tclZlib.c | 19 +++---------------- tests/zlib.test | 14 ++++++++++++++ 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 8fbe049..9c1176e 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -507,7 +507,7 @@ GenerateHeader( * ExtractHeader -- * * Take the values out of a gzip header and store them in a dictionary. - * SetValue is a helper function. + * SetValue is a helper macro. * * Results: * None. @@ -518,18 +518,8 @@ GenerateHeader( *---------------------------------------------------------------------- */ -static inline void -SetValue( - Tcl_Obj *dictObj, - const char *key, - Tcl_Obj *value) -{ - Tcl_Obj *keyObj = Tcl_NewStringObj(key, -1); - - Tcl_IncrRefCount(keyObj); - Tcl_DictObjPut(NULL, dictObj, keyObj, value); - TclDecrRefCount(keyObj); -} +#define SetValue(dictObj, key, value) \ + Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value)) static void ExtractHeader( @@ -2119,9 +2109,6 @@ ZlibCmd( } if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL, headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) { - if (headerDictObj) { - TclDecrRefCount(headerDictObj); - } return TCL_ERROR; } return TCL_OK; diff --git a/tests/zlib.test b/tests/zlib.test index 5f1e5fc..891dba0 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -826,6 +826,20 @@ test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup { } -cleanup { removeFile $file } -result {1000 /foo/bar 0} +test zlib-11.3 {Bug 3595576 variant} -setup { + set file [makeFile {} test.input] +} -constraints zlib -body { + set f [open $file wb] + puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \ + [string repeat "hello" 1000] + close $f + set f [open $file rb] + set d [read $f] + close $f + zlib gunzip $d -header noSuchNs::foo +} -cleanup { + removeFile $file +} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist} ::tcltest::cleanupTests return -- cgit v0.12 From 97482cca000b9f31593285d349c05793f79f9863 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 17 Dec 2012 14:27:44 +0000 Subject: Slim down the code a bit more; we can make more safe assumptions. --- generic/tclOOInfo.c | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 3f37a6d..5be9b01 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -100,6 +100,7 @@ TclOOInitInfo( Tcl_Interp *interp) { Tcl_Command infoCmd; + Tcl_Obj *mapDict; /* * Build the ensembles used to implement [info object] and [info class]. @@ -113,19 +114,12 @@ TclOOInitInfo( */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); - if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) { - Tcl_Obj *mapDict; - - Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); - if (mapDict != NULL) { - - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), - Tcl_NewStringObj("::oo::InfoObject", -1)); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), - Tcl_NewStringObj("::oo::InfoClass", -1)); - Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); - } - } + Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), + Tcl_NewStringObj("::oo::InfoObject", -1)); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), + Tcl_NewStringObj("::oo::InfoClass", -1)); + Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } /* -- cgit v0.12 From 71500874b393cf7e4a8528218307492dd88d18b7 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Dec 2012 09:37:42 +0000 Subject: Generate better code for the common case of subst-ed variables where the variable is a simple scalar or an array with a simple literal element name. --- generic/tclCompCmdsSZ.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 9c93fb2..71a1dfc 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -836,6 +836,21 @@ TclSubstCompile( TclEmitPush(literal, envPtr); count++; continue; + case TCL_TOKEN_VARIABLE: + /* + * Simple variable access; can only generate TCL_OK or TCL_ERROR + * so no need to generate elaborate exception-management code. + */ + + if (tokenPtr->numComponents == 1 || (tokenPtr->numComponents == 2 + && tokenPtr[2].type == TCL_TOKEN_TEXT)) { + envPtr->line = bline; + TclCompileVarSubst(interp, tokenPtr, envPtr); + bline = envPtr->line; + count++; + continue; + } + break; } while (count > 255) { -- cgit v0.12 From ee58f2d325a281f03cf6669e8d7ae2c377a5af2d Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Dec 2012 10:21:34 +0000 Subject: Better version that can handle simple composite array keys as well. As long as they are free of command substitutions, we can still safely omit the exception processor code. --- generic/tclCompCmdsSZ.c | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 71a1dfc..7bead0d 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -838,19 +838,32 @@ TclSubstCompile( continue; case TCL_TOKEN_VARIABLE: /* - * Simple variable access; can only generate TCL_OK or TCL_ERROR - * so no need to generate elaborate exception-management code. + * Check for simple variable access; see if we can only generate + * TCL_OK or TCL_ERROR from the substituted variable read; if so, + * there is no need to generate elaborate exception-management + * code. Note that the first component of TCL_TOKEN_VARIABLE is + * always TCL_TOKEN_TEXT... */ - if (tokenPtr->numComponents == 1 || (tokenPtr->numComponents == 2 - && tokenPtr[2].type == TCL_TOKEN_TEXT)) { - envPtr->line = bline; - TclCompileVarSubst(interp, tokenPtr, envPtr); - bline = envPtr->line; - count++; - continue; + if (tokenPtr->numComponents > 1) { + int i, foundCommand = 0; + + for (i=2 ; i<=tokenPtr->numComponents ; i++) { + if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { + foundCommand = 1; + break; + } + } + if (foundCommand) { + break; + } } - break; + + envPtr->line = bline; + TclCompileVarSubst(interp, tokenPtr, envPtr); + bline = envPtr->line; + count++; + continue; } while (count > 255) { -- cgit v0.12 From b59e26b4ebf4d75131241be768955f8ae29e498f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Dec 2012 08:16:50 +0000 Subject: Turn pkgb.so into a Tcl9 interoperability test library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should either result in an error-message, either succeed, but never crash. Eliminate unnessarcy static HasStubSupport() and isDigit() functions, just do the same inline. --- ChangeLog | 8 ++++++ generic/tclStubLib.c | 33 +++++++---------------- unix/dltest/pkgb.c | 76 ++++++++++++++++++++++++++++------------------------ 3 files changed, 58 insertions(+), 59 deletions(-) diff --git a/ChangeLog b/ChangeLog index 092d5f9..204275f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-12-21 Jan Nijtmans + + * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test + library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should + either result in an error-message, either succeed, but never crash. + * generic/tclStubLib.c: Eliminate unnessarcy static HasStubSupport() and + isDigit() functions, just do the same inline. + 2012-12-13 Jan Nijtmans * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index ceee8f3..7b62f5e 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -19,28 +19,11 @@ TclPlatStubs *tclPlatStubsPtr = NULL; TclIntStubs *tclIntStubsPtr = NULL; TclIntPlatStubs *tclIntPlatStubsPtr = NULL; -static TclStubs * -HasStubSupport(interp) - Tcl_Interp *interp; -{ - Interp *iPtr = (Interp *) interp; - - if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { - return iPtr->stubTable; - } - interp->result = "interpreter uses an incompatible stubs mechanism"; - interp->freeProc = TCL_STATIC; - return NULL; -} - /* - * Use our own isdigit to avoid linking to libc on windows + * Use our own ISDIGIT to avoid linking to libc on windows */ -static int isDigit(const int c) -{ - return (c >= '0' && c <= '9'); -} +#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) /* *---------------------------------------------------------------------- @@ -66,9 +49,10 @@ Tcl_InitStubs(interp, version, exact) CONST char *version; int exact; { + Interp *iPtr = (Interp *) interp; CONST char *actualVersion = NULL; ClientData pkgData = NULL; - TclStubs *stubsPtr; + TclStubs *stubsPtr = iPtr->stubTable; /* * We can't optimize this check by caching tclStubsPtr because that @@ -76,8 +60,9 @@ Tcl_InitStubs(interp, version, exact) * times. [Bug 615304] */ - stubsPtr = HasStubSupport(interp); - if (!stubsPtr) { + if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { + iPtr->result = "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; return NULL; } @@ -90,7 +75,7 @@ Tcl_InitStubs(interp, version, exact) int count = 0; while (*p) { - count += !isDigit(*p++); + count += !ISDIGIT(*p++); } if (count == 1) { CONST char *q = actualVersion; @@ -99,7 +84,7 @@ Tcl_InitStubs(interp, version, exact) while (*p && (*p == *q)) { p++; q++; } - if (*p || isDigit(*q)) { + if (*p || ISDIGIT(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index d7a7e5b..0bff98b 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -1,15 +1,16 @@ -/* +/* * pkgb.c -- * - * This file contains a simple Tcl package "pkgb" that is intended - * for testing the Tcl dynamic loading facilities. It can be used - * in both safe and unsafe interpreters. + * This file contains a simple Tcl package "pkgb" that is intended for + * testing the Tcl dynamic loading facilities. It can be used in both + * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * - * 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. */ + #include "tcl.h" /* @@ -17,17 +18,17 @@ */ static int Pkgb_SubObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int Pkgb_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* *---------------------------------------------------------------------- * * Pkgb_SubObjCmd -- * - * This procedure is invoked to process the "pkgb_sub" Tcl command. - * It expects two arguments and returns their difference. + * This procedure is invoked to process the "pkgb_sub" Tcl command. It + * expects two arguments and returns their difference. * * Results: * A standard Tcl result. @@ -43,17 +44,17 @@ Pkgb_SubObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument objects. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int first, second; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "num num"); - return TCL_ERROR; + return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { - return TCL_ERROR; + return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); return TCL_OK; @@ -64,8 +65,8 @@ Pkgb_SubObjCmd(dummy, interp, objc, objv) * * Pkgb_UnsafeObjCmd -- * - * This procedure is invoked to process the "pkgb_unsafe" Tcl command. - * It just returns a constant string. + * This procedure is invoked to process the "pkgb_unsafe" Tcl command. It + * just returns a constant string. * * Results: * A standard Tcl result. @@ -81,10 +82,9 @@ Pkgb_UnsafeObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument objects. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); - return TCL_OK; + return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); } /* @@ -92,8 +92,8 @@ Pkgb_UnsafeObjCmd(dummy, interp, objc, objv) * * Pkgb_Init -- * - * This is a package initialization procedure, which is called - * by Tcl when this package is to be added to an interpreter. + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. * * Results: * None. @@ -104,17 +104,20 @@ Pkgb_UnsafeObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ -int +DLLEXPORT int Pkgb_Init(interp) - Tcl_Interp *interp; /* Interpreter in which the package is - * to be made available. */ + Tcl_Interp *interp; /* Interpreter in which the package is to be + * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { - return TCL_ERROR; + if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { return code; } @@ -130,8 +133,8 @@ Pkgb_Init(interp) * * Pkgb_SafeInit -- * - * This is a package initialization procedure, which is called - * by Tcl when this package is to be added to an unsafe interpreter. + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to a safe interpreter. * * Results: * None. @@ -142,19 +145,22 @@ Pkgb_Init(interp) *---------------------------------------------------------------------- */ -int +DLLEXPORT int Pkgb_SafeInit(interp) - Tcl_Interp *interp; /* Interpreter in which the package is - * to be made available. */ + Tcl_Interp *interp; /* Interpreter in which the package is to be + * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { - return TCL_ERROR; + if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { - return code; + return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); -- cgit v0.12 From a40590fd31db326000458a35d4bff19a8f7a3b4d Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sat, 22 Dec 2012 19:05:34 +0000 Subject: Stop leaking allocated space when objifying a zero-length DString. [Bug 3598150] spotted by afredd. --- ChangeLog | 5 +++++ generic/tclUtil.c | 18 ++++++++++-------- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 336da37..49da827 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-12-22 Alexandre Ferrieux + + * generic/tclUtil.c: Stop leaking allocated space when objifying a + zero-length DString. [Bug 3598150] spotted by afredd. + 2012-12-21 Jan Nijtmans * unix/dltest/pkgb.c: Inline compat Tcl_GetDefaultEncodingDir. diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 13e54ec..ddf067b 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2927,14 +2927,16 @@ TclDStringToObj( { Tcl_Obj *result; - if (dsPtr->length == 0) { - TclNewObj(result); - } else if (dsPtr->string == dsPtr->staticSpace) { - /* - * Static buffer, so must copy. - */ - - TclNewStringObj(result, dsPtr->string, dsPtr->length); + if (dsPtr->string == dsPtr->staticSpace) { + if (dsPtr->length == 0) { + TclNewObj(result); + } else { + /* + * Static buffer, so must copy. + */ + + TclNewStringObj(result, dsPtr->string, dsPtr->length); + } } else { /* * Dynamic buffer, so transfer ownership and reset. -- cgit v0.12 From 42c352d6258bc3ec26c19183c29b5a4ac4301a81 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 23 Dec 2012 08:17:17 +0000 Subject: Change back to using an isDigit function. We simply don't need to make any (formally non-portable) assumptions about what happens when an unsigned zero is decremented, and the code isn't in a performance-critical area. Remark by jan.nijtmans: The macro is perfectly portable! Not portable is the exact result of the substraction ('\xB0' - '0' might give 0x80 on some platforms and 0xffffff80 on others), but comparing <= 9 always gives the correct result. We are only checking for digits here! The macro correctly inlines with any compiler, so it's better anyway. Remark by dkf: But it's less clear. In this code, that's more important than a teeny bit of speed from inlining in a non-critical location. --- generic/tclStubLib.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index f61e0ca..859cbf9 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -24,10 +24,13 @@ const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; /* - * Use our own ISDIGIT to avoid linking to libc on windows + * Use our own isDigit to avoid linking to libc on windows */ -#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) +static int isDigit(const int c) +{ + return (c >= '0' && c <= '9'); +} /* *---------------------------------------------------------------------- @@ -79,7 +82,7 @@ Tcl_InitStubs( int count = 0; while (*p) { - count += !ISDIGIT(*p++); + count += !isDigit(*p++); } if (count == 1) { const char *q = actualVersion; @@ -88,7 +91,7 @@ Tcl_InitStubs( while (*p && (*p == *q)) { p++; q++; } - if (*p || ISDIGIT(*q)) { + if (*p || isDigit(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; -- cgit v0.12 From d525cce307b002900a04c58a4adff1470f24202c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Dec 2012 09:55:45 +0000 Subject: eliminate dependancy of compat/*.h on tcl.h --- compat/dirent2.h | 10 ++--- compat/dlfcn.h | 19 ++++------ compat/stdlib.h | 51 +++++++++++-------------- compat/string.h | 74 +++++++++++++++--------------------- compat/unistd.h | 112 ++++++++++++++++++++++++++----------------------------- 5 files changed, 115 insertions(+), 151 deletions(-) diff --git a/compat/dirent2.h b/compat/dirent2.h index c00d2f4..5be08ba 100644 --- a/compat/dirent2.h +++ b/compat/dirent2.h @@ -14,10 +14,6 @@ #ifndef _DIRENT #define _DIRENT -#ifndef _TCL -#include -#endif - /* * Dirent structure, which holds information about a single * directory entry. @@ -50,8 +46,8 @@ typedef struct _dirdesc { * Procedures defined for reading directories: */ -extern void closedir _ANSI_ARGS_((DIR *dirp)); -extern DIR * opendir _ANSI_ARGS_((char *name)); -extern struct dirent * readdir _ANSI_ARGS_((DIR *dirp)); +extern void closedir (DIR *dirp); +extern DIR * opendir (char *name); +extern struct dirent * readdir (DIR *dirp); #endif /* _DIRENT */ diff --git a/compat/dlfcn.h b/compat/dlfcn.h index 1a6a118..fb27ea0 100644 --- a/compat/dlfcn.h +++ b/compat/dlfcn.h @@ -1,4 +1,4 @@ -/* +/* * dlfcn.h -- * * This file provides a replacement for the header file "dlfcn.h" @@ -19,7 +19,6 @@ */ /* - * @(#)dlfcn.h 1.4 revision of 95/04/25 09:36:52 * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH * 30159 Hannover, Germany */ @@ -27,10 +26,6 @@ #ifndef __dlfcn_h__ #define __dlfcn_h__ -#ifndef _TCL -#include -#endif - #ifdef __cplusplus extern "C" { #endif @@ -47,14 +42,14 @@ extern "C" { * that contains functions to be called to initialize and terminate. */ struct dl_info { - void (*init) _ANSI_ARGS_((void)); - void (*fini) _ANSI_ARGS_((void)); + void (*init) (void); + void (*fini) (void); }; -VOID *dlopen _ANSI_ARGS_((const char *path, int mode)); -VOID *dlsym _ANSI_ARGS_((void *handle, const char *symbol)); -char *dlerror _ANSI_ARGS_((void)); -int dlclose _ANSI_ARGS_((void *handle)); +void *dlopen (const char *path, int mode); +void *dlsym (void *handle, const char *symbol); +char *dlerror (void); +int dlclose (void *handle); #ifdef __cplusplus } diff --git a/compat/stdlib.h b/compat/stdlib.h index 4d1a386..0ad4c1d 100644 --- a/compat/stdlib.h +++ b/compat/stdlib.h @@ -1,43 +1,36 @@ /* * stdlib.h -- * - * Declares facilities exported by the "stdlib" portion of - * the C library. This file isn't complete in the ANSI-C - * sense; it only declares things that are needed by Tcl. - * This file is needed even on many systems with their own - * stdlib.h (e.g. SunOS) because not all stdlib.h files - * declare all the procedures needed here (such as strtod). + * Declares facilities exported by the "stdlib" portion of the C library. + * This file isn't complete in the ANSI-C sense; it only declares things + * that are needed by Tcl. This file is needed even on many systems with + * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare + * all the procedures needed here (such as strtod). * * Copyright (c) 1991 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * - * 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. */ #ifndef _STDLIB #define _STDLIB -#include - -extern void abort _ANSI_ARGS_((void)); -extern double atof _ANSI_ARGS_((CONST char *string)); -extern int atoi _ANSI_ARGS_((CONST char *string)); -extern long atol _ANSI_ARGS_((CONST char *string)); -extern char * calloc _ANSI_ARGS_((unsigned int numElements, - unsigned int size)); -extern void exit _ANSI_ARGS_((int status)); -extern int free _ANSI_ARGS_((char *blockPtr)); -extern char * getenv _ANSI_ARGS_((CONST char *name)); -extern char * malloc _ANSI_ARGS_((unsigned int numBytes)); -extern void qsort _ANSI_ARGS_((VOID *base, int n, int size, - int (*compar)(CONST VOID *element1, CONST VOID - *element2))); -extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes)); -extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr)); -extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr, - int base)); -extern unsigned long strtoul _ANSI_ARGS_((CONST char *string, - char **endPtr, int base)); +extern void abort(void); +extern double atof(const char *string); +extern int atoi(const char *string); +extern long atol(const char *string); +extern char * calloc(unsigned int numElements, unsigned int size); +extern void exit(int status); +extern int free(char *blockPtr); +extern char * getenv(const char *name); +extern char * malloc(unsigned int numBytes); +extern void qsort(void *base, int n, int size, int (*compar)( + const void *element1, const void *element2)); +extern char * realloc(char *ptr, unsigned int numBytes); +extern double strtod(const char *string, char **endPtr); +extern long strtol(const char *string, char **endPtr, int base); +extern unsigned long strtoul(const char *string, char **endPtr, int base); #endif /* _STDLIB */ diff --git a/compat/string.h b/compat/string.h index 4eb2b86..42be10c 100644 --- a/compat/string.h +++ b/compat/string.h @@ -6,66 +6,52 @@ * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * - * 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. */ #ifndef _STRING #define _STRING -#include - /* - * The following #include is needed to define size_t. (This used to - * include sys/stdtypes.h but that doesn't exist on older versions - * of SunOS, e.g. 4.0.2, so I'm trying sys/types.h now.... hopefully - * it exists everywhere) + * The following #include is needed to define size_t. (This used to include + * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g. + * 4.0.2, so I'm trying sys/types.h now.... hopefully it exists everywhere) */ #include #ifdef __APPLE__ -extern VOID * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); +extern void * memchr(const void *s, int c, size_t n); #else -extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n)); +extern char * memchr(const void *s, int c, size_t n); #endif -extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2, - size_t n)); -extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n)); +extern int memcmp(const void *s1, const void *s2, size_t n); +extern char * memcpy(void *t, const void *f, size_t n); #ifdef NO_MEMMOVE -#define memmove(d, s, n) bcopy ((s), (d), (n)) +#define memmove(d,s,n) (bcopy((s), (d), (n))) #else -extern char * memmove _ANSI_ARGS_((VOID *t, CONST VOID *f, - size_t n)); +extern char * memmove(void *t, const void *f, size_t n); #endif -extern char * memset _ANSI_ARGS_((VOID *s, int c, size_t n)); +extern char * memset(void *s, int c, size_t n); -extern int strcasecmp _ANSI_ARGS_((CONST char *s1, - CONST char *s2)); -extern char * strcat _ANSI_ARGS_((char *dst, CONST char *src)); -extern char * strchr _ANSI_ARGS_((CONST char *string, int c)); -extern int strcmp _ANSI_ARGS_((CONST char *s1, CONST char *s2)); -extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src)); -extern size_t strcspn _ANSI_ARGS_((CONST char *string, - CONST char *chars)); -extern char * strdup _ANSI_ARGS_((CONST char *string)); -extern char * strerror _ANSI_ARGS_((int error)); -extern size_t strlen _ANSI_ARGS_((CONST char *string)); -extern int strncasecmp _ANSI_ARGS_((CONST char *s1, - CONST char *s2, size_t n)); -extern char * strncat _ANSI_ARGS_((char *dst, CONST char *src, - size_t numChars)); -extern int strncmp _ANSI_ARGS_((CONST char *s1, CONST char *s2, - size_t nChars)); -extern char * strncpy _ANSI_ARGS_((char *dst, CONST char *src, - size_t numChars)); -extern char * strpbrk _ANSI_ARGS_((CONST char *string, - CONST char *chars)); -extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); -extern size_t strspn _ANSI_ARGS_((CONST char *string, - CONST char *chars)); -extern char * strstr _ANSI_ARGS_((CONST char *string, - CONST char *substring)); -extern char * strtok _ANSI_ARGS_((char *s, CONST char *delim)); +extern int strcasecmp(const char *s1, const char *s2); +extern char * strcat(char *dst, const char *src); +extern char * strchr(const char *string, int c); +extern int strcmp(const char *s1, const char *s2); +extern char * strcpy(char *dst, const char *src); +extern size_t strcspn(const char *string, const char *chars); +extern char * strdup(const char *string); +extern char * strerror(int error); +extern size_t strlen(const char *string); +extern int strncasecmp(const char *s1, const char *s2, size_t n); +extern char * strncat(char *dst, const char *src, size_t numChars); +extern int strncmp(const char *s1, const char *s2, size_t nChars); +extern char * strncpy(char *dst, const char *src, size_t numChars); +extern char * strpbrk(const char *string, const char *chars); +extern char * strrchr(const char *string, int c); +extern size_t strspn(const char *string, const char *chars); +extern char * strstr(const char *string, const char *substring); +extern char * strtok(char *s, const char *delim); #endif /* _STRING */ diff --git a/compat/unistd.h b/compat/unistd.h index 1a40e90..2de5bd0 100644 --- a/compat/unistd.h +++ b/compat/unistd.h @@ -1,82 +1,76 @@ /* * unistd.h -- * - * Macros, CONSTants and prototypes for Posix conformance. + * Macros, constants and prototypes for Posix conformance. * - * Copyright 1989 Regents of the University of California - * Permission to use, copy, modify, and distribute this - * software and its documentation for any purpose and without - * fee is hereby granted, provided that the above copyright - * notice appear in all copies. The University of California - * makes no representations about the suitability of this - * software for any purpose. It is provided "as is" without - * express or implied warranty. + * Copyright 1989 Regents of the University of California Permission to use, + * copy, modify, and distribute this software and its documentation for any + * purpose and without fee is hereby granted, provided that the above + * copyright notice appear in all copies. The University of California makes + * no representations about the suitability of this software for any purpose. + * It is provided "as is" without express or implied warranty. */ #ifndef _UNISTD #define _UNISTD #include -#ifndef _TCL -# include "tcl.h" -#endif #ifndef NULL #define NULL 0 #endif /* - * Strict POSIX stuff goes here. Extensions go down below, in the - * ifndef _POSIX_SOURCE section. + * Strict POSIX stuff goes here. Extensions go down below, in the ifndef + * _POSIX_SOURCE section. */ -extern void _exit _ANSI_ARGS_((int status)); -extern int access _ANSI_ARGS_((CONST char *path, int mode)); -extern int chdir _ANSI_ARGS_((CONST char *path)); -extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group)); -extern int close _ANSI_ARGS_((int fd)); -extern int dup _ANSI_ARGS_((int oldfd)); -extern int dup2 _ANSI_ARGS_((int oldfd, int newfd)); -extern int execl _ANSI_ARGS_((CONST char *path, ...)); -extern int execle _ANSI_ARGS_((CONST char *path, ...)); -extern int execlp _ANSI_ARGS_((CONST char *file, ...)); -extern int execv _ANSI_ARGS_((CONST char *path, char **argv)); -extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp)); -extern int execvp _ANSI_ARGS_((CONST char *file, char **argv)); -extern pid_t fork _ANSI_ARGS_((void)); -extern char *getcwd _ANSI_ARGS_((char *buf, size_t size)); -extern gid_t getegid _ANSI_ARGS_((void)); -extern uid_t geteuid _ANSI_ARGS_((void)); -extern gid_t getgid _ANSI_ARGS_((void)); -extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer)); -extern pid_t getpid _ANSI_ARGS_((void)); -extern uid_t getuid _ANSI_ARGS_((void)); -extern int isatty _ANSI_ARGS_((int fd)); -extern long lseek _ANSI_ARGS_((int fd, long offset, int whence)); -extern int pipe _ANSI_ARGS_((int *fildes)); -extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); -extern int setgid _ANSI_ARGS_((gid_t group)); -extern int setuid _ANSI_ARGS_((uid_t user)); -extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds)); -extern char *ttyname _ANSI_ARGS_((int fd)); -extern int unlink _ANSI_ARGS_((CONST char *path)); -extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size)); +extern void _exit(int status); +extern int access(const char *path, int mode); +extern int chdir(const char *path); +extern int chown(const char *path, uid_t owner, gid_t group); +extern int close(int fd); +extern int dup(int oldfd); +extern int dup2(int oldfd, int newfd); +extern int execl(const char *path, ...); +extern int execle(const char *path, ...); +extern int execlp(const char *file, ...); +extern int execv(const char *path, char **argv); +extern int execve(const char *path, char **argv, char **envp); +extern int execvpw(const char *file, char **argv); +extern pid_t fork(void); +extern char * getcwd(char *buf, size_t size); +extern gid_t getegid(void); +extern uid_t geteuid(void); +extern gid_t getgid(void); +extern int getgroups(int bufSize, int *buffer); +extern pid_t getpid(void); +extern uid_t getuid(void); +extern int isatty(int fd); +extern long lseek(int fd, long offset, int whence); +extern int pipe(int *fildes); +extern int read(int fd, char *buf, size_t size); +extern int setgid(gid_t group); +extern int setuid(uid_t user); +extern unsigned sleep(unsigned seconds); +extern char * ttyname(int fd); +extern int unlink(const char *path); +extern int write(int fd, const char *buf, size_t size); #ifndef _POSIX_SOURCE -extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *)); -extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group)); -extern int flock _ANSI_ARGS_((int fd, int operation)); -extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length)); -extern int ioctl _ANSI_ARGS_((int fd, int request, ...)); -extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize)); -extern int setegid _ANSI_ARGS_((gid_t group)); -extern int seteuid _ANSI_ARGS_((uid_t user)); -extern int setreuid _ANSI_ARGS_((int ruid, int euid)); -extern int symlink _ANSI_ARGS_((CONST char *, CONST char *)); -extern int ttyslot _ANSI_ARGS_((void)); -extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length)); -extern int vfork _ANSI_ARGS_((void)); +extern char * crypt(const char *, const char *); +extern int fchown(int fd, uid_t owner, gid_t group); +extern int flock(int fd, int operation); +extern int ftruncate(int fd, unsigned long length); +extern int ioctl(int fd, int request, ...); +extern int readlink(const char *path, char *buf, int bufsize); +extern int setegid(gid_t group); +extern int seteuidw(uid_t user); +extern int setreuid(int ruid, int euid); +extern int symlink(const char *, const char *); +extern int ttyslot(void); +extern int truncate(const char *path, unsigned long length); +extern int vfork(void); #endif /* _POSIX_SOURCE */ #endif /* _UNISTD */ - -- cgit v0.12 From 20253b8c7d3f3c59314380703be48df859cdf9e6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 27 Dec 2012 14:41:15 +0000 Subject: [Bug 3598580]: Tcl_ListObjReplace may release deleted elements too early Tests!? Where are the tests!?! They are in test listobj-11.1 --- ChangeLog | 5 +++++ generic/tclListObj.c | 6 ++++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 204275f..728b677 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-12-27 Jan Nijtmans + + * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release + deleted elements too early + 2012-12-21 Jan Nijtmans * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test diff --git a/generic/tclListObj.c b/generic/tclListObj.c index fffe6a2..b4af98a 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -655,6 +655,10 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) count = 0; } + for (i = 0; i < objc; i++) { + Tcl_IncrRefCount(objv[i]); + } + numRequired = (numElems - count + objc); if (numRequired <= listRepPtr->maxElemCount) { /* @@ -689,7 +693,6 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) for (i = 0, j = first; i < objc; i++, j++) { elemPtrs[j] = objv[i]; - Tcl_IncrRefCount(objv[i]); } /* @@ -745,7 +748,6 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) for (i = 0, j = first; i < objc; i++, j++) { newPtrs[j] = objv[i]; - Tcl_IncrRefCount(objv[i]); } listRepPtr->elemCount = numRequired; -- cgit v0.12 From ac61536f6a47bcbaa93399b81a184f647d62a259 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 27 Dec 2012 20:54:31 +0000 Subject: restore old refcounts in TCL_ERROR case. --- generic/tclListObj.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 1166759..97e7152 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -906,6 +906,9 @@ Tcl_ListObjReplace( listRepPtr = AttemptNewList(interp, newMax, NULL); if (listRepPtr == NULL) { + for (i = 0; i < objc; i++) { + objv[i]->refCount--; + } return TCL_ERROR; } -- cgit v0.12 From 7523143f3e7c3a026b3addb99bfeb70dd9adaff5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 29 Dec 2012 00:06:42 +0000 Subject: For Tcl9, do a real Tcl_DecrRefCount --- generic/tclListObj.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 97e7152..5b73a155 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -907,7 +907,11 @@ Tcl_ListObjReplace( listRepPtr = AttemptNewList(interp, newMax, NULL); if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { +#if TCL_MAJOR_VERSION > 8 + Tcl_DecrRefCount(objv[i]); +#else objv[i]->refCount--; +#endif } return TCL_ERROR; } -- cgit v0.12 From 1c7c1c74c471463c45093f14f25a4f69af26211f Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 31 Dec 2012 12:32:13 +0000 Subject: Marked some string subcommands as obsolete, following discussion on tcl-core. --- ChangeLog | 6 ++++++ doc/string.n | 45 +++++++++++++++++++++++++-------------------- 2 files changed, 31 insertions(+), 20 deletions(-) diff --git a/ChangeLog b/ChangeLog index 43b6dfa..d814777 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-12-31 Donal K. Fellows + + * doc/string.n: Noted the obsolescence of the 'bytelength', + 'wordstart' and 'wordend' subcommands, and moved them to later in the + file. + 2012-12-27 Jan Nijtmans * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release diff --git a/doc/string.n b/doc/string.n index 6b3cc59..f5eae39 100644 --- a/doc/string.n +++ b/doc/string.n @@ -19,26 +19,6 @@ string \- Manipulate strings Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: .TP -\fBstring bytelength \fIstring\fR -. -Returns a decimal string giving the number of bytes used to represent -\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to -represent Unicode characters, the byte length will not be the same as -the character length in general. The cases where a script cares about -the byte length are rare. -.RS -.PP -In almost all cases, you should use the -\fBstring length\fR operation (including determining the length of a -Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual -entry for more details on the UTF\-8 representation. -.PP -\fICompatibility note:\fR it is likely that this subcommand will be -withdrawn in a future version of Tcl. It is better to use the -\fBencoding convertto\fR command to convert a string to a known -encoding and then apply \fBstring length\fR to that. -.RE -.TP \fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR . Perform a character-by-character comparison of strings \fIstring1\fR @@ -354,6 +334,31 @@ Returns a value equal to \fIstring\fR except that any trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\0"). +.SS "OBSOLETE SUBCOMMANDS" +.PP +These subcommands are currently supported, but are likely to go away in a +future release as their functionality is either virtually never used or highly +misleading. +.TP +\fBstring bytelength \fIstring\fR +. +Returns a decimal string giving the number of bytes used to represent +\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to +represent Unicode characters, the byte length will not be the same as +the character length in general. The cases where a script cares about +the byte length are rare. +.RS +.PP +In almost all cases, you should use the +\fBstring length\fR operation (including determining the length of a +Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual +entry for more details on the UTF\-8 representation. +.PP +\fICompatibility note:\fR it is likely that this subcommand will be +withdrawn in a future version of Tcl. It is better to use the +\fBencoding convertto\fR command to convert a string to a known +encoding and then apply \fBstring length\fR to that. +.RE .TP \fBstring wordend \fIstring charIndex\fR . -- cgit v0.12