diff options
-rw-r--r-- | ChangeLog | 23 | ||||
-rw-r--r-- | generic/tclAlloc.c | 4 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 3 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 6 | ||||
-rw-r--r-- | generic/tclCompile.c | 6 | ||||
-rw-r--r-- | generic/tclEnv.c | 4 | ||||
-rw-r--r-- | generic/tclEvent.c | 1 | ||||
-rw-r--r-- | generic/tclIO.c | 5 | ||||
-rw-r--r-- | generic/tclIOCmd.c | 141 | ||||
-rw-r--r-- | generic/tclIORChan.c | 2 | ||||
-rw-r--r-- | generic/tclIORTrans.c | 2 | ||||
-rw-r--r-- | generic/tclLiteral.c | 3 | ||||
-rw-r--r-- | generic/tclNotify.c | 1 | ||||
-rw-r--r-- | generic/tclParse.c | 16 | ||||
-rw-r--r-- | generic/tclStringObj.c | 209 | ||||
-rw-r--r-- | generic/tclUtil.c | 1 | ||||
-rw-r--r-- | generic/tclZlib.c | 48 | ||||
-rw-r--r-- | library/tcltest/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | library/tcltest/tcltest.tcl | 33 | ||||
-rw-r--r-- | tests/incr.test | 230 | ||||
-rw-r--r-- | tests/init.test | 28 | ||||
-rw-r--r-- | tests/package.test | 6 | ||||
-rw-r--r-- | unix/Makefile.in | 4 | ||||
-rw-r--r-- | unix/tclUnixFCmd.c | 38 | ||||
-rw-r--r-- | unix/tclUnixNotfy.c | 137 | ||||
-rw-r--r-- | unix/tclUnixPort.h | 454 | ||||
-rw-r--r-- | unix/tclXtNotify.c | 4 | ||||
-rw-r--r-- | win/Makefile.in | 4 |
28 files changed, 826 insertions, 589 deletions
@@ -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(¬ifierMutex); -#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(¬ifierMutex); -#endif +#endif /* TCL_THREADS */ } } @@ -348,7 +352,7 @@ Tcl_AlertNotifier( tsdPtr->eventReady = 1; Tcl_ConditionNotify(&tsdPtr->waitCV); Tcl_MutexUnlock(¬ifierMutex); -#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, ¬ifierMutex, 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(¬ifierCV); Tcl_MutexUnlock(¬ifierMutex); - 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"; |