diff options
Diffstat (limited to 'generic')
| -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 |
16 files changed, 266 insertions, 186 deletions
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. |