diff options
author | oehhar <harald.oehlmann@elmicron.de> | 2014-12-17 07:53:41 (GMT) |
---|---|---|
committer | oehhar <harald.oehlmann@elmicron.de> | 2014-12-17 07:53:41 (GMT) |
commit | 691e34c6ccbee85bbd91e420504983345029d5ea (patch) | |
tree | 53724883281fc684d74af9de3e4a0a1bfd56e946 /generic | |
parent | a9606871f5ddb7d6a8cd69f3fa0c41fe8b3c0396 (diff) | |
parent | 2933029b8c2dfc2e4a8bd89cacad8aa53099d5d4 (diff) | |
download | tcl-691e34c6ccbee85bbd91e420504983345029d5ea.zip tcl-691e34c6ccbee85bbd91e420504983345029d5ea.tar.gz tcl-691e34c6ccbee85bbd91e420504983345029d5ea.tar.bz2 |
Merge trunk
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.h | 4 | ||||
-rw-r--r-- | generic/tclCompCmds.c | 13 | ||||
-rw-r--r-- | generic/tclCompCmdsGR.c | 2 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 81 | ||||
-rw-r--r-- | generic/tclCompile.c | 3 | ||||
-rw-r--r-- | generic/tclExecute.c | 14 | ||||
-rw-r--r-- | generic/tclFileName.c | 8 | ||||
-rw-r--r-- | generic/tclIO.c | 266 | ||||
-rw-r--r-- | generic/tclIOGT.c | 31 | ||||
-rw-r--r-- | generic/tclIORTrans.c | 21 | ||||
-rw-r--r-- | generic/tclIOSock.c | 23 | ||||
-rw-r--r-- | generic/tclInt.h | 1 | ||||
-rw-r--r-- | generic/tclOO.h | 2 | ||||
-rw-r--r-- | generic/tclParse.c | 63 |
14 files changed, 377 insertions, 155 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 7531242..fc477f2 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -56,10 +56,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 2 +#define TCL_RELEASE_SERIAL 3 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6.2" +#define TCL_PATCH_LEVEL "8.6.3" /* *---------------------------------------------------------------------------- diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 18f4564..30c1318 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3289,16 +3289,7 @@ TclPushVarName( nameChars = elNameChars = 0; localIndex = -1; - /* - * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether - * curly braces surround the variable name. This really matters for array - * elements to handle things like - * set {x($foo)} 5 - * which raises an undefined var error if we are not careful here. - */ - - if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && - (varTokenPtr->start[0] != '{')) { + if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { /* * A simple variable name. Divide it up into "name" and "elName" * strings. If it is not a local variable, look it up at runtime. @@ -3373,7 +3364,7 @@ TclPushVarName( nameChars = p - varTokenPtr[1].start; elName = p + 1; remainingChars = (varTokenPtr[2].start - p) - 1; - elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2; + elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1; if (remainingChars) { /* diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 9d258fc..98407f7 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -871,7 +871,7 @@ TclCompileLappendCmd( /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; - if (numWords == 1) { + if (numWords < 3) { return TCL_ERROR; } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 94c1bd6..38c1ceb 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -365,7 +365,7 @@ static const unsigned char prec[] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, + 0, /* Unary operator lexemes */ PREC_UNARY, /* UNARY_PLUS */ PREC_UNARY, /* UNARY_MINUS */ @@ -420,7 +420,7 @@ static const unsigned char instruction[] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, + 0, /* Unary operator lexemes */ INST_UPLUS, /* UNARY_PLUS */ INST_UMINUS, /* UNARY_MINUS */ @@ -488,7 +488,7 @@ static const unsigned char Lexeme[] = { typedef struct JumpList { JumpFixup jump; /* Pass this argument to matching calls of - * TclEmitForwardJump() and + * TclEmitForwardJump() and * TclFixupForwardJump(). */ struct JumpList *next; /* Point to next item on the stack */ } JumpList; @@ -838,7 +838,7 @@ ParseExpr( switch (lexeme) { case NUMBER: - case BOOLEAN: + case BOOLEAN: /* * TODO: Consider using a dict or hash to collapse all * duplicate literals into a single representative value. @@ -861,7 +861,7 @@ ParseExpr( start += scanned; numBytes -= scanned; continue; - + default: break; } @@ -1324,7 +1324,7 @@ ParseExpr( nodePtr->mark = MARK_LEFT; nodePtr->left = complete; - /* + /* * The COMMA operator cannot be optimized, since the function * needs all of its arguments, and optimization would reduce the * number. Other binary operators root constant expressions when @@ -1546,7 +1546,7 @@ ConvertTreeToTokens( * Tcl_ParseExpr() we do not change them now. Internally, we can * do better. */ - + int toCopy = tokenPtr->numComponents + 1; if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) { @@ -1562,7 +1562,7 @@ ConvertTreeToTokens( subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; parsePtr->numTokens += toCopy; } else { - /* + /* * Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to * lead, with fields initialized from the leading token, then * copy entire set of word tokens. @@ -1611,7 +1611,7 @@ ConvertTreeToTokens( case COMMA: case COLON: - /* + /* * Historical practice has been to have no Tcl_Tokens for * these operators. */ @@ -1747,7 +1747,7 @@ ConvertTreeToTokens( /* * Before we leave this node/operator/subexpression for the * last time, finish up its tokens.... - * + * * Our current position scanning the string is where the * substring for the subexpression ends. */ @@ -1967,7 +1967,7 @@ ParseLexeme( case 'i': if ((numBytes > 1) && (start[1] == 'n') - && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { + && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { /* * Must make this check so we can tell the difference between the * "in" operator and the "int" function name and the "infinity" @@ -1981,14 +1981,15 @@ ParseLexeme( case 'e': if ((numBytes > 1) && (start[1] == 'q') - && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { + && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { *lexemePtr = STREQ; return 2; } break; case 'n': - if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { + if ((numBytes > 1) + && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) { switch (start[1]) { case 'e': *lexemePtr = STRNEQ; @@ -2003,9 +2004,8 @@ ParseLexeme( literal = Tcl_NewObj(); if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end, TCL_PARSE_NO_WHITESPACE) == TCL_OK) { - if (end < start + numBytes && !isalnum(UCHAR(*end)) - && UCHAR(*end) != '_') { - + if (end < start + numBytes && !TclIsBareword(*end)) { + number: TclInitStringRep(literal, start, end-start); *lexemePtr = NUMBER; @@ -2029,9 +2029,9 @@ ParseLexeme( const char *p = start; while (p < end) { - if (!isalnum(UCHAR(*p++))) { + if (!TclIsBareword(*p++)) { /* - * The number has non-bareword characters, so we + * The number has non-bareword characters, so we * must treat it as a number. */ goto number; @@ -2054,33 +2054,30 @@ ParseLexeme( } } - if (Tcl_UtfCharComplete(start, numBytes)) { - scanned = Tcl_UtfToUniChar(start, &ch); - } else { - char utfBytes[TCL_UTF_MAX]; + /* + * We reject leading underscores in bareword. No sensible reason why. + * Might be inspired by reserved identifier rules in C, which of course + * have no direct relevance here. + */ - memcpy(utfBytes, start, (size_t) numBytes); - utfBytes[numBytes] = '\0'; - scanned = Tcl_UtfToUniChar(utfBytes, &ch); - } - if (!isalnum(UCHAR(ch))) { - *lexemePtr = INVALID; - Tcl_DecrRefCount(literal); - return scanned; - } - end = start; - while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) { - end += scanned; - numBytes -= scanned; - if (Tcl_UtfCharComplete(end, numBytes)) { - scanned = Tcl_UtfToUniChar(end, &ch); + if (!TclIsBareword(*start) || *start == '_') { + if (Tcl_UtfCharComplete(start, numBytes)) { + scanned = Tcl_UtfToUniChar(start, &ch); } else { char utfBytes[TCL_UTF_MAX]; - memcpy(utfBytes, end, (size_t) numBytes); + memcpy(utfBytes, start, (size_t) numBytes); utfBytes[numBytes] = '\0'; scanned = Tcl_UtfToUniChar(utfBytes, &ch); } + *lexemePtr = INVALID; + Tcl_DecrRefCount(literal); + return scanned; + } + end = start; + while (numBytes && TclIsBareword(*end)) { + end += 1; + numBytes -= 1; } *lexemePtr = BAREWORD; if (literalPtr) { @@ -2098,7 +2095,7 @@ ParseLexeme( * TclCompileExpr -- * * This procedure compiles a string containing a Tcl expression into Tcl - * bytecodes. + * bytecodes. * * Results: * None. @@ -2333,7 +2330,7 @@ CompileExprTree( * Use the numWords count we've kept to invoke the function * command with the correct number of arguments. */ - + if (numWords < 255) { TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords); } else { @@ -2427,7 +2424,7 @@ CompileExprTree( const char *bytes = TclGetStringFromObj(literal, &length); int index = TclRegisterNewLiteral(envPtr, bytes, length); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index); - + if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { /* * Would like to do this: @@ -2570,7 +2567,7 @@ TclSingleOpCmd( * * TclSortingOpCmd -- * Implements the commands: - * <, <=, >, >=, ==, eq + * <, <=, >, >=, ==, eq * in the ::tcl::mathop namespace. These commands are defined for * arbitrary number of arguments by computing the AND of the base * operator applied to all neighbor argument pairs. diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 3736498..0f4dfaf 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -4342,10 +4342,11 @@ TclInitAuxDataTypeTable(void) Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS); /* - * There are only three AuxData types at this time, so register them here. + * There are only four AuxData types at this time, so register them here. */ RegisterAuxDataType(&tclForeachInfoType); + RegisterAuxDataType(&tclNewForeachInfoType); RegisterAuxDataType(&tclJumptableInfoType); RegisterAuxDataType(&tclDictUpdateInfoType); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2e03ab4..b9da8fc 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -81,9 +81,7 @@ int tclTraceExec = 0; static const char *const operatorStrings[] = { "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", - "+", "-", "*", "/", "%", "+", "-", "~", "!", - "BUILTIN FUNCTION", "FUNCTION", - "", "", "", "", "", "", "", "", "eq", "ne" + "+", "-", "*", "/", "%", "+", "-", "~", "!" }; /* @@ -5412,8 +5410,8 @@ TEBCresume( s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; - } else if (((valuePtr->typePtr == &tclStringType) - && (value2Ptr->typePtr == &tclStringType))) { + } else if ((valuePtr->typePtr == &tclStringType) + && (value2Ptr->typePtr == &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of * String type. If the char length == byte length, we can do a @@ -5424,7 +5422,9 @@ TEBCresume( s1len = Tcl_GetCharLength(valuePtr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == valuePtr->length) - && (s2len == value2Ptr->length)) { + && (valuePtr->bytes != NULL) + && (s2len == value2Ptr->length) + && (value2Ptr->bytes != NULL)) { s1 = valuePtr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; @@ -9830,7 +9830,7 @@ IllegalExprOperandType( if (opcode == INST_EXPON) { operator = "**"; - } else if (opcode <= INST_STR_NEQ) { + } else if (opcode <= INST_LNOT) { operator = operatorStrings[opcode - INST_LOR]; } diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5d4702b..a7251bb 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -235,9 +235,9 @@ ExtractWinRoot( if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') - && path[3] >= '1' && path[3] <= '4') { + && path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'com[1-4]:?', which is a serial port. + * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { @@ -257,9 +257,9 @@ ExtractWinRoot( } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { - if (path[3] >= '1' && path[3] <= '3') { + if (path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'lpt[1-3]:?' + * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { diff --git a/generic/tclIO.c b/generic/tclIO.c index 9283bf5..2025742 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -155,6 +155,7 @@ static ChannelBuffer * AllocChannelBuffer(int length); static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); +static void ChannelFree(Channel *chanPtr); static void ChannelTimerProc(ClientData clientData); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, @@ -1914,6 +1915,16 @@ TclChannelRelease( } } +static void +ChannelFree( + Channel *chanPtr) +{ + if (chanPtr->refCount == 0) { + ckfree(chanPtr); + return; + } + chanPtr->typePtr = NULL; +} /* *---------------------------------------------------------------------- @@ -2060,7 +2071,7 @@ Tcl_UnstackChannel( */ result = ChanClose(chanPtr, interp); - chanPtr->typePtr = NULL; + ChannelFree(chanPtr); UpdateInterest(statePtr->topChanPtr); @@ -2811,9 +2822,15 @@ FlushChannel( * write in this call, and we've completed the BG flush. * These are the two cases above. If we get here, that means * there is some kind failure in the writable event machinery. - */ + * + * The tls extension indeed suffers from flaws in its channel + * event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca. + * Until that patch is broadly distributed, disable the + * assertion checking here, so that programs using Tcl and + * tls can be debugged. assert(!calledFromAsyncFlush); + */ } } @@ -3012,7 +3029,8 @@ CloseChannel( statePtr->topChanPtr = downChanPtr; downChanPtr->upChanPtr = NULL; - chanPtr->typePtr = NULL; + + ChannelFree(chanPtr); return Tcl_Close(interp, (Tcl_Channel) downChanPtr); } @@ -3023,7 +3041,7 @@ CloseChannel( * stack, make sure to free the ChannelState structure associated with it. */ - chanPtr->typePtr = NULL; + ChannelFree(chanPtr); Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); @@ -4388,6 +4406,21 @@ Tcl_GetsObj( } /* + * If we're sitting ready to read the eofchar, there's no need to + * do it. + */ + + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + SetFlag(statePtr, CHANNEL_EOF); + assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); + assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + + /* TODO: Do we need this? */ + UpdateInterest(chanPtr); + return -1; + } + + /* * A binary version of Tcl_GetsObj. This could also handle encodings that * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion * done on objPtr. @@ -4453,6 +4486,7 @@ Tcl_GetsObj( eof = NULL; inEofChar = statePtr->inEofChar; + ResetFlag(statePtr, CHANNEL_BLOCKED); while (1) { if (dst >= dstEnd) { if (FilterInputBytes(chanPtr, &gs) != 0) { @@ -4604,6 +4638,7 @@ Tcl_GetsObj( dstEnd = eof; SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } if (GotFlag(statePtr, CHANNEL_EOF)) { skip = 0; @@ -4717,6 +4752,13 @@ Tcl_GetsObj( */ done: + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); + /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. @@ -4740,6 +4782,11 @@ Tcl_GetsObj( * end-of-line or end-of-file has been seen. Bytes read from the input * channel return as a ByteArray obj. * + * WARNING! The notion of "binary" used here is different from + * notions of "binary" used in other places. In particular, this + * "binary" routine may be called when an -eofchar is set on the + * channel. + * * Results: * Number of characters accumulated in the object or -1 if error, * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error @@ -4801,6 +4848,7 @@ TclGetsObjBinary( eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r'; + ResetFlag(statePtr, CHANNEL_BLOCKED); while (1) { /* * Subtract the number of bytes that were removed from channel @@ -4827,6 +4875,17 @@ TclGetsObjBinary( if (bufPtr == NULL) { goto restore; } + } else { + /* + * Incoming CHANNEL_STICKY_EOF is filtered out on entry. + * A new CHANNEL_STICKY_EOF set in this routine leads to + * return before coming back here. When we are not dealing + * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an + * empty buffer. Here the buffer is non-empty so we know + * we're a non-EOF */ + + assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + assert ( !GotFlag(statePtr, CHANNEL_EOF) ); } dst = (unsigned char *) RemovePoint(bufPtr); @@ -4868,6 +4927,7 @@ TclGetsObjBinary( SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } if (GotFlag(statePtr, CHANNEL_EOF)) { skip = 0; @@ -4977,6 +5037,11 @@ TclGetsObjBinary( */ done: + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; @@ -5089,6 +5154,12 @@ FilterInputBytes( */ read: + if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) + == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + gsPtr->charsWrote = 0; + gsPtr->rawRead = 0; + return -1; + } if (GetInput(chanPtr) != 0) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; @@ -5101,6 +5172,17 @@ FilterInputBytes( gsPtr->rawRead = 0; return -1; } + } else { + /* + * Incoming CHANNEL_STICKY_EOF is filtered out on entry. + * A new CHANNEL_STICKY_EOF set in this routine leads to + * return before coming back here. When we are not dealing + * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an + * empty buffer. Here the buffer is non-empty so we know + * we're a non-EOF */ + + assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + assert ( !GotFlag(statePtr, CHANNEL_EOF) ); } /* @@ -5179,12 +5261,6 @@ FilterInputBytes( * some more, but avoid blocking on a non-blocking channel. */ - if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) - == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { - gsPtr->charsWrote = 0; - gsPtr->rawRead = 0; - return -1; - } goto read; } } else { @@ -5431,6 +5507,7 @@ Tcl_ReadRaw( /* State info for channel */ int copied = 0; + assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { return -1; } @@ -5462,8 +5539,19 @@ Tcl_ReadRaw( } } - /* Go to the driver if more data needed. */ + /* + * Go to the driver only if we got nothing from pushback. + * Have to do it this way to avoid EOF mis-timings when we + * consider the ability that EOF may not be a permanent + * condition in the driver, and in that case we have to + * synchronize. + */ + if (copied) { + return copied; + } + + /* This test not needed. */ if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); @@ -5486,12 +5574,10 @@ Tcl_ReadRaw( if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } - } else if (copied > 0) { + } else { /* - * nread == 0. Driver is at EOF, but if copied>0 bytes - * from pushback, then we should not signal it yet. + * nread == 0. Driver is at EOF. Let that state filter up. */ - ResetFlag(statePtr, CHANNEL_EOF); } } return copied; @@ -5590,19 +5676,11 @@ DoReadChars( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int factor, copied, copiedNow, result; - Tcl_Encoding encoding; + int copied, copiedNow, result; + Tcl_Encoding encoding = statePtr->encoding; int binaryMode; #define UTF_EXPANSION_FACTOR 1024 - - /* - * This operation should occur at the top of a channel stack. - */ - - chanPtr = statePtr->topChanPtr; - encoding = statePtr->encoding; - factor = UTF_EXPANSION_FACTOR; - TclChannelPreserve((Tcl_Channel)chanPtr); + int factor = UTF_EXPANSION_FACTOR; binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) @@ -5626,6 +5704,36 @@ DoReadChars( } } + /* + * Early out when next read will see eofchar. + * + * NOTE: See DoRead for argument that it's a bug (one we're keeping) + * to have this escape before the one for zero-char read request. + */ + + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + SetFlag(statePtr, CHANNEL_EOF); + assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); + assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + + UpdateInterest(chanPtr); + return 0; + } + + /* Special handling for zero-char read request. */ + if (toRead == 0) { + ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); + UpdateInterest(chanPtr); + return 0; + } + + /* + * This operation should occur at the top of a channel stack. + */ + + chanPtr = statePtr->topChanPtr; + TclChannelPreserve((Tcl_Channel)chanPtr); + /* Must clear the BLOCKED flag here since we check before reading */ ResetFlag(statePtr, CHANNEL_BLOCKED); for (copied = 0; (unsigned) toRead > 0; ) { @@ -5702,6 +5810,11 @@ DoReadChars( * Update the notifier state so we don't block while there is still data * in the buffers. */ + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copied; @@ -6310,7 +6423,7 @@ TranslateInputEOL( SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; - ResetFlag(statePtr, INPUT_SAW_CR); + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } } @@ -6520,6 +6633,14 @@ GetInput( ChannelState *statePtr = chanPtr->state; /* State info for channel */ + /* + * Verify that all callers know better than to call us when + * it's recorded that the next char waiting to be read is the + * eofchar. + */ + + assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + /* * Prevent reading from a dead channel -- a channel that has been closed * but not yet deallocated, which can happen if the exit handler for @@ -6531,18 +6652,24 @@ GetInput( return EINVAL; } - /* - * For a channel at EOF do not bother allocating buffers; there's - * nothing more to read. Avoid calling the driver inputproc in - * case some of them do not react well to additional calls after - * they've reported an eof state.. - * TODO: Candidate for a can't happen panic. + /* + * WARNING: There was once a comment here claiming that it was + * a bad idea to make another call to the inputproc of a channel + * driver when EOF has already been detected on the channel. Through + * much of Tcl's history, this warning was then completely negated + * by having all (most?) read paths clear the EOF setting before + * reaching here. So we had a guard that was never triggered. + * + * Don't be tempted to restore the guard. Even if EOF is set on + * the channel, continue through and call the inputproc again. This + * is the way to enable the ability to [read] again beyond the EOF, + * which seems a strange thing to do, but for which use cases exist + * [Tcl Bug 5adc350683] and which may even be essential for channels + * representing things like ttys or other devices where the stream + * might take the logical form of a series of 'files' separated by + * an EOF condition. */ - if (GotFlag(statePtr, CHANNEL_EOF)) { - return 0; - } - /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a @@ -6552,6 +6679,7 @@ GetInput( if (chanPtr->inQueueHead != NULL) { + /* TODO: Tests to cover this. */ assert(statePtr->inQueueHead == NULL); statePtr->inQueueHead = chanPtr->inQueueHead; @@ -6582,6 +6710,7 @@ GetInput( * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done * to honor dynamic changes of the buffersize made by the user. + * TODO: Tests to cover this. */ if ((bufPtr != NULL) @@ -7099,9 +7228,7 @@ Tcl_Eof( ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ - return (GotFlag(statePtr, CHANNEL_STICKY_EOF) || - (GotFlag(statePtr, CHANNEL_EOF) && - (Tcl_InputBuffered(chan) == 0))) ? 1 : 0; + return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } /* @@ -9488,6 +9615,36 @@ DoRead( ChannelState *statePtr = chanPtr->state; char *p = dst; + assert (bytesToRead >= 0); + + /* + * Early out when we know a read will get the eofchar. + * + * NOTE: This seems to be a bug. The special handling for + * a zero-char read request ought to come first. As coded + * the EOF due to eofchar has distinguishing behavior from + * the EOF due to reported EOF on the underlying device, and + * that seems undesirable. However recent history indicates + * that new inconsistent behavior in a patchlevel has problems + * too. Keep on keeping on for now. + */ + + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + SetFlag(statePtr, CHANNEL_EOF); + assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); + assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + + UpdateInterest(chanPtr); + return 0; + } + + /* Special handling for zero-char read request. */ + if (bytesToRead == 0) { + ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); + UpdateInterest(chanPtr); + return 0; + } + TclChannelPreserve((Tcl_Channel)chanPtr); while (bytesToRead) { /* @@ -9499,16 +9656,6 @@ DoRead( ChannelBuffer *bufPtr = statePtr->inQueueHead; /* - * When there's no buffered data to read, and we're at EOF, - * escape to the caller. - */ - - if (statePtr->flags & CHANNEL_EOF - && (bufPtr == NULL || IsBufferEmpty(bufPtr))) { - break; - } - - /* * Don't read more data if we have what we need. */ @@ -9568,8 +9715,7 @@ DoRead( * 1) We're @EOF because we saw eof char. */ - if (statePtr->inEofChar - && RemovePoint(bufPtr)[0] == statePtr->inEofChar) { + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { UpdateInterest(chanPtr); break; } @@ -9620,17 +9766,33 @@ DoRead( statePtr->inQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); + bufPtr = statePtr->inQueueHead; } if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads) && GotFlag(statePtr, CHANNEL_BLOCKED)) { break; } + + /* + * When there's no buffered data to read, and we're at EOF, + * escape to the caller. + */ + + if (GotFlag(statePtr, CHANNEL_EOF) + && (bufPtr == NULL || IsBufferEmpty(bufPtr))) { + break; + } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); TclChannelRelease((Tcl_Channel)chanPtr); return (int)(p - dst); } diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 9c4347d..58d1a22 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -187,6 +187,7 @@ struct TransformChannelData { Tcl_Channel self; /* Our own Channel handle. */ int readIsFlushed; /* Flag to note whether in.flushProc was * called or not. */ + int eofPending; /* Flag: EOF seen down, not raised up */ int flags; /* Currently CHANNEL_ASYNC or zero. */ int watchMask; /* Current watch/event/interest mask. */ int mode; /* Mode of parent channel, OR'ed combination @@ -292,6 +293,7 @@ TclChannelTransform( Tcl_DStringInit(&ds); Tcl_GetChannelOption(interp, chan, "-blocking", &ds); dataPtr->readIsFlushed = 0; + dataPtr->eofPending = 0; dataPtr->flags = 0; if (ds.string[0] == '0') { dataPtr->flags |= CHANNEL_ASYNC; @@ -624,7 +626,7 @@ TransformInputProc( if (toRead == 0 || dataPtr->self == NULL) { /* - * Catch a no-op. + * Catch a no-op. TODO: Is this a panic()? */ return 0; } @@ -676,6 +678,17 @@ TransformInputProc( if (toRead <= 0) { break; } + if (dataPtr->eofPending) { + /* + * Already saw EOF from downChan; don't ask again. + * NOTE: Could move this up to avoid the last maxRead + * execution. Believe this would still be correct behavior, + * but the test suite tests the whole command callback + * sequence, so leave it unchanged for now. + */ + + break; + } /* * Get bytes from the underlying channel. @@ -711,14 +724,7 @@ TransformInputProc( * on the down channel. */ - if (dataPtr->readIsFlushed) { - /* - * Already flushed, nothing to do anymore. - */ - - break; - } - + dataPtr->eofPending = 1; dataPtr->readIsFlushed = 1; ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF, P_PRESERVE); @@ -746,8 +752,11 @@ TransformInputProc( break; } } /* while toRead > 0 */ - ReleaseData(dataPtr); + if (gotBytes == 0) { + dataPtr->eofPending = 0; + } + ReleaseData(dataPtr); return gotBytes; } @@ -858,6 +867,7 @@ TransformSeekProc( P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; + dataPtr->eofPending = 0; } ReleaseData(dataPtr); @@ -931,6 +941,7 @@ TransformWideSeekProc( P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; + dataPtr->eofPending = 0; } ReleaseData(dataPtr); diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 45ee08d..8baa9ad 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -161,6 +161,7 @@ typedef struct { int mode; /* Mask of R/W mode */ int nonblocking; /* Flag: Channel is blocking or not. */ int readIsDrained; /* Flag: Read buffers are flushed. */ + int eofPending; /* Flag: EOF seen down, but not raised up */ int dead; /* Boolean signal that some operations * should no longer be attempted. */ ResultBuffer result; @@ -1082,6 +1083,10 @@ ReflectInput( bufObj = Tcl_NewByteArrayObj(NULL, toRead); Tcl_IncrRefCount(bufObj); gotBytes = 0; + if (rtPtr->eofPending) { + goto stop; + } + rtPtr->readIsDrained = 0; while (toRead > 0) { /* * Loop until the request is satisfied (or no data available from @@ -1097,6 +1102,11 @@ ReflectInput( goto stop; } + if (rtPtr->eofPending) { + goto stop; + } + + /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then @@ -1165,11 +1175,9 @@ ReflectInput( * Zero returned from Tcl_ReadRaw() always indicates EOF * on the down channel. */ - - if (rtPtr->readIsDrained) { - goto stop; - } + rtPtr->eofPending = 1; + /* * Now this is a bit different. The partial data waiting is * converted and returned. @@ -1211,6 +1219,9 @@ ReflectInput( } /* while toRead > 0 */ stop: + if (gotBytes == 0) { + rtPtr->eofPending = 0; + } Tcl_DecrRefCount(bufObj); Tcl_Release(rtPtr); return gotBytes; @@ -1766,6 +1777,7 @@ NewReflectedTransform( rtPtr->timer = NULL; rtPtr->mode = 0; rtPtr->readIsDrained = 0; + rtPtr->eofPending = 0; rtPtr->nonblocking = (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING); rtPtr->dead = 0; @@ -3318,6 +3330,7 @@ TransformClear( (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL); rtPtr->readIsDrained = 0; + rtPtr->eofPending = 0; ResultClear(&rtPtr->result); } diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 694501f..f69d30f 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -12,9 +12,26 @@ #include "tclInt.h" #if defined(_WIN32) && defined(UNICODE) -/* On Windows, we always need the ASCII version. */ -# undef gai_strerror -# define gai_strerror gai_strerrorA +/* On Windows, we need to do proper Unicode->UTF-8 conversion. */ + +typedef struct ThreadSpecificData { + int initialized; + Tcl_DString errorMsg; /* UTF-8 encoded error-message */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +#undef gai_strerror +static const char *gai_strerror(int code) { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->initialized) { + Tcl_DStringFree(&tsdPtr->errorMsg); + } else { + tsdPtr->initialized = 1; + } + Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg); + return Tcl_DStringValue(&tsdPtr->errorMsg); +} #endif /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 860c2a3..c989eda 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2987,6 +2987,7 @@ MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsLocalScalar(const char *src, int len); MODULE_SCOPE int TclIsSpaceProc(char byte); +MODULE_SCOPE int TclIsBareword(char byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); diff --git a/generic/tclOO.h b/generic/tclOO.h index 24d3e6f..a7116dc 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -24,7 +24,7 @@ * win/tclooConfig.sh */ -#define TCLOO_VERSION "1.0.2" +#define TCLOO_VERSION "1.0.3" #define TCLOO_PATCHLEVEL TCLOO_VERSION #include "tcl.h" diff --git a/generic/tclParse.c b/generic/tclParse.c index ee0d4c4..ca12be5 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -621,6 +621,47 @@ TclIsSpaceProc( /* *---------------------------------------------------------------------- * + * TclIsBareword-- + * + * Report whether byte is one that can be part of a "bareword". + * This concept is named in expression parsing, where it determines + * what can be a legal function name, but is the same definition used + * in determining what variable names can be parsed as variable + * substitutions without the benefit of enclosing braces. The set of + * ASCII chars that are accepted are the numeric chars ('0'-'9'), + * the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_'). + * + * Results: + * Returns 1, if byte is in the accepted set of chars, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclIsBareword( + char byte) +{ + if (byte < '0' || byte > 'z') { + return 0; + } + if (byte <= '9' || byte >= 'a') { + return 1; + } + if (byte == '_') { + return 1; + } + if (byte < 'A' || byte > 'Z') { + return 0; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * * ParseWhiteSpace -- * * Scans up to numBytes bytes starting at src, consuming white space @@ -1346,9 +1387,7 @@ Tcl_ParseVarName( { Tcl_Token *tokenPtr; register const char *src; - unsigned char c; - int varIndex, offset; - Tcl_UniChar ch; + int varIndex; unsigned array; if ((numBytes == 0) || (start == NULL)) { @@ -1431,22 +1470,12 @@ Tcl_ParseVarName( tokenPtr->numComponents = 0; while (numBytes) { - if (Tcl_UtfCharComplete(src, numBytes)) { - offset = Tcl_UtfToUniChar(src, &ch); - } else { - char utfBytes[TCL_UTF_MAX]; - - memcpy(utfBytes, src, (size_t) numBytes); - utfBytes[numBytes] = '\0'; - offset = Tcl_UtfToUniChar(utfBytes, &ch); - } - c = UCHAR(ch); - if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ - src += offset; - numBytes -= offset; + if (TclIsBareword(*src)) { + src += 1; + numBytes -= 1; continue; } - if ((c == ':') && (numBytes != 1) && (src[1] == ':')) { + if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) { src += 2; numBytes -= 2; while (numBytes && (*src == ':')) { |