summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog23
-rw-r--r--generic/tclAlloc.c4
-rw-r--r--generic/tclCmdMZ.c3
-rw-r--r--generic/tclCompExpr.c6
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclEnv.c4
-rw-r--r--generic/tclEvent.c1
-rw-r--r--generic/tclIO.c5
-rw-r--r--generic/tclIOCmd.c141
-rw-r--r--generic/tclIORChan.c2
-rw-r--r--generic/tclIORTrans.c2
-rw-r--r--generic/tclLiteral.c3
-rw-r--r--generic/tclNotify.c1
-rw-r--r--generic/tclParse.c16
-rw-r--r--generic/tclStringObj.c209
-rw-r--r--generic/tclUtil.c1
-rw-r--r--generic/tclZlib.c48
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl33
-rw-r--r--tests/incr.test230
-rw-r--r--tests/init.test28
-rw-r--r--tests/package.test6
-rw-r--r--unix/Makefile.in4
-rw-r--r--unix/tclUnixFCmd.c38
-rw-r--r--unix/tclUnixNotfy.c137
-rw-r--r--unix/tclUnixPort.h454
-rw-r--r--unix/tclXtNotify.c4
-rw-r--r--win/Makefile.in4
28 files changed, 826 insertions, 589 deletions
diff --git a/ChangeLog b/ChangeLog
index 71adb1a..a03c070 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,26 @@
+2011-03-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): Added this
+ command to handle connecting tcltest to a slave interpreter. This adds
+ in the hook (inside the tcltest namespace) that allows the tests run
+ in the child interpreter to be reported as part of the main sequence
+ of test results. Bumped version of tcltest to 2.3.3.
+ * tests/init.test, tests/package.test: Adapted these test files to use
+ the new feature.
+
+ * generic/tclAlloc.c, generic/tclCmdMZ.c, generic/tclCompExpr.c:
+ * generic/tclCompile.c, generic/tclEnv.c, generic/tclEvent.c:
+ * generic/tclIO.c, generic/tclIOCmd.c, generic/tclIORChan.c:
+ * generic/tclIORTrans.c, generic/tclLiteral.c, generic/tclNotify.c:
+ * generic/tclParse.c, generic/tclStringObj.c, generic/tclUtil.c:
+ * generic/tclZlib.c, unix/tclUnixFCmd.c, unix/tclUnixNotfy.c:
+ * unix/tclUnixPort.h, unix/tclXtNotify.c: Formatting fixes, mainly to
+ comments, so code better fits the style in the Engineering Manual.
+
+2011-03-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/incr.test: Update more of the test suite to use Tcltest 2.
+
2011-03-09 Don Porter <dgp@users.sourceforge.net>
* generic/tclNamesp.c: Tighten the detector of nested [namespace code]
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 51f99e7..6fff92b 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -702,7 +702,7 @@ char *
TclpAlloc(
unsigned int numBytes) /* Number of bytes to allocate. */
{
- return (char*) malloc(numBytes);
+ return (char *) malloc(numBytes);
}
/*
@@ -750,7 +750,7 @@ TclpRealloc(
char *oldPtr, /* Pointer to alloced block. */
unsigned int numBytes) /* New size of memory. */
{
- return (char*) realloc(oldPtr, numBytes);
+ return (char *) realloc(oldPtr, numBytes);
}
#endif /* !USE_TCLALLOC */
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cf375b4e..26831c3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3923,6 +3923,7 @@ TclNRSwitchObjCmd(
INT2PTR(pc), (ClientData) pattern);
return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
}
+
static int
SwitchPostProc(
ClientData data[], /* Data passed from Tcl_NRAddCallback above */
@@ -4772,7 +4773,7 @@ TclListLines(
int i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
- int *clNext= (clLocPtr ? &clLocPtr->loc[0] : NULL);
+ int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 1d42b81..34deff7 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1333,13 +1333,12 @@ ParseExpr(
numBytes -= scanned;
} /* main parsing loop */
- error:
-
/*
* We only get here if there's been an error. Any errors that didn't get a
* suitable parsePtr->errorType, get recorded as syntax errors.
*/
+ error:
if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
parsePtr->errorType = TCL_PARSE_SYNTAX;
}
@@ -1349,7 +1348,7 @@ ParseExpr(
*/
if (nodes != NULL) {
- ckfree((char*) nodes);
+ ckfree((char *) nodes);
}
if (interp == NULL) {
@@ -1361,7 +1360,6 @@ ParseExpr(
Tcl_DecrRefCount(msg);
}
} else {
-
/*
* Construct the complete error message. Start with the simple error
* message, pulled from the interp result if necessary...
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 9dcafb4..4f04403 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1765,6 +1765,7 @@ TclCompileScript(
* unmodified. We care only if the we are in a context
* which already allows absolute counting.
*/
+
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
@@ -1813,7 +1814,6 @@ TclCompileScript(
&isnew);
Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
-
if (wordIdx <= 255) {
TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
} else {
@@ -2661,7 +2661,7 @@ TclExpandCodeArray(
*/
size_t currBytes = envPtr->codeNext - envPtr->codeStart;
- size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
+ size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
if (envPtr->mallocedCodeArray) {
envPtr->codeStart = (unsigned char *)
@@ -2728,7 +2728,7 @@ EnterCmdStartData(
*/
size_t currElems = envPtr->cmdMapEnd;
- size_t newElems = 2*currElems;
+ size_t newElems = 2 * currElems;
size_t currBytes = currElems * sizeof(CmdLocation);
size_t newBytes = newElems * sizeof(CmdLocation);
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index bd710d6..4a52bea 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -649,8 +649,8 @@ ReplaceString(
env.cache = (char **) ckrealloc((char *) env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
- (void) memset(env.cache+env.cacheSize+1, (int) 0,
- (size_t) (growth-1) * sizeof(char*));
+ (void) memset(env.cache+env.cacheSize+1, 0,
+ (size_t) (growth-1) * sizeof(char *));
env.cacheSize += growth;
}
}
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index b4b5299..ad20626 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -119,7 +119,6 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
-
/*
*----------------------------------------------------------------------
diff --git a/generic/tclIO.c b/generic/tclIO.c
index d0ebe21..7abbba4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3292,10 +3292,11 @@ CloseWrite(
* interpreter */
{
/* Notes: clear-channel-handlers - write side only ? or keep around, just
- * not called */
+ * not called. */
/* No close cllbacks are run - channel is still open (read side) */
- ChannelState *statePtr = chanPtr->state; /* State of real IO channel */
+ ChannelState *statePtr = chanPtr->state;
+ /* State of real IO channel. */
int flushcode;
int result = 0;
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index c889862..abbe002 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,8 +16,8 @@
*/
typedef struct AcceptCallback {
- char *script; /* Script to invoke. */
- Tcl_Interp *interp; /* Interpreter in which to run it. */
+ char *script; /* Script to invoke. */
+ Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
/*
@@ -117,12 +117,12 @@ Tcl_PutsObjCmd(
ThreadSpecificData *tsdPtr;
switch (objc) {
- case 2: /* [puts $x] */
+ case 2: /* [puts $x] */
string = objv[1];
newline = 1;
break;
- case 3: /* [puts -nonewline $x] or [puts $chan $x] */
+ case 3: /* [puts -nonewline $x] or [puts $chan $x] */
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
newline = 0;
} else {
@@ -132,7 +132,8 @@ Tcl_PutsObjCmd(
string = objv[2];
break;
- case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
+ case 4: /* [puts -nonewline $chan $x] or
+ * [puts $chan $x nonewline] */
newline = 0;
if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
chanObjPtr = objv[2];
@@ -153,8 +154,8 @@ Tcl_PutsObjCmd(
#endif
}
/* Fall through */
- default:
- /* [puts] or [puts some bad number of arguments...] */
+ default: /* [puts] or
+ * [puts some bad number of arguments...] */
Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
return TCL_ERROR;
}
@@ -200,9 +201,8 @@ Tcl_PutsObjCmd(
error:
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error writing \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "error writing \"", TclGetString(chanObjPtr),
+ "\": ", Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -260,8 +260,8 @@ Tcl_FlushObjCmd(
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error flushing \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp),
+ NULL);
}
return TCL_ERROR;
}
@@ -319,10 +319,10 @@ Tcl_GetsObjCmd(
Tcl_DecrRefCount(linePtr);
/*
- * TIP #219. Capture error messages put by the driver into the
- * bypass area and put them into the regular interpreter result.
- * Fall back to the regular message if nothing was found in the
- * bypass.
+ * TIP #219.
+ * Capture error messages put by the driver into the bypass area
+ * and put them into the regular interpreter result. Fall back to
+ * the regular message if nothing was found in the bypass.
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
@@ -341,7 +341,6 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
- return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
@@ -417,7 +416,7 @@ Tcl_ReadObjCmd(
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
- i++; /* Consumed channel name. */
+ i++; /* Consumed channel name. */
/*
* Compute how many bytes to read.
@@ -425,7 +424,8 @@ Tcl_ReadObjCmd(
toRead = -1;
if (i < objc) {
- if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) {
+ if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
+ || (toRead < 0)) {
#if TCL_MAJOR_VERSION < 9
/*
* The code below provides backwards compatibility with an old
@@ -462,8 +462,8 @@ Tcl_ReadObjCmd(
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp),
+ NULL);
}
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
@@ -550,10 +550,11 @@ Tcl_SeekObjCmd(
* put them into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypass.
*/
+
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error during seek on \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ TclGetString(objv[1]), "\": ", Tcl_PosixError(interp),
+ NULL);
}
return TCL_ERROR;
}
@@ -644,6 +645,10 @@ Tcl_CloseObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
+ static const char *const dirOptions[] = {
+ "read", "write", NULL
+ };
+ static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
@@ -655,21 +660,17 @@ Tcl_CloseObjCmd(
}
if (objc == 3) {
- int optionIndex, dir;
- static const char *const dirOptions[] = {
- "read", "write", NULL
- };
- static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+ int index, dir;
/*
* Get direction requested to close, and check syntax.
*/
if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
- &optionIndex) != TCL_OK) {
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- dir = dirArray[optionIndex];
+ dir = dirArray[index];
/*
* Check direction against channel mode. It is an error if we try to
@@ -678,8 +679,7 @@ Tcl_CloseObjCmd(
*/
if (!(dir & Tcl_GetChannelMode(chan))) {
- Tcl_AppendResult(interp, "Half-close of ",
- dirOptions[optionIndex],
+ Tcl_AppendResult(interp, "Half-close of ", dirOptions[index],
"-side not possible, side not opened or already closed",
NULL);
return TCL_ERROR;
@@ -758,8 +758,7 @@ Tcl_FconfigureObjCmd(
int i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "channelId ?-option value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
return TCL_ERROR;
}
@@ -870,14 +869,9 @@ Tcl_ExecObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- /*
- * This function generates an argv array for the string arguments. It
- * starts out with stack-allocated space but uses dynamically-allocated
- * storage if needed.
- */
-
Tcl_Obj *resultPtr;
- const char **argv;
+ const char **argv; /* An array for the string arguments. Stored
+ * on the _Tcl_ stack. */
const char *string;
Tcl_Channel chan;
int argc, background, i, index, keepNewline, result, skip, length;
@@ -935,8 +929,7 @@ Tcl_ExecObjCmd(
*/
argc = objc - skip;
- argv = (const char **)
- TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
+ argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
/*
* Copy the string conversions of each (post option) object into the
@@ -948,7 +941,7 @@ Tcl_ExecObjCmd(
}
argv[argc] = NULL;
chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
- (ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));
+ ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
/*
* Free the argv array.
@@ -1108,11 +1101,13 @@ Tcl_OpenObjCmd(
int code = TCL_ERROR;
int scanned = TclParseAllWhiteSpace(permString, -1);
- /* Support legacy octal numbers */
+ /*
+ * Support legacy octal numbers.
+ */
+
if ((permString[scanned] == '0')
&& (permString[scanned+1] >= '0')
&& (permString[scanned+1] <= '7')) {
-
Tcl_Obj *permObj;
TclNewLiteralStringObj(permObj, "0o");
@@ -1259,13 +1254,12 @@ RegisterTcpServerInterpCleanup(
Tcl_HashEntry *hPtr; /* Entry for this record. */
int isNew; /* Is the entry new? */
- hTblPtr = (Tcl_HashTable *)
- Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
- (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
+ Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, hTblPtr);
}
@@ -1306,8 +1300,7 @@ UnregisterTcpServerInterpCleanupProc(
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclTCPAcceptCallbacks", NULL);
+ hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
return;
}
@@ -1345,7 +1338,7 @@ AcceptCallbackProc(
char *address, /* Address of client that was accepted. */
int port) /* Port of client that was accepted. */
{
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
@@ -1390,8 +1383,8 @@ AcceptCallbackProc(
Tcl_Release(script);
} else {
/*
- * The interpreter has been deleted, so there is no useful way to
- * utilize the client socket - just close it.
+ * The interpreter has been deleted, so there is no useful way to use
+ * the client socket - just close it.
*/
Tcl_Close(NULL, chan);
@@ -1424,7 +1417,7 @@ TcpServerCloseProc(
ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = callbackData;
/* The actual data. */
if (acceptCallbackPtr->interp != NULL) {
@@ -1955,25 +1948,25 @@ TclInitChanCmd(
* function at the moment.
*/
static const EnsembleImplMap initMap[] = {
- {"blocked", Tcl_FblockedObjCmd, NULL, NULL, NULL, 0},
- {"close", Tcl_CloseObjCmd, NULL, NULL, NULL, 0},
- {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
- {"create", TclChanCreateObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
- {"eof", Tcl_EofObjCmd, NULL, NULL, NULL, 0},
- {"event", Tcl_FileEventObjCmd, NULL, NULL, NULL, 0},
- {"flush", Tcl_FlushObjCmd, NULL, NULL, NULL, 0},
- {"gets", Tcl_GetsObjCmd, NULL, NULL, NULL, 0},
- {"names", TclChannelNamesCmd, NULL, NULL, NULL, 0},
- {"pending", ChanPendingObjCmd, NULL, NULL, NULL, 0}, /* TIP #287 */
- {"pop", TclChanPopObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
- {"postevent", TclChanPostEventObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */
- {"push", TclChanPushObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */
- {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
- {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
- {"seek", Tcl_SeekObjCmd, NULL, NULL, NULL, 0},
- {"pipe", ChanPipeObjCmd, NULL, NULL, NULL, 0}, /* TIP #304 */
- {"tell", Tcl_TellObjCmd, NULL, NULL, NULL, 0},
- {"truncate", ChanTruncateObjCmd, NULL, NULL, NULL, 0}, /* TIP #208 */
+ {"blocked", Tcl_FblockedObjCmd},
+ {"close", Tcl_CloseObjCmd},
+ {"copy", Tcl_FcopyObjCmd},
+ {"create", TclChanCreateObjCmd}, /* TIP #219 */
+ {"eof", Tcl_EofObjCmd},
+ {"event", Tcl_FileEventObjCmd},
+ {"flush", Tcl_FlushObjCmd},
+ {"gets", Tcl_GetsObjCmd},
+ {"names", TclChannelNamesCmd},
+ {"pending", ChanPendingObjCmd}, /* TIP #287 */
+ {"pop", TclChanPopObjCmd}, /* TIP #230 */
+ {"postevent", TclChanPostEventObjCmd}, /* TIP #219 */
+ {"push", TclChanPushObjCmd}, /* TIP #230 */
+ {"puts", Tcl_PutsObjCmd},
+ {"read", Tcl_ReadObjCmd},
+ {"seek", Tcl_SeekObjCmd},
+ {"pipe", ChanPipeObjCmd}, /* TIP #304 */
+ {"tell", Tcl_TellObjCmd},
+ {"truncate", ChanTruncateObjCmd}, /* TIP #208 */
{NULL, NULL, NULL, NULL, NULL, 0}
};
static const char *const extras[] = {
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 3751d6c..b3e3fde 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2381,7 +2381,7 @@ ErrnoReturn(
if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
|| (code >= 0))) {
if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
- code = - EAGAIN;
+ code = -EAGAIN;
} else {
code = 0;
}
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index f888bde..ec3a266 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -440,7 +440,7 @@ static const char *msg_dstlost =
* information waiting in buffers (fileevent support).
*/
-#define FLUSH_DELAY (5)
+#define FLUSH_DELAY (5)
/*
* Helper functions encapsulating some of the thread forwarding to make the
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 5af63b2..0bf3be1 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -136,9 +136,8 @@ TclCleanupLiteralTable(
typePtr->freeIntRepProc(objPtr);
didOne = 1;
break;
- } else {
- entryPtr = nextPtr;
}
+ entryPtr = nextPtr;
}
} while (didOne);
}
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index b241838..7edb192 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -362,6 +362,7 @@ Tcl_QueueEvent(
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
QueueEvent(tsdPtr, evPtr, position);
}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 705a141..ff7cdd6 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -479,11 +479,11 @@ Tcl_ParseCommand(
if ((code != TCL_OK) || nakedbs) {
/*
- * Some list element could not be parsed, or contained
- * naked backslashes. This means the literal string was
- * not in fact a valid nor canonical list. Defer the
- * handling of this to compile/eval time, where code is
- * already in place to report the "attempt to expand a
+ * Some list element could not be parsed, or contained
+ * naked backslashes. This means the literal string was
+ * not in fact a valid nor canonical list. Defer the
+ * handling of this to compile/eval time, where code is
+ * already in place to report the "attempt to expand a
* non-list" error or expand lists that require
* substitution.
*/
@@ -1103,7 +1103,7 @@ ParseTokens(
}
/*
- * This is a variable reference. Call Tcl_ParseVarName to do all
+ * This is a variable reference. Call Tcl_ParseVarName to do all
* the dirty work of parsing the name.
*/
@@ -1127,7 +1127,7 @@ ParseTokens(
}
/*
- * Command substitution. Call Tcl_ParseCommand recursively (and
+ * Command substitution. Call Tcl_ParseCommand recursively (and
* repeatedly) to parse the nested command(s), then throw away the
* parse information.
*/
@@ -1875,10 +1875,10 @@ Tcl_ParseQuotedString(
* None.
*
* Side effects:
-
* The Tcl_Parse struct '*parsePtr' is filled with parse results.
* The caller is expected to eventually call Tcl_FreeParse() to properly
* cleanup the value written there.
+ *
* If a parse error occurs, the Tcl_InterpState value '*statePtr' is
* filled with the state created by that error. When *statePtr is written
* to, the caller is expected to make the required calls to either
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 142cdd4..956a9f0 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -40,9 +40,10 @@
/*
* Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
* This is an escape hatch in case the changes have some unexpected unwelcome
- * impact on performance. If things go well, this mechanism can go away when
+ * impact on performance. If things go well, this mechanism can go away when
* post-8.6 development begins.
*/
+
#define COMPAT 0
/*
@@ -141,7 +142,7 @@ typedef struct String {
((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
-
+
/*
* TCL STRING GROWTH ALGORITHM
*
@@ -186,11 +187,13 @@ GrowStringBuffer(
int needed,
int flag)
{
- /* Pre-conditions:
+ /*
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->allocated
* flag || objPtr->bytes != NULL
*/
+
String *stringPtr = GET_STRING(objPtr);
char *ptr = NULL;
int attempt;
@@ -208,15 +211,20 @@ GrowStringBuffer(
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
+
unsigned int limit = INT_MAX - needed;
unsigned int extra = needed - objPtr->length + TCL_GROWTH_MIN_ALLOC;
int growth = (int) ((extra > limit) ? limit : extra);
+
attempt = needed + growth;
ptr = attemptckrealloc(objPtr->bytes, (unsigned) attempt + 1);
}
}
if (ptr == NULL) {
- /* First allocation - just big enough; or last chance fallback. */
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
attempt = needed;
ptr = ckrealloc(objPtr->bytes, (unsigned) attempt + 1);
}
@@ -229,16 +237,21 @@ GrowUnicodeBuffer(
Tcl_Obj *objPtr,
int needed)
{
- /* Pre-conditions:
+ /*
+ * Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
* needed < STRING_MAXCHARS
*/
+
String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
int attempt;
if (stringPtr->maxChars > 0) {
- /* Subsequent appends - apply the growth algorithm. */
+ /*
+ * Subsequent appends - apply the growth algorithm.
+ */
+
attempt = 2 * needed;
if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
ptr = stringAttemptRealloc(stringPtr, attempt);
@@ -248,16 +261,21 @@ GrowUnicodeBuffer(
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
+
unsigned int limit = STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
+ TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
int growth = (int) ((extra > limit) ? limit : extra);
+
attempt = needed + growth;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
- /* First allocation - just big enough; or last chance fallback. */
+ /*
+ * First allocation - just big enough; or last chance fallback.
+ */
+
attempt = needed;
ptr = stringRealloc(stringPtr, attempt);
}
@@ -473,7 +491,10 @@ Tcl_GetCharLength(
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars;
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (numChars == -1) {
TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
@@ -481,8 +502,8 @@ Tcl_GetCharLength(
#if COMPAT
if (numChars < objPtr->length) {
/*
- * Since we've just computed the number of chars, and not all
- * UTF chars are 1-byte long, go ahead and populate the unicode
+ * Since we've just computed the number of chars, and not all UTF
+ * chars are 1-byte long, go ahead and populate the unicode
* string.
*/
@@ -538,7 +559,10 @@ Tcl_GetUniChar(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
@@ -669,14 +693,20 @@ Tcl_GetRange(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
- /* If numChars is unknown, compute it. */
+ /*
+ * If numChars is unknown, compute it.
+ */
+
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
- /* Since we know the char length of the result, store it. */
+ /*
+ * Since we know the char length of the result, store it.
+ */
+
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars = newObjPtr->length;
@@ -832,14 +862,17 @@ Tcl_SetObjLength(
stringPtr->maxChars = length;
}
- /* Mark the new end of the unicode string */
+ /*
+ * Mark the new end of the unicode string
+ */
+
stringPtr->numChars = length;
stringPtr->unicode[length] = 0;
stringPtr->hasUnicode = 1;
/*
- * Can only get here when objPtr->bytes == NULL.
- * No need to invalidate the string rep.
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
*/
}
}
@@ -879,9 +912,10 @@ Tcl_AttemptSetObjLength(
if (length < 0) {
/*
- * Setting to a negative length is nonsense. This is probably the
+ * Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
+
return 0;
}
if (Tcl_IsShared(objPtr)) {
@@ -902,6 +936,7 @@ Tcl_AttemptSetObjLength(
/*
* Need to enlarge the buffer.
*/
+
char *newBytes;
if (objPtr->bytes == tclEmptyStringRep) {
@@ -942,14 +977,17 @@ Tcl_AttemptSetObjLength(
stringPtr->maxChars = length;
}
- /* Mark the new end of the unicode string */
+ /*
+ * Mark the new end of the unicode string.
+ */
+
stringPtr->unicode[length] = 0;
stringPtr->numChars = length;
stringPtr->hasUnicode = 1;
/*
- * Can only get here when objPtr->bytes == NULL.
- * No need to invalidate the string rep.
+ * Can only get here when objPtr->bytes == NULL. No need to invalidate
+ * the string rep.
*/
}
return 1;
@@ -1370,12 +1408,14 @@ AppendUnicodeToUnicodeRep(
stringCheckLimits(numChars);
if (numChars > stringPtr->maxChars) {
+ int offset = -1;
+
/*
* Protect against case where unicode points into the existing
- * stringPtr->unicode array. Force it to follow any relocations
- * due to the reallocs below.
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- int offset = -1;
+
if (unicode >= stringPtr->unicode
&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
offset = unicode - stringPtr->unicode;
@@ -1384,7 +1424,10 @@ AppendUnicodeToUnicodeRep(
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
- /* Relocate unicode if needed; see above. */
+ /*
+ * Relocate unicode if needed; see above.
+ */
+
if (offset >= 0) {
unicode = stringPtr->unicode + offset;
}
@@ -1436,7 +1479,10 @@ AppendUnicodeToUtfRep(
}
#if COMPAT
- /* Invalidate the unicode rep */
+ /*
+ * Invalidate the unicode rep.
+ */
+
stringPtr->hasUnicode = 0;
#endif
}
@@ -1448,7 +1494,7 @@ AppendUnicodeToUtfRep(
*
* This function converts the contents of "bytes" to Unicode and appends
* the Unicode to the Unicode rep of "objPtr". objPtr must already have a
- * valid Unicode rep. numBytes must be non-negative.
+ * valid Unicode rep. numBytes must be non-negative.
*
* Results:
* None.
@@ -1524,22 +1570,30 @@ AppendUtfToUtfRep(
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
+ int offset = -1;
+
/*
* Protect against case where unicode points into the existing
- * stringPtr->unicode array. Force it to follow any relocations
- * due to the reallocs below.
+ * stringPtr->unicode array. Force it to follow any relocations due to
+ * the reallocs below.
*/
- int offset = -1;
+
if (bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
- /* TODO: consider passing flag=1: no overalloc on first append.
- * This would make test stringObj-8.1 fail.*/
+ /*
+ * TODO: consider passing flag=1: no overalloc on first append. This
+ * would make test stringObj-8.1 fail.
+ */
+
GrowStringBuffer(objPtr, newLength, 0);
- /* Relocate bytes if needed; see above. */
+ /*
+ * Relocate bytes if needed; see above.
+ */
+
if (offset >= 0) {
bytes = objPtr->bytes + offset;
}
@@ -1587,6 +1641,7 @@ Tcl_AppendStringsToObjVA(
while (1) {
const char *bytes = va_arg(argList, char *);
+
if (bytes == NULL) {
break;
}
@@ -2070,8 +2125,7 @@ Tcl_AppendFormatToObj(
case 'b': {
Tcl_WideUInt bits = (Tcl_WideUInt) 0;
Tcl_WideInt numDigits = (Tcl_WideInt) 0;
- int length, numBits = 4, base = 16;
- int index = 0, shift = 0;
+ int length, numBits = 4, base = 16, index = 0, shift = 0;
Tcl_Obj *pure;
char *bytes;
@@ -2355,6 +2409,7 @@ Tcl_Format(
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
+
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
@@ -2400,7 +2455,6 @@ AppendPrintfToObjVA(
}
do {
switch (*p) {
-
case '\0':
seekingConversion = 0;
break;
@@ -2453,11 +2507,11 @@ AppendPrintfToObjVA(
case -1:
case 0:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- (long int)va_arg(argList, int)));
+ (long) va_arg(argList, int)));
break;
case 1:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- va_arg(argList, long int)));
+ va_arg(argList, long)));
break;
}
break;
@@ -2471,7 +2525,7 @@ AppendPrintfToObjVA(
seekingConversion = 0;
break;
case '*':
- lastNum = (int)va_arg(argList, int);
+ lastNum = (int) va_arg(argList, int);
Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
p++;
break;
@@ -2573,8 +2627,8 @@ Tcl_ObjPrintf(
*
* Results:
* An unshared Tcl value which is the [string reverse] of the argument
- * supplied. When sharing rules permit, the returned value might be
- * the argument with modifications done in place.
+ * supplied. When sharing rules permit, the returned value might be the
+ * argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
@@ -2602,7 +2656,10 @@ TclStringObjReverse(
return objPtr;
}
if (stringPtr->numChars == objPtr->length) {
- /* All one-byte chars. Reverse in objPtr->bytes. */
+ /*
+ * All one-byte chars. Reverse in objPtr->bytes.
+ */
+
if (Tcl_IsShared(objPtr)) {
resultPtr = Tcl_NewObj();
Tcl_SetObjLength(resultPtr, objPtr->length);
@@ -2613,11 +2670,16 @@ TclStringObjReverse(
}
return resultPtr;
}
- /* Unshared. Reverse objPtr->bytes in place. */
+
+ /*
+ * Unshared. Reverse objPtr->bytes in place.
+ */
+
dest = objPtr->bytes;
src = dest + objPtr->length - 1;
while (dest < src) {
char tmp = *src;
+
*src-- = *dest;
*dest++ = tmp;
}
@@ -2630,7 +2692,10 @@ TclStringObjReverse(
return objPtr;
}
- /* Reverse the Unicode rep. */
+ /*
+ * Reverse the Unicode rep.
+ */
+
if (Tcl_IsShared(objPtr)) {
Tcl_UniChar ch = 0;
@@ -2649,11 +2714,15 @@ TclStringObjReverse(
return resultPtr;
}
- /* Unshared. Reverse objPtr->bytes in place. */
+ /*
+ * Unshared. Reverse objPtr->bytes in place.
+ */
+
udest = stringPtr->unicode;
usrc = udest + stringPtr->numChars - 1;
while (udest < usrc) {
Tcl_UniChar tmp = *usrc;
+
*usrc-- = *udest;
*udest++ = tmp;
}
@@ -2686,6 +2755,7 @@ FillUnicodeRep(
* rep. */
{
String *stringPtr = GET_STRING(objPtr);
+
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
stringPtr->numChars);
}
@@ -2754,15 +2824,17 @@ DupStringInternalRep(
#if COMPAT==0
if (srcStringPtr->numChars == -1) {
/*
- * The String struct in the source value holds zero useful data.
- * Don't bother copying it. Don't even bother allocating space in
- * which to copy it. Just let the copy be untyped.
+ * The String struct in the source value holds zero useful data. Don't
+ * bother copying it. Don't even bother allocating space in which to
+ * copy it. Just let the copy be untyped.
*/
+
return;
}
if (srcStringPtr->hasUnicode) {
int copyMaxChars;
+
if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
copyMaxChars = 2 * srcStringPtr->numChars;
} else {
@@ -2782,12 +2854,13 @@ DupStringInternalRep(
copyStringPtr->numChars = srcStringPtr->numChars;
/*
- * Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that
- * might exist in the source object.
+ * Tricky point: the string value was copied by generic object management
+ * code, so it doesn't contain any extra bytes that might exist in the
+ * source object.
*/
+
copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
-#else
+#else /* COMPAT!=0 */
/*
* If the src obj is a string of 1-byte Utf chars, then copy the string
* rep of the source object and create an "empty" Unicode internal rep for
@@ -2796,7 +2869,10 @@ DupStringInternalRep(
*/
if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
- /* Copy the full allocation for the Unicode buffer. */
+ /*
+ * Copy the full allocation for the Unicode buffer.
+ */
+
copyStringPtr = stringAlloc(srcStringPtr->maxChars);
copyStringPtr->maxChars = srcStringPtr->maxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
@@ -2807,16 +2883,18 @@ DupStringInternalRep(
copyStringPtr = stringAlloc(0);
copyStringPtr->unicode[0] = 0;
copyStringPtr->maxChars = 0;
+
/*
* Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that
- * might exist in the source object.
+ * management code, so it doesn't contain any extra bytes that might
+ * exist in the source object.
*/
+
copyStringPtr->allocated = copyPtr->length;
}
copyStringPtr->numChars = srcStringPtr->numChars;
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-#endif
+#endif /* COMPAT==0 */
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
@@ -2848,7 +2926,7 @@ SetStringFromAny(
String *stringPtr = stringAlloc(0);
/*
- * Convert whatever we have into an untyped value. Just A String.
+ * Convert whatever we have into an untyped value. Just A String.
*/
(void) TclGetString(objPtr);
@@ -2892,6 +2970,7 @@ UpdateStringOfString(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
String *stringPtr = GET_STRING(objPtr);
+
if (stringPtr->numChars == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {
@@ -2906,10 +2985,12 @@ ExtendStringRepWithUnicode(
const Tcl_UniChar *unicode,
int numChars)
{
+ /*
+ * Pre-condition: this is the "string" Tcl_ObjType.
+ */
+
int i, origLength, size = 0;
char *dst, buf[TCL_UTF_MAX];
-
- /* Pre-condition: this is the "string" Tcl_ObjType */
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {
@@ -2925,7 +3006,10 @@ ExtendStringRepWithUnicode(
}
size = origLength = objPtr->length;
- /* Quick cheap check in case we have more than enough room. */
+ /*
+ * Quick cheap check in case we have more than enough room.
+ */
+
if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
@@ -2938,12 +3022,15 @@ ExtendStringRepWithUnicode(
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- /* Grow space if needed */
+ /*
+ * Grow space if needed.
+ */
+
if (size > stringPtr->allocated) {
GrowStringBuffer(objPtr, size, 1);
}
- copyBytes:
+ copyBytes:
dst = objPtr->bytes + origLength;
for (i = 0; i < numChars; i++) {
dst += Tcl_UniCharToUtf((int) unicode[i], dst);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index d77c276..c3c340b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1952,6 +1952,7 @@ Tcl_DStringResult(
* result of interp. */
{
Interp *iPtr = (Interp *) interp;
+
Tcl_ResetResult(interp);
if (dsPtr->string != dsPtr->staticSpace) {
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 7f17bc7..6dabd44 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -122,30 +122,30 @@ typedef struct {
* Prototypes for private procedures defined later in this file:
*/
-static Tcl_CmdDeleteProc ZlibStreamCmdDelete;
-static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
-static Tcl_DriverCloseProc ZlibTransformClose;
-static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
-static Tcl_DriverGetOptionProc ZlibTransformGetOption;
-static Tcl_DriverHandlerProc ZlibTransformHandler;
-static Tcl_DriverInputProc ZlibTransformInput;
-static Tcl_DriverOutputProc ZlibTransformOutput;
-static Tcl_DriverSetOptionProc ZlibTransformSetOption;
-static Tcl_DriverWatchProc ZlibTransformWatch;
-static Tcl_ObjCmdProc ZlibCmd;
-static Tcl_ObjCmdProc ZlibStreamCmd;
-
-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 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 void ZlibTransformTimerRun(ClientData clientData);
-static void ZlibTransformTimerSetup(ZlibChannelData *cd);
+static Tcl_CmdDeleteProc ZlibStreamCmdDelete;
+static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
+static Tcl_DriverCloseProc ZlibTransformClose;
+static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
+static Tcl_DriverGetOptionProc ZlibTransformGetOption;
+static Tcl_DriverHandlerProc ZlibTransformHandler;
+static Tcl_DriverInputProc ZlibTransformInput;
+static Tcl_DriverOutputProc ZlibTransformOutput;
+static Tcl_DriverSetOptionProc ZlibTransformSetOption;
+static Tcl_DriverWatchProc ZlibTransformWatch;
+static Tcl_ObjCmdProc ZlibCmd;
+static Tcl_ObjCmdProc ZlibStreamCmd;
+
+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 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 void ZlibTransformTimerRun(ClientData clientData);
+static void ZlibTransformTimerSetup(ZlibChannelData *cd);
/*
* Type of zlib-based compressing and decompressing channels.
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index fe80272..2eb43a6 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.3.2 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.3 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 15b7293..ad61f9c 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
- variable Version 2.3.2
+ variable Version 2.3.3
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -795,6 +795,29 @@ namespace eval tcltest {
trace variable Option(-errfile) w \
[namespace code {errorChannel $Option(-errfile) ;#}]
+ proc loadIntoSlaveInterpreter {slave args} {
+ variable Version
+ interp eval $slave [list set ::argv $args]
+ interp eval $slave [list package require tcltest $Version]
+ interp alias $slave ::tcltest::ReportToMaster \
+ {} ::tcltest::ReportedFromSlave
+ }
+ proc ReportedFromSlave {total passed skipped failed because newfiles} {
+ variable numTests
+ variable skippedBecause
+ variable createdNewFiles
+ incr numTests(Total) $total
+ incr numTests(Passed) $passed
+ incr numTests(Skipped) $skipped
+ incr numTests(Failed) $failed
+ foreach {constraint count} $because {
+ incr skippedBecause($constraint) $count
+ }
+ foreach {testfile created} $newfiles {
+ lappend createdNewFiles($testfile) {*}$created
+ }
+ return
+ }
}
#####################################################################
@@ -2354,6 +2377,14 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
FillFilesExisted
set testFileName [file tail [info script]]
+ # Hook to handle reporting to a parent interpreter
+ if {[llength [info commands [namespace current]::ReportToMaster]]} {
+ ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
+ $numTests(Failed) [array get skippedBecause] \
+ [array get createdNewFiles]
+ set testSingleFile false
+ }
+
# Call the cleanup hook
cleanupTestsHook
diff --git a/tests/incr.test b/tests/incr.test
index 253cb1d..9243be0 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -1,51 +1,56 @@
# Commands covered: incr
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+unset -nocomplain x i
+proc readonly varName {
+ upvar 1 $varName var
+ trace add variable var write \
+ {apply {{args} {error "variable is read-only"}}}
+}
+
# Basic "incr" operation.
-catch {unset x}
-catch {unset i}
-
-test incr-1.1 {TclCompileIncrCmd: missing variable name} {
- list [catch {incr} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body {
+ incr
+} -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.2 {TclCompileIncrCmd: simple variable name} {
set i 10
list [incr i] $i
} {11 11}
-test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
+test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body {
set i 10
- catch {incr "i"xxx} msg
- set msg
-} {extra characters after close-quote}
+ incr "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
set i 17
list [incr "i"] $i
} {18 18}
-test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
- catch {unset {a simple var}}
+test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup {
+ unset -nocomplain {a simple var}
+} -body {
set {a simple var} 27
list [incr {a simple var}] ${a simple var}
-} {28 28}
-test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
- catch {unset a}
+} -result {28 28}
+test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup {
+ unset -nocomplain a
+} -body {
set a(foo) 37
list [incr a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
set x "i"
set i 77
@@ -56,7 +61,6 @@ test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
set i 77
list [incr [set x] +2] $i
} {79 79}
-
test incr-1.9 {TclCompileIncrCmd: increment given} {
set i 10
list [incr i +07] $i
@@ -65,7 +69,6 @@ test incr-1.10 {TclCompileIncrCmd: no increment given} {
set i 10
list [incr i] $i
} {11 11}
-
test incr-1.11 {TclCompileIncrCmd: simple global name} {
proc p {} {
global i
@@ -147,22 +150,23 @@ test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
}
260locals
} {1}
-test incr-1.15 {TclCompileIncrCmd: variable is array} {
- catch {unset a}
+test incr-1.15 {TclCompileIncrCmd: variable is array} -setup {
+ unset -nocomplain a
+} -body {
set a(foo) 27
- set x [incr a(foo) 11]
- catch {unset a}
- set x
-} 38
-test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
- catch {unset a}
+ incr a(foo) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
+test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup {
+ unset -nocomplain a
+} -body {
set i 5
set a(foo5) 27
- set x [incr a(foo$i) 11]
- catch {unset a}
- set x
-} 38
-
+ incr a(foo$i) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
set i 5
incr i 123
@@ -173,8 +177,8 @@ test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
} -95
test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
set i 5
- catch {incr i [set]} msg
- set ::errorInfo
+ catch {incr i [set]} -> opts
+ dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -194,19 +198,14 @@ test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
incr i 0o00012345 ;# an octal literal
} 5374
-test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
+test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
set i 25
- catch {incr i 1a} msg
- set msg
-} {expected integer but got "1a"}
-
-test incr-1.25 {TclCompileIncrCmd: too many arguments} {
+ incr i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-1.25 {TclCompileIncrCmd: too many arguments} -body {
set i 10
- catch {incr i 10 20} msg
- set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
+ incr i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
unset -nocomplain {"foo}
incr {"foo}
@@ -217,69 +216,68 @@ test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
while *ing
"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
- proc readonly args {error "variable is read-only"}
set x 123
- trace var x w readonly
+ readonly x
list [catch {incr x 1} msg] $msg $::errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+} -match glob -cleanup {
+ unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
"incr x 1"}}
-catch {unset x}
-test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
+test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
set x " - "
- list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got " - "}}
-
-test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
+ incr x 1
+} -returnCodes error -result {expected integer but got " - "}
+test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
catch {unset array}
+} -body {
set array(\$foo) 4
incr {array($foo)}
-} 5
-
+} -result 5
+
# Check "incr" and computed command names.
+unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
set i 5
set z incr
$z i -1
- set i
+ return $i
} 4
-catch {unset x}
-catch {unset i}
-
-test incr-2.1 {incr command (not compiled): missing variable name} {
+test incr-2.1 {incr command (not compiled): missing variable name} -body {
set z incr
- list [catch {$z} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+ $z
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-2.2 {incr command (not compiled): simple variable name} {
set z incr
set i 10
list [$z i] $i
} {11 11}
-test incr-2.3 {incr command (not compiled): error compiling variable name} {
+test incr-2.3 {incr command (not compiled): error compiling variable name} -body {
set z incr
set i 10
- catch {$z "i"xxx} msg
- set msg
-} {extra characters after close-quote}
+ $z "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
set z incr
set i 17
list [$z "i"] $i
} {18 18}
-test incr-2.5 {incr command (not compiled): simple variable name in braces} {
+test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup {
+ unset -nocomplain {a simple var}
+} -body {
set z incr
- catch {unset {a simple var}}
set {a simple var} 27
list [$z {a simple var}] ${a simple var}
-} {28 28}
-test incr-2.6 {incr command (not compiled): simple array variable name} {
+} -result {28 28}
+test incr-2.6 {incr command (not compiled): simple array variable name} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set a(foo) 37
list [$z a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
set z incr
set x "i"
@@ -292,7 +290,6 @@ test incr-2.8 {incr command (not compiled): non-simple (computed) variable name}
set i 77
list [$z [set x] +2] $i
} {79 79}
-
test incr-2.9 {incr command (not compiled): increment given} {
set z incr
set i 10
@@ -303,7 +300,6 @@ test incr-2.10 {incr command (not compiled): no increment given} {
set i 10
list [$z i] $i
} {11 11}
-
test incr-2.11 {incr command (not compiled): simple global name} {
proc p {} {
set z incr
@@ -389,24 +385,25 @@ test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
}
260locals
} {1}
-test incr-2.15 {incr command (not compiled): variable is array} {
+test incr-2.15 {incr command (not compiled): variable is array} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set a(foo) 27
- set x [$z a(foo) 11]
- catch {unset a}
- set x
-} 38
-test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
+ $z a(foo) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
+test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set i 5
set a(foo5) 27
- set x [$z a(foo$i) 11]
- catch {unset a}
- set x
-} 38
-
+ $z a(foo$i) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
test incr-2.17 {incr command (not compiled): increment given, simple int} {
set z incr
set i 5
@@ -420,8 +417,8 @@ test incr-2.18 {incr command (not compiled): increment given, simple int} {
test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
set z incr
set i 5
- catch {$z i [set]} msg
- set ::errorInfo
+ catch {$z i [set]} -> opts
+ dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -445,26 +442,22 @@ test incr-2.23 {incr command (not compiled): increment given, formatted int != i
set i 25
$z i 0o00012345 ;# an octal literal
} 5374
-test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
+test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
set z incr
set i 25
- catch {$z i 1a} msg
- set msg
-} {expected integer but got "1a"}
-
-test incr-2.25 {incr command (not compiled): too many arguments} {
+ $z i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-2.25 {incr command (not compiled): too many arguments} -body {
set z incr
set i 10
- catch {$z i 10 20} msg
- set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
-test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
+ $z i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
+test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
set z incr
$z {"foo}
-} 1
+} -result 1
test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
set z incr
list [catch {$z [set]} msg] $msg $::errorInfo
@@ -473,20 +466,20 @@ test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -
"set"*}}
test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
set z incr
- proc readonly args {error "variable is read-only"}
set x 123
- trace var x w readonly
+ readonly x
list [catch {$z x 1} msg] $msg $::errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+} -match glob -cleanup {
+ unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
"$z x 1"}}
-catch {unset x}
-test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
+test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
set z incr
set x " - "
- list [catch {$z x 1} msg] $msg
-} {1 {expected integer but got " - "}}
+ $z x 1
+} -returnCodes error -result {expected integer but got " - "}
test incr-2.30 {incr command (not compiled): bad increment} {
set z incr
set x 0
@@ -518,7 +511,12 @@ test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
} -cleanup {
rename x {}
} -result 1
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/init.test b/tests/init.test
index 40fa507..62b3af2 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -45,26 +45,22 @@ test init-1.7 {auto_qualify - multiples colons 1} {
test init-1.8 {auto_qualify - multiple colons 2} {
auto_qualify :::foo ::bar
} foo
-
+
# We use a sub-interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-interp eval $testInterp [list set argv $argv]
+tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
interp eval $testInterp {
- package require tcltest 2
namespace import -force ::tcltest::*
customMatch pairwise {apply {{mode pair} {
if {[llength $pair] != 2} {error "need a pair of values to check"}
string $mode [lindex $pair 0] [lindex $pair 1]
}}}
-}
-# TODO: Connect result reporting to master interp
-interp eval $testInterp {
-
-auto_reset
-catch {rename parray {}}
+ auto_reset
+ catch {rename parray {}}
+
test init-2.0 {load parray - stage 1} -body {
parray
} -returnCodes error -cleanup {
@@ -127,12 +123,12 @@ test init-3.0 {random stuff in the auto_index, should still work} {
set count 0
foreach arg [subst -nocommands -novariables {
- c
- {argument
+ c
+ {argument
which spans
multiple lines}
- {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
- {argument which spans multiple lines
+ {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
+ {argument which spans multiple lines
and is long enough to be truncated and
" <- includes a false lead in the prune point search
and must be longer still to force truncation}
@@ -141,13 +137,13 @@ foreach arg [subst -nocommands -novariables {
error stack cannot be uniquely determined.
foo bar foo
"}
- {contrived example: rare circumstance
+ {contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar
"}
- {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
- }] {
+ {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
+ }] { ;# emacs needs -> "
test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
auto_reset
diff --git a/tests/package.test b/tests/package.test
index dbeedb7..55aaf2b 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -19,11 +19,9 @@ if {"::tcltest" ni [namespace children]} {
# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
-interp eval $i [list set argv $argv]
-interp eval $i [list package require tcltest 2]
-interp eval $i [list namespace import -force ::tcltest::*]
+tcltest::loadIntoSlaveInterpreter $i {*}$argv
interp eval $i {
-
+namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index bba6f91..20ba896 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -836,8 +836,8 @@ install-libraries: libraries
done;
@echo "Installing package msgcat 1.4.3 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.3.tm;
- @echo "Installing package tcltest 2.3.2 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.2.tm;
+ @echo "Installing package tcltest 2.3.3 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.3.tm;
@echo "Installing package platform 1.0.9 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.9.tm;
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 9214345..c71ccd0 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -47,7 +47,7 @@
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
-#endif
+#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
#include <fts.h>
#endif
@@ -112,7 +112,7 @@ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
extern TclFileAttrProcs tclpFileAttrProcs[];
extern const char *const tclpFileAttrStrings[];
-#else
+#else /* !DJGPP */
enum {
UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
@@ -152,7 +152,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
{TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
#endif
};
-#endif
+#endif /* DJGPP */
/*
* This is the maximum number of consecutive readdir/unlink calls that can be
@@ -183,11 +183,13 @@ static int DoRemoveDirectory(Tcl_DString *pathPtr,
int recursive, Tcl_DString *errorPtr);
static int DoRenameFile(const char *src, const char *dst);
static int TraversalCopy(Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr,
- int type, Tcl_DString *errorPtr);
+ Tcl_DString *dstPtr,
+ const Tcl_StatBuf *statBufPtr, int type,
+ Tcl_DString *errorPtr);
static int TraversalDelete(Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, const Tcl_StatBuf *statBufPtr,
- int type, Tcl_DString *errorPtr);
+ Tcl_DString *dstPtr,
+ const Tcl_StatBuf *statBufPtr, int type,
+ Tcl_DString *errorPtr);
static int TraverseUnixTree(TraversalProc *traversalProc,
Tcl_DString *sourcePtr, Tcl_DString *destPtr,
Tcl_DString *errorPtr, int doRewind);
@@ -211,8 +213,8 @@ Realpath(
return realpath(path, resolved);
}
#else
-#define Realpath realpath
-#endif
+# define Realpath realpath
+#endif /* PURIFY */
#ifndef NO_REALPATH
#if defined(__APPLE__) && defined(TCL_THREADS) && \
@@ -225,16 +227,16 @@ Realpath(
*/
MODULE_SCOPE long tclMacOSXDarwinRelease;
-#define haveRealpath (tclMacOSXDarwinRelease >= 7)
+# define haveRealpath (tclMacOSXDarwinRelease >= 7)
#else
-#define haveRealpath 1
+# define haveRealpath 1
#endif
#endif /* NO_REALPATH */
#ifdef HAVE_FTS
#ifdef HAVE_STRUCT_STAT64
/* fts doesn't do stat64 */
-#define noFtsStat 1
+# define noFtsStat 1
#elif defined(__APPLE__) && defined(__LP64__) && \
defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
MAC_OS_X_VERSION_MIN_REQUIRED < 1050
@@ -245,9 +247,9 @@ MODULE_SCOPE long tclMacOSXDarwinRelease;
*/
MODULE_SCOPE long tclMacOSXDarwinRelease;
-#define noFtsStat (tclMacOSXDarwinRelease < 9)
+# define noFtsStat (tclMacOSXDarwinRelease < 9)
#else
-#define noFtsStat 0
+# define noFtsStat 0
#endif
#endif /* HAVE_FTS */
@@ -467,7 +469,7 @@ DoCopyFile(
#endif
break;
}
-#endif
+#endif /* !DJGPP */
case S_IFBLK:
case S_IFCHR:
if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */
@@ -521,7 +523,7 @@ TclUnixCopyFile(
#define BINMODE |O_BINARY
#else
#define BINMODE
-#endif
+#endif /* DJGPP */
#define DEFAULT_COPY_BLOCK_SIZE 4069
@@ -1037,7 +1039,7 @@ TraverseUnixTree(
}
#else /* HAVE_FTS */
paths[0] = source;
- fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR |
+ fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR |
(noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL);
if (fts == NULL) {
errfile = source;
@@ -1096,7 +1098,7 @@ TraverseUnixTree(
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
-#endif /* HAVE_FTS */
+#endif /* !HAVE_FTS */
end:
if (errfile != NULL) {
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 0075d9d..34e1fbb 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -51,13 +51,13 @@ typedef struct FileHandlerEvent {
/*
* The following structure contains a set of select() masks to track readable,
- * writable, and exceptional conditions.
+ * writable, and exception conditions.
*/
typedef struct SelectMasks {
fd_set readable;
fd_set writable;
- fd_set exceptional;
+ fd_set exception;
} SelectMasks;
/*
@@ -170,16 +170,16 @@ static Tcl_Condition notifierCV;
static Tcl_ThreadId notifierThread;
-#endif
+#endif /* TCL_THREADS */
/*
* Static routines defined in this file.
*/
#ifdef TCL_THREADS
-static void NotifierThreadProc(ClientData clientData);
+static void NotifierThreadProc(ClientData clientData);
#endif
-static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
/*
*----------------------------------------------------------------------
@@ -204,6 +204,7 @@ Tcl_InitNotifier(void)
return tclNotifierHooks.initNotifierProc();
} else {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
#ifdef TCL_THREADS
tsdPtr->eventReady = 0;
@@ -229,7 +230,7 @@ Tcl_InitNotifier(void)
}
Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
return tsdPtr;
}
}
@@ -275,7 +276,8 @@ Tcl_FinalizeNotifier(
int result;
if (triggerPipe < 0) {
- Tcl_Panic("Tcl_FinalizeNotifier: notifier pipe not initialized");
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "notifier pipe not initialized");
}
/*
@@ -290,7 +292,8 @@ Tcl_FinalizeNotifier(
*/
if (write(triggerPipe, "q", 1) != 1) {
- Tcl_Panic("Tcl_FinalizeNotifier: unable to write q to triggerPipe");
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "unable to write q to triggerPipe");
}
close(triggerPipe);
while(triggerPipe >= 0) {
@@ -299,7 +302,8 @@ Tcl_FinalizeNotifier(
result = Tcl_JoinThread(notifierThread, NULL);
if (result) {
- Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier thread");
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "unable to join notifier thread");
}
}
@@ -307,10 +311,10 @@ Tcl_FinalizeNotifier(
* Clean up any synchronization objects in the thread local storage.
*/
- Tcl_ConditionFinalize(&(tsdPtr->waitCV));
+ Tcl_ConditionFinalize(&tsdPtr->waitCV);
Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
}
}
@@ -348,7 +352,7 @@ Tcl_AlertNotifier(
tsdPtr->eventReady = 1;
Tcl_ConditionNotify(&tsdPtr->waitCV);
Tcl_MutexUnlock(&notifierMutex);
-#endif
+#endif /* TCL_THREADS */
}
}
@@ -456,7 +460,7 @@ Tcl_CreateFileHandler(
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
@@ -471,19 +475,19 @@ Tcl_CreateFileHandler(
*/
if (mask & TCL_READABLE) {
- FD_SET(fd, &(tsdPtr->checkMasks.readable));
+ FD_SET(fd, &tsdPtr->checkMasks.readable);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.readable));
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
}
if (mask & TCL_WRITABLE) {
- FD_SET(fd, &(tsdPtr->checkMasks.writable));
+ FD_SET(fd, &tsdPtr->checkMasks.writable);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.writable));
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
}
if (mask & TCL_EXCEPTION) {
- FD_SET(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_SET(fd, &tsdPtr->checkMasks.exception);
} else {
- FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_CLR(fd, &tsdPtr->checkMasks.exception);
}
if (tsdPtr->numFdBits <= fd) {
tsdPtr->numFdBits = fd+1;
@@ -525,7 +529,7 @@ Tcl_DeleteFileHandler(
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
- prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return;
}
@@ -539,13 +543,13 @@ Tcl_DeleteFileHandler(
*/
if (filePtr->mask & TCL_READABLE) {
- FD_CLR(fd, &(tsdPtr->checkMasks.readable));
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
}
if (filePtr->mask & TCL_WRITABLE) {
- FD_CLR(fd, &(tsdPtr->checkMasks.writable));
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
}
if (filePtr->mask & TCL_EXCEPTION) {
- FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
+ FD_CLR(fd, &tsdPtr->checkMasks.exception);
}
/*
@@ -556,9 +560,9 @@ Tcl_DeleteFileHandler(
int numFdBits = 0;
for (i = fd-1; i >= 0; i--) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
- || FD_ISSET(i, &(tsdPtr->checkMasks.writable))
- || FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.writable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
numFdBits = i+1;
break;
}
@@ -678,7 +682,6 @@ Tcl_WaitForEvent(
return tclNotifierHooks.waitForEventProc(timePtr);
} else {
FileHandler *filePtr;
- FileHandlerEvent *fileEvPtr;
int mask;
Tcl_Time vTime;
#ifdef TCL_THREADS
@@ -750,7 +753,7 @@ Tcl_WaitForEvent(
* poll. [Bug 1457797]
*/
|| timePtr->usec < 10
-#endif
+#endif /* __APPLE__ && __LP64__ */
)) {
/*
* Cannot emulate a polling select with a polling condition
@@ -784,13 +787,14 @@ Tcl_WaitForEvent(
tsdPtr->onList = 1;
if (write(triggerPipe, "", 1) != 1) {
- Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe");
+ Tcl_Panic("Tcl_WaitForEvent: %s",
+ "unable to write to triggerPipe");
}
}
- FD_ZERO(&(tsdPtr->readyMasks.readable));
- FD_ZERO(&(tsdPtr->readyMasks.writable));
- FD_ZERO(&(tsdPtr->readyMasks.exceptional));
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exception);
if (!tsdPtr->eventReady) {
Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
@@ -816,15 +820,16 @@ Tcl_WaitForEvent(
tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
tsdPtr->onList = 0;
if (write(triggerPipe, "", 1) != 1) {
- Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe");
+ Tcl_Panic("Tcl_WaitForEvent: %s",
+ "unable to write to triggerPipe");
}
}
#else
tsdPtr->readyMasks = tsdPtr->checkMasks;
- numFound = select(tsdPtr->numFdBits, &(tsdPtr->readyMasks.readable),
- &(tsdPtr->readyMasks.writable),
- &(tsdPtr->readyMasks.exceptional), timeoutPtr);
+ numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
+ &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
+ timeoutPtr);
/*
* Some systems don't clear the masks after an error, so we have to do
@@ -832,9 +837,9 @@ Tcl_WaitForEvent(
*/
if (numFound == -1) {
- FD_ZERO(&(tsdPtr->readyMasks.readable));
- FD_ZERO(&(tsdPtr->readyMasks.writable));
- FD_ZERO(&(tsdPtr->readyMasks.exceptional));
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exception);
}
#endif /* TCL_THREADS */
@@ -844,15 +849,14 @@ Tcl_WaitForEvent(
for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
filePtr = filePtr->nextPtr) {
-
mask = 0;
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) {
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
mask |= TCL_READABLE;
}
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) {
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
mask |= TCL_WRITABLE;
}
- if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) {
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
mask |= TCL_EXCEPTION;
}
@@ -866,8 +870,9 @@ Tcl_WaitForEvent(
*/
if (filePtr->readyMask == 0) {
- fileEvPtr = (FileHandlerEvent *)
+ FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
+
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
@@ -913,7 +918,7 @@ NotifierThreadProc(
ThreadSpecificData *tsdPtr;
fd_set readableMask;
fd_set writableMask;
- fd_set exceptionalMask;
+ fd_set exceptionMask;
int fds[2];
int i, numFdBits = 0, receivePipe;
long found;
@@ -921,22 +926,26 @@ NotifierThreadProc(
char buf[2];
if (pipe(fds) != 0) {
- Tcl_Panic("NotifierThreadProc: could not create trigger pipe");
+ Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
}
receivePipe = fds[0];
if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make receive pipe non blocking");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make receive pipe non blocking");
}
if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make trigger pipe non blocking");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make trigger pipe non blocking");
}
if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make receive pipe close-on-exec");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make receive pipe close-on-exec");
}
if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) {
- Tcl_Panic("NotifierThreadProc: could not make trigger pipe close-on-exec");
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make trigger pipe close-on-exec");
}
/*
@@ -960,7 +969,7 @@ NotifierThreadProc(
while (1) {
FD_ZERO(&readableMask);
FD_ZERO(&writableMask);
- FD_ZERO(&exceptionalMask);
+ FD_ZERO(&exceptionMask);
/*
* Compute the logical OR of the select masks from all the waiting
@@ -971,14 +980,14 @@ NotifierThreadProc(
timePtr = NULL;
for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
FD_SET(i, &readableMask);
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
FD_SET(i, &writableMask);
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
- FD_SET(i, &exceptionalMask);
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
+ FD_SET(i, &exceptionMask);
}
}
if (tsdPtr->numFdBits > numFdBits) {
@@ -1005,7 +1014,7 @@ NotifierThreadProc(
}
FD_SET(receivePipe, &readableMask);
- if (select(numFdBits, &readableMask, &writableMask, &exceptionalMask,
+ if (select(numFdBits, &readableMask, &writableMask, &exceptionMask,
timePtr) == -1) {
/*
* Try again immediately on an error.
@@ -1023,19 +1032,19 @@ NotifierThreadProc(
found = 0;
for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
&& FD_ISSET(i, &readableMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.readable));
+ FD_SET(i, &tsdPtr->readyMasks.readable);
found = 1;
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))
+ if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
&& FD_ISSET(i, &writableMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.writable));
+ FD_SET(i, &tsdPtr->readyMasks.writable);
found = 1;
}
- if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))
- && FD_ISSET(i, &exceptionalMask)) {
- FD_SET(i, &(tsdPtr->readyMasks.exceptional));
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exception)
+ && FD_ISSET(i, &exceptionMask)) {
+ FD_SET(i, &tsdPtr->readyMasks.exception);
found = 1;
}
}
@@ -1099,7 +1108,7 @@ NotifierThreadProc(
Tcl_ConditionNotify(&notifierCV);
Tcl_MutexUnlock(&notifierMutex);
- TclpThreadExit (0);
+ TclpThreadExit(0);
}
#endif /* TCL_THREADS */
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 54bff49..fd396f7 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -1,32 +1,31 @@
/*
* tclUnixPort.h --
*
- * This header file handles porting issues that occur because
- * of differences between systems. It reads in UNIX-related
- * header files and sets up UNIX-related macros for Tcl's UNIX
- * core. It should be the only file that contains #ifdefs to
- * handle different flavors of UNIX. This file sets up the
- * union of all UNIX-related things needed by any of the Tcl
- * core files. This file depends on configuration #defines such
- * as NO_DIRENT_H that are set up by the "configure" script.
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in UNIX-related header files and
+ * sets up UNIX-related macros for Tcl's UNIX core. It should be the only
+ * file that contains #ifdefs to handle different flavors of UNIX. This
+ * file sets up the union of all UNIX-related things needed by any of the
+ * Tcl core files. This file depends on configuration #defines such as
+ * NO_DIRENT_H that are set up by the "configure" script.
*
- * Much of the material in this file was originally contributed
- * by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
+ * Much of the material in this file was originally contributed by Karl
+ * Lehenbauer, Mark Diekhans and Peter da Silva.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLUNIXPORT
#define _TCLUNIXPORT
#ifndef MODULE_SCOPE
-#define MODULE_SCOPE extern
+#define MODULE_SCOPE extern
#endif
-
+
/*
*---------------------------------------------------------------------------
* The following sets of #includes and #ifdefs are required to get Tcl to
@@ -54,6 +53,12 @@
# include <dirent.h>
#endif
#endif
+
+/*
+ *---------------------------------------------------------------------------
+ * Parameterize for 64-bit filesystem support.
+ *---------------------------------------------------------------------------
+ */
#ifdef HAVE_STRUCT_DIRENT64
typedef struct dirent64 Tcl_DirEntry;
@@ -80,6 +85,12 @@ typedef off_t Tcl_SeekOffset;
# define TclOSstat stat
# define TclOSlstat lstat
#endif
+
+/*
+ *---------------------------------------------------------------------------
+ * Miscellaneous includes that might be missing.
+ *---------------------------------------------------------------------------
+ */
#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
@@ -116,14 +127,17 @@ typedef off_t Tcl_SeekOffset;
# include "../compat/unistd.h"
#endif
-MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
+MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#include <utime.h>
-
+
/*
- * Socket support stuff: This likely needs more work to parameterize for
- * each system.
+ *---------------------------------------------------------------------------
+ * Socket support stuff: This likely needs more work to parameterize for each
+ * system.
+ *---------------------------------------------------------------------------
*/
+
#include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
#ifndef NO_UNAME
# include <sys/utsname.h> /* uname system call. */
@@ -134,11 +148,13 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifdef NEED_FAKE_RFC2553
# include "../compat/fake-rfc2553.h"
#endif
-
+
/*
- * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we
- * look for an alternative definition. If no other alternative is available
- * we use a reasonable guess.
+ *---------------------------------------------------------------------------
+ * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we look
+ * for an alternative definition. If no other alternative is available we use
+ * a reasonable guess.
+ *---------------------------------------------------------------------------
*/
#ifndef NO_FLOAT_H
@@ -151,74 +167,84 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifndef FLT_MAX
# ifdef MAXFLOAT
-# define FLT_MAX MAXFLOAT
+# define FLT_MAX MAXFLOAT
# else
-# define FLT_MAX 3.402823466E+38F
+# define FLT_MAX 3.402823466E+38F
# endif
#endif
#ifndef FLT_MIN
# ifdef MINFLOAT
-# define FLT_MIN MINFLOAT
+# define FLT_MIN MINFLOAT
# else
-# define FLT_MIN 1.175494351E-38F
+# define FLT_MIN 1.175494351E-38F
# endif
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* NeXT doesn't define O_NONBLOCK, so #define it here if necessary.
+ *---------------------------------------------------------------------------
*/
#ifndef O_NONBLOCK
# define O_NONBLOCK 0x80
#endif
-
+
/*
- * The type of the status returned by wait varies from UNIX system
- * to UNIX system. The macro below defines it:
+ *---------------------------------------------------------------------------
+ * The type of the status returned by wait varies from UNIX system to UNIX
+ * system. The macro below defines it:
+ *---------------------------------------------------------------------------
*/
#ifdef _AIX
-# define WAIT_STATUS_TYPE pid_t
+# define WAIT_STATUS_TYPE pid_t
#else
#ifndef NO_UNION_WAIT
-# define WAIT_STATUS_TYPE union wait
+# define WAIT_STATUS_TYPE union wait
#else
-# define WAIT_STATUS_TYPE int
+# define WAIT_STATUS_TYPE int
#endif
#endif
-
+
/*
- * Supply definitions for macros to query wait status, if not already
- * defined in header files above.
+ *---------------------------------------------------------------------------
+ * Supply definitions for macros to query wait status, if not already defined
+ * in header files above.
+ *---------------------------------------------------------------------------
*/
#ifndef WIFEXITED
-# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
+# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
#endif
#ifndef WEXITSTATUS
-# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif
#ifndef WIFSIGNALED
-# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
+# define WIFSIGNALED(stat) \
+ (((*((int *) &(stat)))) && ((*((int *) &(stat))) \
+ == ((*((int *) &(stat))) & 0x00ff)))
#endif
#ifndef WTERMSIG
-# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
+# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
#endif
#ifndef WIFSTOPPED
-# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
+# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
#endif
#ifndef WSTOPSIG
-# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif
-
+
/*
- * Define constants for waitpid() system call if they aren't defined
- * by a system header file.
+ *---------------------------------------------------------------------------
+ * Define constants for waitpid() system call if they aren't defined by a
+ * system header file.
+ *---------------------------------------------------------------------------
*/
#ifndef WNOHANG
@@ -227,10 +253,12 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifndef WUNTRACED
# define WUNTRACED 2
#endif
-
+
/*
- * Supply macros for seek offsets, if they're not already provided by
- * an include file.
+ *---------------------------------------------------------------------------
+ * Supply macros for seek offsets, if they're not already provided by an
+ * include file.
+ *---------------------------------------------------------------------------
*/
#ifndef SEEK_SET
@@ -242,10 +270,12 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#ifndef SEEK_END
# define SEEK_END 2
#endif
-
+
/*
- * The stuff below is needed by the "time" command. If this system has no
+ *---------------------------------------------------------------------------
+ * The stuff below is needed by the "time" command. If this system has no
* gettimeofday call, then must use times() instead.
+ *---------------------------------------------------------------------------
*/
#ifdef NO_GETTOD
@@ -257,38 +287,45 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#endif
#ifdef GETTOD_NOT_DECLARED
-MODULE_SCOPE int gettimeofday(struct timeval *tp, struct timezone *tzp);
+MODULE_SCOPE int gettimeofday(struct timeval *tp,
+ struct timezone *tzp);
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* Define access mode constants if they aren't already defined.
+ *---------------------------------------------------------------------------
*/
#ifndef F_OK
-# define F_OK 00
+# define F_OK 00
#endif
#ifndef X_OK
-# define X_OK 01
+# define X_OK 01
#endif
#ifndef W_OK
-# define W_OK 02
+# define W_OK 02
#endif
#ifndef R_OK
-# define R_OK 04
+# define R_OK 04
#endif
-
+
/*
- * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't
- * already defined.
+ *---------------------------------------------------------------------------
+ * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't already
+ * defined.
+ *---------------------------------------------------------------------------
*/
#ifndef FD_CLOEXEC
-# define FD_CLOEXEC 1
+# define FD_CLOEXEC 1
#endif
-
+
/*
- * On systems without symbolic links (i.e. S_IFLNK isn't defined)
- * define "lstat" to use "stat" instead.
+ *---------------------------------------------------------------------------
+ * On systems without symbolic links (i.e. S_IFLNK isn't defined) define
+ * "lstat" to use "stat" instead.
+ *---------------------------------------------------------------------------
*/
#ifndef S_IFLNK
@@ -297,264 +334,313 @@ MODULE_SCOPE int gettimeofday(struct timeval *tp, struct timezone *tzp);
# define lstat64 stat64
# define TclOSlstat TclOSstat
#endif
-
+
/*
- * Define macros to query file type bits, if they're not already
- * defined.
+ *---------------------------------------------------------------------------
+ * Define macros to query file type bits, if they're not already defined.
+ *---------------------------------------------------------------------------
*/
#ifndef S_ISREG
# ifdef S_IFREG
-# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
# else
-# define S_ISREG(m) 0
+# define S_ISREG(m) 0
# endif
#endif /* !S_ISREG */
#ifndef S_ISDIR
# ifdef S_IFDIR
-# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
# else
-# define S_ISDIR(m) 0
+# define S_ISDIR(m) 0
# endif
#endif /* !S_ISDIR */
#ifndef S_ISCHR
# ifdef S_IFCHR
-# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
+# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
# else
-# define S_ISCHR(m) 0
+# define S_ISCHR(m) 0
# endif
#endif /* !S_ISCHR */
+
#ifndef S_ISBLK
# ifdef S_IFBLK
-# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
+# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
# else
-# define S_ISBLK(m) 0
+# define S_ISBLK(m) 0
# endif
#endif /* !S_ISBLK */
+
#ifndef S_ISFIFO
# ifdef S_IFIFO
-# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
# else
-# define S_ISFIFO(m) 0
+# define S_ISFIFO(m) 0
# endif
#endif /* !S_ISFIFO */
+
#ifndef S_ISLNK
# ifdef S_IFLNK
-# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
# else
-# define S_ISLNK(m) 0
+# define S_ISLNK(m) 0
# endif
#endif /* !S_ISLNK */
+
#ifndef S_ISSOCK
# ifdef S_IFSOCK
-# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
+# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
# else
-# define S_ISSOCK(m) 0
+# define S_ISSOCK(m) 0
# endif
#endif /* !S_ISSOCK */
-
+
/*
+ *---------------------------------------------------------------------------
* Make sure that MAXPATHLEN and MAXNAMLEN are defined.
+ *---------------------------------------------------------------------------
*/
#ifndef MAXPATHLEN
# ifdef PATH_MAX
-# define MAXPATHLEN PATH_MAX
+# define MAXPATHLEN PATH_MAX
# else
-# define MAXPATHLEN 2048
+# define MAXPATHLEN 2048
# endif
#endif
#ifndef MAXNAMLEN
# ifdef NAME_MAX
-# define MAXNAMLEN NAME_MAX
+# define MAXNAMLEN NAME_MAX
# else
-# define MAXNAMLEN 255
+# define MAXNAMLEN 255
# endif
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* Make sure that L_tmpnam is defined.
+ *---------------------------------------------------------------------------
*/
#ifndef L_tmpnam
-# define L_tmpnam 100
+# define L_tmpnam 100
#endif
-
+
/*
- * The following macro defines the type of the mask arguments to
- * select:
+ *---------------------------------------------------------------------------
+ * The following macro defines the type of the mask arguments to select:
+ *---------------------------------------------------------------------------
*/
#ifndef NO_FD_SET
-# define SELECT_MASK fd_set
+# define SELECT_MASK fd_set
#else /* NO_FD_SET */
# ifndef _AIX
- typedef long fd_mask;
+ typedef long fd_mask;
# endif /* !AIX */
# if defined(_IBMR2)
-# define SELECT_MASK void
+# define SELECT_MASK void
# else /* !defined(_IBMR2) */
-# define SELECT_MASK int
+# define SELECT_MASK int
# endif /* defined(_IBMR2) */
#endif /* !NO_FD_SET */
-
+
/*
+ *---------------------------------------------------------------------------
* Define "NBBY" (number of bits per byte) if it's not already defined.
+ *---------------------------------------------------------------------------
*/
#ifndef NBBY
-# define NBBY 8
+# define NBBY 8
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* The following macro defines the number of fd_masks in an fd_set:
+ *---------------------------------------------------------------------------
*/
#ifndef FD_SETSIZE
# ifdef OPEN_MAX
-# define FD_SETSIZE OPEN_MAX
+# define FD_SETSIZE OPEN_MAX
# else
-# define FD_SETSIZE 256
+# define FD_SETSIZE 256
# endif
#endif /* FD_SETSIZE */
-#if !defined(howmany)
-# define howmany(x, y) (((x)+((y)-1))/(y))
+
+#ifndef howmany
+# define howmany(x, y) (((x)+((y)-1))/(y))
#endif /* !defined(howmany) */
+
#ifndef NFDBITS
-# define NFDBITS NBBY*sizeof(fd_mask)
+# define NFDBITS NBBY*sizeof(fd_mask)
#endif /* NFDBITS */
-#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+
/*
- * Not all systems declare the errno variable in errno.h. so this
- * file does it explicitly. The list of system error messages also
- * isn't generally declared in a header file anywhere.
+ *---------------------------------------------------------------------------
+ * Not all systems declare the errno variable in errno.h. so this file does it
+ * explicitly. The list of system error messages also isn't generally declared
+ * in a header file anywhere.
+ *---------------------------------------------------------------------------
*/
#ifdef NO_ERRNO
extern int errno;
#endif /* NO_ERRNO */
-
+
/*
- * Not all systems declare all the errors that Tcl uses! Provide some
+ *---------------------------------------------------------------------------
+ * Not all systems declare all the errors that Tcl uses! Provide some
* work-arounds...
+ *---------------------------------------------------------------------------
*/
#ifndef EOVERFLOW
# ifdef EFBIG
-# define EOVERFLOW EFBIG
+# define EOVERFLOW EFBIG
# else /* !EFBIG */
-# define EOVERFLOW EINVAL
+# define EOVERFLOW EINVAL
# endif /* EFBIG */
#endif /* EOVERFLOW */
-
+
/*
+ *---------------------------------------------------------------------------
* Variables provided by the C library:
+ *---------------------------------------------------------------------------
*/
#if defined(__APPLE__) && defined(__DYNAMIC__)
# include <crt_externs.h>
-# define environ (*_NSGetEnviron())
-# define USE_PUTENV 1
+# define environ (*_NSGetEnviron())
+# define USE_PUTENV 1
#else
# if defined(_sgi) || defined(__sgi)
-# define environ _environ
+# define environ _environ
# endif
-extern char **environ;
+extern char ** environ;
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* Darwin specifc configure overrides.
+ *---------------------------------------------------------------------------
*/
#ifdef __APPLE__
+
/*
+ *---------------------------------------------------------------------------
* Support for fat compiles: configure runs only once for multiple architectures
+ *---------------------------------------------------------------------------
*/
+
# if defined(__LP64__) && defined (NO_COREFOUNDATION_64)
-# undef HAVE_COREFOUNDATION
-# endif /* __LP64__ && NO_COREFOUNDATION_64 */
+# undef HAVE_COREFOUNDATION
+# endif /* __LP64__ && NO_COREFOUNDATION_64 */
# include <sys/cdefs.h>
# ifdef __DARWIN_UNIX03
-# if __DARWIN_UNIX03
-# undef HAVE_PUTENV_THAT_COPIES
-# else
-# define HAVE_PUTENV_THAT_COPIES 1
-# endif
+# if __DARWIN_UNIX03
+# undef HAVE_PUTENV_THAT_COPIES
+# else
+# define HAVE_PUTENV_THAT_COPIES 1
+# endif
# endif /* __DARWIN_UNIX03 */
+
/*
+ *---------------------------------------------------------------------------
* The termios configure test program relies on the configure script being run
- * from a terminal, which is not the case e.g. when configuring from Xcode.
+ * from a terminal, which is not the case e.g., when configuring from Xcode.
* Since termios is known to be present on all Mac OS X releases since 10.0,
* override the configure defines for serial API here. [Bug 497147]
+ *---------------------------------------------------------------------------
*/
+
# define USE_TERMIOS 1
-# undef USE_TERMIO
-# undef USE_SGTTY
+# undef USE_TERMIO
+# undef USE_SGTTY
+
/*
+ *---------------------------------------------------------------------------
* Include AvailabilityMacros.h here (when available) to ensure any symbolic
* MAC_OS_X_VERSION_* constants passed on the command line are translated.
+ *---------------------------------------------------------------------------
*/
+
# ifdef HAVE_AVAILABILITYMACROS_H
-# include <AvailabilityMacros.h>
+# include <AvailabilityMacros.h>
# endif
+
/*
+ *---------------------------------------------------------------------------
* Support for weak import.
+ *---------------------------------------------------------------------------
*/
+
# ifdef HAVE_WEAK_IMPORT
-# if !defined(HAVE_AVAILABILITYMACROS_H) || !defined(MAC_OS_X_VERSION_MIN_REQUIRED)
-# undef HAVE_WEAK_IMPORT
-# else
-# ifndef WEAK_IMPORT_ATTRIBUTE
-# define WEAK_IMPORT_ATTRIBUTE __attribute__((weak_import))
-# endif
-# endif
+# if !defined(HAVE_AVAILABILITYMACROS_H) || !defined(MAC_OS_X_VERSION_MIN_REQUIRED)
+# undef HAVE_WEAK_IMPORT
+# else
+# ifndef WEAK_IMPORT_ATTRIBUTE
+# define WEAK_IMPORT_ATTRIBUTE __attribute__((weak_import))
+# endif
+# endif
# endif /* HAVE_WEAK_IMPORT */
+
/*
+ *---------------------------------------------------------------------------
* Support for MAC_OS_X_VERSION_MAX_ALLOWED define from AvailabilityMacros.h:
* only use API available in the indicated OS version or earlier.
+ *---------------------------------------------------------------------------
*/
+
# ifdef MAC_OS_X_VERSION_MAX_ALLOWED
-# if MAC_OS_X_VERSION_MAX_ALLOWED < 1050 && defined(__LP64__)
-# undef HAVE_COREFOUNDATION
-# endif
-# if MAC_OS_X_VERSION_MAX_ALLOWED < 1040
-# undef HAVE_OSSPINLOCKLOCK
-# undef HAVE_PTHREAD_ATFORK
-# undef HAVE_COPYFILE
-# endif
-# if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
-# ifdef TCL_THREADS
+# if MAC_OS_X_VERSION_MAX_ALLOWED < 1050 && defined(__LP64__)
+# undef HAVE_COREFOUNDATION
+# endif
+# if MAC_OS_X_VERSION_MAX_ALLOWED < 1040
+# undef HAVE_OSSPINLOCKLOCK
+# undef HAVE_PTHREAD_ATFORK
+# undef HAVE_COPYFILE
+# endif
+# if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
+# ifdef TCL_THREADS
/* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
-# define NO_REALPATH 1
-# endif
-# undef HAVE_LANGINFO
-# endif
+# define NO_REALPATH 1
+# endif
+# undef HAVE_LANGINFO
+# endif
# endif /* MAC_OS_X_VERSION_MAX_ALLOWED */
# if defined(HAVE_COREFOUNDATION) && defined(__LP64__) && \
defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050
-# warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5."
+# warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5."
# endif
+
/*
+ *---------------------------------------------------------------------------
* At present, using vfork() instead of fork() causes execve() to fail
* intermittently on Darwin x86_64. rdar://4685553
+ *---------------------------------------------------------------------------
*/
+
# if defined(__x86_64__) && !defined(FIXED_RDAR_4685553)
-# undef USE_VFORK
+# undef USE_VFORK
# endif /* __x86_64__ */
/* Workaround problems with vfork() when building with llvm-gcc-4.2 */
# if defined (__llvm__) && \
(__GNUC__ > 4 || (__GNUC__ == 4 && (__GNUC_MINOR__ > 2 || \
(__GNUC_MINOR__ == 2 && __GNUC_PATCHLEVEL__ > 0))))
-# undef USE_VFORK
+# undef USE_VFORK
# endif /* __llvm__ */
#endif /* __APPLE__ */
-
+
/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
- * generic and unix-specific parts of Tcl. Some of the macros may override
+ * generic and unix-specific parts of Tcl. Some of the macros may override
* functions declared in tclInt.h.
*---------------------------------------------------------------------------
*/
@@ -569,58 +655,72 @@ typedef int socklen_t;
#else
#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF
#endif
-
+
/*
+ *---------------------------------------------------------------------------
* The following macros have trivial definitions, allowing generic code to
* address platform-specific issues.
+ *---------------------------------------------------------------------------
*/
#define TclpGetPid(pid) ((unsigned long) (pid))
#define TclpReleaseFile(file) /* Nothing. */
-
+
/*
+ *---------------------------------------------------------------------------
* The following defines wrap the system memory allocation routines.
+ *---------------------------------------------------------------------------
*/
-#define TclpSysAlloc(size, isBin) malloc((size_t)size)
-#define TclpSysFree(ptr) free((char*)ptr)
-#define TclpSysRealloc(ptr, size) realloc((char*)ptr, (size_t)size)
-
+#define TclpSysAlloc(size, isBin) malloc((size_t)(size))
+#define TclpSysFree(ptr) free((char *)(ptr))
+#define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size))
+
/*
- * The following macros and declaration wrap the C runtime library
- * functions.
+ *---------------------------------------------------------------------------
+ * The following macros and declaration wrap the C runtime library functions.
+ *---------------------------------------------------------------------------
*/
-#define TclpExit exit
+#define TclpExit exit
#ifdef TCL_THREADS
# undef inet_ntoa
# define inet_ntoa(x) TclpInetNtoa(x)
#endif /* TCL_THREADS */
-/* FIXME */
+/* FIXME - Hyper-enormous platform assumption! */
#ifndef AF_INET6
-#define AF_INET6 10
+# define AF_INET6 10
#endif
-
+
/*
- * Set of MT-safe implementations of some
- * known-to-be-MT-unsafe library calls.
- * Instead of returning pointers to the
- * static storage, those return pointers
+ *---------------------------------------------------------------------------
+ * Set of MT-safe implementations of some known-to-be-MT-unsafe library calls.
+ * Instead of returning pointers to the static storage, those return pointers
* to the TSD data.
+ *---------------------------------------------------------------------------
*/
#include <pwd.h>
#include <grp.h>
-MODULE_SCOPE struct passwd* TclpGetPwNam(const char *name);
-MODULE_SCOPE struct group* TclpGetGrNam(const char *name);
-MODULE_SCOPE struct passwd* TclpGetPwUid(uid_t uid);
-MODULE_SCOPE struct group* TclpGetGrGid(gid_t gid);
-MODULE_SCOPE struct hostent* TclpGetHostByName(const char *name);
-MODULE_SCOPE struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
-MODULE_SCOPE Tcl_Channel TclpMakeTcpClientChannelMode(ClientData tcpSocket, int mode);
-
+MODULE_SCOPE struct passwd * TclpGetPwNam(const char *name);
+MODULE_SCOPE struct group * TclpGetGrNam(const char *name);
+MODULE_SCOPE struct passwd * TclpGetPwUid(uid_t uid);
+MODULE_SCOPE struct group * TclpGetGrGid(gid_t gid);
+MODULE_SCOPE struct hostent * TclpGetHostByName(const char *name);
+MODULE_SCOPE struct hostent * TclpGetHostByAddr(const char *addr,
+ int length, int type);
+MODULE_SCOPE Tcl_Channel TclpMakeTcpClientChannelMode(
+ ClientData tcpSocket, int mode);
#endif /* _TCLUNIXPORT */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c
index 64943c2..71215f4 100644
--- a/unix/tclXtNotify.c
+++ b/unix/tclXtNotify.c
@@ -85,7 +85,7 @@ static void FileProc(ClientData clientData, int *source,
static void NotifierExitHandler(ClientData clientData);
static void TimerProc(ClientData clientData, XtIntervalId *id);
static void CreateFileHandler(int fd, int mask,
- Tcl_FileProc * proc, ClientData clientData);
+ Tcl_FileProc *proc, ClientData clientData);
static void DeleteFileHandler(int fd);
static void SetTimer(CONST86 Tcl_Time * timePtr);
static int WaitForEvent(CONST86 Tcl_Time * timePtr);
@@ -358,7 +358,7 @@ CreateFileHandler(
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->read = 0;
filePtr->write = 0;
diff --git a/win/Makefile.in b/win/Makefile.in
index eaf40d1..a2d855d 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -672,8 +672,8 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing package msgcat 1.4.3 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.3.tm;
- @echo "Installing package tcltest 2.3.2 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.2.tm;
+ @echo "Installing package tcltest 2.3.3 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.3.tm;
@echo "Installing package platform 1.0.9 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.9.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";