-- cgit v0.12 From e451e666af76a6917a4c5c054b87c4c6f39d9484 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 19 Apr 2012 08:05:50 +0000 Subject: [Bug 3519357] fCmd.test failed on unix by foreign files or directory in /tmp. --- tests/fCmd.test | 89 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 46 insertions(+), 43 deletions(-) diff --git a/tests/fCmd.test b/tests/fCmd.test index 37867f3..6c73dee 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -551,11 +551,11 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup { } -returnCodes error -match glob -result \ [subst {error renaming "td2" to "[file join td1 td2]": file *}] test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest createfile tf1 - file rename tf1 /tmp - glob -nocomplain tf* /tmp/tf1 -} {/tmp/tf1} + file rename tf1 /tmp/tcltmptest + glob -nocomplain tf* /tmp/tcltmptest/tf1 +} {/tmp/tcltmptest/tf1} test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force c:/tcl8975@ d:/tcl8975@} } -body { @@ -570,27 +570,27 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { } -result {d:/tcl8975@} test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \ {unix notRoot} { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest file mkdir td1 - file rename td1 /tmp - glob -nocomplain td* /tmp/td* -} {/tmp/td1} + file rename td1 /tmp/tcltmptest + glob -nocomplain td* /tmp/tcltmptest/td* +} {/tmp/tcltmptest/td1} test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \ {unix notRoot} { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest createfile tf1 - file rename tf1 /tmp - glob -nocomplain tf* /tmp/tf* -} {/tmp/tf1} + file rename tf1 /tmp/tcltmptest + glob -nocomplain tf* /tmp/tcltmptest/tf* +} {/tmp/tcltmptest/tf1} test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest } -constraints {unix notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0000 - file rename td1 /tmp + file rename td1 /tmp/tcltmptest } -returnCodes error -cleanup { file attributes td1 -permissions 0755 -} -match regexp -result {^error renaming "td1"( to "/tmp/td1")?: permission denied$} +} -match regexp -result {^error renaming "td1"( to "/tmp/tcltmptest/td1")?: permission denied$} test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { @@ -626,54 +626,55 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { file delete -force ~/td1 } -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest } -constraints {unix notRoot xdev} -returnCodes error -body { file mkdir td1/td2/td3 - file mkdir /tmp/td1 - createfile /tmp/td1/tf1 - file rename -force td1 /tmp -} -result {error renaming "td1" to "/tmp/td1": file already exists} + file mkdir /tmp/tcltmptest/td1 + createfile /tmp/tcltmptest/td1/tf1 + file rename -force td1 /tmp/tcltmptest +} -result {error renaming "td1" to "/tmp/tcltmptest/td1": file already exists} test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest } -constraints {unix notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1/td2/td3 -permissions 0000 - file rename td1 /tmp + file rename td1 /tmp/tcltmptest } -returnCodes error -cleanup { file attributes td1/td2/td3 -permissions 0755 -} -result {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied} +} -result {error renaming "td1" to "/tmp/tcltmptest/td1": "td1/td2/td3": permission denied} test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { - cleanup /tmp + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest } -constraints {unix notRoot xdev} -body { file mkdir td1/td2/td3 - file rename td1 /tmp - glob td* /tmp/td1/t* -} -result {/tmp/td1/td2} + file rename td1 /tmp/tcltmptest + glob td* /tmp/tcltmptest/td1/t* +} -result {/tmp/tcltmptest/td1/td2} test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { cleanup + file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest } -constraints {unix notRoot} -body { file mkdir foo/bar file attr foo -perm 040555 - file rename foo/bar /tmp + file rename foo/bar /tmp/tcltmptest } -returnCodes error -cleanup { - catch {file delete /tmp/bar} + catch {file delete /tmp/tcltmptest/bar} catch {file attr foo -perm 040777} catch {file delete -force foo} } -match glob -result {*: permission denied} test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup { - catch {cleanup /tmp} + catch {cleanup /tmp/tcltmptest} } -constraints {unix notRoot xdev} -body { - file mkdir /tmp/td1 - createfile /tmp/td1/tf1 - file rename /tmp/td1/tf1 tf1 - list [file exists /tmp/td1/tf1] [file exists tf1] + file mkdir /tmp/tcltmptest/td1 + createfile /tmp/tcltmptest/td1/tf1 + file rename /tmp/tcltmptest/td1/tf1 tf1 + list [file exists /tmp/tcltmptest/td1/tf1] [file exists tf1] } -result {0 1} test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup { cleanup } -returnCodes error -body { file copy tf1 tf2 } -result {error copying "tf1": no such file or directory} -catch {cleanup /tmp} +catch {file delete -force /tmp/tcltmptest} test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup { cleanup @@ -1305,23 +1306,25 @@ test fCmd-12.8 {renamefile: generic error} -setup { file delete -force tfa } -result {1} test fCmd-12.9 {renamefile: moving a file across volumes} -setup { - catch {file delete -force -- tfa /tmp/tfa} + file mkdir /tmp/tcltmptest + catch {file delete -force -- tfa /tmp/tcltmptest/tfa} } -constraints {unix notRoot} -body { set s [createfile tfa] - file rename tfa /tmp - list [checkcontent /tmp/tfa $s] [file exists tfa] + file rename tfa /tmp/tcltmptest + list [checkcontent /tmp/tcltmptest/tfa $s] [file exists tfa] } -cleanup { - file delete /tmp/tfa + file delete -force /tmp/tcltmptest } -result {1 0} test fCmd-12.10 {renamefile: moving a directory across volumes} -setup { - catch {file delete -force -- tfad /tmp/tfad} + file mkdir /tmp/tcltmptest + catch {file delete -force -- tfad /tmp/tcltmptest/tfad} } -constraints {unix notRoot} -body { file mkdir tfad set s [createfile tfad/a] - file rename tfad /tmp - list [checkcontent /tmp/tfad/a $s] [file exists tfad] + file rename tfad /tmp/tcltmptest + list [checkcontent /tmp/tcltmptest/tfad/a $s] [file exists tfad] } -cleanup { - file delete -force /tmp/tfad + file delete -force /tmp/tcltmptest } -result {1 0} # -- cgit v0.12 From a3a3198dfe08f980f9895d03c2a31a6c302c21dc Mon Sep 17 00:00:00 2001 From: andreask Date: Thu, 17 May 2012 21:45:35 +0000 Subject: Fix for bug 3525907. Reworked TransformInput() entirely, tightened use of timed events, and added code handling special situations like EAGAIN, parent eof, etc. --- generic/tclIORTrans.c | 2 +- generic/tclZlib.c | 306 +++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 257 insertions(+), 51 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 6c9a41b..5d99f73 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -1230,7 +1230,7 @@ ReflectInput( * * ReflectOutput -- * - * This function is invoked when data is writen to the channel. + * This function is invoked when data is written to the channel. * * Results: * The number of bytes actually written. diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 3673833..540b779 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -17,6 +17,7 @@ #include "tclInt.h" #ifdef HAVE_ZLIB #include +#include "tclIO.h" /* * Magic flags used with wbits fields to indicate that we're handling the gzip @@ -90,6 +91,7 @@ typedef struct { GzipHeader outHeader; /* Header to write to an output stream, when * compressing a gzip stream. */ Tcl_TimerToken timer; /* Timer used for keeping events fresh. */ + Tcl_DString result; /* Buffer for decompression results */ } ZlibChannelData; /* @@ -119,6 +121,12 @@ typedef struct { #define TRANSFORM_FLUSH_DELAY 5 /* + * Convenience macro to make some casts easier to use. + */ + +#define UCHARP(x) ((unsigned char *) (x)) + +/* * Prototypes for private procedures defined later in this file: */ @@ -147,6 +155,9 @@ static void ZlibTransformTimerKill(ZlibChannelData *cd); static void ZlibTransformTimerRun(ClientData clientData); static void ZlibTransformTimerSetup(ZlibChannelData *cd); +static int ResultCopy(Tcl_DString* r, unsigned char *buf, int toRead); +static int ResultGenerate(ZlibChannelData *cd, int n, int flush, int* errorCodePtr); + /* * Type of zlib-based compressing and decompressing channels. */ @@ -2320,6 +2331,8 @@ ZlibTransformClose( * Release all memory. */ + Tcl_DStringFree (&cd->result); + if (cd->inBuffer) { ckfree(cd->inBuffer); cd->inBuffer = NULL; @@ -2342,77 +2355,130 @@ ZlibTransformInput( ZlibChannelData *cd = instanceData; Tcl_DriverInputProc *inProc = Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); - int e, readBytes, flush = Z_NO_FLUSH; + int readBytes, gotBytes, copied; if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead, errorCodePtr); } - cd->inStream.next_out = (Bytef *) buf; - cd->inStream.avail_out = toRead; - if (cd->inStream.next_in == NULL) { - goto doReadFirst; - } - while (1) { - e = inflate(&cd->inStream, flush); - if ((e == Z_STREAM_END) || (e==Z_OK && cd->inStream.avail_out==0)) { - return toRead - cd->inStream.avail_out; - } - + gotBytes = 0; + while (toRead > 0) { /* - * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html - * - * Just indicates that the zlib couldn't consume input/produce output, - * and is fixed by supplying more input. + * Loop until the request is satisfied (or no data available from + * below, possibly EOF). */ - if ((e != Z_OK) && (e != Z_BUF_ERROR)) { - Tcl_Obj *errObj = Tcl_NewListObj(0, NULL); + copied = ResultCopy(&cd->result, UCHARP(buf), toRead); + toRead -= copied; + buf += copied; + gotBytes += copied; - Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->inStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); - *errorCodePtr = EINVAL; - return -1; + if (toRead == 0) { + goto stop; } /* - * Check if the inflate stopped early. + * The buffer is exhausted, but the caller wants even more. We now + * have to go to the underlying channel, get more bytes and then + * transform them for delivery. We may not get what we want (full EOF + * or temporarily out of data). + * + * Length (cd->result) == 0, toRead > 0 here. + * + * The zlib transform allows us to read at most one character from the + * underlying channel to properly identify Z_STREAM_END without + * reading over the border. */ - if (cd->inStream.avail_in > 0) { - continue; + readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1); + + if (readBytes < 0) { + /* + * Report errors to caller. The state of the seek system is + * unchanged! + */ + + if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) { + /* + * EAGAIN is a special situation. If we had some data before + * we report that instead of the request to re-try. + */ + + goto stop; + } + + *errorCodePtr = Tcl_GetErrno(); + goto error; } - /* - * Emptied the buffer of data from the underlying channel. Get some - * more. - */ + if (readBytes == 0) { + /* + * Check wether we hit on EOF in 'parent' or not. If not + * differentiate between blocking and non-blocking modes. In + * non-blocking mode we ran temporarily out of data. Signal this + * to the caller via EWOULDBLOCK and error return (-1). In the + * other cases we simply return what we got and let the caller + * wait for more. On the other hand, if we got an EOF we have to + * convert and flush all waiting partial data. + */ + + if (!Tcl_Eof(cd->parent)) { + /* + * The state of the seek system is unchanged! + */ + + if ((gotBytes == 0) && (cd->flags & ASYNC)) { + *errorCodePtr = EWOULDBLOCK; + goto error; + } + goto stop; + } else { + /* + * (Semi-)Eof in parent. + * + * Now this is a bit different. The partial data waiting is + * converted and returned. + */ + + if (ResultGenerate (cd, 0, Z_SYNC_FLUSH, errorCodePtr) < 0) { + goto error; + } + + if (Tcl_DStringLength(&cd->result) == 0) { + /* + * The drain delivered nothing. + */ + + goto stop; + } + + /* + * Reset eof, force caller to drain result buffer. + */ + + ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF; + continue; /* at: while (toRead > 0) */ + } + } /* readBytes == 0 */ - doReadFirst: /* - * Hack for Bug 2762041. Disable pre-reading of lots of input, read - * only one character. This way the Z_END_OF_STREAM can be read - * without triggering an EOF in the base channel. The higher input - * loops in DoReadChars() would react to that by stopping, despite the - * transform still having data which could be read. - * - * This is only a hack because other transforms may not be able to - * work around the general problem in this way. + * Transform the read chunk, which was not empty. Anything we get back + * is a transformation result to be put into our buffers, and the next + * iteration will put it into the result. */ - readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1); - if (readBytes < 0) { - *errorCodePtr = Tcl_GetErrno(); - return -1; - } else if (readBytes == 0) { - flush = Z_SYNC_FLUSH; + if (ResultGenerate (cd, readBytes, Z_NO_FLUSH, errorCodePtr) < 0) { + goto error; } + } /* while toRead > 0 */ - cd->inStream.next_in = (Bytef *) cd->inBuffer; - cd->inStream.avail_in = readBytes; - } + stop: + return gotBytes; + + error: + gotBytes = -1; + goto stop; } static int @@ -2521,6 +2587,11 @@ ZlibTransformSetOption( /* not used */ return Tcl_BadChannelOption(interp, optionName, chanOptions); } + /* + * Pass all unknown options down, to deeper transforms and/or the base + * channel. + */ + return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, optionName, value); } @@ -2615,8 +2686,9 @@ ZlibTransformWatch( watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); - if (!(mask & TCL_READABLE) - || (cd->inStream.avail_in == (uInt) cd->inAllocated)) { + + if (!(mask & TCL_READABLE) || + (Tcl_DStringLength(&cd->result) == 0)) { ZlibTransformTimerKill(cd); } else { ZlibTransformTimerSetup(cd); @@ -2804,6 +2876,8 @@ ZlibStackChannelTransform( } } + Tcl_DStringInit(&cd->result); + chan = Tcl_StackChannel(interp, &zlibChannelType, cd, Tcl_GetChannelMode(channel), channel); if (chan == NULL) { @@ -2829,6 +2903,138 @@ ZlibStackChannelTransform( /* *---------------------------------------------------------------------- + * + * ResultCopy -- + * + * Copies the requested number of bytes from the buffer into the + * specified array and removes them from the buffer afterward. Copies + * less if there is not enough data in the buffer. + * + * Side effects: + * See above. + * + * Result: + * The number of actually copied bytes, possibly less than 'toRead'. + * + *---------------------------------------------------------------------- + */ + +static int +ResultCopy( + Tcl_DString* ds, /* The buffer to read from */ + unsigned char *buf, /* The buffer to copy into */ + int toRead) /* Number of requested bytes */ +{ + int copied; + int have = Tcl_DStringLength (ds); + + if (have == 0) { + /* + * Nothing to copy in the case of an empty buffer. + */ + + copied = 0; + } else if (have > toRead) { + /* + * The internal buffer contains more than requested. Copy the + * requested subset to the caller, shift the remaining bytes down, and + * truncate. + */ + + char* src = Tcl_DStringValue (ds); + + memcpy(buf, src, toRead); + memmove(src, src + toRead, have - toRead); + + Tcl_DStringSetLength (ds, have - toRead); + copied = toRead; + } else /* have <= toRead */ { + /* + * There is just or not enough in the buffer to fully satisfy the + * caller, so take everything as best effort. + */ + + memcpy(buf, Tcl_DStringValue (ds), have); + Tcl_DStringSetLength (ds, 0); + copied = have; + } + + /* -- common postwork code ------- */ + + return copied; +} + +static int +ResultGenerate(ZlibChannelData *cd, int n, int flush, int* errorCodePtr) +{ +#define MAXBUF 1024 + unsigned char buf [MAXBUF]; + int e, written; + + cd->inStream.next_in = (Bytef *) cd->inBuffer; + cd->inStream.avail_in = n; + + while (1) { + cd->inStream.next_out = (Bytef *) buf; + cd->inStream.avail_out = MAXBUF; + + e = inflate(&cd->inStream, flush); + + /* + * avail_out is now the left over space in the output. + * Therefore "MAXBUF - avail_out" is the amount of bytes + * generated. + */ + + written = MAXBUF - cd->inStream.avail_out; + + if (written) { + Tcl_DStringAppend (&cd->result, (char*) buf, written); + } + + if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) || + (e == Z_STREAM_END) || + (e==Z_OK && cd->inStream.avail_out==0)) { + break; + } + + /* + * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html + * + * Just indicates that the zlib couldn't consume input/produce output, + * and is fixed by supplying more input. + */ + + if ((e != Z_OK) && (e != Z_BUF_ERROR)) { + Tcl_Obj *errObj = Tcl_NewListObj(0, NULL); + + Tcl_ListObjAppendElement(NULL, errObj, + Tcl_NewStringObj(cd->inStream.msg, -1)); + Tcl_SetChannelError(cd->parent, errObj); + *errorCodePtr = EINVAL; + return -1; + } + + /* + * Check if the inflate stopped early. + */ + + if (cd->inStream.avail_in > 0) { + continue; + } + + if (flush == Z_SYNC_FLUSH) { + continue; + } + + break; + } + + return 0; +} + +/* + *---------------------------------------------------------------------- * Finally, the TclZlibInit function. Used to install the zlib API. *---------------------------------------------------------------------- */ -- cgit v0.12 From dbfa28f04fc02921314fbdeb342585b87557ef8f Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sun, 20 May 2012 20:46:58 +0000 Subject: Add test showing both loss of bytes and empty-fileevent frenzy. --- tests/zlib.test | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/zlib.test b/tests/zlib.test index d8d710a..4ed5b33 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -169,6 +169,24 @@ test zlib-8.4 {transformation and flushing: Bug 3517696} -setup { catch {close $fd} removeFile $file } -result {} +test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup { + foreach {r w} [chan pipe] break +} -constraints zlib -body { + set ::res {} + fconfigure $w -buffering none + zlib push compress $w + puts -nonewline $w qwertyuiop + chan configure $w -flush sync + after 500 {puts -nonewline $w asdfghjkl;close $w} + fconfigure $r -blocking 0 -buffering none + zlib push decompress $r + fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}} + after 250 {lappend ::res MIDDLE} + vwait ::done + set ::res +} -cleanup { + catch {close $r} +} -result {qwertyuiop MIDDLE asdfghjkl} test zlib-9.1 "check fcopy with push" -constraints zlib -setup { set sfile [makeFile {} testsrc.gz] -- cgit v0.12 From a89ca11a44b7af7cb1017a6cbaf59f53c3e16ed7 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 21 May 2012 16:17:11 +0000 Subject: When using Tcl_SetObjLength() calls to grow and shrink the objPtr->bytes buffer, care must be taken that the value cannot possibly become pure Unicode. Calling Tcl_AppendToObj() has the possibility of making such a conversion. Bug found while valgrinding the trunk. --- ChangeLog | 8 ++++++++ generic/tclFileName.c | 4 ++-- generic/tclIOUtil.c | 2 +- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index fad0871..1769bd9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-05-21 Don Porter + + * generic/tclFileName.c: When using Tcl_SetObjLength() calls to grow + * generic/tclIOUtil.c: and shrink the objPtr->bytes buffer, care must be + taken that the value cannot possibly become pure Unicode. Calling + Tcl_AppendToObj() has the possibility of making such a conversion. Bug + found while valgrinding the trunk. + 2012-05-17 Donal K. Fellows * doc/expr.n: [Bug 3525462]: Corrected statement about what happens diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 761c8be..c5ecf0f 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1155,7 +1155,7 @@ TclpNativeJoinPath(prefix, joining) if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -1194,7 +1194,7 @@ TclpNativeJoinPath(prefix, joining) if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index d50f2e3..40f3f76 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -4977,7 +4977,7 @@ Tcl_FSJoinPath(listObj, elements) if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - length++; + Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); -- cgit v0.12 From c165b1b8ae2365a2afce837baf0ca643a80fe9c2 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 21 May 2012 16:49:48 +0000 Subject: Update requirements to avoid old buggy Thread releases. --- tests/socket.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/socket.test b/tests/socket.test index f06a548..d88eb65 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -64,7 +64,7 @@ package require tcltest 2 namespace import -force ::tcltest::* # Some tests require the Thread package or exec command -testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}] +testConstraint thread [expr {0 == [catch {package require Thread 2.6.6}]}] testConstraint exec [llength [info commands exec]] # Produce a random port number in the Dynamic/Private range -- cgit v0.12 From 56312304b98fa9311dc467ce59da8b0e9e3dae4c Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 21 May 2012 17:08:51 +0000 Subject: Use [package prefer latest] to force valgrinding to use a version of Thread suitable for the whole test suite. --- tests/all.tcl | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/all.tcl b/tests/all.tcl index b436fbe..05d3024 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -10,6 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. +package prefer latest package require Tcl 8.5 package require tcltest 2.2 namespace import tcltest::* -- cgit v0.12 From 6f812b4ccb74d0aebe4bbf520bd6710fa82cf549 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 May 2012 07:30:32 +0000 Subject: Revert most of [ae92de6078], since when we let cygwin share the win32 stub table this is no longer necessary implement TclpInetNtoa for win32 Let cygwin share stub table with win32 --- ChangeLog | 9 + generic/tclDecls.h | 22 +-- generic/tclInt.decls | 132 ++++----------- generic/tclIntPlatDecls.h | 409 +++++++++++++++------------------------------- generic/tclPlatDecls.h | 24 +-- generic/tclStubInit.c | 172 +++++++------------ tools/genStubs.tcl | 176 +++++++++++++++++--- win/Makefile.in | 14 +- win/tclWinSock.c | 29 +++- 9 files changed, 444 insertions(+), 543 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1769bd9..ff1d562 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2012-05-22 Jan Nijtmans + + * tools/genStubs.tcl: Let cygwin share stub table with win32 + * win/Makefile.in: Don't hardcode dde and reg dll version numbers + * win/tclWinSock.c: implement TclpInetNtoa for win32 + * generic/tclInt.decls: Revert most of [ae92de6078], since when + we let cygwin share the win32 stub table this is no longer necessary + * generic/tcl*Decls.h: re-generated + 2012-05-21 Don Porter * generic/tclFileName.c: When using Tcl_SetObjLength() calls to grow diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 9261a1a..b5d376e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1627,7 +1627,7 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData)); /* 0 */ CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr)); /* 1 */ - void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */ + void (*tcl_Panic) _ANSI_ARGS_((CONST char *format, ...)); /* 2 */ char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */ void (*tcl_Free) _ANSI_ARGS_((char *ptr)); /* 4 */ char * (*tcl_Realloc) _ANSI_ARGS_((char *ptr, unsigned int size)); /* 5 */ @@ -1637,18 +1637,18 @@ typedef struct TclStubs { #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc *proc, ClientData clientData)); /* 9 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) /* WIN */ VOID *reserved9; -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL VOID *reserved9; #endif /* MAC_TCL */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) /* WIN */ VOID *reserved10; -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL VOID *reserved10; #endif /* MAC_TCL */ @@ -1656,7 +1656,7 @@ typedef struct TclStubs { void (*tcl_Sleep) _ANSI_ARGS_((int ms)); /* 12 */ int (*tcl_WaitForEvent) _ANSI_ARGS_((Tcl_Time *timePtr)); /* 13 */ int (*tcl_AppendAllObjTypes) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); /* 14 */ - void (*tcl_AppendStringsToObj) _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr)); /* 15 */ + void (*tcl_AppendStringsToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, ...)); /* 15 */ void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, CONST char *bytes, int length)); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 17 */ int (*tcl_ConvertToType) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr)); /* 18 */ @@ -1711,7 +1711,7 @@ typedef struct TclStubs { void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *message, int length)); /* 67 */ void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp *interp)); /* 68 */ void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *element)); /* 69 */ - void (*tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 70 */ + void (*tcl_AppendResult) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 70 */ Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc *proc, ClientData clientData)); /* 71 */ void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */ int (*tcl_AsyncInvoke) _ANSI_ARGS_((Tcl_Interp *interp, int code)); /* 73 */ @@ -1811,9 +1811,9 @@ typedef struct TclStubs { #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr)); /* 167 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) /* WIN */ VOID *reserved167; -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL VOID *reserved167; #endif /* MAC_TCL */ @@ -1877,7 +1877,7 @@ typedef struct TclStubs { int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue)); /* 225 */ int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr)); /* 226 */ void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */ - void (*tcl_SetErrorCode) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 228 */ + void (*tcl_SetErrorCode) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 228 */ void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time *timePtr)); /* 229 */ void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc *panicProc)); /* 230 */ int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp *interp, int depth)); /* 231 */ @@ -1909,7 +1909,7 @@ typedef struct TclStubs { void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName)); /* 257 */ int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags)); /* 258 */ int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags)); /* 259 */ - int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */ + int (*tcl_VarEval) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 260 */ ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)); /* 261 */ ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)); /* 262 */ int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char *s, int slen)); /* 263 */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 9944ab6..67f3db6 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -410,9 +410,6 @@ declare 103 { declare 104 { int TclSockMinimumBuffersOld(int sock, int size) } -declare 110 { - int TclSockMinimumBuffers(void *sock, int size) -} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -429,6 +426,9 @@ declare 108 { declare 109 { int TclUpdateReturnInfo(Interp *iPtr) } +declare 110 { + int TclSockMinimumBuffers(void *sock, int size) +} # Removed in 8.1: # declare 110 { # char *TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr) @@ -844,12 +844,16 @@ declare 3 win { declare 4 win { HINSTANCE TclWinGetTclInstance(void) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 5 win { + int TclUnixWaitForFile(int fd, int mask, int timeout) +} # Removed in 8.1: # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } declare 6 win { - u_short TclWinNToHS(u_short ns) + unsigned short TclWinNToHS(unsigned short ns) } declare 7 win { int TclWinSetSockOpt(SOCKET s, int level, int optname, @@ -861,6 +865,10 @@ declare 8 win { declare 9 win { int TclWinGetPlatformId(void) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 10 win { + Tcl_DirEntry *TclpReaddir(DIR *dir) +} # Removed in 8.3.1 (for Win32s only) #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) @@ -882,9 +890,9 @@ declare 14 win { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 15 win { - int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, - TclFile inputFile, TclFile outputFile, TclFile errorFile, - Tcl_Pid *pidPtr) + int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: # declare 16 win { @@ -902,7 +910,10 @@ declare 19 win { declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } - +# new for 8.4.20+/8.5.12+ +declare 21 win { + char *TclpInetNtoa(struct in_addr addr) +} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -945,51 +956,42 @@ declare 29 win { # Pipe channel functions -# On non-cygwin, this is actually a reference to TclGetAndDetachPids declare 0 unix { - void TclWinConvertError(unsigned int errCode) + void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } -# On non-cygwin, this is actually a reference to TclpCloseFile declare 1 unix { - void TclWinConvertWSAError(unsigned int errCode) + int TclpCloseFile(TclFile file) } -# On non-cygwin, this is actually a reference to TclpCreateCommandChannel declare 2 unix { - struct servent *TclWinGetServByName(const char *nm, const char *proto) + Tcl_Channel TclpCreateCommandChannel(TclFile readFile, + TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } -# On non-cygwin, this is actually a reference to TclpCreatePipe declare 3 unix { - int TclWinGetSockOpt(void *s, int level, int optname, - char *optval, int *optlen) + int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } -# On non-cygwin, this is actually a reference to TclpCreateProcess declare 4 unix { - void *TclWinGetTclInstance(void) + int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: # declare 5 unix { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) # } - -# On non-cygwin, this is actually a reference to TclpMakeFile declare 6 unix { - unsigned short TclWinNToHS(unsigned short ns) + TclFile TclpMakeFile(Tcl_Channel channel, int direction) } -# On non-cygwin, this is actually a reference to TclpOpenFile declare 7 unix { - int TclWinSetSockOpt(void *s, int level, int optname, - const char *optval, int optlen) + TclFile TclpOpenFile(const char *fname, int mode) } -# On non-cygwin, this is actually a reference to TclUnixWaitForFile declare 8 unix { - int TclpGetPid(Tcl_Pid pid) + int TclUnixWaitForFile(int fd, int mask, int timeout) } # Added in 8.1: -# On non-cygwin, this is actually a reference to TclpCreateTempFile declare 9 unix { - int TclWinGetPlatformId(void) + TclFile TclpCreateTempFile(const char *contents) } # Added in 8.4: @@ -999,88 +1001,18 @@ declare 10 unix { } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs -# On cygwin, this is actually a reference to TclGetAndDetachPids declare 11 unix { struct tm *TclpLocaltime_unix(TclpTime_t_CONST clock) } -# On cygwin, this is actually a reference to TclpCloseFile declare 12 unix { struct tm *TclpGmtime_unix(TclpTime_t_CONST clock) } -# On cygwin, this is a reference to TclpCreateCommandChannel -# Otherwise, this is a reference to TclpInetNtoa declare 13 unix { - void TclIntPlatReserved13(void) -} -#On cygwin, TclpCreateProcess is here -declare 15 unix { - int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr) -} -#On cygwin, TclpMakeFile is here -declare 18 unix { - int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, - const char *fileName, Tcl_StatBuf *statBufPtr, - Tcl_GlobTypeData *types) -} -#On cygwin, TclpOpenFile is here -declare 19 unix { - void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) -} -declare 20 unix { - void TclWinAddProcess(void *hProcess, unsigned int id) -} -declare 22 unix { - TclFile TclpCreateTempFile(const char *contents) -} -declare 24 unix { - char *TclWinNoBackslash(char *path) -} -declare 25 unix { - TclPlatformType *TclWinGetPlatform(void) -} -declare 26 unix { - void TclWinSetInterfaces(int wide) -} -declare 27 unix { - void TclWinFlushDirtyChannels(void) -} -declare 28 unix { - void TclWinResetInterfaces(void) + char *TclpInetNtoa(struct in_addr addr) } declare 29 unix { int TclWinCPUID(unsigned int index, unsigned int *regs) } -declare 30 unix { - void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) -} -declare 31 unix { - int TclpCloseFile(TclFile file) -} -declare 32 unix { - Tcl_Channel TclpCreateCommandChannel(TclFile readFile, - TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) -} -declare 33 unix { - int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) -} -declare 34 unix { - int TclpCreateProcess(Tcl_Interp *interp, - int argc, const char **argv, TclFile inputFile, - TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) -} -declare 35 unix { - char *TclpInetNtoa(struct in_addr addr) -} -declare 36 unix { - TclFile TclpMakeFile(Tcl_Channel channel, int direction) -} -declare 37 unix { - TclFile TclpOpenFile(const char *fname, int mode) -} -declare 38 unix { - int TclUnixWaitForFile(int fd, int mask, int timeout) -} # Local Variables: # mode: tcl diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index d109506..201c597 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -13,6 +13,11 @@ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS +#ifdef __WIN32__ +# define Tcl_DirEntry void +# define DIR void +#endif + /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -25,30 +30,37 @@ * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL) /* UNIX */ /* 0 */ -EXTERN void TclWinConvertError _ANSI_ARGS_((unsigned int errCode)); +EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Channel chan)); /* 1 */ -EXTERN void TclWinConvertWSAError _ANSI_ARGS_(( - unsigned int errCode)); +EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file)); /* 2 */ -EXTERN struct servent * TclWinGetServByName _ANSI_ARGS_((CONST char *nm, - CONST char *proto)); +EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_(( + TclFile readFile, TclFile writeFile, + TclFile errorFile, int numPids, + Tcl_Pid *pidPtr)); /* 3 */ -EXTERN int TclWinGetSockOpt _ANSI_ARGS_((VOID *s, int level, - int optname, char *optval, int *optlen)); +EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe, + TclFile *writePipe)); /* 4 */ -EXTERN VOID * TclWinGetTclInstance _ANSI_ARGS_((void)); +EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp, + int argc, CONST char **argv, + TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr)); /* Slot 5 is reserved */ /* 6 */ -EXTERN unsigned short TclWinNToHS _ANSI_ARGS_((unsigned short ns)); +EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel, + int direction)); /* 7 */ -EXTERN int TclWinSetSockOpt _ANSI_ARGS_((VOID *s, int level, - int optname, CONST char *optval, int optlen)); +EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char *fname, + int mode)); /* 8 */ -EXTERN int TclpGetPid _ANSI_ARGS_((Tcl_Pid pid)); +EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask, + int timeout)); /* 9 */ -EXTERN int TclWinGetPlatformId _ANSI_ARGS_((void)); +EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((CONST char *contents)); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir _ANSI_ARGS_((DIR *dir)); /* 11 */ @@ -57,73 +69,27 @@ EXTERN struct tm * TclpLocaltime_unix _ANSI_ARGS_(( /* 12 */ EXTERN struct tm * TclpGmtime_unix _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 13 */ -EXTERN void TclIntPlatReserved13 _ANSI_ARGS_((void)); +EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr)); /* Slot 14 is reserved */ -/* 15 */ -EXTERN int TclMacOSXGetFileAttribute _ANSI_ARGS_(( - Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)); +/* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ -/* 18 */ -EXTERN int TclMacOSXMatchType _ANSI_ARGS_((Tcl_Interp *interp, - CONST char *pathName, CONST char *fileName, - Tcl_StatBuf *statBufPtr, - Tcl_GlobTypeData *types)); -/* 19 */ -EXTERN void TclMacOSXNotifierAddRunLoopMode _ANSI_ARGS_(( - CONST VOID *runLoopMode)); -/* 20 */ -EXTERN void TclWinAddProcess _ANSI_ARGS_((VOID *hProcess, - unsigned int id)); +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* 22 */ -EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((CONST char *contents)); +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -/* 24 */ -EXTERN char * TclWinNoBackslash _ANSI_ARGS_((char *path)); -/* 25 */ -EXTERN TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void)); -/* 26 */ -EXTERN void TclWinSetInterfaces _ANSI_ARGS_((int wide)); -/* 27 */ -EXTERN void TclWinFlushDirtyChannels _ANSI_ARGS_((void)); -/* 28 */ -EXTERN void TclWinResetInterfaces _ANSI_ARGS_((void)); +/* Slot 24 is reserved */ +/* Slot 25 is reserved */ +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID _ANSI_ARGS_((unsigned int index, unsigned int *regs)); -/* 30 */ -EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Channel chan)); -/* 31 */ -EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file)); -/* 32 */ -EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_(( - TclFile readFile, TclFile writeFile, - TclFile errorFile, int numPids, - Tcl_Pid *pidPtr)); -/* 33 */ -EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe, - TclFile *writePipe)); -/* 34 */ -EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp, - int argc, CONST char **argv, - TclFile inputFile, TclFile outputFile, - TclFile errorFile, Tcl_Pid *pidPtr)); -/* 35 */ -EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr)); -/* 36 */ -EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel, - int direction)); -/* 37 */ -EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char *fname, - int mode)); -/* 38 */ -EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask, - int timeout)); #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError _ANSI_ARGS_((DWORD errCode)); /* 1 */ @@ -136,9 +102,11 @@ EXTERN int TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level, int optname, char *optval, int *optlen)); /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance _ANSI_ARGS_((void)); -/* Slot 5 is reserved */ +/* 5 */ +EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask, + int timeout)); /* 6 */ -EXTERN u_short TclWinNToHS _ANSI_ARGS_((u_short ns)); +EXTERN unsigned short TclWinNToHS _ANSI_ARGS_((unsigned short ns)); /* 7 */ EXTERN int TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level, int optname, CONST char *optval, int optlen)); @@ -146,7 +114,8 @@ EXTERN int TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level, EXTERN int TclpGetPid _ANSI_ARGS_((Tcl_Pid pid)); /* 9 */ EXTERN int TclWinGetPlatformId _ANSI_ARGS_((void)); -/* Slot 10 is reserved */ +/* 10 */ +EXTERN Tcl_DirEntry * TclpReaddir _ANSI_ARGS_((DIR *dir)); /* 11 */ EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); @@ -176,7 +145,8 @@ EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char *fname, /* 20 */ EXTERN void TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess, DWORD id)); -/* Slot 21 is reserved */ +/* 21 */ +EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr)); /* 22 */ EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((CONST char *contents)); /* 23 */ @@ -194,7 +164,7 @@ EXTERN void TclWinResetInterfaces _ANSI_ARGS_((void)); /* 29 */ EXTERN int TclWinCPUID _ANSI_ARGS_((unsigned int index, unsigned int *regs)); -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL /* 0 */ EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin)); @@ -270,59 +240,50 @@ typedef struct TclIntPlatStubs { int magic; struct TclIntPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ - void (*tclWinConvertError) _ANSI_ARGS_((unsigned int errCode)); /* 0 */ - void (*tclWinConvertWSAError) _ANSI_ARGS_((unsigned int errCode)); /* 1 */ - struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char *nm, CONST char *proto)); /* 2 */ - int (*tclWinGetSockOpt) _ANSI_ARGS_((VOID *s, int level, int optname, char *optval, int *optlen)); /* 3 */ - VOID * (*tclWinGetTclInstance) _ANSI_ARGS_((void)); /* 4 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL) /* UNIX */ + void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 0 */ + int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 1 */ + Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 2 */ + int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 3 */ + int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 4 */ VOID *reserved5; - unsigned short (*tclWinNToHS) _ANSI_ARGS_((unsigned short ns)); /* 6 */ - int (*tclWinSetSockOpt) _ANSI_ARGS_((VOID *s, int level, int optname, CONST char *optval, int optlen)); /* 7 */ - int (*tclpGetPid) _ANSI_ARGS_((Tcl_Pid pid)); /* 8 */ - int (*tclWinGetPlatformId) _ANSI_ARGS_((void)); /* 9 */ + TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */ + TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 7 */ + int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */ + TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 9 */ Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR *dir)); /* 10 */ struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 11 */ struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 12 */ - void (*tclIntPlatReserved13) _ANSI_ARGS_((void)); /* 13 */ + char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */ VOID *reserved14; - int (*tclMacOSXGetFileAttribute) _ANSI_ARGS_((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)); /* 15 */ + VOID *reserved15; VOID *reserved16; VOID *reserved17; - int (*tclMacOSXMatchType) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types)); /* 18 */ - void (*tclMacOSXNotifierAddRunLoopMode) _ANSI_ARGS_((CONST VOID *runLoopMode)); /* 19 */ - void (*tclWinAddProcess) _ANSI_ARGS_((VOID *hProcess, unsigned int id)); /* 20 */ + VOID *reserved18; + VOID *reserved19; + VOID *reserved20; VOID *reserved21; - TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 22 */ + VOID *reserved22; VOID *reserved23; - char * (*tclWinNoBackslash) _ANSI_ARGS_((char *path)); /* 24 */ - TclPlatformType * (*tclWinGetPlatform) _ANSI_ARGS_((void)); /* 25 */ - void (*tclWinSetInterfaces) _ANSI_ARGS_((int wide)); /* 26 */ - void (*tclWinFlushDirtyChannels) _ANSI_ARGS_((void)); /* 27 */ - void (*tclWinResetInterfaces) _ANSI_ARGS_((void)); /* 28 */ + VOID *reserved24; + VOID *reserved25; + VOID *reserved26; + VOID *reserved27; + VOID *reserved28; int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int *regs)); /* 29 */ - void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 30 */ - int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 31 */ - Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 32 */ - int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 33 */ - int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 34 */ - char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 35 */ - TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 36 */ - TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 37 */ - int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 38 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */ void (*tclWinConvertWSAError) _ANSI_ARGS_((DWORD errCode)); /* 1 */ struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char *nm, CONST char *proto)); /* 2 */ int (*tclWinGetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, char *optval, int *optlen)); /* 3 */ HINSTANCE (*tclWinGetTclInstance) _ANSI_ARGS_((void)); /* 4 */ - VOID *reserved5; - u_short (*tclWinNToHS) _ANSI_ARGS_((u_short ns)); /* 6 */ + int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 5 */ + unsigned short (*tclWinNToHS) _ANSI_ARGS_((unsigned short ns)); /* 6 */ int (*tclWinSetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, CONST char *optval, int optlen)); /* 7 */ int (*tclpGetPid) _ANSI_ARGS_((Tcl_Pid pid)); /* 8 */ int (*tclWinGetPlatformId) _ANSI_ARGS_((void)); /* 9 */ - VOID *reserved10; + Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR *dir)); /* 10 */ void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 11 */ int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 13 */ @@ -333,7 +294,7 @@ typedef struct TclIntPlatStubs { TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 19 */ void (*tclWinAddProcess) _ANSI_ARGS_((HANDLE hProcess, DWORD id)); /* 20 */ - VOID *reserved21; + char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 21 */ TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 22 */ char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 23 */ char * (*tclWinNoBackslash) _ANSI_ARGS_((char *path)); /* 24 */ @@ -342,7 +303,7 @@ typedef struct TclIntPlatStubs { void (*tclWinFlushDirtyChannels) _ANSI_ARGS_((void)); /* 27 */ void (*tclWinResetInterfaces) _ANSI_ARGS_((void)); /* 28 */ int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int *regs)); /* 29 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL VOID * (*tclpSysAlloc) _ANSI_ARGS_((long size, int isBin)); /* 0 */ void (*tclpSysFree) _ANSI_ARGS_((VOID *ptr)); /* 1 */ @@ -388,43 +349,43 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ -#ifndef TclWinConvertError -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL) /* UNIX */ +#ifndef TclGetAndDetachPids +#define TclGetAndDetachPids \ + (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ #endif -#ifndef TclWinConvertWSAError -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ +#ifndef TclpCloseFile +#define TclpCloseFile \ + (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ #endif -#ifndef TclWinGetServByName -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ +#ifndef TclpCreateCommandChannel +#define TclpCreateCommandChannel \ + (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ #endif -#ifndef TclWinGetSockOpt -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ +#ifndef TclpCreatePipe +#define TclpCreatePipe \ + (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #endif -#ifndef TclWinGetTclInstance -#define TclWinGetTclInstance \ - (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ +#ifndef TclpCreateProcess +#define TclpCreateProcess \ + (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ #endif /* Slot 5 is reserved */ -#ifndef TclWinNToHS -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ +#ifndef TclpMakeFile +#define TclpMakeFile \ + (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #endif -#ifndef TclWinSetSockOpt -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +#ifndef TclpOpenFile +#define TclpOpenFile \ + (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ #endif -#ifndef TclpGetPid -#define TclpGetPid \ - (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ +#ifndef TclUnixWaitForFile +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #endif -#ifndef TclWinGetPlatformId -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +#ifndef TclpCreateTempFile +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #endif #ifndef TclpReaddir #define TclpReaddir \ @@ -438,97 +399,31 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpGmtime_unix \ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ #endif -#ifndef TclIntPlatReserved13 -#define TclIntPlatReserved13 \ - (tclIntPlatStubsPtr->tclIntPlatReserved13) /* 13 */ +#ifndef TclpInetNtoa +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #endif /* Slot 14 is reserved */ -#ifndef TclMacOSXGetFileAttribute -#define TclMacOSXGetFileAttribute \ - (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ -#endif +/* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ -#ifndef TclMacOSXMatchType -#define TclMacOSXMatchType \ - (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ -#endif -#ifndef TclMacOSXNotifierAddRunLoopMode -#define TclMacOSXNotifierAddRunLoopMode \ - (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ -#endif -#ifndef TclWinAddProcess -#define TclWinAddProcess \ - (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#endif +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#ifndef TclpCreateTempFile -#define TclpCreateTempFile \ - (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ -#endif +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#ifndef TclWinNoBackslash -#define TclWinNoBackslash \ - (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ -#endif -#ifndef TclWinGetPlatform -#define TclWinGetPlatform \ - (tclIntPlatStubsPtr->tclWinGetPlatform) /* 25 */ -#endif -#ifndef TclWinSetInterfaces -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ -#endif -#ifndef TclWinFlushDirtyChannels -#define TclWinFlushDirtyChannels \ - (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#endif -#ifndef TclWinResetInterfaces -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ -#endif +/* Slot 24 is reserved */ +/* Slot 25 is reserved */ +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #ifndef TclWinCPUID #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #endif -#ifndef TclGetAndDetachPids -#define TclGetAndDetachPids \ - (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */ -#endif -#ifndef TclpCloseFile -#define TclpCloseFile \ - (tclIntPlatStubsPtr->tclpCloseFile) /* 31 */ -#endif -#ifndef TclpCreateCommandChannel -#define TclpCreateCommandChannel \ - (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 32 */ -#endif -#ifndef TclpCreatePipe -#define TclpCreatePipe \ - (tclIntPlatStubsPtr->tclpCreatePipe) /* 33 */ -#endif -#ifndef TclpCreateProcess -#define TclpCreateProcess \ - (tclIntPlatStubsPtr->tclpCreateProcess) /* 34 */ -#endif -#ifndef TclpInetNtoa -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 35 */ -#endif -#ifndef TclpMakeFile -#define TclpMakeFile \ - (tclIntPlatStubsPtr->tclpMakeFile) /* 36 */ -#endif -#ifndef TclpOpenFile -#define TclpOpenFile \ - (tclIntPlatStubsPtr->tclpOpenFile) /* 37 */ -#endif -#ifndef TclUnixWaitForFile -#define TclUnixWaitForFile \ - (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 38 */ -#endif #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #ifndef TclWinConvertError #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ @@ -549,7 +444,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #endif -/* Slot 5 is reserved */ +#ifndef TclUnixWaitForFile +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ +#endif #ifndef TclWinNToHS #define TclWinNToHS \ (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ @@ -566,7 +464,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ #endif -/* Slot 10 is reserved */ +#ifndef TclpReaddir +#define TclpReaddir \ + (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +#endif #ifndef TclGetAndDetachPids #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ @@ -601,7 +502,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ #endif -/* Slot 21 is reserved */ +#ifndef TclpInetNtoa +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +#endif #ifndef TclpCreateTempFile #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ @@ -634,7 +538,7 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #endif -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL #ifndef TclpSysAlloc #define TclpSysAlloc \ @@ -752,59 +656,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclpLocaltime_unix #undef TclpGmtime_unix -#undef TclIntPlatReserved13 - -#if !defined(__WIN32__) && !defined(MAC_TCL) -# undef TclpGetPid -# define TclpGetPid(pid) ((unsigned long) (pid)) - -# if defined(USE_TCL_STUBS) -# undef TclpCreateProcess -# undef TclpMakeFile -# undef TclpOpenFile -# undef TclpCreateCommandChannel -# ifdef __CYGWIN__ -# define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \ - CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \ - tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) -# define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \ - int direction))) tclIntPlatStubsPtr->tclMacOSXMatchType) -# define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \ - tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) -# define TclpCreateCommandChannel ((Tcl_Channel (*) _ANSI_ARGS_((TclFile, TclFile, \ - TclFile, int, Tcl_Pid *))) tclIntPlatStubsPtr->tclIntPlatReserved13) -# else -# define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \ - CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \ - tclIntPlatStubsPtr->tclWinGetTclInstance) -# define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \ - int direction))) tclIntPlatStubsPtr->tclWinNToHS) -# define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \ - tclIntPlatStubsPtr->tclWinSetSockOpt) -# define TclpCreateCommandChannel ((Tcl_Channel (*) _ANSI_ARGS_((TclFile, TclFile, \ - TclFile, int, Tcl_Pid *))) tclIntPlatStubsPtr->tclWinGetServByName) - -# undef TclpCreateTempFile -# undef TclGetAndDetachPids -# undef TclpCloseFile -# undef TclpCreatePipe -# undef TclpInetNtoa -# undef TclUnixWaitForFile -# define TclpCreateTempFile ((TclFile (*) _ANSI_ARGS_((CONST char *))) \ - tclIntPlatStubsPtr->tclWinGetPlatformId) -# define TclGetAndDetachPids ((void (*) _ANSI_ARGS_((Tcl_Interp *, Tcl_Channel))) \ - tclIntPlatStubsPtr->tclWinConvertError) -# define TclpCloseFile ((int (*) _ANSI_ARGS_((TclFile))) \ - tclIntPlatStubsPtr->tclWinConvertWSAError) -# define TclpCreatePipe ((int (*)_ANSI_ARGS_((TclFile *, TclFile *))) \ - tclIntPlatStubsPtr->tclWinGetSockOpt) -# define TclpInetNtoa ((char *(*) _ANSI_ARGS_((struct in_addr addr))) \ - tclIntPlatStubsPtr->tclIntPlatReserved13) -# define TclUnixWaitForFile (int (*) _ANSI_ARGS_((int, int, int))) \ - tclIntPlatStubsPtr->tclpGetPid) -# endif -# endif +#if !defined(__WIN32__) && !defined(__CYGWIN__) +# undef TclpGetPid +# define TclpGetPid(pid) ((unsigned long) (pid)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index b288296..f63b9c0 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -29,14 +29,14 @@ * Exported function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char *str, int len, Tcl_DString *dsPtr)); /* 1 */ EXTERN char * Tcl_WinTCharToUtf _ANSI_ARGS_((CONST TCHAR *str, int len, Tcl_DString *dsPtr)); -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL /* 0 */ EXTERN void Tcl_MacSetEventProc _ANSI_ARGS_(( @@ -68,7 +68,7 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1, EXTERN int strcasecmp _ANSI_ARGS_((CONST char *s1, CONST char *s2)); #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL +#ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_(( Tcl_Interp *interp, CONST char *bundleName, @@ -80,16 +80,16 @@ EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_(( CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath)); -#endif /* MAC_OSX_TCL */ +#endif /* MACOSX */ typedef struct TclPlatStubs { int magic; struct TclPlatStubHooks *hooks; -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char *str, int len, Tcl_DString *dsPtr)); /* 0 */ char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR *str, int len, Tcl_DString *dsPtr)); /* 1 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL void (*tcl_MacSetEventProc) _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr)); /* 0 */ char * (*tcl_MacConvertTextResource) _ANSI_ARGS_((Handle resource)); /* 1 */ @@ -101,10 +101,10 @@ typedef struct TclPlatStubs { int (*strncasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2, size_t n)); /* 7 */ int (*strcasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2)); /* 8 */ #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL +#ifdef MAC_OSX_TCL /* MACOSX */ int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 0 */ int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 1 */ -#endif /* MAC_OSX_TCL */ +#endif /* MACOSX */ } TclPlatStubs; #ifdef __cplusplus @@ -121,7 +121,7 @@ extern TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #ifndef Tcl_WinUtfToTChar #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ @@ -130,7 +130,7 @@ extern TclPlatStubs *tclPlatStubsPtr; #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ #endif -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL #ifndef Tcl_MacSetEventProc #define Tcl_MacSetEventProc \ @@ -169,7 +169,7 @@ extern TclPlatStubs *tclPlatStubsPtr; (tclPlatStubsPtr->strcasecmp) /* 8 */ #endif #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL +#ifdef MAC_OSX_TCL /* MACOSX */ #ifndef Tcl_MacOSXOpenBundleResources #define Tcl_MacOSXOpenBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ @@ -178,7 +178,7 @@ extern TclPlatStubs *tclPlatStubsPtr; #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif -#endif /* MAC_OSX_TCL */ +#endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 87c5039..e623fa6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -69,26 +69,19 @@ int TclSockMinimumBuffersOld(sock, size) } #endif -#ifdef __CYGWIN__ -#define TclWinGetPlatformId winGetPlatformId -#define Tcl_WinUtfToTChar winUtfToTChar -#define Tcl_WinTCharToUtf winTCharToUtf -#define TclWinGetTclInstance winGetTclInstance -#define TclWinNToHS winNToHS -#define TclWinSetSockOpt winSetSockOpt -#define TclWinGetSockOpt winGetSockOpt -#define TclWinGetServByName winGetServByName -#define TclWinNoBackslash winNoBackslash -#define TclWinSetInterfaces (void (*) (int)) doNothing -#define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing -#define TclIntPlatReserved13 (void (*) ()) TclpCreateCommandChannel -#define TclWinFlushDirtyChannels doNothing -#define TclWinResetInterfaces doNothing -#define TclpGetPid getPid +#ifdef __WIN32__ +# define TclUnixWaitForFile 0 +# define TclpReaddir 0 +#elif defined(__CYGWIN__) +# define TclWinSetInterfaces (void (*) (int)) doNothing +# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing +# define TclWinFlushDirtyChannels doNothing +# define TclWinResetInterfaces doNothing +# define TclpGetTZName 0 static Tcl_Encoding winTCharEncoding; -static int +int TclWinGetPlatformId() { /* Don't bother to determine the real platform on cygwin, @@ -96,13 +89,13 @@ TclWinGetPlatformId() return 2; /* VER_PLATFORM_WIN32_NT */; } -EXTERN TclPlatformType * +TclPlatformType * TclWinGetPlatform() { return &tclPlatform; } -static void *TclWinGetTclInstance() +void *TclWinGetTclInstance() { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, @@ -110,21 +103,21 @@ static void *TclWinGetTclInstance() return hInstance; } -static unsigned short +unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } -static int -TclWinSetSockOpt(void *s, int level, int optname, +int +TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt((int) s, level, optname, optval, optlen); } -static int -TclWinGetSockOpt(void *s, int level, int optname, +int +TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen) { return getsockopt((int) s, level, optname, optval, optlen); @@ -136,7 +129,7 @@ TclWinGetServByName(const char *name, const char *proto) return getservbyname(name, proto); } -static char * +char * TclWinNoBackslash(char *path) { char *p; @@ -149,7 +142,7 @@ TclWinNoBackslash(char *path) return path; } -static int +int TclpGetPid(Tcl_Pid pid) { return (int) (size_t) pid; @@ -161,11 +154,11 @@ doNothing(void) /* dummy implementation, no need to do anything */ } -static char * -Tcl_WinUtfToTChar(string, len, dsPtr) - CONST char *string; - int len; - Tcl_DString *dsPtr; +char * +Tcl_WinUtfToTChar( + const char *string, + int len, + Tcl_DString *dsPtr) { if (!winTCharEncoding) { winTCharEncoding = Tcl_GetEncoding(0, "unicode"); @@ -174,9 +167,9 @@ Tcl_WinUtfToTChar(string, len, dsPtr) string, len, dsPtr); } -static char * +char * Tcl_WinTCharToUtf( - CONST char *string, + const char *string, int len, Tcl_DString *dsPtr) { @@ -187,38 +180,8 @@ Tcl_WinTCharToUtf( string, len, dsPtr); } -#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *, \ - int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess -#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, CONST char *, \ - CONST char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile -#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((CONST void *))) TclpOpenFile -#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((TclpTime_t_CONST))) TclGetAndDetachPids -#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((TclpTime_t_CONST))) TclpCloseFile - -#elif !defined(__WIN32__) /* UNIX and MAC */ -# define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids -# define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile -# define TclWinGetPlatform 0 -# define TclWinGetPlatformId (int (*)()) TclpCreateTempFile -# define TclWinGetTclInstance (void *(*)()) TclpCreateProcess -# define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile -# define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, CONST char *, int))) TclpOpenFile -# define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int *))) TclpCreatePipe -# define TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel -# define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa -# define TclWinAddProcess 0 -# define TclWinNoBackslash 0 -# define TclWinSetInterfaces 0 -# define TclWinFlushDirtyChannels 0 -# define TclWinResetInterfaces 0 +#else /* UNIX and MAC */ # define TclpGetPid 0 -# define TclMacOSXGetFileAttribute 0 /* Only implemented in Tcl >= 8.5 */ -# define TclMacOSXMatchType 0 /* Only implemented in Tcl >= 8.5 */ -# define TclMacOSXNotifierAddRunLoopMode 0 /* Only implemented in Tcl >= 8.5 */ -# ifndef MAC_OSX_TCL -# define Tcl_MacOSXOpenBundleResources 0 -# define Tcl_MacOSXOpenVersionedBundleResources 0 -# endif # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime #endif @@ -449,59 +412,50 @@ TclIntStubs tclIntStubs = { TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, NULL, -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ - TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ - TclWinGetTclInstance, /* 4 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL) /* UNIX */ + TclGetAndDetachPids, /* 0 */ + TclpCloseFile, /* 1 */ + TclpCreateCommandChannel, /* 2 */ + TclpCreatePipe, /* 3 */ + TclpCreateProcess, /* 4 */ NULL, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ - TclpGetPid, /* 8 */ - TclWinGetPlatformId, /* 9 */ + TclpMakeFile, /* 6 */ + TclpOpenFile, /* 7 */ + TclUnixWaitForFile, /* 8 */ + TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ - TclIntPlatReserved13, /* 13 */ + TclpInetNtoa, /* 13 */ NULL, /* 14 */ - TclMacOSXGetFileAttribute, /* 15 */ + NULL, /* 15 */ NULL, /* 16 */ NULL, /* 17 */ - TclMacOSXMatchType, /* 18 */ - TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclWinAddProcess, /* 20 */ + NULL, /* 18 */ + NULL, /* 19 */ + NULL, /* 20 */ NULL, /* 21 */ - TclpCreateTempFile, /* 22 */ + NULL, /* 22 */ NULL, /* 23 */ - TclWinNoBackslash, /* 24 */ - TclWinGetPlatform, /* 25 */ - TclWinSetInterfaces, /* 26 */ - TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + NULL, /* 24 */ + NULL, /* 25 */ + NULL, /* 26 */ + NULL, /* 27 */ + NULL, /* 28 */ TclWinCPUID, /* 29 */ - TclGetAndDetachPids, /* 30 */ - TclpCloseFile, /* 31 */ - TclpCreateCommandChannel, /* 32 */ - TclpCreatePipe, /* 33 */ - TclpCreateProcess, /* 34 */ - TclpInetNtoa, /* 35 */ - TclpMakeFile, /* 36 */ - TclpOpenFile, /* 37 */ - TclUnixWaitForFile, /* 38 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ TclWinConvertWSAError, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ - NULL, /* 5 */ + TclUnixWaitForFile, /* 5 */ TclWinNToHS, /* 6 */ TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ - NULL, /* 10 */ + TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ @@ -512,7 +466,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - NULL, /* 21 */ + TclpInetNtoa, /* 21 */ TclpCreateTempFile, /* 22 */ TclpGetTZName, /* 23 */ TclWinNoBackslash, /* 24 */ @@ -521,7 +475,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclWinFlushDirtyChannels, /* 27 */ TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL TclpSysAlloc, /* 0 */ TclpSysFree, /* 1 */ @@ -556,10 +510,10 @@ TclIntPlatStubs tclIntPlatStubs = { TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, NULL, -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL Tcl_MacSetEventProc, /* 0 */ Tcl_MacConvertTextResource, /* 1 */ @@ -571,10 +525,10 @@ TclPlatStubs tclPlatStubs = { strncasecmp, /* 7 */ strcasecmp, /* 8 */ #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL +#ifdef MAC_OSX_TCL /* MACOSX */ Tcl_MacOSXOpenBundleResources, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ -#endif /* MAC_OSX_TCL */ +#endif /* MACOSX */ }; static TclStubHooks tclStubHooks = { @@ -598,18 +552,18 @@ TclStubs tclStubs = { #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ Tcl_CreateFileHandler, /* 9 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) /* WIN */ NULL, /* 9 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL NULL, /* 9 */ #endif /* MAC_TCL */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) /* WIN */ NULL, /* 10 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL NULL, /* 10 */ #endif /* MAC_TCL */ @@ -772,9 +726,9 @@ TclStubs tclStubs = { #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ Tcl_GetOpenFile, /* 167 */ #endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) /* WIN */ NULL, /* 167 */ -#endif /* __WIN32__ */ +#endif /* WIN */ #ifdef MAC_TCL NULL, /* 167 */ #endif /* MAC_TCL */ diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 009db07..00888c9 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -31,6 +31,22 @@ namespace eval genStubs { variable curName "UNKNOWN" + # scspec -- + # + # Storage class specifier for external function declarations. + # Normally "EXTERN", may be set to something like XYZAPI + # + variable scspec "EXTERN" + + # epoch, revision -- + # + # The epoch and revision numbers of the interface currently being defined. + # (@@@TODO: should be an array mapping interface names -> numbers) + # + + variable epoch {} + variable revision 0 + # hooks -- # # An array indexed by interface name that contains the set of @@ -92,6 +108,27 @@ proc genStubs::interface {name} { return } +# genStubs::scspec -- +# +# Define the storage class macro used for external function declarations. +# Typically, this will be a macro like XYZAPI or EXTERN that +# expands to either DLLIMPORT or DLLEXPORT, depending on whether +# -DBUILD_XYZ has been set. +# +proc genStubs::scspec {value} { + variable scspec $value +} + +# genStubs::epoch -- +# +# Define the epoch number for this library. The epoch +# should be incrememented when a release is made that +# contains incompatible changes to the public API. +# +proc genStubs::epoch {value} { + variable epoch $value +} + # genStubs::hooks -- # # This function defines the subinterface hooks for the current @@ -130,7 +167,9 @@ proc genStubs::hooks {names} { proc genStubs::declare {args} { variable stubs variable curName + variable revision + incr revision if {[llength $args] == 2} { lassign $args index decl set platformList generic @@ -166,6 +205,25 @@ proc genStubs::declare {args} { return } +# genStubs::export -- +# +# This function is used in the declarations file to declare a symbol +# that is exported from the library but is not in the stubs table. +# +# Arguments: +# decl The C function declaration, or {} for an undefined +# entry. +# +# Results: +# None. + +proc genStubs::export {args} { + if {[llength $args] != 1} { + puts stderr "wrong # args: export $args" + } + return +} + # genStubs::rewriteFile -- # # This function replaces the machine generated portion of the @@ -221,25 +279,55 @@ proc genStubs::rewriteFile {file text} { # Results: # Returns the original text inside an appropriate #ifdef. -proc genStubs::addPlatformGuard {plat text} { +proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { + set text "" switch $plat { win { - return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n" + append text "#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */\n${iftxt}" + if {$eltxt != ""} { + append text "#else /* WIN */\n${eltxt}" + } + append text "#endif /* WIN */\n" } unix { - return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */\n${text}#endif /* UNIX */\n" + append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL)\ + /* UNIX */\n${iftxt}" + if {$eltxt != ""} { + append text "#else /* UNIX */\n${eltxt}" + } + append text "#endif /* UNIX */\n" } mac { - return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n" + append text "#ifdef MAC_TCL\n${iftxt}" + if {$eltxt != ""} { + append text "#else /* MAC_TCL */\n${eltxt}" + } + append text "#endif /* MAC_TCL */\n" } macosx { - return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n" + append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}" + if {$eltxt != ""} { + append text "#else /* MACOSX */\n${eltxt}" + } + append text "#endif /* MACOSX */\n" } aqua { - return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n" + append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}" + if {$eltxt != ""} { + append text "#else /* AQUA */\n${eltxt}" + } + append text "#endif /* AQUA */\n" } x11 { - return "#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n" + append text "#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_TCL) || defined(MAC_OSX_TK))\ + /* X11 */\n${iftxt}" + if {$eltxt != ""} { + append text "#else /* X11 */\n${eltxt}" + } + append text "#endif /* X11 */\n" + } + default { + append text "${iftxt}${eltxt}" } } return $text @@ -280,8 +368,8 @@ proc genStubs::emitSlots {name textVar} { proc genStubs::parseDecl {decl} { if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} { - puts stderr "Malformed declaration: $decl" - return + set prefix $decl + set args {} } set prefix [string trim $prefix] if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} { @@ -289,19 +377,23 @@ proc genStubs::parseDecl {decl} { return } set rtype [string trim $rtype] + if {$args == ""} { + return [list $rtype $fname {}] + } foreach arg [split $args ,] { lappend argList [string trim $arg] } if {![string compare [lindex $argList end] "..."]} { - if {[llength $argList] != 2} { - puts stderr "Only one argument is allowed in varargs form: $decl" - } - set arg [parseArg [lindex $argList 0]] - if {$arg == "" || ([llength $arg] != 2)} { - puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'" - return + set args TCL_VARARGS + foreach arg [lrange $argList 0 end-1] { + set argInfo [parseArg $arg] + if {[llength $argInfo] == 2 || [llength $argInfo] == 3} { + lappend args $argInfo + } else { + puts stderr "Bad argument: '$arg' in '$decl'" + return + } } - set args [list TCL_VARARGS $arg] } else { set args {} foreach arg $argList { @@ -359,13 +451,14 @@ proc genStubs::parseArg {arg} { # Returns the formatted declaration string. proc genStubs::makeDecl {name decl index} { + variable scspec lassign $decl rtype fname args append text "/* $index */\n" if {($rtype != "void") && ($rtype != "pascal void")} { regsub -all void $rtype VOID rtype } - set line "EXTERN $rtype" + set line "$scspec $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] set pad [expr {24 - [string length $line]}] @@ -373,6 +466,12 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } + if {$args eq ""} { + append line $fname + append text $line + append text ";\n" + return $text + } append line "$fname _ANSI_ARGS_(" regsub -all void $args VOID args @@ -470,6 +569,10 @@ proc genStubs::makeSlot {name decl index} { append lfname [string range $fname 1 end] set text " " + if {$args == ""} { + append text $rtype " *" $lfname "; /* $index */\n" + return $text + } if {($rtype != "void") && ($rtype != "pascal void")} { regsub -all void $rtype VOID rtype } @@ -485,8 +588,16 @@ proc genStubs::makeSlot {name decl index} { append text "(void)" } TCL_VARARGS { - set arg [lindex $args 1] - append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])" + set sep "(" + foreach arg [lrange $args 1 end] { + append text $sep [lindex $arg 0] + if {[string index $text end] != "*"} { + append text " " + } + append text [lindex $arg 1] [lindex $arg 2] + set sep ", " + } + append text ", ...)" } default { set sep "(" @@ -519,7 +630,11 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - append text " " [lindex $decl 1] ", /* " $index " */\n" + if {[lindex $decl 2] eq ""} { + append text " &" [lindex $decl 1] ", /* " $index " */\n" + } else { + append text " " [lindex $decl 1] ", /* " $index " */\n" + } return $text } @@ -728,10 +843,19 @@ proc genStubs::emitMacros {name textVar} { proc genStubs::emitHeader {name} { variable outDir variable hooks + variable epoch + variable revision set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] + if {$epoch != ""} { + set CAPName [string toupper $name] + append text "\n" + append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" + append text "#define ${CAPName}_STUBS_REVISION $revision\n" + } + emitDeclarations $name text if {[info exists hooks($name)]} { @@ -745,6 +869,10 @@ proc genStubs::emitHeader {name} { } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" + if {$epoch != ""} { + append text " int epoch;\n" + append text " int revision;\n" + } append text " struct ${capName}StubHooks *hooks;\n\n" emitSlots $name text @@ -774,6 +902,7 @@ proc genStubs::emitHeader {name} { proc genStubs::emitInit {name textVar} { variable hooks + variable epoch upvar $textVar text set capName [string toupper [string index $name 0]] @@ -790,6 +919,11 @@ proc genStubs::emitInit {name textVar} { } append text "\n${capName}Stubs ${name}Stubs = \{\n" append text " TCL_STUB_MAGIC,\n" + if {$epoch != ""} { + set CAPName [string toupper $name] + append text " ${CAPName}_STUBS_EPOCH,\n" + append text " ${CAPName}_STUBS_REVISION,\n" + } if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { diff --git a/win/Makefile.in b/win/Makefile.in index f11ef53..58811e5 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -438,7 +438,7 @@ install-binaries: binaries else true; \ fi; \ done; - @for i in dde1.2 reg1.1; \ + @for i in dde$(DDEDOTVER) reg$(REGDOTVER); \ do \ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \ @@ -462,23 +462,23 @@ install-binaries: binaries done @if [ -f $(DDE_DLL_FILE) ]; then \ echo installing $(DDE_DLL_FILE); \ - $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.2; \ + $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/dde1.2; \ + $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo installing $(DDE_LIB_FILE); \ - $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \ + $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde$(DDEDOTVER); \ fi @if [ -f $(REG_DLL_FILE) ]; then \ echo installing $(REG_DLL_FILE); \ - $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.1; \ + $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ - $(LIB_INSTALL_DIR)/reg1.1; \ + $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi @if [ -f $(REG_LIB_FILE) ]; then \ echo installing $(REG_LIB_FILE); \ - $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.1; \ + $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg$(REGDOTVER); \ fi install-libraries: libraries diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 06d0590..328198b 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -96,7 +96,7 @@ TCL_DECLARE_MUTEX(socketMutex) struct sockaddr FAR *name, int FAR *namelen); typedef int (PASCAL FAR *LPFN_GETSOCKOPT)(SOCKET s, int level, int optname, char FAR * optval, int FAR *optlen); - typedef u_short (PASCAL FAR *LPFN_HTONS)(u_short hostshort); + typedef unsigned short (PASCAL FAR *LPFN_HTONS)(unsigned short hostshort); typedef unsigned long (PASCAL FAR *LPFN_INET_ADDR) (const char FAR * cp); typedef char FAR * (PASCAL FAR *LPFN_INET_NTOA) @@ -104,7 +104,7 @@ TCL_DECLARE_MUTEX(socketMutex) typedef int (PASCAL FAR *LPFN_IOCTLSOCKET)(SOCKET s, long cmd, u_long FAR *argp); typedef int (PASCAL FAR *LPFN_LISTEN)(SOCKET s, int backlog); - typedef u_short (PASCAL FAR *LPFN_NTOHS)(u_short netshort); + typedef unsigned short (PASCAL FAR *LPFN_NTOHS)(unsigned short netshort); typedef int (PASCAL FAR *LPFN_RECV)(SOCKET s, char FAR * buf, int len, int flags); typedef int (PASCAL FAR *LPFN_SELECT)(int nfds, @@ -1320,7 +1320,7 @@ CreateSocketAddress(sockaddrPtr, host, port) ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN)); sockaddrPtr->sin_family = AF_INET; - sockaddrPtr->sin_port = winSock.htons((u_short) (port & 0xFFFF)); + sockaddrPtr->sin_port = winSock.htons((unsigned short) (port & 0xFFFF)); if (host == NULL) { addr.s_addr = INADDR_ANY; } else { @@ -2678,8 +2678,8 @@ TclWinSetSockOpt(SOCKET s, int level, int optname, const char * optval, return winSock.setsockopt(s, level, optname, optval, optlen); } -u_short -TclWinNToHS(u_short netshort) +unsigned short +TclWinNToHS(unsigned short netshort) { /* * Check that WinSock is initialized; do not call it if not, to @@ -2689,12 +2689,29 @@ TclWinNToHS(u_short netshort) */ if (!SocketsEnabled()) { - return (u_short) -1; + return (unsigned short) -1; } return winSock.ntohs(netshort); } +char * +TclpInetNtoa(struct in_addr addr) +{ + /* + * Check that WinSock is initialized; do not call it if not, to + * prevent system crashes. This can happen at exit time if the exit + * handler for WinSock ran before other exit handlers that want to + * use sockets. + */ + + if (!SocketsEnabled()) { + return NULL; + } + + return winSock.inet_ntoa(addr); +} + struct servent * TclWinGetServByName(const char * name, const char * proto) { -- cgit v0.12 From 18e9a6f3e4ca3f54e389e421704129e2cb8d7fd6 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 22 May 2012 12:32:35 +0000 Subject: Increase the timer resolution of test io-29.33b so the timing sensitivity of the test is reduced and failures on slow runs are avoided. --- tests/io.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/io.test b/tests/io.test index e6cea16..386179e 100644 --- a/tests/io.test +++ b/tests/io.test @@ -2748,13 +2748,13 @@ test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} { set f [open $path(script2) w] puts $f {after 2000} close $f - set t1 [clock seconds] + set t1 [clock milliseconds] set ff [open "|[list [interpreter] $path(script2)]" w] catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)} exec [interpreter] $path(script) >@ $ff - set t2 [clock seconds] + set t2 [clock milliseconds] close $ff - expr {($t2-$t1)/2} + expr {($t2-$t1)/2000 ? $t2-$t1 : 0} } 0 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} { variable c 0 -- cgit v0.12 From e7a344471ef19a4d60d6fd62eb07fc1b2344f77e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 May 2012 12:58:12 +0000 Subject: MAC_OSX_TK -> MAC_OSX_TCL --- generic/tclDecls.h | 18 +++++++++--------- generic/tclIntPlatDecls.h | 6 +++--- generic/tclStubInit.c | 8 ++++---- tools/genStubs.tcl | 2 +- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 703030d..4225c96 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -86,7 +86,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, CONST char *file, int line); EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, CONST char *file, int line); #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_CreateFileHandler_TCL_DECLARED #define Tcl_CreateFileHandler_TCL_DECLARED /* 9 */ @@ -102,7 +102,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_DeleteFileHandler_TCL_DECLARED #define Tcl_DeleteFileHandler_TCL_DECLARED /* 10 */ @@ -1013,7 +1013,7 @@ EXTERN CONST char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_GetOpenFile_TCL_DECLARED #define Tcl_GetOpenFile_TCL_DECLARED /* 167 */ @@ -3428,7 +3428,7 @@ typedef struct TclStubs { char * (*tcl_DbCkalloc) (unsigned int size, CONST char *file, int line); /* 6 */ void (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */ char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ #if defined(__WIN32__) /* WIN */ @@ -3437,7 +3437,7 @@ typedef struct TclStubs { #ifdef MAC_OSX_TCL /* MACOSX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* UNIX */ #if defined(__WIN32__) /* WIN */ @@ -3602,7 +3602,7 @@ typedef struct TclStubs { Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ CONST char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* UNIX */ #if defined(__WIN32__) /* WIN */ @@ -4075,7 +4075,7 @@ extern TclStubs *tclStubsPtr; #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_CreateFileHandler #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ @@ -4087,7 +4087,7 @@ extern TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_DeleteFileHandler #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ @@ -4723,7 +4723,7 @@ extern TclStubs *tclStubsPtr; #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ #endif -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef Tcl_GetOpenFile #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 447a736..5354157 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -41,7 +41,7 @@ * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef TclGetAndDetachPids_TCL_DECLARED #define TclGetAndDetachPids_TCL_DECLARED /* 0 */ @@ -425,7 +425,7 @@ typedef struct TclIntPlatStubs { int magic; struct TclIntPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ int (*tclpCloseFile) (TclFile file); /* 1 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ @@ -537,7 +537,7 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #ifndef TclGetAndDetachPids #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 5fa6f0a..529a3ba 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -451,7 +451,7 @@ TclIntStubs tclIntStubs = { TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, NULL, -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ @@ -649,7 +649,7 @@ TclStubs tclStubs = { Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_CreateFileHandler, /* 9 */ #endif /* UNIX */ #if defined(__WIN32__) /* WIN */ @@ -658,7 +658,7 @@ TclStubs tclStubs = { #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_CreateFileHandler, /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* UNIX */ #if defined(__WIN32__) /* WIN */ @@ -823,7 +823,7 @@ TclStubs tclStubs = { Tcl_GetMaster, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TK) /* UNIX */ +#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_GetOpenFile, /* 167 */ #endif /* UNIX */ #if defined(__WIN32__) /* WIN */ diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 2deef9c..b43423d 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -292,7 +292,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { append text "#endif /* WIN */\n" } unix { - append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TK)\ + append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL)\ /* UNIX */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* UNIX */\n${eltxt}" -- cgit v0.12 From e6e220f14d2d0b998a5e2e1977116a701371a88f Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 22 May 2012 15:11:01 +0000 Subject: Avoid calling close() on a bogus fd when an attempt to open a client socket with an unsupported address family leaves one behind. --- unix/tclUnixSock.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index e48cc2b..12e5a9a 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -545,6 +545,9 @@ TcpCloseProc( */ for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { + if (fds->fd < 0) { + continue; + } Tcl_DeleteFileHandler(fds->fd); if (close(fds->fd) < 0) { errorCode = errno; -- cgit v0.12 From f1be70ab35fd454a2234ac10ed10c88b9c884b13 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 22 May 2012 16:05:24 +0000 Subject: 3528601 Fix broken --disable-threads build. --- generic/tclIORChan.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 2d31da3..938def2 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -934,8 +934,11 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ +#ifdef TCL_THREADS if (rcPtr->owner == rcPtr->thread) { +#endif Tcl_NotifyChannel (chan, events); +#ifdef TCL_THREADS } else { ReflectEvent* ev = ckalloc (sizeof (ReflectEvent)); ev->header.proc = ReflectEventRun; @@ -965,6 +968,7 @@ TclChanPostEventObjCmd( Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL); Tcl_ThreadAlert (rcPtr->owner); } +#endif /* * Squash interp results left by the event script. -- cgit v0.12 From 3cc210b6d0579358daa94a0f3670e30c973b7f34 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Tue, 22 May 2012 20:28:48 +0000 Subject: Use zero-delays instead of finite ones when posting fileevents, because (1) they should be zero in the first place (see UpdateInterest) and (2) ever-reposting cases will be detected with greater ease. --- generic/tclIORTrans.c | 9 +-------- generic/tclZlib.c | 9 +-------- 2 files changed, 2 insertions(+), 16 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 5d99f73..fd25f2d 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -439,13 +439,6 @@ static const char *msg_dstlost = */ /* - * Number of milliseconds to wait before firing an event to try to flush out - * information waiting in buffers (fileevent support). - */ - -#define FLUSH_DELAY (5) - -/* * Helper functions encapsulating some of the thread forwarding to make the * control flow in callers easier. */ @@ -2861,7 +2854,7 @@ TimerSetup( return; } - rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr); + rtPtr->timer = Tcl_CreateTimerHandler(0, TimerRun, rtPtr); } /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 540b779..731176c 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -114,13 +114,6 @@ typedef struct { #define DEFAULT_BUFFER_SIZE 4096 /* - * Time to wait (in milliseconds) before flushing the channel when reading - * data through the transform. - */ - -#define TRANSFORM_FLUSH_DELAY 5 - -/* * Convenience macro to make some casts easier to use. */ @@ -2737,7 +2730,7 @@ ZlibTransformTimerSetup( ZlibChannelData *cd) { if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY, + cd->timer = Tcl_CreateTimerHandler(0, ZlibTransformTimerRun, cd); } } -- cgit v0.12 From 565885307e6c24d3a27eaa01d7701dd2819336a8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 23 May 2012 12:00:02 +0000 Subject: fix [bug 3529063]: 2 minor bugs in TIP #106 implementation --- win/tclWinDde.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 895551a..617e4e5 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1189,8 +1189,8 @@ DdeObjCmd( enum DdeExecOptions { DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; - static const char *const ddePokeOptions[] = { - "-binary", NULL + static const char *const ddeEvalOptions[] = { + "-async", NULL }; static const char *const ddeReqOptions[] = { "-binary", NULL @@ -1295,7 +1295,7 @@ DdeObjCmd( firstArg = 2; break; } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddePokeOptions, "option", 0, &argIndex) == TCL_OK)) { + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { binary = 1; firstArg = 3; break; @@ -1306,7 +1306,7 @@ DdeObjCmd( */ Tcl_WrongNumArgs(interp, 2, objv, - "serviceName ?-binary? topicName item value"); + "?-binary? serviceName topicName item value"); return TCL_ERROR; case DDE_REQUEST: if (objc == 5) { @@ -1340,7 +1340,7 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; -- cgit v0.12 From 78bbbde35c3f53764827e54afe963af4ea244aa4 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 24 May 2012 09:54:19 +0000 Subject: minor: Cleaning up code, adding comments. --- generic/tclZlib.c | 305 +++++++++++++++++++++++++++++++++--------------------- 1 file changed, 187 insertions(+), 118 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 0c38602..d4019fc 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -91,7 +91,7 @@ typedef struct { GzipHeader outHeader; /* Header to write to an output stream, when * compressing a gzip stream. */ Tcl_TimerToken timer; /* Timer used for keeping events fresh. */ - Tcl_DString result; /* Buffer for decompression results. */ + Tcl_DString decompressed; /* Buffer for decompression results. */ } ZlibChannelData; /* @@ -114,10 +114,10 @@ typedef struct { #define DEFAULT_BUFFER_SIZE 4096 /* - * Convenience macro to make some casts easier to use. + * Time to wait before delivering a timer event. */ -#define UCHARP(x) ((unsigned char *) (x)) +#define TRANSFORM_TIMEOUT 0 /* * Prototypes for private procedures defined later in this file: @@ -128,7 +128,7 @@ static Tcl_DriverBlockModeProc ZlibTransformBlockMode; static Tcl_DriverCloseProc ZlibTransformClose; static Tcl_DriverGetHandleProc ZlibTransformGetHandle; static Tcl_DriverGetOptionProc ZlibTransformGetOption; -static Tcl_DriverHandlerProc ZlibTransformHandler; +static Tcl_DriverHandlerProc ZlibTransformEventHandler; static Tcl_DriverInputProc ZlibTransformInput; static Tcl_DriverOutputProc ZlibTransformOutput; static Tcl_DriverSetOptionProc ZlibTransformSetOption; @@ -140,7 +140,7 @@ static void ConvertError(Tcl_Interp *interp, int code); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); -static int ResultCopy(Tcl_DString *r, unsigned char *buf, +static inline int ResultCopy(ZlibChannelData *cd, char *buf, int toRead); static int ResultGenerate(ZlibChannelData *cd, int n, int flush, int *errorCodePtr); @@ -148,9 +148,8 @@ static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, int mode, int format, int level, Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr); static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr); -static void ZlibTransformTimerKill(ZlibChannelData *cd); +static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd); static void ZlibTransformTimerRun(ClientData clientData); -static void ZlibTransformTimerSetup(ZlibChannelData *cd); /* * Type of zlib-based compressing and decompressing channels. @@ -170,7 +169,7 @@ static const Tcl_ChannelType zlibChannelType = { NULL, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ - ZlibTransformHandler, + ZlibTransformEventHandler, NULL, /* wideSeekProc */ NULL, NULL @@ -2264,6 +2263,12 @@ ZlibStreamCmd( *---------------------------------------------------------------------- * Set of functions to support channel stacking. *---------------------------------------------------------------------- + * + * ZlibTransformClose -- + * + * How to shut down a stacked compressing/decompressing transform. + * + *---------------------------------------------------------------------- */ static int @@ -2278,7 +2283,7 @@ ZlibTransformClose( * Delete the support timer. */ - ZlibTransformTimerKill(cd); + ZlibTransformEventTimerKill(cd); /* * Flush any data waiting to be compressed. @@ -2325,7 +2330,7 @@ ZlibTransformClose( * Release all memory. */ - Tcl_DStringFree (&cd->result); + Tcl_DStringFree(&cd->decompressed); if (cd->inBuffer) { ckfree(cd->inBuffer); @@ -2338,6 +2343,16 @@ ZlibTransformClose( ckfree(cd); return result; } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformInput -- + * + * Reader filter that does decompression. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformInput( @@ -2363,13 +2378,13 @@ ZlibTransformInput( * below, possibly EOF). */ - copied = ResultCopy(&cd->result, UCHARP(buf), toRead); + copied = ResultCopy(cd, buf, toRead); toRead -= copied; buf += copied; gotBytes += copied; if (toRead == 0) { - goto stop; + return gotBytes; } /* @@ -2378,7 +2393,7 @@ ZlibTransformInput( * transform them for delivery. We may not get what we want (full EOF * or temporarily out of data). * - * Length (cd->result) == 0, toRead > 0 here. + * Length (cd->decompressed) == 0, toRead > 0 here. * * The zlib transform allows us to read at most one character from the * underlying channel to properly identify Z_STREAM_END without @@ -2387,6 +2402,16 @@ ZlibTransformInput( readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1); + /* + * Three cases here: + * 1. Got some data from the underlying channel (readBytes > 0) so + * it should be fed through the decompression engine. + * 2. Got an error (readBytes < 0) which we should report up except + * for the case where we can convert it to a short read. + * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If + * it is EOF, try flushing the data out of the decompressor. + */ + if (readBytes < 0) { /* * Report errors to caller. The state of the seek system is @@ -2399,16 +2424,14 @@ ZlibTransformInput( * we report that instead of the request to re-try. */ - goto stop; + return gotBytes; } *errorCodePtr = Tcl_GetErrno(); - goto error; - } - - if (readBytes == 0) { + return -1; + } else if (readBytes == 0) { /* - * Check wether we hit on EOF in 'parent' or not. If not + * Check wether we hit on EOF in 'parent' or not. If not, * differentiate between blocking and non-blocking modes. In * non-blocking mode we ran temporarily out of data. Signal this * to the caller via EWOULDBLOCK and error return (-1). In the @@ -2424,56 +2447,61 @@ ZlibTransformInput( if ((gotBytes == 0) && (cd->flags & ASYNC)) { *errorCodePtr = EWOULDBLOCK; - goto error; - } - goto stop; - } else { - /* - * (Semi-)Eof in parent. - * - * Now this is a bit different. The partial data waiting is - * converted and returned. - */ - - if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) < 0) { - goto error; + return -1; } + return gotBytes; + } - if (Tcl_DStringLength(&cd->result) == 0) { - /* - * The drain delivered nothing. - */ + /* + * (Semi-)Eof in parent. + * + * Now this is a bit different. The partial data waiting is + * converted and returned. + */ - goto stop; - } + if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) { + return -1; + } + if (Tcl_DStringLength(&cd->decompressed) == 0) { /* - * Reset eof, force caller to drain result buffer. + * The drain delivered nothing. Time to deliver what we've + * got. */ - ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF; - continue; /* at: while (toRead > 0) */ + return gotBytes; } - } /* readBytes == 0 */ - /* - * Transform the read chunk, which was not empty. Anything we get back - * is a transformation result to be put into our buffers, and the next - * iteration will put it into the result. - */ + /* + * Reset eof, force caller to drain result buffer. + */ - if (ResultGenerate(cd, readBytes, Z_NO_FLUSH, errorCodePtr) < 0) { - goto error; - } - } /* while toRead > 0 */ + ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF; + } else /* readBytes > 0 */ { + /* + * Transform the read chunk, which was not empty. Anything we get + * back is a transformation result to be put into our buffers, and + * the next iteration will put it into the result. + */ - stop: + if (ResultGenerate(cd, readBytes, Z_NO_FLUSH, + errorCodePtr) != TCL_OK) { + return -1; + } + } + } return gotBytes; - - error: - gotBytes = -1; - goto stop; } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformOutput -- + * + * Writer filter that does compression. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformOutput( @@ -2518,6 +2546,16 @@ ZlibTransformOutput( return toWrite - cd->outStream.avail_in; } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformSetOption -- + * + * Writing side of [fconfigure] on our channel. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformSetOption( /* not used */ @@ -2568,7 +2606,7 @@ ZlibTransformSetOption( /* not used */ } if (Tcl_WriteRaw(cd->parent, cd->outBuffer, - cd->outStream.next_out - (Bytef*)cd->outBuffer) < 0) { + cd->outStream.next_out - (Bytef *) cd->outBuffer) < 0) { Tcl_AppendResult(interp, "problem flushing channel: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; @@ -2589,6 +2627,16 @@ ZlibTransformSetOption( /* not used */ return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, optionName, value); } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformGetOption -- + * + * Reading side of [fconfigure] on our channel. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformGetOption( @@ -2665,6 +2713,17 @@ ZlibTransformGetOption( } return Tcl_BadChannelOption(interp, optionName, chanOptions); } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformWatch, ZlibTransformEventHandler -- + * + * If we have data pending, trigger a readable event after a short time + * (in order to allow a real event to catch up). + * + *---------------------------------------------------------------------- + */ static void ZlibTransformWatch( @@ -2681,63 +2740,27 @@ ZlibTransformWatch( watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); - if (!(mask & TCL_READABLE) || - (Tcl_DStringLength(&cd->result) == 0)) { - ZlibTransformTimerKill(cd); - } else { - ZlibTransformTimerSetup(cd); - } -} - -static int -ZlibTransformGetHandle( - ClientData instanceData, - int direction, - ClientData *handlePtr) -{ - ZlibChannelData *cd = instanceData; - - return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); -} - -static int -ZlibTransformBlockMode( - ClientData instanceData, - int mode) -{ - ZlibChannelData *cd = instanceData; - - if (mode == TCL_MODE_NONBLOCKING) { - cd->flags |= ASYNC; - } else { - cd->flags &= ~ASYNC; + if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) { + ZlibTransformEventTimerKill(cd); + } else if (cd->timer == NULL) { + cd->timer = Tcl_CreateTimerHandler(TRANSFORM_TIMEOUT, + ZlibTransformTimerRun, cd); } - return TCL_OK; } static int -ZlibTransformHandler( +ZlibTransformEventHandler( ClientData instanceData, int interestMask) { ZlibChannelData *cd = instanceData; - ZlibTransformTimerKill(cd); + ZlibTransformEventTimerKill(cd); return interestMask; } -static void -ZlibTransformTimerSetup( - ZlibChannelData *cd) -{ - if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(0, - ZlibTransformTimerRun, cd); - } -} - -static void -ZlibTransformTimerKill( +static inline void +ZlibTransformEventTimerKill( ZlibChannelData *cd) { if (cd->timer != NULL) { @@ -2759,6 +2782,53 @@ ZlibTransformTimerRun( /* *---------------------------------------------------------------------- * + * ZlibTransformGetHandle -- + * + * Anything that needs the OS handle is told to get it from what we are + * stacked on top of. + * + *---------------------------------------------------------------------- + */ + +static int +ZlibTransformGetHandle( + ClientData instanceData, + int direction, + ClientData *handlePtr) +{ + ZlibChannelData *cd = instanceData; + + return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); +} + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformBlockMode -- + * + * We need to keep track of the blocking mode; it changes our behavior. + * + *---------------------------------------------------------------------- + */ + +static int +ZlibTransformBlockMode( + ClientData instanceData, + int mode) +{ + ZlibChannelData *cd = instanceData; + + if (mode == TCL_MODE_NONBLOCKING) { + cd->flags |= ASYNC; + } else { + cd->flags &= ~ASYNC; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * ZlibStackChannelTransform -- * * Stacks either compression or decompression onto a channel. @@ -2870,7 +2940,7 @@ ZlibStackChannelTransform( } } - Tcl_DStringInit(&cd->result); + Tcl_DStringInit(&cd->decompressed); chan = Tcl_StackChannel(interp, &zlibChannelType, cd, Tcl_GetChannelMode(channel), channel); @@ -2913,13 +2983,13 @@ ZlibStackChannelTransform( *---------------------------------------------------------------------- */ -static int +static inline int ResultCopy( - Tcl_DString *ds, /* The buffer to read from */ - unsigned char *buf, /* The buffer to copy into */ + ZlibChannelData *cd, /* The location of the buffer to read from. */ + char *buf, /* The buffer to copy into */ int toRead) /* Number of requested bytes */ { - int have = Tcl_DStringLength(ds); + int have = Tcl_DStringLength(&cd->decompressed); if (have == 0) { /* @@ -2927,20 +2997,19 @@ ResultCopy( */ return 0; - } - if (have > toRead) { + } else if (have > toRead) { /* * The internal buffer contains more than requested. Copy the * requested subset to the caller, shift the remaining bytes down, and * truncate. */ - char *src = Tcl_DStringValue(ds); + char *src = Tcl_DStringValue(&cd->decompressed); memcpy(buf, src, toRead); memmove(src, src + toRead, have - toRead); - Tcl_DStringSetLength(ds, have - toRead); + Tcl_DStringSetLength(&cd->decompressed, have - toRead); return toRead; } else /* have <= toRead */ { /* @@ -2948,8 +3017,8 @@ ResultCopy( * caller, so take everything as best effort. */ - memcpy(buf, Tcl_DStringValue(ds), have); - Tcl_DStringSetLength(ds, 0); + memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); + Tcl_DStringSetLength(&cd->decompressed, 0); return have; } } @@ -2963,7 +3032,7 @@ ResultCopy( * in our working buffer. * * Result: - * Zero on success, -1 on error (with *errorCodePtr updated with reason). + * TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason). * * Side effects: * See above. @@ -2998,7 +3067,7 @@ ResultGenerate( written = MAXBUF - cd->inStream.avail_out; if (written) { - Tcl_DStringAppend(&cd->result, (char*) buf, written); + Tcl_DStringAppend(&cd->decompressed, (char *) buf, written); } /* @@ -3008,7 +3077,7 @@ ResultGenerate( if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) || (e == Z_STREAM_END) || (e == Z_OK && cd->inStream.avail_out == 0)) { - return 0; + return TCL_OK; } /* @@ -3027,7 +3096,7 @@ ResultGenerate( Tcl_NewStringObj(cd->inStream.msg, -1)); Tcl_SetChannelError(cd->parent, errObj); *errorCodePtr = EINVAL; - return -1; + return TCL_ERROR; } /* @@ -3035,7 +3104,7 @@ ResultGenerate( */ if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { - return 0; + return TCL_OK; } } } -- cgit v0.12 From 53c90dd2dd157a577d263f199af9af9c2fb896d4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 24 May 2012 19:18:21 +0000 Subject: Take cygwin handling of X11 into account Implement TclpIsAtty, Cygwin only doc/dde.n: doc fix --- ChangeLog | 8 ++++++++ doc/dde.n | 4 ++-- generic/tclInt.decls | 4 ++++ generic/tclIntPlatDecls.h | 10 +++++++--- generic/tclStubInit.c | 10 +++++++++- tools/genStubs.tcl | 38 ++++++++++++++++++++++++----------- win/tclWinDde.c | 51 +++++++++++++++++++++++++++++++++-------------- 7 files changed, 92 insertions(+), 33 deletions(-) diff --git a/ChangeLog b/ChangeLog index ff1d562..7fe65c8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-05-24 Jan Nijtmans + + * tools/genStubs.tcl: Take cygwin handling of X11 into account. + * generic/tcl*Decls.h: re-generated + * generic/tclStubInit.c: Implement TclpIsAtty, Cygwin only. + * doc/dde.n: Doc fix: "dde execute iexplore" doesn't work + without -async, because iexplore doesn't return a value + 2012-05-22 Jan Nijtmans * tools/genStubs.tcl: Let cygwin share stub table with win32 diff --git a/doc/dde.n b/doc/dde.n index 7222f51..5dbbee5 100644 --- a/doc/dde.n +++ b/doc/dde.n @@ -124,7 +124,7 @@ unpredictable results. .PP An external application which wishes to run a script in Tcl should have that script store its result in a variable, run the \fBdde execute\fR -command, and the run \fBdde request\fR to get the value of the +command, and then run \fBdde request\fR to get the value of the variable. .PP When using DDE, be careful to ensure that the event queue is flushed @@ -140,7 +140,7 @@ This asks Internet Explorer (which must already be running) to go to a particularly important website: .CS package require dde -\fBdde execute\fR iexplore WWW_OpenURL http://www.tcl.tk/ +\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl.tk/ .CE .SH "SEE ALSO" diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 67f3db6..d714e85 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -894,6 +894,10 @@ declare 15 win { const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 16 win { + int TclpIsAtty(int fd) +} # Signature changed in 8.1: # declare 16 win { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 201c597..350df03 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -134,7 +134,8 @@ EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); -/* Slot 16 is reserved */ +/* 16 */ +EXTERN int TclpIsAtty _ANSI_ARGS_((int fd)); /* Slot 17 is reserved */ /* 18 */ EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel, @@ -289,7 +290,7 @@ typedef struct TclIntPlatStubs { Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 13 */ int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 14 */ int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 15 */ - VOID *reserved16; + int (*tclpIsAtty) _ANSI_ARGS_((int fd)); /* 16 */ VOID *reserved17; TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 19 */ @@ -488,7 +489,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #endif -/* Slot 16 is reserved */ +#ifndef TclpIsAtty +#define TclpIsAtty \ + (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ +#endif /* Slot 17 is reserved */ #ifndef TclpMakeFile #define TclpMakeFile \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e623fa6..b548b1d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,7 +72,9 @@ int TclSockMinimumBuffersOld(sock, size) #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclpReaddir 0 +# define TclpIsAtty 0 #elif defined(__CYGWIN__) +# define TclpIsAtty TclPlatIsAtty # define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing @@ -81,6 +83,12 @@ int TclSockMinimumBuffersOld(sock, size) static Tcl_Encoding winTCharEncoding; +static int +TclpIsAtty(int fd) +{ + return isatty(fd); +} + int TclWinGetPlatformId() { @@ -461,7 +469,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ - NULL, /* 16 */ + TclpIsAtty, /* 16 */ NULL, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 00888c9..e4cf868 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -279,18 +279,26 @@ proc genStubs::rewriteFile {file text} { # Results: # Returns the original text inside an appropriate #ifdef. -proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { +proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { set text "" switch $plat { win { - append text "#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */\n${iftxt}" + append text "#if defined(__WIN32__)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " /* WIN */\n${iftxt}" if {$eltxt != ""} { append text "#else /* WIN */\n${eltxt}" } append text "#endif /* WIN */\n" } unix { - append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL)\ + append text "#if !defined(__WIN32__)" + if {$withCygwin} { + append text " && !defined(__CYGWIN__)" + } + append text " && !defined(MAC_TCL)\ /* UNIX */\n${iftxt}" if {$eltxt != ""} { append text "#else /* UNIX */\n${eltxt}" @@ -319,7 +327,11 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { append text "#endif /* AQUA */\n" } x11 { - append text "#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_TCL) || defined(MAC_OSX_TK))\ + append text "#if !(defined(__WIN32__)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" if {$eltxt != ""} { append text "#else /* X11 */\n${eltxt}" @@ -466,7 +478,7 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } - if {$args eq ""} { + if {$args == ""} { append line $fname append text $line append text ";\n" @@ -490,7 +502,7 @@ proc genStubs::makeDecl {name decl index} { append line $sep set next {} append next [lindex $arg 0] - if {[string index $next end] ne "*"} { + if {[string index $next end] != "*"} { append next " " } append next [lindex $arg 1] [lindex $arg 2] @@ -603,7 +615,7 @@ proc genStubs::makeSlot {name decl index} { set sep "(" foreach arg $args { append text $sep [lindex $arg 0] - if {[string index $text end] ne "*"} { + if {[string index $text end] != "*"} { append text " " } append text [lindex $arg 1] [lindex $arg 2] @@ -630,7 +642,7 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - if {[lindex $decl 2] eq ""} { + if {[lindex $decl 2] == ""} { append text " &" [lindex $decl 1] ", /* " $index " */\n" } else { append text " " [lindex $decl 1] ", /* " $index " */\n" @@ -737,7 +749,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar append temp [$slotProc $name $stubs($name,$plat,$i) $i] } } - append text [addPlatformGuard $plat $temp] + append text [addPlatformGuard $plat $temp {} true] } } # Again, make sure you don't duplicate entries for macosx & aqua. @@ -780,7 +792,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar append temp [$slotProc $name $stubs($name,x11,$i) $i] } } - append text [addPlatformGuard x11 $temp] + append text [addPlatformGuard x11 $temp {} true] } } } @@ -820,12 +832,14 @@ proc genStubs::emitMacros {name textVar} { upvar $textVar text set upName [string toupper $libraryName] - append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n" + append text "\n#if defined(USE_${upName}_STUBS) &&\ + !defined(USE_${upName}_STUB_PROCS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" forAllStubs $name makeMacro 0 text - append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n" + append text "\n#endif /* defined(USE_${upName}_STUBS) &&\ + !defined(USE_${upName}_STUB_PROCS) */\n" return } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 3b8ca23..4ef7f41 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -181,7 +181,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + TCL_DDE_SERVICE_NAME, CP_WINANSI); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -577,6 +577,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; + Tcl_UniChar *uniStr; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -590,11 +591,21 @@ DdeServerProc( } utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - if (len && !utilString[len-1]) { - len--; + uniStr = (Tcl_UniChar *) utilString; + if (!dlen) { + /* Empty string. (Since TIP #106 we can create this!) */ + ddeObjectPtr = Tcl_NewObj(); + } else if (0) { + /* Cannot be unicode, so assume utf-8 */ + if (!utilString[dlen-1]) { + dlen--; + } + ddeObjectPtr = Tcl_NewStringObj(utilString, dlen); + } else { + /* unicode */ + dlen >>= 1; + ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen); } - ddeObjectPtr = Tcl_NewStringObj(utilString, len); Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { @@ -712,8 +723,8 @@ MakeDdeConnection( HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINANSI); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -989,7 +1000,7 @@ DdeObjCmd( "-binary", NULL }; - int index, length; + int index, length, argIndex; int async = 0, binary = 0; int result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; @@ -1081,11 +1092,9 @@ DdeObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); return TCL_ERROR; } else { - int dummy; - firstArg = 2; if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", - 0, &dummy) == TCL_OK) { + 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } @@ -1143,8 +1152,12 @@ DdeObjCmd( break; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + if (ddeService) { + DdeFreeStringHandle(ddeInstance, ddeService); + } + if (ddeTopic) { + DdeFreeStringHandle(ddeInstance, ddeTopic); + } if (hConv == NULL) { SetDdeError(interp); @@ -1185,8 +1198,12 @@ DdeObjCmd( goto cleanup; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + if (ddeService) { + DdeFreeStringHandle(ddeInstance, ddeService); + } + if (ddeTopic) { + DdeFreeStringHandle(ddeInstance, ddeTopic); + } if (hConv == NULL) { SetDdeError(interp); @@ -1242,8 +1259,12 @@ DdeObjCmd( &length); hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + if (ddeService) { DdeFreeStringHandle(ddeInstance, ddeService); + } + if (ddeTopic) { DdeFreeStringHandle(ddeInstance, ddeTopic); + } if (hConv == NULL) { SetDdeError(interp); -- cgit v0.12 From b8df44e69e283fac9c93c0f64a77f61780e11ada Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 May 2012 06:33:08 +0000 Subject: fix genStubs.tcl --- tools/genStubs.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index e4cf868..96354f0 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -331,7 +331,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { if {$withCygwin} { append text " || defined(__CYGWIN__)" } - append text " || defined(MAC_OSX_TK))\ + append text " || defined(MAC_TCL) || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" if {$eltxt != ""} { append text "#else /* X11 */\n${eltxt}" -- cgit v0.12 From f182c12f4a885f158795c23c07ffbc23af91c41e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 May 2012 07:24:04 +0000 Subject: [Bug 473946]: special characters not correctly sent, now for XTYP_EXECUTE as well as XTYP_REQUEST. Fix "make genstubs" when cross-compiling on UNIX --- ChangeLog | 6 ++++++ win/Makefile.in | 6 +++--- win/tclWinDde.c | 6 +++--- 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7fe65c8..c91a822 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-05-25 Jan Nijtmans + + * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent, + now for XTYP_EXECUTE as well as XTYP_REQUEST. + * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX + 2012-05-24 Jan Nijtmans * tools/genStubs.tcl: Take cygwin handling of X11 into account. diff --git a/win/Makefile.in b/win/Makefile.in index 58811e5..af4ca68 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -620,7 +620,7 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \ @echo "This warning can be safely ignored, do not report as a bug!" genstubs: - $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \ + $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ - "$(GENERIC_DIR_NATIVE)\tcl.decls" \ - "$(GENERIC_DIR_NATIVE)\tclInt.decls" + "$(GENERIC_DIR_NATIVE)/tcl.decls" \ + "$(GENERIC_DIR_NATIVE)/tclInt.decls" diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 4ef7f41..4aa6f71 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -593,9 +593,9 @@ DdeServerProc( utilString = (char *) DdeAccessData(hData, &dlen); uniStr = (Tcl_UniChar *) utilString; if (!dlen) { - /* Empty string. (Since TIP #106 we can create this!) */ + /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); - } else if (0) { + } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) { /* Cannot be unicode, so assume utf-8 */ if (!utilString[dlen-1]) { dlen--; @@ -604,7 +604,7 @@ DdeServerProc( } else { /* unicode */ dlen >>= 1; - ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen); + ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); -- cgit v0.12 From 423017faed3aa258b3fa9c04cf9c6f5289d355a8 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 25 May 2012 08:50:37 +0000 Subject: Factor out constant that must be the same in multiple places. Prompted by a conversation with Alexandre Ferrieux. --- ChangeLog | 6 ++++++ generic/tclIO.c | 7 ++++--- generic/tclIO.h | 7 +++++++ generic/tclIORTrans.c | 3 ++- generic/tclTimer.c | 9 +++------ generic/tclZlib.c | 8 +------- 6 files changed, 23 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index 012fe5f..09dbe4d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-05-25 Donal K. Fellows + + * generic/tclIO.h (SYNTHETIC_EVENT_TIME): Factored out the definition + of the amount of time that should be waited before firing a synthetic + event on a channel. + 2012-05-25 Jan Nijtmans * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent, diff --git a/generic/tclIO.c b/generic/tclIO.c index 9e729c4..a76aba3 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8419,8 +8419,8 @@ UpdateInterest( mask &= ~TCL_EXCEPTION; if (!statePtr->timer) { - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, - chanPtr); + statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ChannelTimerProc, chanPtr); } } } @@ -8461,7 +8461,8 @@ ChannelTimerProc( * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr); + statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ChannelTimerProc,chanPtr); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* diff --git a/generic/tclIO.h b/generic/tclIO.h index 3283c3e..1e89878 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -423,6 +423,13 @@ typedef struct GetsState { * appended to objPtr so far, just before the * last call to FilterInputBytes(). */ } GetsState; + +/* + * The length of time to wait between synthetic timer events. Must be zero or + * bad things tend to happen. + */ + +#define SYNTHETIC_EVENT_TIME 0 /* * Local Variables: diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index fd25f2d..8f111b0 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -2854,7 +2854,8 @@ TimerSetup( return; } - rtPtr->timer = Tcl_CreateTimerHandler(0, TimerRun, rtPtr); + rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + TimerRun, rtPtr); } /* diff --git a/generic/tclTimer.c b/generic/tclTimer.c index cf91dca..36adaad 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -182,8 +182,7 @@ static void TimerSetupProc(ClientData clientData, int flags); static ThreadSpecificData * InitTimer(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -214,8 +213,7 @@ static void TimerExitProc( ClientData clientData) /* Not used. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { @@ -297,9 +295,8 @@ TclCreateAbsoluteTimerHandler( ClientData clientData) { register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; - ThreadSpecificData *tsdPtr; + ThreadSpecificData *tsdPtr = InitTimer(); - tsdPtr = InitTimer(); timerHandlerPtr = ckalloc(sizeof(TimerHandler)); /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index d4019fc..84a81f8 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -114,12 +114,6 @@ typedef struct { #define DEFAULT_BUFFER_SIZE 4096 /* - * Time to wait before delivering a timer event. - */ - -#define TRANSFORM_TIMEOUT 0 - -/* * Prototypes for private procedures defined later in this file: */ @@ -2743,7 +2737,7 @@ ZlibTransformWatch( if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) { ZlibTransformEventTimerKill(cd); } else if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(TRANSFORM_TIMEOUT, + cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ZlibTransformTimerRun, cd); } } -- cgit v0.12 From b317e4d6a30ce58b28482a6b884f3aed5a3f05f7 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 25 May 2012 14:49:30 +0000 Subject: [Bug 3528418]: Document what is going on with respect to qualification of command prefixes in ensemble subcommand maps. --- ChangeLog | 6 ++++++ doc/Ensemble.3 | 2 ++ doc/namespace.n | 5 ++++- 3 files changed, 12 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 8cb4b3f..4266d9b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-05-25 Donal K. Fellows + + * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is + going on with respect to qualification of command prefixes in ensemble + subcommand maps. + 2012-05-25 Jan Nijtmans * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent, diff --git a/doc/Ensemble.3 b/doc/Ensemble.3 index 5a5842d..bc743c2 100644 --- a/doc/Ensemble.3 +++ b/doc/Ensemble.3 @@ -148,6 +148,8 @@ code (TCL_OK, or TCL_ERROR if the token does not refer to an ensemble) and the dictionary obtained from \fBTcl_GetEnsembleMappingDict\fR should always be treated as immutable even if it is unshared. +All command names in prefixes set via \fBTcl_SetEnsembleMappingDict\fR +must be fully qualified. .TP \fBsubcommand list\fR (read-write) A list of all the subcommand names for the ensemble, or NULL if this diff --git a/doc/namespace.n b/doc/namespace.n index ddf7b51..8b26786 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -714,7 +714,10 @@ When non-empty, this option supplies a dictionary that provides a mapping from subcommand names to a list of prefix words to substitute in place of the ensemble command and subcommand words (in a manner similar to an alias created with \fBinterp alias\fR; the words are not -reparsed after substitution). When this option is empty, the mapping +reparsed after substitution); if the first word of any target is not +fully qualified when set, it is assumed to be relative to the +\fIcurrent\fR namespace and changed to be exactly that (that is, it is +always fully qualified when read). When this option is empty, the mapping will be from the local name of the subcommand to its fully-qualified name. Note that when this option is non-empty and the \fB\-subcommands\fR option is empty, the ensemble subcommand names -- cgit v0.12 From 8d944280e1616ab92d470c999c5c1b98bf97908d Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 26 May 2012 12:51:55 +0000 Subject: Track the remnants of [Bug 2913625] as knownBug tests. :-( --- tests/safe.test | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/tests/safe.test b/tests/safe.test index 7b83cc6..4bd8509 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -690,6 +690,52 @@ test safe-14.1 {Check that module path is the same as in the master interpreter } -cleanup { safe::interpDelete $i } -result [::tcl::tm::path list] + +### ~ should have no special meaning in paths in safe interpreters +test safe-15.1 {Bug 2913625: defang ~ in paths} -setup { + set savedHOME $env(HOME) + set env(HOME) /foo/bar + set i [safe::interpCreate] +} -constraints knownBug -body { + $i eval { + set d [format %c 126] + list [file dirname $d] [file tail $d] \ + [file join [file dirname $d] [file tail $d]] + } +} -cleanup { + safe::interpDelete $i + set env(HOME) $savedHOME +} -result {~} +test safe-15.2 {Bug 2913625: defang ~user in paths} -setup { + set i [safe::interpCreate] + set user $tcl_platform(user) +} -constraints knownBug -body { + string map [list $user USER] [$i eval \ + "file join \[file dirname ~$user\] \[file tail ~$user\]"] +} -cleanup { + safe::interpDelete $i +} -result {~USER} +test safe-15.3 {Bug 2913625: defang ~ in globs} -setup { + set savedHOME $env(HOME) + set env(HOME) / + set i [safe::interpCreate] +} -constraints knownBug -body { + $i expose glob realglob + $i eval {realglob -nocomplain [join {~ / *} ""]} +} -cleanup { + safe::interpDelete $i + set env(HOME) $savedHOME +} -result {~} +test safe-15.4 {Bug 2913625: defang ~user in globs} -setup { + set i [safe::interpCreate] + set user $tcl_platform(user) +} -constraints knownBug -body { + $i expose glob realglob + string map [list $user USER] [$i eval [list\ + realglob -directory ~$user *]] +} -cleanup { + safe::interpDelete $i +} -result {~USER} set ::auto_path $saveAutoPath # cleanup -- cgit v0.12 From 235be5061fb7d0b7bf7b0844e2d707e56a54c5e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 May 2012 08:39:18 +0000 Subject: fix for bug bug-3525762 --- win/tclWinDde.c | 77 +++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 50 insertions(+), 27 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d3c9b85..9f6a41e 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -13,8 +13,6 @@ #undef STATIC_BUILD #undef USE_TCL_STUBS #define USE_TCL_STUBS -#undef UNICODE -#undef _UNICODE #include "tclInt.h" #include #include @@ -22,6 +20,10 @@ #ifndef UNICODE # undef CP_WINUNICODE # define CP_WINUNICODE CP_WINANSI +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) #endif /* @@ -345,7 +347,9 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - OutputDebugString(Tcl_GetStringResult(interp)); + Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); + OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringFree(&dString); return NULL; } @@ -362,13 +366,13 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, name, -1); - Tcl_DStringAppend(&dString, " #", 2); + Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); - actualName = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); + actualName = (TCHAR *) Tcl_DStringValue(&dString); } - sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); + _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), TEXT("%d"), suffix); } /* @@ -377,16 +381,18 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; + Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - if (_tcscmp(actualName, Tcl_GetString(namePtr)) == 0) { + Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; + Tcl_DStringFree(&ds); break; } + Tcl_DStringFree(&ds); } } - Tcl_DStringSetLength(&dString, - offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* @@ -745,8 +751,11 @@ DdeServerProc( if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { - Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + Tcl_WinTCharToUtf(utilString, -1, &ds); + variableObjPtr = Tcl_GetVar2Ex( + convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { if (uFmt == CF_TEXT) { @@ -763,6 +772,7 @@ DdeServerProc( } else { ddeReturn = NULL; } + Tcl_DStringFree(&ds); } } Tcl_DStringFree(&dString); @@ -776,7 +786,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; - Tcl_UniChar *uniStr; + char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -790,20 +800,20 @@ DdeServerProc( } utilString = (TCHAR *) DdeAccessData(hData, &dlen); - uniStr = (Tcl_UniChar *) utilString; + string = (char *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); - } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) { + } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { /* Cannot be unicode, so assume utf-8 */ - if (!utilString[dlen-1]) { + if (!string[dlen-1]) { dlen--; } - ddeObjectPtr = Tcl_NewStringObj(utilString, dlen); + ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { /* unicode */ dlen >>= 1; - ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1); + ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); @@ -1024,6 +1034,7 @@ DdeServicesOnAck( ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; TCHAR sz[255]; + Tcl_DString dString; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -1037,9 +1048,13 @@ DdeServicesOnAck( Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); GlobalGetAtomName(topic, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique @@ -1368,7 +1383,11 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { +#ifdef UNICODE + serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); +#else serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); +#endif } else { length = 0; } @@ -1381,7 +1400,11 @@ DdeObjCmd( } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { +#ifdef UNICODE + topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length); +#else topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); +#endif if (length == 0) { topicName = NULL; } else { @@ -1395,7 +1418,7 @@ DdeObjCmd( serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); + Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1)); } else { Tcl_ResetResult(interp); } @@ -1403,18 +1426,18 @@ DdeObjCmd( case DDE_EXECUTE: { int dataLength; - BYTE *dataString; + const char *dataString; if (flags & DDE_FLAG_BINARY) { - dataString = (BYTE *) + dataString = (const char *) Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { - dataString = (BYTE *) + dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength); dataLength += 1; } - if (dataLength <= ((flags & DDE_FLAG_BINARY) ? 0 : sizeof(TCHAR))) { + if (dataLength <= ((flags & DDE_FLAG_BINARY) ? 0 : (int)sizeof(TCHAR))) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); @@ -1431,7 +1454,7 @@ DdeObjCmd( break; } - ddeData = DdeCreateDataHandle(ddeInstance, dataString, + ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, (DWORD) dataLength, 0, 0, CF_TEXT, 0); if (ddeData != NULL) { if (flags & DDE_FLAG_ASYNC) { -- cgit v0.12 From d2671297206026b44157d1a47ba3720c8159d508 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 28 May 2012 13:17:59 +0000 Subject: [Bug 3529949]: Defang 'file dirname ~' etc in safe interps --- ChangeLog | 6 ++++++ library/safe.tcl | 16 +++++++++++++++- tests/safe.test | 44 ++++++++++++++++++++++---------------------- 3 files changed, 43 insertions(+), 23 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2958fa0..9405ed9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-05-28 Donal K. Fellows + + * library/safe.tcl (safe::AliasFileSubcommand): [Bug 3529949]: Made a + more sophisticated method for preventing information leakage; it + changes references to "~user" into "./~user", which is safe. + 2012-05-25 Donal K. Fellows * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is diff --git a/library/safe.tcl b/library/safe.tcl index 52f6e85..4ad5c36 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -467,7 +467,8 @@ proc ::safe::InterpInit { ::interp expose $slave file foreach subcommand {dirname extension rootname tail} { - ::interp alias $slave ::tcl::file::$subcommand {} file $subcommand + ::interp alias $slave ::tcl::file::$subcommand {} \ + ::safe::AliasFileSubcommand $slave $subcommand } foreach subcommand { atime attributes copy delete executable exists isdirectory isfile @@ -675,6 +676,17 @@ proc ::safe::CheckFileName {slave file} { } } +# AliasFileSubcommand handles selected subcommands of [file] in safe +# interpreters that are *almost* safe. In particular, it just acts to +# prevent discovery of what home directories exist. + +proc ::safe::AliasFileSubcommand {slave subcommand name} { + if {[string match ~* $name]} { + set name ./$name + } + tailcall $slave invokehidden tcl:file:$subcommand $name +} + # AliasGlob is the target of the "glob" alias in safe interpreters. proc ::safe::AliasGlob {slave args} { @@ -761,6 +773,8 @@ proc ::safe::AliasGlob {slave args} { foreach opt [lrange $args $at end] { if {![regexp $dirPartRE $opt -> thedir thefile]} { set thedir . + } elseif {[string match ~* $thedir]} { + set thedir ./$thedir } if {$thedir eq "*" && ($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} { diff --git a/tests/safe.test b/tests/safe.test index ae78da9..f270248 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -27,7 +27,7 @@ set ::auto_path [info library] # Force actual loading of the safe package because we use un exported (and # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} - + # testing that nested and statics do what is advertised (we use a static # package - Tcltest - but it might be absent if we're in standard tclsh) @@ -700,50 +700,50 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup { } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} ### ~ should have no special meaning in paths in safe interpreters -test safe-16.1 {Bug 2913625: defang ~ in paths} -setup { +test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar set i [safe::interpCreate] -} -constraints knownBug -body { +} -body { $i eval { set d [format %c 126] - list [file dirname $d] [file tail $d] \ - [file join [file dirname $d] [file tail $d]] + list [file join [file dirname $d] [file tail $d]] } } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME -} -result {~} -test safe-16.2 {Bug 2913625: defang ~user in paths} -setup { +} -result {./~} +test safe-16.2 {Bug 3529949: defang ~user in paths} -setup { set i [safe::interpCreate] set user $tcl_platform(user) -} -constraints knownBug -body { +} -body { string map [list $user USER] [$i eval \ "file join \[file dirname ~$user\] \[file tail ~$user\]"] } -cleanup { safe::interpDelete $i -} -result {~USER} -test safe-16.3 {Bug 2913625: defang ~ in globs} -setup { +} -result {./~USER} +test safe-16.3 {Bug 3529949: defang ~ in globs} -setup { + set syntheticHOME [makeDirectory foo] + makeFile {} bar $syntheticHOME set savedHOME $env(HOME) - set env(HOME) / + set env(HOME) $syntheticHOME set i [safe::interpCreate] -} -constraints knownBug -body { - $i expose glob realglob - $i eval {realglob -nocomplain [join {~ / *} ""]} +} -body { + ::safe::interpAddToAccessPath $i $syntheticHOME + $i eval {glob -nocomplain ~/*} } -cleanup { safe::interpDelete $i set env(HOME) $savedHOME -} -result {~} -test safe-16.4 {Bug 2913625: defang ~user in globs} -setup { + removeDirectory $syntheticHOME +} -result {} +test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { set i [safe::interpCreate] - set user $tcl_platform(user) -} -constraints knownBug -body { - $i expose glob realglob - string map [list $user USER] [$i eval [list\ - realglob -directory ~$user *]] +} -body { + ::safe::interpAddToAccessPath $i $~$tcl_platform(user) + $i eval [list glob -nocomplain ~$tcl_platform(user)/*] } -cleanup { safe::interpDelete $i -} -result {~USER} +} -result {} set ::auto_path $saveAutoPath # cleanup -- cgit v0.12 From bf9e2cb2dfa20c810fdacb68cc1551046be9cd2f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 May 2012 19:30:27 +0000 Subject: explicitely specify encoding in DdeCreateStringHandle --- win/tclWinDde.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 9f6a41e..8e74f73 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -241,7 +241,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -932,8 +932,8 @@ MakeDdeConnection( HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); -- cgit v0.12 From 3be8c207009de29d1b986abc9e11c9815a42beec Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 29 May 2012 09:44:44 +0000 Subject: [Bug 2931407]: Clarified semantics of division and remainder operators. --- ChangeLog | 5 +++++ doc/expr.n | 15 ++++++++++++++- doc/mathop.n | 16 +++++++++++----- 3 files changed, 30 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4266d9b..43c73c1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-05-29 Donal K. Fellows + + * doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of + division and remainder operators. + 2012-05-25 Donal K. Fellows * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is diff --git a/doc/expr.n b/doc/expr.n index 177e127..dbc9026 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -131,7 +131,20 @@ Multiply, divide, remainder. None of these operators may be applied to string operands, and remainder may be applied only to integers. The remainder will always have the same sign as the divisor and -an absolute value smaller than the divisor. +an absolute value smaller than the absolute value of the divisor. +.RS +.PP +When applied to integers, the division and remainder operators can be +considered to partition the number line into a sequence of equal-sized +adjacent non-overlapping pieces where each piece is the size of the divisor; +the division result identifies which piece the divisor lay within, and the +remainder result identifies where within that piece the divisor lay. A +consequence of this is that the result of +.QW "-57 \fB/\fR 10" +is always -6, and the result of +.QW "-57 \fB%\fR 10" +is always 3. +.RE .TP 20 \fB+\0\0\-\fR Add and subtract. Valid for any numeric operands. diff --git a/doc/mathop.n b/doc/mathop.n index 5a6ba4e..5757f87 100644 --- a/doc/mathop.n +++ b/doc/mathop.n @@ -126,13 +126,19 @@ will be an integer. .TP \fB%\fR \fInumber number\fR . -Returns the integral modulus of the first argument with respect to the second. -Each \fInumber\fR must have an integral value. Note that Tcl defines this -operation exactly even for negative numbers, so that the following equality -holds true: +Returns the integral modulus (i.e., remainder) of the first argument +with respect to the second. +Each \fInumber\fR must have an integral value. +Also, the sign of the result will be the same as the sign of the second +\fInumber\fR, which must not be zero. .RS +.PP +Note that Tcl defines this operation exactly even for negative numbers, so +that the following command returns a true value (omitting the namespace for +clarity): +.PP .CS -(\fIx \fB/ \fIy\fR) \fB* \fIy \fB== \fIx \fB-\fR (\fIx \fB% \fIy\fR) +\fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB-\fI x\fR [\fB%\fI x y\fR]] .CE .RE .TP -- cgit v0.12 From 92aede1febb4abc04e59263f1894cb8caacab5aa Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 29 May 2012 09:52:34 +0000 Subject: minor: rewrap overlong lines --- ChangeLog | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 17ebcd3..c2e2b75 100644 --- a/ChangeLog +++ b/ChangeLog @@ -26,9 +26,9 @@ 2012-05-25 Jan Nijtmans - * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent, - now for XTYP_EXECUTE as well as XTYP_REQUEST. - * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX + * win/tclWinDde.c: [Bug 473946]: Special characters were not correctly + sent, now for XTYP_EXECUTE as well as XTYP_REQUEST. + * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX 2012-05-24 Jan Nijtmans @@ -56,11 +56,11 @@ 2012-05-21 Don Porter - * generic/tclFileName.c: When using Tcl_SetObjLength() calls to grow - * generic/tclPathObj.c: and shrink the objPtr->bytes buffer, care must be - taken that the value cannot possibly become pure Unicode. Calling - Tcl_AppendToObj() has the possibility of making such a conversion. Bug - found while valgrinding the trunk. + * generic/tclFileName.c: When using Tcl_SetObjLength() calls to + * generic/tclPathObj.c: grow and shrink the objPtr->bytes + buffer, care must be taken that the value cannot possibly become pure + Unicode. Calling Tcl_AppendToObj() has the possibility of making such + a conversion. Bug found while valgrinding the trunk. 2012-05-21 Jan Nijtmans -- cgit v0.12 From 161a43e685132ef00e715c16fe1cf9c6a33e0a6d Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 30 May 2012 14:41:04 +0000 Subject: minor: make TIP 106 commit easier to spot in ChangeLog --- ChangeLog | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index c2e2b75..ff6f2e7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -64,9 +64,11 @@ 2012-05-21 Jan Nijtmans - * win/tclWinDde.c: TIP #106: Add Encoding Abilities to the [dde] - * library/dde/pkgIndex.tcl: Command. Dde version is now 1.4.0. - * tests/winDde.test: + IMPLEMENTATION OF TIP#106 + + * win/tclWinDde.c: Added encoding-related abilities to + * library/dde/pkgIndex.tcl: the [dde] command. The dde package's + * tests/winDde.test: version is now 1.4.0. * doc/dde.n: 2012-05-20 Donal K. Fellows -- cgit v0.12 From 19090f685f5610f567baac9ded8a7495631ca63c Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 31 May 2012 09:04:03 +0000 Subject: Prevented intermittent test failure due to race condition. --- ChangeLog | 5 +++++ tests/socket.test | 1 + 2 files changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index ff6f2e7..69108c9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-05-31 Donal K. Fellows + + * tests/socket.test (socket*-13.1): Prevented intermittent test + failure due to race condition. + 2012-05-29 Donal K. Fellows * doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of diff --git a/tests/socket.test b/tests/socket.test index d88eb65..9f1cc78 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1696,6 +1696,7 @@ test socket_$af-13.1 {Testing use of shared socket between two threads} -body { set i 0 vwait x close $f + thread::wait }]] set port [thread::send $serverthread {set listen}] set s [socket $localhost $port] -- cgit v0.12 From 21dc9cfd81ea3a902c1d4934fc4966ec6b28bd39 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 31 May 2012 10:02:55 +0000 Subject: [Bug 1997845]: Corrected formatting so that generated HTML can link properly. --- ChangeLog | 5 +++++ doc/safe.n | 2 +- tools/tcltk-man2html.tcl | 5 +++++ 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 43c73c1..c70acbb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-05-31 Donal K. Fellows + + * doc/safe.n: [Bug 1997845]: Corrected formatting so that generated + * tools/tcltk-man2html.tcl (cross-reference): HTML can link properly. + 2012-05-29 Donal K. Fellows * doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of diff --git a/doc/safe.n b/doc/safe.n index 78fa6ad..590f2c6 100644 --- a/doc/safe.n +++ b/doc/safe.n @@ -67,7 +67,7 @@ The following commands are provided in the master interpreter: \fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR? Creates a safe interpreter, installs the aliases described in the section \fBALIASES\fR and initializes the auto-loading and package mechanism as -specified by the supplied \fBoptions\fR. +specified by the supplied \fIoptions\fR. See the \fBOPTIONS\fR section below for a description of the optional arguments. If the \fIslave\fR argument is omitted, a name will be generated. diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index c6932d0..59a2a63 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -947,6 +947,11 @@ proc cross-reference {ref} { return $ref } } + safe.n { + if {$lref in {options}} { + return $ref + } + } } ## ## return the cross reference -- cgit v0.12 From 88726e934130098aa10cde9b33859d45a8c87bdd Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 31 May 2012 14:20:29 +0000 Subject: fix subtle problem with safe [file] that caused Tk test failure --- ChangeLog | 4 ++++ library/safe.tcl | 18 +++++++++++------- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 22fe1f3..81bf5e9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2012-05-31 Donal K. Fellows + * library/safe.tcl (safe::AliasFileSubcommand): Don't assume that + slaves have corresponding commands, as that is not true for + sub-subinterpreters (used in Tk's test suite). + * doc/safe.n: [Bug 1997845]: Corrected formatting so that generated HTML can link properly. diff --git a/library/safe.tcl b/library/safe.tcl index 4ad5c36..394aa97 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -494,16 +494,16 @@ proc ::safe::InterpInit { if {[catch {::interp eval $slave { source [file join $tcl_library init.tcl] - }} msg]} { + }} msg opt]} { Log $slave "can't source init.tcl ($msg)" - return -code error "can't source init.tcl into slave $slave ($msg)" + return -options $opt "can't source init.tcl into slave $slave ($msg)" } if {[catch {::interp eval $slave { source [file join $tcl_library tm.tcl] - }} msg]} { + }} msg opt]} { Log $slave "can't source tm.tcl ($msg)" - return -code error "can't source tm.tcl into slave $slave ($msg)" + return -options $opt "can't source tm.tcl into slave $slave ($msg)" } # Sync the paths used to search for Tcl modules. This can be done only @@ -684,7 +684,7 @@ proc ::safe::AliasFileSubcommand {slave subcommand name} { if {[string match ~* $name]} { set name ./$name } - tailcall $slave invokehidden tcl:file:$subcommand $name + tailcall ::interp invokehidden $slave tcl:file:$subcommand $name } # AliasGlob is the target of the "glob" alias in safe interpreters. @@ -882,6 +882,7 @@ proc ::safe::AliasSource {slave args} { # because we want to control [info script] in the slave so information # doesn't leak so much. [Bug 2913625] set old [::interp eval $slave {info script}] + set replacementMsg "script error" set code [catch { set f [open $realfile] fconfigure $f -eofchar \032 @@ -891,14 +892,17 @@ proc ::safe::AliasSource {slave args} { set contents [read $f] close $f ::interp eval $slave [list info script $file] - ::interp eval $slave $contents } msg opt] + if {$code == 0} { + set code [catch {::interp eval $slave $contents} msg opt] + set replacementMsg $msg + } catch {interp eval $slave [list info script $old]} # Note that all non-errors are fine result codes from [source], so we must # take a little care to do it properly. [Bug 2923613] if {$code == 1} { Log $slave $msg - return -code error "script error" + return -code error $replacementMsg } return -code $code -options $opt $msg } -- cgit v0.12 From d8dbcfab2c16c65a16daffe6aaa9ed531079dfad Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 31 May 2012 14:52:40 +0000 Subject: [Bug 3531089] Added test to stop this from happening again --- tests/safe.test | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/safe.test b/tests/safe.test index f270248..dcd5bfd 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -204,6 +204,11 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body { [safe::interpConfigure $i]\ [safe::interpDelete $i] } -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" +test safe-7.3 {check that safe subinterpreters work} { + set i [safe::interpCreate] + set j [safe::interpCreate [list $i x]] + list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] +} {ok {} 0} # test source control on file name test safe-8.1 {safe source control on file} -setup { -- cgit v0.12 From 91726f2a230497571abc2e7b8b5857e394d91337 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Jun 2012 21:09:13 +0000 Subject: bug-3530536 --- generic/tclZlib.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 84a81f8..0ff8b50 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -537,6 +537,7 @@ Tcl_ZlibStreamInit( zshPtr->currentInput = NULL; zshPtr->streamEnd = 0; memset(&zshPtr->stream, 0, sizeof(z_stream)); + zshPtr->stream.adler = 1; /* * No output buffer available yet -- cgit v0.12 From ac7af4b977dbecc4a95d4335d152756824c6e62d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Jun 2012 21:34:48 +0000 Subject: two more testcases, showing that only the "deflate" and "inflate" streams don't update the checksum, other streams do. --- tests/zlib.test | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/zlib.test b/tests/zlib.test index 4ed5b33..fb94c0a 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -103,6 +103,22 @@ test zlib-7.4 {zlib stream} zlib { $s close lappend result $data } {{} 1 abcdeEDCBA} +test zlib-7.5 {zlib stream} zlib { + set s [zlib stream gzip] + $s put -finalize abcdeEDCBA + set data [$s get] + set result [list [$s get] [format %x [$s checksum]]] + $s close + lappend result [zlib gunzip $data] +} {{} ffffffffe3b38816 abcdeEDCBA} +test zlib-7.6 {zlib stream} zlib { + set s [zlib stream gunzip] + $s put -finalize [zlib gzip abcdeEDCBA] + set data [$s get] + set result [list [$s get] [format %x [$s checksum]]] + $s close + lappend result $data +} {{} ffffffffe3b38816 abcdeEDCBA} test zlib-8.1 {zlib transformation} -constraints zlib -setup { set file [makeFile {} test.gz] -- cgit v0.12 From a0ca94afce1f63b761b2d168b5ceed5774425cfd Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 5 Jun 2012 13:04:59 +0000 Subject: 3530533 Add comments to failing tests. --- tests/io.test | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/io.test b/tests/io.test index beb5a30..68051d7 100644 --- a/tests/io.test +++ b/tests/io.test @@ -2086,6 +2086,8 @@ set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose openpipe} { + # This test may fail on old Unix systems (seen on IRIX64 6.5) with + # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] @@ -2645,6 +2647,8 @@ test io-29.30 {Tcl_WriteChars, crlf mode} { file size $path(test1) } 25 test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} { + # This test may fail on old Unix systems (seen on IRIX64 6.5) with + # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] @@ -2686,6 +2690,8 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} { } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose openpipe} { + # This test may fail on old Unix systems (seen on IRIX64 6.5) with + # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] -- cgit v0.12 From 22bee8161ff83b967a50d1c853fc96598d6d48c6 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 5 Jun 2012 15:40:56 +0000 Subject: Remove unused variable mantDIGIT. --- generic/tclStrToD.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 5f59500..76adf75 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -167,8 +167,6 @@ static int maxDigits; /* The maximum number of digits to the left of * the decimal point of a double. */ static int minDigits; /* The maximum number of digits to the right * of the decimal point in a double. */ -static int mantDIGIT; /* Number of mp_digit's needed to hold the - * significand of a double. */ static const double pow_10_2_n[] = { /* Inexact higher powers of ten. */ 1.0, 100.0, @@ -4405,7 +4403,6 @@ TclInitDoubleConversion(void) + 0.5 * log(10.)) / log(10.)); minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG) * log((double) FLT_RADIX) / log(10.)); - mantDIGIT = (mantBits + DIGIT_BIT-1) / DIGIT_BIT; log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.)); /* -- cgit v0.12 From 7d602745337ea00ec3bd5cbb4efcd1c0e3379fbb Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 5 Jun 2012 15:59:34 +0000 Subject: Remove unused variable NULL_CONTEXT. --- generic/tclBasic.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e09ea1e..b38558a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -81,8 +81,6 @@ TCL_DECLARE_MUTEX(cancelLock) * are used to save the evaluation state between NR calls to each coro. */ -static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL}; - #define SAVE_CONTEXT(context) \ (context).framePtr = iPtr->framePtr; \ (context).varFramePtr = iPtr->varFramePtr; \ -- cgit v0.12 From c94c7e03ecc4666f31df363c2f728acd5007a2b5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Jun 2012 12:43:57 +0000 Subject: On Cygwin, use win32 API in stead of uname() to determine the tcl_platform variables --- ChangeLog | 5 ++++ generic/tcl.decls | 6 ++--- generic/tclInt.decls | 4 +-- unix/tclUnixInit.c | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 79 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index c91a822..0bb1715 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-06-06 Jan Nijtmans + + * unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname() + to determine the tcl_platform variables. + 2012-05-25 Jan Nijtmans * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent, diff --git a/generic/tcl.decls b/generic/tcl.decls index db9950c..d4651c6 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1822,12 +1822,12 @@ declare 1 win { # Mac declarations # This is needed by the shells to handle Macintosh events. - + declare 0 mac { void Tcl_MacSetEventProc(Tcl_MacConvertEventPtr procPtr) } -# These routines are useful for handling using scripts from resources +# These routines are useful for handling using scripts from resources # in the application shell declare 1 mac { @@ -1859,7 +1859,7 @@ declare 6 mac { # These are not in MSL 2.1.2, so we need to export them from the # Tcl shared library. They are found in the compat directory. - + declare 7 mac { int strncasecmp(const char *s1, const char *s2, size_t n) } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index d714e85..1366fc3 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -799,10 +799,10 @@ declare 19 mac { declare 20 mac { int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr, int insert) -} +} declare 21 mac { short TclMacUnRegisterResourceFork(char *tokenPtr, Tcl_Obj *resultPtr) -} +} declare 22 mac { int TclMacCreateEnv(void) } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 46ef042..5de9e48 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -34,6 +34,51 @@ # endif #endif +#ifdef __CYGWIN__ +DLLIMPORT extern __stdcall unsigned char GetVersionExA(void *); +DLLIMPORT extern __stdcall void GetSystemInfo(void *); + +#define NUMPLATFORMS 4 +static const char *const platforms[NUMPLATFORMS] = { + "Win32s", "Windows 95", "Windows NT", "Windows CE" +}; + +#define NUMPROCESSORS 11 +static const char *const processors[NUMPROCESSORS] = { + "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", + "amd64", "ia32_on_win64" +}; + +typedef struct _SYSTEM_INFO { + union { + DWORD dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; + }; + DWORD dwPageSize; + void *lpMinimumApplicationAddress; + void *lpMaximumApplicationAddress; + void *dwActiveProcessorMask; + DWORD dwNumberOfProcessors; + DWORD dwProcessorType; + DWORD dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; +} SYSTEM_INFO; + +typedef struct _OSVERSIONINFOA { + DWORD dwOSVersionInfoSize; + DWORD dwMajorVersion; + DWORD dwMinorVersion; + DWORD dwBuildNumber; + DWORD dwPlatformId; + char szCSDVersion[128]; +} OSVERSIONINFOA; +#endif + + /* * The Init script (common to Windows and Unix platforms) is * defined in tkInitScript.h @@ -774,7 +819,11 @@ void TclpSetVariables(interp) Tcl_Interp *interp; { -#ifndef NO_UNAME +#ifdef __CYGWIN__ + SYSTEM_INFO sysInfo; + OSVERSIONINFOA osInfo; + char buffer[TCL_INTEGER_SPACE * 2]; +#elif !defined(NO_UNAME) struct utsname name; #endif int unameOK; @@ -876,7 +925,25 @@ TclpSetVariables(interp) Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); #endif unameOK = 0; -#ifndef NO_UNAME +#ifdef __CYGWIN__ + unameOK = 1; + osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); + GetVersionExA(&osInfo); + GetSystemInfo(&sysInfo); + + if (osInfo.dwPlatformId < NUMPLATFORMS) { + Tcl_SetVar2(interp, "tcl_platform", "os", + platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); + } + sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); + Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); + if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { + Tcl_SetVar2(interp, "tcl_platform", "machine", + processors[sysInfo.wProcessorArchitecture], + TCL_GLOBAL_ONLY); + } + +#elif !defined NO_UNAME if (uname(&name) >= 0) { CONST char *native; -- cgit v0.12 From 342d27d13f57e57c4e1bc71b6dd00ef6244d8af1 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 6 Jun 2012 14:48:50 +0000 Subject: Declare that Tcl provides the zlib 2.0 package. --- ChangeLog | 7 +++++++ generic/tclZlib.c | 11 ++++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index a35eebc..3f089d5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-06-06 Donal K. Fellows + + * generic/tclZlib.c (TclZlibInit): Declare that Tcl is publishing the + zlib package (version 2.0) as part of its bootstrap process. This will + have an impact on tclkit (which includes zlib 1.1) but otherwise be + very low impact. + 2012-06-06 Jan Nijtmans * unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname() diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 0ff8b50..b970b3d 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -20,6 +20,15 @@ #include "tclIO.h" /* + * The version of the zlib "package" that this implements. Note that this + * thoroughly supersedes the versions included with tclkit, which are "1.1", + * so this is at least "2.0" (there's no general *commitment* to have the same + * interface, even if that is mostly true). + */ + +#define TCL_ZLIB_VERSION "2.0" + +/* * Magic flags used with wbits fields to indicate that we're handling the gzip * format or automatic detection of format. Putting it here is slightly less * gross! @@ -3127,7 +3136,7 @@ TclZlibInit( */ Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0); - return TCL_OK; + return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); } /* -- cgit v0.12 From 1c287f81b4cc32553c3336ad9f095f0e422b7116 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Jun 2012 08:07:01 +0000 Subject: Revise the "null data" check: null strings are possible, but empty binary arrays are not --- ChangeLog | 7 ++ tests/winDde.test | 250 ++++++++++++++++++++++++++++-------------------------- win/tclWinDde.c | 2 +- 3 files changed, 138 insertions(+), 121 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3f089d5..3995874 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-06-08 Jan Nijtmans + + * win/tclWinDde.c: Revise the "null data" check: null strings are + possible, but empty binary arrays are not. + * tests/winDde.test: Add test-case (winDde-9.4) for transferring + null-strings with dde. Convert tests to tcltest-2 syntax. + 2012-06-06 Donal K. Fellows * generic/tclZlib.c (TclZlibInit): Declare that Tcl is publishing the diff --git a/tests/winDde.test b/tests/winDde.test index bc64a24..83f3598 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -15,18 +15,16 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -if {[testConstraint win]} { - if [catch { - # Is the dde extension already static to this shell? - if [catch {load {} Dde; set ::ddelib {}}] { - # try the location given to use on the commandline to tcltest - ::tcltest::loadTestedCommands - load $::ddelib Dde - } - testConstraint dde 1 - }] { - testConstraint dde 0 +if [catch { + # Is the dde extension already static to this shell? + if [catch {load {} Dde; set ::ddelib {}}] { + # try the location given to use on the commandline to tcltest + ::tcltest::loadTestedCommands + load $::ddelib Dde } + testConstraint dde 1 +}] { + testConstraint dde 0 } @@ -36,7 +34,7 @@ if {[testConstraint win]} { set scriptName [makeFile {} script1.tcl] -proc createChildProcess { ddeServerName {handler {}}} { +proc createChildProcess {ddeServerName args} { file delete -force $::scriptName set f [open $::scriptName w+] @@ -51,7 +49,7 @@ proc createChildProcess { ddeServerName {handler {}}} { package require tcltest namespace import -force ::tcltest::* } - + # If an error occurs during the tests, this process may end up not # being closed down. To deal with this we create a 30s timeout. proc ::DoTimeout {} { @@ -61,16 +59,19 @@ proc createChildProcess { ddeServerName {handler {}}} { flush stdout } set timeout [after 30000 ::DoTimeout] - + # Define a restricted handler. proc Handler1 {cmd} { if {$cmd eq "stop"} {set ::done 1} - puts $cmd ; flush stdout + if {$cmd == ""} { + set cmd "null data" + } + puts $cmd ; flush stdout return } proc Handler2 {cmd} { if {$cmd eq "stop"} {set ::done 1} - puts [uplevel \#0 $cmd] ; flush stdout + puts [uplevel \#0 $cmd] ; flush stdout return } proc Handler3 {prefix cmd} { @@ -80,11 +81,7 @@ proc createChildProcess { ddeServerName {handler {}}} { } } # set the dde server name to the supplied argument. - if {$handler == {}} { - puts $f [list dde servername $ddeServerName] - } else { - puts $f [list dde servername -handler $handler -- $ddeServerName] - } + puts $f [list dde servername {*}$args -- $ddeServerName] puts $f { # run the server and handle final cleanup. after 200;# give dde a chance to get going. @@ -94,12 +91,12 @@ proc createChildProcess { ddeServerName {handler {}}} { # allow enough time for the calling process to # claim all results, to avoid spurious "server did # not respond" - after 200 { set reallyDone 1 } + after 200 {set reallyDone 1} vwait reallyDone exit } close $f - + # run the child server script. set f [open |[list [interpreter] $::scriptName] r] fconfigure $f -buffering line @@ -109,160 +106,160 @@ proc createChildProcess { ddeServerName {handler {}}} { # ------------------------------------------------------------------------- -test winDde-1.1 {Settings the server's topic name} {win dde} { +test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] -} {foobar foobar self} +} -result {foobar foobar self} -test winDde-2.1 {Checking for other services} {win dde} { +test winDde-2.1 {Checking for other services} -constraints dde -body { expr [llength [dde services {} {}]] >= 0 -} 1 +} -result 1 test winDde-2.2 {Checking for existence, with service and topic specified} \ - {win dde} { + -constraints dde -body { llength [dde services TclEval self] -} 1 +} -result 1 test winDde-2.3 {Checking for existence, with only the service specified} \ - {win dde} { + -constraints dde -body { expr [llength [dde services TclEval {}]] >= 1 -} 1 +} -result 1 test winDde-2.4 {Checking for existence, with only the topic specified} \ - {win dde} { + -constraints dde -body { expr [llength [dde services {} self]] >= 1 -} 1 +} -result 1 # ------------------------------------------------------------------------- -test winDde-3.1 {DDE execute locally} {win dde} { - set a "" - dde execute TclEval self {set a "foo"} - set a -} foo -test winDde-3.2 {DDE execute -async locally} {win dde} { - set a "" - dde execute -async TclEval self {set a "foo"} +test winDde-3.1 {DDE execute locally} -constraints dde -body { + set \xe1 "" + dde execute TclEval self [list set \xe1 foo] + set \xe1 +} -result foo +test winDde-3.2 {DDE execute -async locally} -constraints dde -body { + set \xe1 "" + dde execute -async TclEval self [list set \xe1 foo] update - set a -} foo -test winDde-3.3 {DDE request locally} {win dde} { + set \xe1 +} -result foo +test winDde-3.3 {DDE request locally} -constraints dde -body { set a "" - dde execute TclEval self {set a "foo"} + dde execute TclEval self [list set a foo] dde request TclEval self a -} foo -test winDde-3.4 {DDE eval locally} {win dde} { - set a "" - dde eval self set a "foo" -} foo -test winDde-3.5 {DDE request locally} {win dde} { +} -result foo +test winDde-3.4 {DDE eval locally} -constraints dde -body { + set \xe1 "" + dde eval self set \xe1 foo +} -result foo +test winDde-3.5 {DDE request locally} -constraints dde -body { set a "" - dde execute TclEval self {set a "foo"} + dde execute TclEval self [list set a foo] dde request -binary TclEval self a -} "foo\x00" +} -result "foo\x00" # Set variable a to A with diaeresis (unicode C4) by relying on the fact # that utf8 is sent (e.g. "c3 84" on the wire) -test winDde-3.6 {DDE request utf8} {win dde} { +test winDde-3.6 {DDE request utf8} -constraints dde -body { set a "not set" dde execute TclEval self "set a \xc4" scan $a %c -} 196 +} -result 196 # Set variable a to A with diaeresis (unicode C4) using binary execute # and compose utf-8 (e.g. "c3 84" ) manualy -test winDde-3.7 {DDE request binary} {win dde} { +test winDde-3.7 {DDE request binary} -constraints dde -body { set a "not set" - dde execute -binary TclEval self "set a \xc3\x84\x00" + dde execute -binary TclEval self [list set a \xc3\x84\x00] scan $a %c -} 196 +} -result 196 # ------------------------------------------------------------------------- -test winDde-4.1 {DDE execute remotely} {stdio win dde} { - set a "" - set name child-4.1 +test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body { + set \xe1 "" + set name ch\xEDld-4.1 set child [createChildProcess $name] - dde execute TclEval $name {set a "foo"} + dde execute TclEval $name [list set \xe1 foo] dde execute TclEval $name {set done 1} update - set a -} "" -test winDde-4.2 {DDE execute async remotely} {stdio win dde} { - set a "" - set name child-4.2 + set \xe1 +} -result "" +test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body { + set \xe1 "" + set name ch\xEDld-4.2 set child [createChildProcess $name] - dde execute -async TclEval $name {set a "foo"} + dde execute -async TclEval $name [list set \xe1 foo] update dde execute TclEval $name {set done 1} update - set a -} "" -test winDde-4.3 {DDE request remotely} {stdio win dde} { + set \xe1 +} -result "" +test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body { set a "" - set name chile-4.3 + set name ch\xEDld-4.3 set child [createChildProcess $name] - dde execute TclEval $name {set a "foo"} + dde execute TclEval $name [list set a foo] set a [dde request TclEval $name a] dde execute TclEval $name {set done 1} update set a -} foo -test winDde-4.4 {DDE eval remotely} {stdio win dde} { +} -result foo +test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body { set a "" - set name child-4.4 + set name ch\xEDld-4.4 set child [createChildProcess $name] - set a [dde eval $name set a "foo"] + set a [dde eval $name set a foo] dde execute TclEval $name {set done 1} update set a -} foo +} -result foo # ------------------------------------------------------------------------- -test winDde-5.1 {check for bad arguments} -constraints {win dde} -body { +test winDde-5.1 {check for bad arguments} -constraints dde -body { dde execute "" "" "" "" } -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"} -test winDde-5.2 {check for bad arguments} -constraints {win dde} -body { - dde execute "" "" "" +test winDde-5.2 {check for bad arguments} -constraints dde -body { + dde execute -binary "" "" "" } -returnCodes error -result {cannot execute null data} -test winDde-5.3 {check for bad arguments} -constraints {win dde} -body { +test winDde-5.3 {check for bad arguments} -constraints dde -body { dde execute -foo "" "" "" } -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"} -test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body { +test winDde-5.4 {DDE eval bad arguments} -constraints dde -body { dde eval "" "foo" } -returnCodes error -result {invalid service name ""} # ------------------------------------------------------------------------- -test winDde-6.1 {DDE servername bad arguments} -constraints {win dde} -body { +test winDde-6.1 {DDE servername bad arguments} -constraints dde -body { dde servername -z -z -z } -returnCodes error -result {bad option "-z": must be -force, -handler, or --} -test winDde-6.2 {DDE servername set name} -constraints {win dde} -body { +test winDde-6.2 {DDE servername set name} -constraints dde -body { dde servername -- winDde-6.2 } -result {winDde-6.2} -test winDde-6.3 {DDE servername set exact name} -constraints {win dde} -body { +test winDde-6.3 {DDE servername set exact name} -constraints dde -body { dde servername -force winDde-6.3 } -result {winDde-6.3} -test winDde-6.4 {DDE servername set exact name} -constraints {win dde} -body { +test winDde-6.4 {DDE servername set exact name} -constraints dde -body { dde servername -force -- winDde-6.4 } -result {winDde-6.4} -test winDde-6.5 {DDE remote servername collision} -constraints {stdio win dde} -setup { - set name child-6.5 +test winDde-6.5 {DDE remote servername collision} -constraints {dde stdio} -setup { + set name ch\xEDld-6.5 set child [createChildProcess $name] } -body { dde servername -- $name } -cleanup { dde execute TclEval $name {set done 1} update -} -result "child-6.5 #2" -test winDde-6.6 {DDE remote servername collision force} -constraints {stdio win dde} -setup { - set name child-6.6 +} -result "ch\xEDld-6.5 #2" +test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio} -setup { + set name ch\xEDld-6.6 set child [createChildProcess $name] } -body { dde servername -force -- $name } -cleanup { dde execute TclEval $name {set done 1} update -} -result {child-6.6} +} -result "ch\xEDld-6.6" # ------------------------------------------------------------------------- -test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup { +test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup { interp create slave } -body { slave eval [list load $::ddelib Dde] @@ -270,7 +267,7 @@ test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup { } -cleanup { interp delete slave } -result {dde-interp-7.1} -test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup { +test winDde-7.2 {DDE slave cleanup} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.5] @@ -283,7 +280,7 @@ test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup { set s } } -result {} -test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup { +test winDde-7.3 {DDE present in slave interp} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.3] @@ -292,7 +289,7 @@ test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup { } -cleanup { interp delete slave } -result {{TclEval dde-interp-7.3}} -test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setup { +test winDde-7.4 {interp name collision with -force} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.4] @@ -301,7 +298,7 @@ test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setu } -cleanup { interp delete slave } -result {dde-interp-7.4} -test winDde-7.5 {interp name collision without -force} -constraints {win dde} -setup { +test winDde-7.5 {interp name collision without -force} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.5] @@ -313,7 +310,7 @@ test winDde-7.5 {interp name collision without -force} -constraints {win dde} -s # ------------------------------------------------------------------------- -test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup { +test winDde-8.1 {Safe DDE load} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde } -body { @@ -321,20 +318,20 @@ test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup { } -cleanup { interp delete slave } -returnCodes error -result {invalid command name "dde"} -test winDde-8.2 {Safe DDE set servername} -constraints {win dde} -setup { +test winDde-8.2 {Safe DDE set servername} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde } -body { slave invokehidden dde servername slave } -cleanup {interp delete slave} -result {slave} -test winDde-8.3 {Safe DDE check handler required for eval} -constraints {win dde} -setup { +test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave invokehidden dde servername slave } -body { catch {dde eval slave set a 1} msg } -cleanup {interp delete slave} -result {1} -test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} -setup { +test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave invokehidden dde servername slave @@ -343,7 +340,7 @@ test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} - dde execute TclEval slave {set a 2} slave eval set a } -cleanup {interp delete slave} -result 1 -test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} -setup { +test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave invokehidden dde servername slave @@ -353,14 +350,14 @@ test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} - } -cleanup { interp delete slave } -returnCodes error -result {remote server cannot handle this command} -test winDde-8.6 {Safe DDE assign handler procedure} -constraints {win dde} -setup { +test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} } -body { slave invokehidden dde servername -handler DDEACCEPT slave } -cleanup {interp delete slave} -result slave -test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup { +test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} @@ -368,7 +365,7 @@ test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup { } -body { dde eval slave set x 1 } -cleanup {interp delete slave} -result {set x 1} -test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup { +test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} @@ -378,16 +375,16 @@ test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup dde eval slave $s string equal [slave eval set DDECMD] $s } -cleanup {interp delete slave} -result 1 -test winDde-8.9 {Safe DDE check command evaluation} -constraints {win dde} -setup { +test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} slave invokehidden dde servername -handler DDEACCEPT slave } -body { - dde eval slave set x 1 - slave eval set x + dde eval slave set \xe1 1 + slave eval set \xe1 } -cleanup {interp delete slave} -result 1 -test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde} -setup { +test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} @@ -396,7 +393,7 @@ test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde} dde eval slave [list set x 1] slave eval set x } -cleanup {interp delete slave} -result 1 -test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde} -setup { +test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} @@ -408,9 +405,9 @@ test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde} # ------------------------------------------------------------------------- -test winDde-9.1 {External safe DDE check string passing} -constraints {win dde stdio} -setup { - set name child-9.1 - set child [createChildProcess $name Handler1] +test winDde-9.1 {External safe DDE check string passing} -constraints {dde stdio} -setup { + set name ch\xEDld-9.1 + set child [createChildProcess $name -handler Handler1] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 @@ -421,9 +418,9 @@ test winDde-9.1 {External safe DDE check string passing} -constraints {win dde s update file delete -force -- dde-script.tcl } -result {set x 1} -test winDde-9.2 {External safe DDE check command evaluation} -constraints {win dde stdio} -setup { - set name child-9.2 - set child [createChildProcess $name Handler2] +test winDde-9.2 {External safe DDE check command evaluation} -constraints {dde stdio} -setup { + set name ch\xEDld-9.2 + set child [createChildProcess $name -handler Handler2] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 @@ -434,9 +431,9 @@ test winDde-9.2 {External safe DDE check command evaluation} -constraints {win d update file delete -force -- dde-script.tcl } -result 1 -test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win dde stdio} -setup { - set name child-9.3 - set child [createChildProcess $name [list Handler3 ARG]] +test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {dde stdio} -setup { + set name ch\xEDld-9.3 + set child [createChildProcess $name -handler [list Handler3 ARG]] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 @@ -447,6 +444,19 @@ test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win d update file delete -force -- dde-script.tcl } -result {ARG {set x 1}} +test winDde-9.4 {External safe DDE check null data passing} -constraints {dde stdio} -setup { + set name ch\xEDld-9.4 + set child [createChildProcess $name -handler Handler1] + file copy -force script1.tcl dde-script.tcl +} -body { + dde execute TclEval $name "" + gets $child line + set line +} -cleanup { + dde execute TclEval $name stop + update + file delete -force -- dde-script.tcl +} -result {null data} # ------------------------------------------------------------------------- diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 5f2ef32..e40e114 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1443,7 +1443,7 @@ DdeObjCmd( dataLength += 1; } - if (dataLength <= ((flags & DDE_FLAG_BINARY) ? 0 : (int)sizeof(TCHAR))) { + if (dataLength <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); -- cgit v0.12 From 58d31239da28572a5de112c0792a6e071066fddc Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 8 Jun 2012 13:00:01 +0000 Subject: 3530533 Centralize #include in the tclUnixPort.h header so that old unix systems that need inclusion in all compilation units are supported. --- ChangeLog | 6 ++++++ unix/tclUnixPort.h | 2 +- unix/tclUnixThrd.c | 2 -- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1fee643..fc826e2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-06-08 Don Porter + + * unix/tclUnixPort.h: [Bug 3530533] Centralize #include + * unix/tclUnixThrd.c: in the tclUnixPort.h header so that old unix + systems that need inclusion in all compilation units are supported. + 2012-06-06 Jan Nijtmans * unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname() diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 8684757..6ff13eb 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -626,6 +626,7 @@ typedef int socklen_t; #define TclpExit exit #ifdef TCL_THREADS +# include EXTERN struct tm *TclpLocaltime(CONST time_t *); EXTERN struct tm *TclpGmtime(CONST time_t *); /* #define localtime(x) TclpLocaltime(x) @@ -639,7 +640,6 @@ EXTERN struct tm *TclpGmtime(CONST time_t *); * Assume it is in pthread_np.h if it isn't in pthread.h. [Bug 1064882] * We might need to revisit this in the future. :^( */ -# include # include # endif # else diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index fd2cd8f..ad36242 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -14,8 +14,6 @@ #ifdef TCL_THREADS -#include "pthread.h" - typedef struct ThreadSpecificData { char nabuf[16]; } ThreadSpecificData; -- cgit v0.12 From 9ea2ab76f4646c44e090b45ba151a94d38b085f1 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 8 Jun 2012 13:04:58 +0000 Subject: Update autogoo for gettimeofday(). Thanks Joe English. --- ChangeLog | 6 ++ unix/configure | 220 ++++++++++++++++++++++------------------------------- unix/configure.in | 9 +-- unix/tclUnixPort.h | 4 - 4 files changed, 100 insertions(+), 139 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0bb1715..6b9c072 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-06-08 Don Porter + + * unix/configure.in: Update autogoo for gettimeofday(). + * unix/tclUnixPort.h: Thanks Joe English. + * unix/configure: autoconf 2.13 + 2012-06-06 Jan Nijtmans * unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname() diff --git a/unix/configure b/unix/configure index 5b8621f..8e3f47d 100755 --- a/unix/configure +++ b/unix/configure @@ -8266,70 +8266,18 @@ fi # The code below deals with several issues related to gettimeofday: # 1. Some systems don't provide a gettimeofday function at all # (set NO_GETTOD if this is the case). -# 2. SGI systems don't use the BSD form of the gettimeofday function, -# but they have a BSDgettimeofday function that can be used instead. -# 3. See if gettimeofday is declared in the header file. +# 2. See if gettimeofday is declared in the header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- -echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6 -echo "configure:8278: checking for BSDgettimeofday" >&5 -if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char BSDgettimeofday(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_BSDgettimeofday) || defined (__stub___BSDgettimeofday) -choke me -#else -BSDgettimeofday(); -#endif - -; return 0; } -EOF -if { (eval echo configure:8306: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_BSDgettimeofday=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_BSDgettimeofday=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'BSDgettimeofday`\" = yes"; then - echo "$ac_t""yes" 1>&6 - cat >> confdefs.h <<\EOF -#define HAVE_BSDGETTIMEOFDAY 1 -EOF - -else - echo "$ac_t""no" 1>&6 - - echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6 -echo "configure:8328: checking for gettimeofday" >&5 +echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6 +echo "configure:8276: checking for gettimeofday" >&5 if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8304: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gettimeofday=yes" else @@ -8375,17 +8323,14 @@ EOF fi - -fi - echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6 -echo "configure:8383: checking for gettimeofday declaration" >&5 +echo "configure:8328: checking for gettimeofday declaration" >&5 if eval "test \"`echo '$''{'tcl_cv_grep_gettimeofday'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF @@ -8416,14 +8361,14 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6 -echo "configure:8420: checking whether char is unsigned" >&5 +echo "configure:8365: checking whether char is unsigned" >&5 if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$GCC" = yes; then # GCC predefines this symbol on systems where it applies. cat > conftest.$ac_ext <&2; exit 1; } else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:8404: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_c_char_unsigned=yes else @@ -8479,13 +8424,13 @@ EOF fi echo $ac_n "checking signed char declarations""... $ac_c" 1>&6 -echo "configure:8483: checking signed char declarations" >&5 +echo "configure:8428: checking signed char declarations" >&5 if eval "test \"`echo '$''{'tcl_cv_char_signed'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:8444: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_char_signed=yes else @@ -8520,7 +8465,7 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for a putenv() that copies the buffer""... $ac_c" 1>&6 -echo "configure:8524: checking for a putenv() that copies the buffer" >&5 +echo "configure:8469: checking for a putenv() that copies the buffer" >&5 if eval "test \"`echo '$''{'tcl_cv_putenv_copy'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -8529,7 +8474,7 @@ else tcl_cv_putenv_copy=no else cat > conftest.$ac_ext < @@ -8551,7 +8496,7 @@ else } EOF -if { (eval echo configure:8555: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:8500: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then tcl_cv_putenv_copy=no else @@ -8591,17 +8536,17 @@ fi if test "$langinfo_ok" = "yes"; then ac_safe=`echo "langinfo.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for langinfo.h""... $ac_c" 1>&6 -echo "configure:8595: checking for langinfo.h" >&5 +echo "configure:8540: checking for langinfo.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8605: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8550: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8625,21 +8570,21 @@ fi fi echo $ac_n "checking whether to use nl_langinfo""... $ac_c" 1>&6 -echo "configure:8629: checking whether to use nl_langinfo" >&5 +echo "configure:8574: checking whether to use nl_langinfo" >&5 if test "$langinfo_ok" = "yes"; then if eval "test \"`echo '$''{'tcl_cv_langinfo_h'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < int main() { nl_langinfo(CODESET); ; return 0; } EOF -if { (eval echo configure:8643: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:8588: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_cv_langinfo_h=yes else @@ -8672,17 +8617,17 @@ if test "`uname -s`" = "Darwin" ; then do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:8676: checking for $ac_hdr" >&5 +echo "configure:8621: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8686: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8631: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8711,12 +8656,12 @@ done for ac_func in copyfile do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8715: checking for $ac_func" >&5 +echo "configure:8660: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8688: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8768,17 +8713,17 @@ done do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:8772: checking for $ac_hdr" >&5 +echo "configure:8717: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8782: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8727: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8807,12 +8752,12 @@ done for ac_func in OSSpinLockLock do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8811: checking for $ac_func" >&5 +echo "configure:8756: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8784: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8862,12 +8807,12 @@ done for ac_func in pthread_atfork do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8866: checking for $ac_func" >&5 +echo "configure:8811: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8839: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8931,17 +8876,17 @@ EOF do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:8935: checking for $ac_hdr" >&5 +echo "configure:8880: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8945: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -8969,14 +8914,14 @@ done if test "$ac_cv_header_AvailabilityMacros_h" = yes; then echo $ac_n "checking if weak import is available""... $ac_c" 1>&6 -echo "configure:8973: checking if weak import is available" >&5 +echo "configure:8918: checking if weak import is available" >&5 if eval "test \"`echo '$''{'tcl_cv_cc_weak_import'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8941: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* tcl_cv_cc_weak_import=yes else @@ -9020,13 +8965,13 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for fts""... $ac_c" 1>&6 -echo "configure:9024: checking for fts" >&5 +echo "configure:8969: checking for fts" >&5 if eval "test \"`echo '$''{'tcl_cv_api_fts'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < @@ -9041,7 +8986,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:9045: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:8990: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* tcl_cv_api_fts=yes else @@ -9073,17 +9018,17 @@ fi do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:9077: checking for $ac_hdr" >&5 +echo "configure:9022: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9087: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9032: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -9113,17 +9058,17 @@ done do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:9117: checking for $ac_hdr" >&5 +echo "configure:9062: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9127: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9072: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -9151,7 +9096,7 @@ done echo $ac_n "checking system version""... $ac_c" 1>&6 -echo "configure:9155: checking system version" >&5 +echo "configure:9100: checking system version" >&5 if eval "test \"`echo '$''{'tcl_cv_sys_version'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -9182,7 +9127,7 @@ echo "$ac_t""$tcl_cv_sys_version" 1>&6 system=$tcl_cv_sys_version echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6 -echo "configure:9186: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 +echo "configure:9131: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 case $system in OSF*) cat >> confdefs.h <<\EOF @@ -9226,17 +9171,17 @@ fi if test $tcl_ok = yes; then ac_safe=`echo "sys/sdt.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/sdt.h""... $ac_c" 1>&6 -echo "configure:9230: checking for sys/sdt.h" >&5 +echo "configure:9175: checking for sys/sdt.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9240: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9185: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -9263,7 +9208,7 @@ if test $tcl_ok = yes; then # Extract the first word of "dtrace", so it can be a program name with args. set dummy dtrace; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:9267: checking for $ac_word" >&5 +echo "configure:9212: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_path_DTRACE'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -9298,7 +9243,7 @@ fi test -z "$ac_cv_path_DTRACE" && tcl_ok=no fi echo $ac_n "checking whether to enable DTrace support""... $ac_c" 1>&6 -echo "configure:9302: checking whether to enable DTrace support" >&5 +echo "configure:9247: checking whether to enable DTrace support" >&5 MAKEFILE_SHELL='/bin/sh' if test $tcl_ok = yes; then cat >> confdefs.h <<\EOF @@ -9328,13 +9273,13 @@ echo "$ac_t""$tcl_ok" 1>&6 #-------------------------------------------------------------------- echo $ac_n "checking whether the cpuid instruction is usable""... $ac_c" 1>&6 -echo "configure:9332: checking whether the cpuid instruction is usable" >&5 +echo "configure:9277: checking whether the cpuid instruction is usable" >&5 if eval "test \"`echo '$''{'tcl_cv_cpuid'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:9298: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* tcl_cv_cpuid=yes else @@ -9398,7 +9343,7 @@ if test "`uname -s`" = "Darwin" ; then if test "`uname -s`" = "Darwin" ; then echo $ac_n "checking how to package libraries""... $ac_c" 1>&6 -echo "configure:9402: checking how to package libraries" >&5 +echo "configure:9347: checking how to package libraries" >&5 # Check whether --enable-framework or --disable-framework was given. if test "${enable_framework+set}" = set; then enableval="$enable_framework" @@ -9678,15 +9623,34 @@ trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. -cat > conftest.defs <<\EOF -s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g -s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g -s%\[%\\&%g -s%\]%\\&%g -s%\$%$$%g -EOF -DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` -rm -f conftest.defs +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed # Without the "./", some shells look in PATH for config.status. diff --git a/unix/configure.in b/unix/configure.in index 63d7170..55c305e 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -394,17 +394,12 @@ fi # The code below deals with several issues related to gettimeofday: # 1. Some systems don't provide a gettimeofday function at all # (set NO_GETTOD if this is the case). -# 2. SGI systems don't use the BSD form of the gettimeofday function, -# but they have a BSDgettimeofday function that can be used instead. -# 3. See if gettimeofday is declared in the header file. +# 2. See if gettimeofday is declared in the header file. # if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can # declare it. #-------------------------------------------------------------------- -AC_CHECK_FUNC(BSDgettimeofday, - [AC_DEFINE(HAVE_BSDGETTIMEOFDAY)], [ - AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD)]) -]) +AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD)]) AC_CACHE_CHECK([for gettimeofday declaration], tcl_cv_grep_gettimeofday, [ AC_EGREP_HEADER(gettimeofday, sys/time.h, tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)]) diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 9a76301..7f913ca 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -305,10 +305,6 @@ EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((CONST char *string, # define CLK_TCK 60 # endif # endif -#else -# ifdef HAVE_BSDGETTIMEOFDAY -# define gettimeofday BSDgettimeofday -# endif #endif #ifdef GETTOD_NOT_DECLARED -- cgit v0.12 From f3f5448b0aa89dfc3c913d3f2e43e34e1c0c106c Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 8 Jun 2012 15:51:00 +0000 Subject: Work in progress fixing 3532959 --- generic/tclBasic.c | 3 ++- generic/tclProc.c | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 954b2b3..1d289f2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1388,7 +1388,8 @@ DeleteInterpProc( hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); - + Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); + procPtr->iPtr = NULL; if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); } diff --git a/generic/tclProc.c b/generic/tclProc.c index 43e88c6..325506b 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2198,7 +2198,7 @@ TclProcCleanupProc( * the same ProcPtr is overwritten with a new CmdFrame. */ - if (!iPtr) { + if (iPtr == NULL || iPtr->linePBodyPtr == NULL) { return; } -- cgit v0.12 From ac5377745066c2cc9fdc1d30ff2d449e2bb5b6d4 Mon Sep 17 00:00:00 2001 From: dgp Date: Sun, 10 Jun 2012 23:34:45 +0000 Subject: 3532959 Arrange for every lambda to place an entry in the linePBodyPtr hash table. Then the two teardowns of data in that table synchronize so that the first to run signals the other not to operate. Test proc-7.4 in a mem debug build of Tcl will detect Bug 3532959 by crashing. --- generic/tclBasic.c | 10 ++++++---- generic/tclProc.c | 22 +++++++++++++--------- tests/proc.test | 8 ++++++++ 3 files changed, 27 insertions(+), 13 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 1d289f2..fa13b50 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1390,11 +1390,13 @@ DeleteInterpProc( CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + } + ckfree((char *) cfPtr->line); + ckfree((char *) cfPtr); } - ckfree((char *) cfPtr->line); - ckfree((char *) cfPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); diff --git a/generic/tclProc.c b/generic/tclProc.c index 325506b..7a93dbf 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2198,7 +2198,7 @@ TclProcCleanupProc( * the same ProcPtr is overwritten with a new CmdFrame. */ - if (iPtr == NULL || iPtr->linePBodyPtr == NULL) { + if (iPtr == NULL) { return; } @@ -2209,13 +2209,15 @@ TclProcCleanupProc( cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr); - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); - cfPtr->data.eval.path = NULL; + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + cfPtr->data.eval.path = NULL; + } + ckfree((char *) cfPtr->line); + cfPtr->line = NULL; + ckfree((char *) cfPtr); } - ckfree((char *) cfPtr->line); - cfPtr->line = NULL; - ckfree((char *) cfPtr); Tcl_DeleteHashEntry(hePtr); } @@ -2447,7 +2449,7 @@ SetLambdaFromAny( Interp *iPtr = (Interp *) interp; char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr; - int objc, result; + int isNew, objc, result; Proc *procPtr; if (interp == NULL) { @@ -2512,6 +2514,8 @@ SetLambdaFromAny( * common elements into a single function. */ + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, + &isNew), NULL); if (iPtr->cmdFramePtr) { CmdFrame *contextPtr; @@ -2544,7 +2548,7 @@ SetLambdaFromAny( if (contextPtr->line && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { - int isNew, buf[2]; + int buf[2]; CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); /* diff --git a/tests/proc.test b/tests/proc.test index 5673caa..c0f80e3 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -391,6 +391,14 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} { set res } {0 4} +test proc-7.4 {Proc struct outlives its interp: Bug 3532959} { + set lambda x + lappend lambda {set a 1} + interp create slave + slave eval [list apply $lambda foo] + interp delete slave + unset lambda +} {} # cleanup -- cgit v0.12 From 2c0667d7b04e34fa929ccc4758a19af166cf4206 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 11 Jun 2012 12:21:30 +0000 Subject: Revised so that we avoid hashing twice. --- generic/tclProc.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index 7a93dbf..2c6d300 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2450,6 +2450,7 @@ SetLambdaFromAny( char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr; int isNew, objc, result; + CmdFrame *cfPtr = NULL; Proc *procPtr; if (interp == NULL) { @@ -2514,8 +2515,6 @@ SetLambdaFromAny( * common elements into a single function. */ - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, - &isNew), NULL); if (iPtr->cmdFramePtr) { CmdFrame *contextPtr; @@ -2549,13 +2548,13 @@ SetLambdaFromAny( if (contextPtr->line && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { int buf[2]; - CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); /* * Move from approximation (line of list cmd word) to actual * location (line of 2nd list element). */ + cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; @@ -2571,9 +2570,6 @@ SetLambdaFromAny( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew), cfPtr); } /* @@ -2585,6 +2581,8 @@ SetLambdaFromAny( } TclStackFree(interp, contextPtr); } + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, + &isNew), cfPtr); /* * Set the namespace for this lambda: given by objv[2] understood as a -- cgit v0.12 From b1856533641e3211ef6e5b973ef1b0ea065c20ea Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 12 Jun 2012 12:35:18 +0000 Subject: add test that triggered reporting of [Bug 3530230] --- tests/safe.test | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/safe.test b/tests/safe.test index 4bd8509..8879518 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -309,6 +309,20 @@ test safe-8.9 {safe source and return} -setup { catch {safe::interpDelete $i} removeFile $returnScript } -result ok +test safe-8.10 {safe source and return} -setup { + set returnScript [makeFile {return -level 2 "ok"} return.tcl] + catch {safe::interpDelete $i} +} -body { + safe::interpCreate $i + set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] + $i eval [list apply {filename { + source $filename + error boom + }} $token/[file tail $returnScript]] +} -cleanup { + catch {safe::interpDelete $i} + removeFile $returnScript +} -result ok test safe-9.1 {safe interps' deleteHook} { set i "a"; -- cgit v0.12 From 9e832d51f5cf8e1317b58eae1f0b7ded6e0b198d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Jun 2012 07:27:05 +0000 Subject: more readable --- library/dde/pkgIndex.tcl | 2 +- library/platform/shell.tcl | 2 +- library/reg/pkgIndex.tcl | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index db67e98..1450276 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,5 +1,5 @@ if {![package vsatisfies [package provide Tcl] 8]} return -if {[string compare [info sharedlibextension] .dll]} return +if {[info sharedlibextension] != ".dll"} return if {[info exists ::tcl_platform(debug)]} { package ifneeded dde 1.2.5 [list load [file join $dir tcldde12g.dll] dde] } else { diff --git a/library/platform/shell.tcl b/library/platform/shell.tcl index e0a129a..d37cdcd 100644 --- a/library/platform/shell.tcl +++ b/library/platform/shell.tcl @@ -187,7 +187,7 @@ proc ::platform::shell::TEMP {} { } } } - if {[string compare $channel ""]} { + if {$channel != ""} { return -code error "Failed to open a temporary file: $channel" } else { return -code error "Failed to find an unused temporary file name" diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index 35b1143..40032a5 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,5 +1,5 @@ if {![package vsatisfies [package provide Tcl] 8]} return -if {[string compare [info sharedlibextension] .dll]} return +if {[info sharedlibextension] != ".dll"} return if {[info exists ::tcl_platform(debug)]} { package ifneeded registry 1.1.5 \ [list load [file join $dir tclreg11g.dll] registry] -- cgit v0.12 From 7485fdafcf89b96cc2194aed57e115adebe20580 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Jun 2012 13:56:20 +0000 Subject: fix fCmd-6.19 on win32, which was broken by [a7e00a0e02] --- tests/fCmd.test | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/fCmd.test b/tests/fCmd.test index f2adcef..4775f05 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -48,15 +48,15 @@ if {[testConstraint unix]} { set group [lindex $groupList 0] testConstraint foundGroup 1 } +} - proc dev dir { - file stat $dir stat - return $stat(dev) - } +proc dev dir { + file stat $dir stat + return $stat(dev) +} - if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { - testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] - } +if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { + testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] } # Also used in winFCmd... -- cgit v0.12 From c27b10d62b0addac6746257f64433a0c9ebd7ce5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Jun 2012 09:02:06 +0000 Subject: upgrade to 1.2.7 build of dll --- compat/zlib/win32/zlib1.dll | Bin 100352 -> 107520 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll index 869b00d..9943b3e 100644 Binary files a/compat/zlib/win32/zlib1.dll and b/compat/zlib/win32/zlib1.dll differ -- cgit v0.12 From bccf168ae55a2c314248ee8e3a2369efba47f317 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Jun 2012 09:39:34 +0000 Subject: alternative fix for [a7e00a0e02] breakage: just make sure that the variable $tmpspace is always set --- tests/fCmd.test | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/tests/fCmd.test b/tests/fCmd.test index 4775f05..72b7da9 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -39,6 +39,7 @@ if {[testConstraint win]} { } } +set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that # require Unix groups. testConstraint foundGroup [expr {![testConstraint unix]}] @@ -48,15 +49,15 @@ if {[testConstraint unix]} { set group [lindex $groupList 0] testConstraint foundGroup 1 } -} -proc dev dir { - file stat $dir stat - return $stat(dev) -} + proc dev dir { + file stat $dir stat + return $stat(dev) + } -if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { - testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] + if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { + testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] + } } # Also used in winFCmd... @@ -591,7 +592,7 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup { [subst {error renaming "td2" to "[file join td1 td2]": file *}] test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup { cleanup $tmpspace -} -constraints {xdev notRoot} -body { +} -constraints {unix notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf1] @@ -610,21 +611,21 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { } -result {d:/tcl8975@} test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup { cleanup $tmpspace -} -constraints {xdev notRoot} -body { +} -constraints {unix notRoot} -body { file mkdir td1 file rename td1 $tmpspace glob -nocomplain td* [file join $tmpspace td*] } -result [file join $tmpspace td1] test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup { cleanup $tmpspace -} -constraints {xdev notRoot} -body { +} -constraints {unix notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf*] } -result [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace -} -constraints {notRoot xdev} -body { +} -constraints {xdev notRoot} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0000 file rename td1 $tmpspace @@ -693,7 +694,7 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { } -result [file join $tmpspace td1 td2] test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { cleanup $tmpspace -} -constraints {xdev notRoot} -body { +} -constraints {unix notRoot} -body { file mkdir foo/bar file attr foo -perm 040555 file rename foo/bar $tmpspace @@ -1353,7 +1354,7 @@ test fCmd-12.8 {renamefile: generic error} -setup { } -result {1} test fCmd-12.9 {renamefile: moving a file across volumes} -setup { cleanup $tmpspace -} -constraints {xdev notRoot} -body { +} -constraints {unix notRoot} -body { set s [createfile tfa] file rename tfa $tmpspace list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa] -- cgit v0.12 From 67e3f2064bffa1c3b92cde8ab9e703e8362d37ee Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Jun 2012 11:58:58 +0000 Subject: make tclWinReg.c compile/run without UNICODE (suggested in bug #3362446) --- win/tclWinReg.c | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 937089c..aa06e44 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -22,6 +22,13 @@ #endif #include +#ifndef UNICODE +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif + /* * Ensure that we can say which registry is being accessed. */ @@ -611,7 +618,7 @@ GetKeyNames( result = TCL_ERROR; break; } - Tcl_WinTCharToUtf(buffer, bufSize * sizeof(WCHAR), &ds); + Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); name = Tcl_DStringValue(&ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); @@ -898,7 +905,7 @@ GetValueNames( resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, - (int) (maxSize*sizeof(WCHAR))); + (int) (maxSize*sizeof(TCHAR))); index = 0; result = TCL_OK; @@ -1209,7 +1216,7 @@ RecursiveDeleteKey( Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, - (int) (maxSize * sizeof(WCHAR))); + (int) (maxSize * sizeof(TCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { -- cgit v0.12 From 869661b25a7665bee7b0d441164b367e4f1aaab7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Jun 2012 13:22:05 +0000 Subject: [bug 3362446]: registry keys command fails with 8.5/8.6 --- win/tclWinReg.c | 94 ++++++++++++++++++--------------------------------------- 1 file changed, 30 insertions(+), 64 deletions(-) diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 3960fda..0b93f3a 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -25,6 +25,14 @@ #define TCL_STORAGE_CLASS DLLEXPORT /* + * The maximum length of a sub-key name. + */ + +#ifndef MAX_KEY_LENGTH +#define MAX_KEY_LENGTH 256 +#endif + +/* * The following macros convert between different endian ints. */ @@ -90,9 +98,6 @@ typedef struct RegWinProcs { DWORD *, BYTE *, DWORD *); LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM, HKEY *); - LONG (WINAPI *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *, - DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, - FILETIME *); LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *, BYTE *, DWORD *); LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD, @@ -117,9 +122,6 @@ static RegWinProcs asciiProcs = { DWORD *, BYTE *, DWORD *)) RegEnumValueA, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, HKEY *)) RegOpenKeyExA, - (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *, - DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, - FILETIME *)) RegQueryInfoKeyA, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, BYTE *, DWORD *)) RegQueryValueExA, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, @@ -142,9 +144,6 @@ static RegWinProcs unicodeProcs = { DWORD *, BYTE *, DWORD *)) RegEnumValueW, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, HKEY *)) RegOpenKeyExW, - (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *, - DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, - FILETIME *)) RegQueryInfoKeyW, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, BYTE *, DWORD *)) RegQueryValueExW, (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, @@ -513,9 +512,7 @@ GetKeyNames( { char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - DWORD subKeyCount; /* Number of subkeys to list */ - DWORD maxSubKeyLen; /* Maximum string length of any subkey */ - char *buffer; /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -537,14 +534,6 @@ GetKeyNames( return TCL_ERROR; } - /* - * Determine how big a buffer is needed for enumerating subkeys, and - * how many subkeys there are - */ - - result = (*regWinProcs->regQueryInfoKeyProc) - (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL, - NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_NewObj()); Tcl_AppendResult(interp, "unable to query key \"", @@ -553,27 +542,25 @@ GetKeyNames( RegCloseKey(key); return TCL_ERROR; } - if (regWinProcs->useWide) { - buffer = ckalloc((maxSubKeyLen+1) * sizeof(WCHAR)); - } else { - buffer = ckalloc(maxSubKeyLen+1); - } /* Enumerate the subkeys */ resultPtr = Tcl_NewObj(); - for (index = 0; index < subKeyCount; ++index) { - bufSize = maxSubKeyLen+1; + for (index = 0;; ++index) { + bufSize = MAX_KEY_LENGTH; result = (*regWinProcs->regEnumKeyExProc) (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, - "unable to enumerate subkeys of \"", - Tcl_GetString(keyNameObj), - "\": ", NULL); - AppendSystemError(interp, result); - result = TCL_ERROR; + if (result == ERROR_NO_MORE_ITEMS) { + result = TCL_OK; + } else { + Tcl_SetObjResult(interp, Tcl_NewObj()); + Tcl_AppendResult(interp, + "unable to enumerate subkeys of \"", + Tcl_GetString(keyNameObj), "\": ", NULL); + AppendSystemError(interp, result); + result = TCL_ERROR; + } break; } if (regWinProcs->useWide) { @@ -595,9 +582,10 @@ GetKeyNames( } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */ } - ckfree(buffer); RegCloseKey(key); return result; } @@ -839,7 +827,7 @@ GetValueNames( { HKEY key; Tcl_Obj *resultPtr; - DWORD index, size, maxSize, result; + DWORD index, size, result; Tcl_DString buffer, ds; char *pattern, *name; @@ -854,27 +842,9 @@ GetValueNames( resultPtr = Tcl_GetObjResult(interp); - /* - * Query the key to determine the appropriate buffer size to hold the - * largest value name plus the terminating null. - */ - - result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL, - NULL, NULL, &index, &maxSize, NULL, NULL, NULL); - if (result != ERROR_SUCCESS) { - Tcl_AppendStringsToObj(resultPtr, "unable to query key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - RegCloseKey(key); - result = TCL_ERROR; - goto done; - } - maxSize++; - - Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, - (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize)); + (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH)); index = 0; result = TCL_OK; @@ -890,7 +860,7 @@ GetValueNames( * after each iteration because RegEnumValue smashes the old value. */ - size = maxSize; + size = MAX_KEY_LENGTH; while ((*regWinProcs->regEnumValueProc)(key, index, Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { @@ -912,11 +882,10 @@ GetValueNames( Tcl_DStringFree(&ds); index++; - size = maxSize; + size = MAX_KEY_LENGTH; } Tcl_DStringFree(&buffer); - done: RegCloseKey(key); return result; } @@ -1161,7 +1130,7 @@ RecursiveDeleteKey( CONST char *keyName) /* Name of key to be deleted in external * encoding, not UTF. */ { - DWORD result, size, maxSize; + DWORD result, size; Tcl_DString subkey; HKEY hKey; @@ -1178,23 +1147,20 @@ RecursiveDeleteKey( if (result != ERROR_SUCCESS) { return result; } - result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL, - &maxSize, NULL, NULL, NULL, NULL, NULL, NULL); - maxSize++; if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, - (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize)); + (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH)); while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ - size = maxSize; + size = MAX_KEY_LENGTH; result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { -- cgit v0.12 From b4274908c29bc7b8e88b1af0b34ba947453ccdbc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Jun 2012 14:55:42 +0000 Subject: Plug memory leak, part of [Bug #3362446] --- ChangeLog | 4 ++++ win/tclWinReg.c | 2 ++ 2 files changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index 6b9c072..5d4d5b9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-06-19 Jan Nijtmans + + * win/tclWinReg.c: Plug memory leak, part of [Bug #3362446] + 2012-06-08 Don Porter * unix/configure.in: Update autogoo for gettimeofday(). diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 3960fda..7d50996 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -595,6 +595,8 @@ GetKeyNames( } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */ } ckfree(buffer); -- cgit v0.12 From c1b361063c982bbd7cc02b0c26c524cc414379e6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Jun 2012 07:38:45 +0000 Subject: add test case for very long value names and values --- tests/registry.test | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/registry.test b/tests/registry.test index 85b4f42..a3bc891 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -458,6 +458,12 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba r baz" +test registry-6.21 {GetValue: very long value names and values} {pcOnly} { + registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz + set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]] + registry delete HKEY_CURRENT_USER\\TclFoobar + set result +} [string repeat x 16383] test registry-7.1 {GetValueNames: bad key} {pcOnly english} { registry delete HKEY_CURRENT_USER\\TclFoobar -- cgit v0.12 From af21439b8bdd0c25c86c7da8c35b704514557dcc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Jun 2012 13:26:17 +0000 Subject: remove some unused code --- win/tclWinReg.c | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 0b93f3a..6f99fe1 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -534,15 +534,6 @@ GetKeyNames( return TCL_ERROR; } - if (result != ERROR_SUCCESS) { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, "unable to query key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); - AppendSystemError(interp, result); - RegCloseKey(key); - return TCL_ERROR; - } - /* Enumerate the subkeys */ resultPtr = Tcl_NewObj(); @@ -1147,9 +1138,6 @@ RecursiveDeleteKey( if (result != ERROR_SUCCESS) { return result; } - if (result != ERROR_SUCCESS) { - return result; - } Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, @@ -1496,3 +1484,11 @@ ConvertDWORD( localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD)SWAPLONG(value) : value; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ -- cgit v0.12 From 72e0260dd8c56fb8041518ded09189144ab90b74 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jun 2012 17:41:09 +0000 Subject: Remove dead code that complicates fs path values but adds no value. --- generic/tclIOUtil.c | 41 ++++++++++------------------------------- 1 file changed, 10 insertions(+), 31 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 40f3f76..bb82d32 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -68,9 +68,9 @@ typedef struct FilesystemRecord { int TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr)); int TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, ClientData clientData)); + Tcl_Obj *objPtr)); int TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr)); + Tcl_Obj *pathPtr, int startAt)); Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr)); Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_(( @@ -1376,8 +1376,6 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) } } if (nplen > 0) { - ClientData clientData = NULL; - retVal = Tcl_FSJoinPath(split, nplen); /* * Now we have an absolute path, with no '..', '.' sequences, @@ -1391,15 +1389,15 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) * other criteria for normalizing a path. */ Tcl_IncrRefCount(retVal); - TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); + TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can * actually convert this object into an "path" object for * greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal, clientData); + TclFSMakePathFromNormalized(interp, retVal); if (clientDataPtr != NULL) { - *clientDataPtr = clientData; + *clientDataPtr = NULL; } } else { /* Init to an empty string */ @@ -1456,15 +1454,13 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) *--------------------------------------------------------------------------- */ int -TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) +TclFSNormalizeToUniquePath(interp, pathPtr, startAt) Tcl_Interp *interp; Tcl_Obj *pathPtr; int startAt; - ClientData *clientDataPtr; { FilesystemRecord *fsRecPtr, *firstFsRecPtr; /* Ignore this variable */ - (void)clientDataPtr; /* * Call each of the "normalise path" functions in succession. This is @@ -5347,11 +5343,9 @@ TclFSMakePathRelative(interp, objPtr, cwdPtr) */ int -TclFSMakePathFromNormalized(interp, objPtr, nativeRep) +TclFSMakePathFromNormalized(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ - ClientData nativeRep; /* The native rep for the object, if known - * else NULL. */ { FsPath *fsPathPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -5383,7 +5377,7 @@ TclFSMakePathFromNormalized(interp, objPtr, nativeRep) fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = objPtr; fsPathPtr->cwdPtr = NULL; - fsPathPtr->nativePathPtr = nativeRep; + fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; @@ -5618,7 +5612,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) int cwdLen; int pathType; CONST char *cwdStr; - ClientData clientData = NULL; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); @@ -5688,8 +5681,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * after that separator. */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); } /* Now we need to construct the new path object */ @@ -5715,14 +5707,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) /* That's our reference to copy used */ Tcl_DecrRefCount(dir); } - if (clientData != NULL) { - /* - * This may be unnecessary. It appears that the - * TclFSNormalizeToUniquePath call above should have already - * set this up. Not changing out of fear of the unknown. - */ - fsPathPtr->nativePathPtr = clientData; - } PATHFLAGS(pathObjPtr) = 0; } /* Ensure cwd hasn't changed */ @@ -5742,7 +5726,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) int cwdLen; Tcl_Obj *copy; CONST char *cwdStr; - ClientData clientData = NULL; copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); Tcl_IncrRefCount(copy); @@ -5780,12 +5763,8 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * the end of the previously normalized 'dir'. This should * be much faster! */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } } } if (fsPathPtr->normPathPtr == NULL) { -- cgit v0.12 From 52d15b52d02ef41a6a25128de9bd49c2fc59b343 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jun 2012 18:22:30 +0000 Subject: ...and one more line. --- generic/tclIOUtil.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bb82d32..b6f89d9 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1460,7 +1460,6 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt) int startAt; { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - /* Ignore this variable */ /* * Call each of the "normalise path" functions in succession. This is -- cgit v0.12 From 38f0b4d80988173806607621adbf9258d555f033 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jun 2012 19:36:13 +0000 Subject: Purge more dead fs path code. --- generic/tclIOUtil.c | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index b6f89d9..94d0a6c 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -98,8 +98,7 @@ static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); static Tcl_FSPathInFilesystemProc NativePathInFilesystem; static Tcl_Obj* TclFSNormalizeAbsolutePath - _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr, - ClientData *clientDataPtr)); + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr)); /* * Prototypes for procedures defined later in this file. */ @@ -1337,10 +1336,9 @@ Tcl_FSData(fsPtr) *--------------------------------------------------------------------------- */ static Tcl_Obj * -TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) +TclFSNormalizeAbsolutePath(interp, pathPtr) Tcl_Interp* interp; /* Interpreter to use */ Tcl_Obj *pathPtr; /* Absolute path to normalize */ - ClientData *clientDataPtr; { int splen = 0, nplen, eltLen, i; char *eltName; @@ -1396,9 +1394,6 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) * greater efficiency */ TclFSMakePathFromNormalized(interp, retVal); - if (clientDataPtr != NULL) { - *clientDataPtr = NULL; - } } else { /* Init to an empty string */ retVal = Tcl_NewStringObj("",0); @@ -2538,7 +2533,7 @@ Tcl_FSGetCwd(interp) * could be problematic. */ if (retVal != NULL) { - Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. @@ -2580,7 +2575,7 @@ Tcl_FSGetCwd(interp) if (proc != NULL) { Tcl_Obj *retVal = (*proc)(interp); if (retVal != NULL) { - Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); /* * Check whether cwd has changed from the value * previously stored in cwdPathPtr. Really 'norm' @@ -5665,7 +5660,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * we avoid [Bug 2385549] ... */ - Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL); + Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); Tcl_DecrRefCount(copy); copy = newCopy; } else { @@ -5767,7 +5762,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) } } if (fsPathPtr->normPathPtr == NULL) { - ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; /* * Since normPathPtr is NULL, but this is a valid path @@ -5854,12 +5848,8 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) } } /* Already has refCount incremented */ - fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); - if (0 && (clientData != NULL)) { - fsPathPtr->nativePathPtr = - (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); - } + fsPathPtr->normPathPtr + = TclFSNormalizeAbsolutePath(interp, absolutePath); if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr), Tcl_GetString(pathObjPtr))) { /* -- cgit v0.12 From 989a8101fcd98ea1768732253c10b554aa99f9be Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Jun 2012 10:56:52 +0000 Subject: [Bug 3362446]: possible allocation error when using UNICODE --- win/tclWinReg.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/win/tclWinReg.c b/win/tclWinReg.c index de9f756..ee0c243 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -17,7 +17,6 @@ # define USE_TCL_STUBS #endif #include "tclInt.h" -#include "tclPort.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif @@ -766,8 +765,8 @@ GetValue( */ Tcl_DStringInit(&data); - length = TCL_DSTRING_STATIC_SIZE - 1; - Tcl_DStringSetLength(&data, (int) length); + Tcl_DStringSetLength(&data, (int) TCL_DSTRING_STATIC_SIZE - 1); + length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); @@ -910,7 +909,7 @@ GetValueNames( size = MAX_KEY_LENGTH; while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - size *= 2; + size *= sizeof(TCHAR); Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); -- cgit v0.12 From b6f50b1321a5cd34af747eb670aad924fc66d7b7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Jun 2012 10:59:15 +0000 Subject: [Bug 3362446]: possible allocation error when using UNICODE --- win/tclWinReg.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 7d50996..701edfb 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -731,8 +731,8 @@ GetValue( */ Tcl_DStringInit(&data); - length = TCL_DSTRING_STATIC_SIZE - 1; - Tcl_DStringSetLength(&data, (int) length); + Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); + length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1; resultPtr = Tcl_GetObjResult(interp); @@ -748,8 +748,8 @@ GetValue( * Required for HKEY_PERFORMANCE_DATA */ length *= 2; - Tcl_DStringSetLength(&data, (int) length); - result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, + Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); + result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); -- cgit v0.12 From 687013812cd6ca56d2bfc1c0b75d98a6f8a2d264 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 21 Jun 2012 17:48:37 +0000 Subject: Stop storing FilesystemRecord in the intrep of a "path". We never use it. Store the Tcl_Filesystem instead, which is what we actually need. --- generic/tclFileSystem.h | 7 +----- generic/tclIOUtil.c | 27 +------------------- generic/tclPathObj.c | 65 ++++++++++++++++++------------------------------- 3 files changed, 26 insertions(+), 73 deletions(-) diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index d6e1546..3dfc1de 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -68,15 +68,10 @@ MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt); MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr); -MODULE_SCOPE Tcl_Obj * TclFSInternalToNormalized( - Tcl_Filesystem *fromFilesystem, - ClientData clientData, - FilesystemRecord **fsRecPtrPtr); MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, - FilesystemRecord *fsRecPtr, - ClientData clientData); + Tcl_Filesystem *fsPtr, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index e3c5816..3bdcca3 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -3814,31 +3814,6 @@ Tcl_FSSplitPath( return result; } -/* Simple helper function */ -Tcl_Obj * -TclFSInternalToNormalized( - Tcl_Filesystem *fromFilesystem, - ClientData clientData, - FilesystemRecord **fsRecPtrPtr) -{ - FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); - - while (fsRecPtr != NULL) { - if (fsRecPtr->fsPtr == fromFilesystem) { - *fsRecPtrPtr = fsRecPtr; - break; - } - fsRecPtr = fsRecPtr->nextPtr; - } - - if ((fsRecPtr != NULL) - && (fromFilesystem->internalToNormalizedProc != NULL)) { - return (*fromFilesystem->internalToNormalizedProc)(clientData); - } else { - return NULL; - } -} - /* *---------------------------------------------------------------------- * @@ -4436,7 +4411,7 @@ Tcl_FSGetFileSystemForPath( * above call to the pathInFilesystemProc. */ - TclFSSetPathDetails(pathPtr, fsRecPtr, clientData); + TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); retVal = fsRecPtr->fsPtr; } } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 147c619..7911dea 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -92,9 +92,7 @@ typedef struct FsPath { * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ - struct FilesystemRecord *fsRecPtr; - /* Pointer to the filesystem record entry to - * use for this path. */ + Tcl_Filesystem *fsPtr; /* The Tcl_Filesystem that claims this path */ } FsPath; /* @@ -1312,7 +1310,7 @@ TclNewFSPathObj( fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; + fsPathPtr->fsPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; SETPATHOBJ(pathPtr, fsPathPtr); @@ -1433,7 +1431,7 @@ TclFSMakePathRelative( * with a recorded cwdPtr context has any actual value. * * Nothing is getting cached. Not normPathPtr, not nativePathPtr, - * nor fsRecPtr, so storing the cwdPtr context against which such + * nor fsPtr, so storing the cwdPtr context against which such * cached values might later be validated appears to be of no * value. Take that away, and all this code is just a mildly * optimized equivalent of a call to SetFsPathFromAny(). That @@ -1482,7 +1480,7 @@ TclFSMakePathRelative( fsPathPtr->cwdPtr = cwdPtr; Tcl_IncrRefCount(cwdPtr); fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; + fsPathPtr->fsPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; SETPATHOBJ(pathPtr, fsPathPtr); @@ -1592,7 +1590,7 @@ TclFSMakePathFromNormalized( fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; + fsPathPtr->fsPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; SETPATHOBJ(pathPtr, fsPathPtr); @@ -1632,14 +1630,14 @@ Tcl_FSNewNativePath( Tcl_Filesystem *fromFilesystem, ClientData clientData) { - Tcl_Obj *pathPtr; + Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - FilesystemRecord *fsFromPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, - &fsFromPtr); + if (fromFilesystem->internalToNormalizedProc != NULL) { + pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); + } if (pathPtr == NULL) { return NULL; } @@ -1670,8 +1668,7 @@ Tcl_FSNewNativePath( fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; - fsPathPtr->fsRecPtr = fsFromPtr; - fsPathPtr->fsRecPtr->fileRefCount++; + fsPathPtr->fsPtr = fromFilesystem; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; SETPATHOBJ(pathPtr, fsPathPtr); @@ -2128,7 +2125,7 @@ Tcl_FSGetInternalRep( * not easily achievable with the current implementation. */ - if (srcFsPathPtr->fsRecPtr == NULL) { + if (srcFsPathPtr->fsPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which create a * string object and pass it to TclpObjStat. Code which calls the @@ -2148,7 +2145,7 @@ Tcl_FSGetInternalRep( */ srcFsPathPtr = PATHOBJ(pathPtr); - if (srcFsPathPtr->fsRecPtr == NULL) { + if (srcFsPathPtr->fsPtr == NULL) { return NULL; } } @@ -2160,7 +2157,7 @@ Tcl_FSGetInternalRep( * for this is we ask what filesystem this path belongs to. */ - if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { + if (fsPtr != srcFsPathPtr->fsPtr) { const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); if (actualFs == fsPtr) { @@ -2173,7 +2170,7 @@ Tcl_FSGetInternalRep( Tcl_FSCreateInternalRepProc *proc; char *nativePathPtr; - proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; + proc = srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } @@ -2241,8 +2238,8 @@ TclFSEnsureEpochOk( * Check whether the object is already assigned to a fs. */ - if (srcFsPathPtr->fsRecPtr != NULL) { - *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr; + if (srcFsPathPtr->fsPtr != NULL) { + *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; } @@ -2266,7 +2263,7 @@ TclFSEnsureEpochOk( void TclFSSetPathDetails( Tcl_Obj *pathPtr, - FilesystemRecord *fsRecPtr, + Tcl_Filesystem *fsPtr, ClientData clientData) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); @@ -2283,10 +2280,9 @@ TclFSSetPathDetails( } srcFsPathPtr = PATHOBJ(pathPtr); - srcFsPathPtr->fsRecPtr = fsRecPtr; + srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - fsRecPtr->fileRefCount++; } /* @@ -2535,7 +2531,7 @@ SetFsPathFromAny( fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; + fsPathPtr->fsPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; /* @@ -2569,25 +2565,15 @@ FreeFsPathInternalRep( if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); } - if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) { + if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = - fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc; + fsPathPtr->fsPtr->freeInternalRepProc; if (freeProc != NULL) { (*freeProc)(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } - if (fsPathPtr->fsRecPtr != NULL) { - fsPathPtr->fsRecPtr->fileRefCount--; - if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { - /* - * It has been unregistered already. - */ - - ckfree((char *) fsPathPtr->fsRecPtr); - } - } ckfree((char *) fsPathPtr); pathPtr->typePtr = NULL; @@ -2630,10 +2616,10 @@ DupFsPathInternalRep( copyFsPathPtr->flags = srcFsPathPtr->flags; - if (srcFsPathPtr->fsRecPtr != NULL + if (srcFsPathPtr->fsPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { Tcl_FSDupInternalRepProc *dupProc = - srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; + srcFsPathPtr->fsPtr->dupInternalRepProc; if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = @@ -2644,11 +2630,8 @@ DupFsPathInternalRep( } else { copyFsPathPtr->nativePathPtr = NULL; } - copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; + copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - if (copyFsPathPtr->fsRecPtr != NULL) { - copyFsPathPtr->fsRecPtr->fileRefCount++; - } copyPtr->typePtr = &tclFsPathType; } -- cgit v0.12