diff options
| -rw-r--r-- | doc/FileSystem.3 | 18 | ||||
| -rw-r--r-- | doc/Translate.3 | 3 | ||||
| -rw-r--r-- | doc/cd.n | 2 | ||||
| -rw-r--r-- | doc/chan.n | 29 | ||||
| -rw-r--r-- | doc/cookiejar.n | 4 | ||||
| -rw-r--r-- | doc/exec.n | 2 | ||||
| -rw-r--r-- | doc/file.n | 7 | ||||
| -rw-r--r-- | doc/glob.n | 22 | ||||
| -rw-r--r-- | doc/tclvars.n | 10 | ||||
| -rw-r--r-- | generic/tclIO.c | 74 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 7 | ||||
| -rw-r--r-- | generic/tclObj.c | 2 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 2 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 84 | ||||
| -rw-r--r-- | tests/chanio.test | 6 | ||||
| -rw-r--r-- | tests/io.test | 61 | ||||
| -rw-r--r-- | tests/ioCmd.test | 3 | ||||
| -rw-r--r-- | tests/zlib.test | 4 | ||||
| -rw-r--r-- | win/tclWinChan.c | 6 | ||||
| -rw-r--r-- | win/tclWinSerial.c | 2 |
20 files changed, 163 insertions, 185 deletions
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 469af22..3387f50 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -678,11 +678,6 @@ of zero, they will be freed when this function returns. \fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid Tcl path type, taking account of the fact that the cwd may have changed even if this value is already supposedly of the correct type. -The filename may begin with -.QW ~ -(to indicate current user's home directory) or -.QW ~<user> -(to indicate any user's home directory). .PP If the conversion succeeds (i.e.\ the value is a valid path in one of the current filesystems), then \fBTCL_OK\fR is returned. Otherwise @@ -704,14 +699,7 @@ from the given Tcl_Obj. .PP If the translation succeeds (i.e.\ the value is a valid path), then it is returned. Otherwise NULL will be returned, and an error message may be -left in the interpreter. A -.QW translated -path is one which contains no -.QW ~ -or -.QW ~user -sequences (these have been expanded to their current -representation in the filesystem). The value returned is owned by the +left in the interpreter. The value returned is owned by the caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is freed. This function is of little practical use, and \fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually @@ -1068,9 +1056,7 @@ must have a single unique string representation. Depending on the filesystem, there may be more than one unnormalized string representation which refers to that path (e.g.\ a relative path, a path with different -character case if the filesystem is case insensitive, a path contain a -reference to a home directory such as -.QW ~ , +character case if the filesystem is case insensitive, a path containing symbolic links, etc). If the very last component in the path is a symbolic link, it should not be converted into the value it points to (but diff --git a/doc/Translate.3 b/doc/Translate.3 index 256baec..e7668eb 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -21,8 +21,7 @@ char * .AP Tcl_Interp *interp in Interpreter in which to report an error, if any. .AP "const char" *name in -File name, which may start with a -.QW ~ . +File name .AP Tcl_DString *bufferPtr in/out If needed, this dynamic string is used to store the new file name. At the time of the call it should be uninitialized or free. The @@ -28,7 +28,7 @@ and all threads. Change to the home directory of the user \fBfred\fR: .PP .CS -\fBcd\fR ~fred +\fBcd\fR [file home fred] .CE .PP Change to the directory \fBlib\fR that is a sibling directory of the @@ -124,18 +124,8 @@ returned by \fBencoding names\fR, or from Unicode to the encoding. .RS .PP -\fBbinary\fR is an alias for \fBiso8859-1\fR: Each byte read from the -channel becomes the Unicode character having the same value as that byte, and -each character written to the channel becomes a single byte in the output, -allowing Tcl to work seamlessly with binary data as long as each "character" in -the data remains in the range of 0 to 255 so that there is no distinction between -binary data and text. For example, A JPEG image can be read from a -\fBbinary\fR channel, manipulated, and then written back to a \fBbinary\fR -channel. - -For working with binary data \fB\-translation binary\fR is usually used -instead, as it sets the encoding to \fBbinary\fR and also disables other -translations on the channel. +\fBbinary\fR is an alias for \fBiso8859-1\fR. This alone is not sufficient for +working with binary data. Use \fB\-translation binary\fR instead. .PP The encoding of a new channel is the value of \fBencoding system\fR, which returns the platform- and locale-dependent system encoding used to @@ -196,10 +186,17 @@ platforms it is \fBcrlf\fR for both input and output. .TP \fBbinary\fR . -Like \fBlf\fR, no end-of-line translation is performed, but in addition, -\fB\-eofchar\fR is set to the empty string to disable it, and \fB\-encoding\fR -is set to \fBbinary\fR. With this one setting, a channel is fully configured -for binary input and output. +Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets +\fB\-eofchar\fR to the empty string to disable it, sets \fB\-encoding\fR to +\fBiso8859-1\fR, and sets \fB-profile\fR to \fBstrict\fR so the the channel is +fully configured for binary input and output: Each byte read from the channel +becomes the Unicode character having the same value as that byte, and each +character written to the channel becomes a single byte in the output. This +makes it possible to work seamlessly with binary data as long as each character +in the data remains in the range of 0 to 255 so that there is no distinction +between binary data and text. For example, A JPEG image can be read from a +such a channel, manipulated, and then written back to such a channel. + .TP \fBcr\fR . diff --git a/doc/cookiejar.n b/doc/cookiejar.n index 7d2f46b..1391e01 100644 --- a/doc/cookiejar.n +++ b/doc/cookiejar.n @@ -178,7 +178,7 @@ the start of the application. package require http \fBpackage require cookiejar\fR -set cookiedb ~/.tclcookies.db +set cookiedb [file join [file home] cookiejar] http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb] # No further explicit steps are required to use cookies @@ -201,7 +201,7 @@ oo::class create MyCookieJar { } } -set cookiedb ~/.tclcookies.db +set cookiedb [file join [file home] cookiejar] http::configure -cookiejar [MyCookieJar new $cookiedb] # No further explicit steps are required to use cookies @@ -449,7 +449,7 @@ encrypted so that only the current user can access it requires use of the \fICIPHER\fR command, like this: .PP .CS -set secureDir "~/Desktop/Secure Directory" +set secureDir [file join [file home] Desktop/SecureDirectory] file mkdir $secureDir \fBexec\fR CIPHER /e /s:[file nativename $secureDir] .CE @@ -242,10 +242,7 @@ must be relative to the actual \fIlinkName\fR's location (not to the cwd), but on all other platforms where relative links are not supported, target paths will always be converted to absolute, normalized form before the link is created (and therefore relative paths are interpreted -as relative to the cwd). Furthermore, -.QW ~user -paths are always expanded -to absolute form. When creating links on filesystems that either do not +as relative to the cwd). When creating links on filesystems that either do not support any links, or do not support the specific type requested, an error message will be returned. Most Unix platforms support both symbolic and hard links (the latter for files only). Windows @@ -571,7 +568,7 @@ interface) but the name passed to the operating system must be in native format: .PP .CS -exec {*}[auto_execok start] {} [\fBfile nativename\fR ~/example.txt] +exec {*}[auto_execok start] {} [\fBfile nativename\fR C:/Users/fred/example.txt] .CE .SH "SEE ALSO" filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n), @@ -72,7 +72,7 @@ is equivalent to .QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" . For \fB\-path\fR specifications, the returned names will include the last path segment, so -.QW "\fBglob \-tails \-path [file rootname ~/foo.tex] .*\fR" +.QW "\fBglob \-tails \-path [file rootname /home/fred/foo.tex] .*\fR" will return paths like \fBfoo.aux foo.bib foo.tex\fR etc. .TP \fB\-types\fR \fItypeList\fR @@ -168,16 +168,6 @@ which must be matched explicitly (this is to avoid a recursive pattern like from recursing up the directory hierarchy as well as down). In addition, all .QW / characters must be matched explicitly. -.LP -If the first character in a \fIpattern\fR is -.QW ~ -then it refers to the home directory for the user whose name follows the -.QW ~ . -If the -.QW ~ -is followed immediately by -.QW / -then the value of the HOME environment variable is used. .PP The \fBglob\fR command differs from csh globbing in two ways. First, it does not sort its result list (use the \fBlsort\fR @@ -188,13 +178,7 @@ contains a ?, *, or [] construct. .SH "WINDOWS PORTABILITY ISSUES" .PP For Windows UNC names, the servername and sharename components of the path -may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is -of the form -.QW \fB~\fIusername\fB@\fIdomain\fR , -it refers to the home -directory of the user whose account information resides on the specified NT -domain server. Otherwise, user account information is obtained from -the local computer. +may not contain ?, *, or [] constructs. .PP Since the backslash character has a special meaning to the glob command, glob patterns containing Windows style path separators need @@ -229,7 +213,7 @@ Find all the Tcl files in the user's home directory, irrespective of what the current directory is: .PP .CS -\fBglob\fR \-directory ~ *.tcl +\fBglob\fR \-directory [file home] *.tcl .CE .PP Find all subdirectories of the current directory: diff --git a/doc/tclvars.n b/doc/tclvars.n index 8214473..d244953 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -73,11 +73,11 @@ The following elements of \fBenv\fR are special to Tcl: \fBenv(HOME)\fR . This environment variable, if set, gives the location of the directory -considered to be the current user's home directory, and to which a -call of \fBcd\fR without arguments or with just -.QW ~ -as an argument will change into. Most platforms set this correctly by -default; it does not normally need to be set by user code. +considered to be the current user's home directory. The value of this variable +is returned by the \fBfile home\fR command. Most platforms set this correctly by +default; it does not normally need to be set by user code. On Windows, if not +already set, it is set to the value of the \fBUSERPROFILE\fR environment +variable. .TP \fBenv(TCL_LIBRARY)\fR . diff --git a/generic/tclIO.c b/generic/tclIO.c index c5e6965..92b9f72 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1675,11 +1675,8 @@ Tcl_CreateChannel( * interpretation that Tcl_Channels give to the "-encoding binary" option. */ - statePtr->encoding = NULL; name = Tcl_GetEncodingName(NULL); - if (strcmp(name, "binary") != 0) { - statePtr->encoding = Tcl_GetEncoding(NULL, name); - } + statePtr->encoding = Tcl_GetEncoding(NULL, name); statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, @@ -3480,7 +3477,8 @@ TclClose( stickyError = 0; - if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) + if (GotFlag(statePtr, TCL_WRITABLE) + && (statePtr->encoding != GetBinaryEncoding()) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { int code = CheckChannelErrors(statePtr, TCL_WRITABLE); @@ -4269,11 +4267,7 @@ Tcl_WriteObj( do { int chunkSize = srcLen > INT_MAX ? INT_MAX : srcLen; int written; - if (statePtr->encoding == NULL) { - written = WriteBytes(chanPtr, src, chunkSize); - } else { - written = WriteChars(chanPtr, src, chunkSize); - } + written = WriteChars(chanPtr, src, chunkSize); if (written < 0) { return TCL_INDEX_NONE; } @@ -4651,7 +4645,7 @@ Tcl_GetsObj( * done on objPtr. */ - if ((statePtr->encoding == NULL) + if (statePtr->encoding == GetBinaryEncoding() && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) || (statePtr->inputTranslation == TCL_TRANSLATE_CR)) && Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) { @@ -4682,15 +4676,6 @@ Tcl_GetsObj( } /* - * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't - * produce ByteArray objects. - */ - - if (encoding == NULL) { - encoding = GetBinaryEncoding(); - } - - /* * Object used by FilterInputBytes to keep track of how much data has been * consumed from the channel buffers. */ @@ -5236,7 +5221,7 @@ TclGetsObjBinary( * XXX - unimplemented. */ - if (statePtr->encoding != NULL) { + if (statePtr->encoding != GetBinaryEncoding()) { } /* @@ -5951,7 +5936,7 @@ DoReadChars( #define UTF_EXPANSION_FACTOR 1024 int factor = UTF_EXPANSION_FACTOR; - binaryMode = (encoding == NULL) + binaryMode = (encoding == GetBinaryEncoding()) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); @@ -6244,8 +6229,7 @@ ReadChars( * UTF-8. On output, contains another guess * based on the data seen so far. */ { - Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding - : GetBinaryEncoding(); + Tcl_Encoding encoding = statePtr->encoding; Tcl_EncodingState savedState = statePtr->inputEncodingState; ChannelBuffer *bufPtr = statePtr->inQueueHead; int savedIEFlags = statePtr->inputEncodingFlags; @@ -7971,12 +7955,8 @@ Tcl_GetChannelOption( if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-encoding"); } - if (statePtr->encoding == NULL) { - Tcl_DStringAppendElement(dsPtr, "binary"); - } else { - Tcl_DStringAppendElement(dsPtr, - Tcl_GetEncodingName(statePtr->encoding)); - } + Tcl_DStringAppendElement(dsPtr, + Tcl_GetEncodingName(statePtr->encoding)); if (len > 0) { return TCL_OK; } @@ -8196,7 +8176,13 @@ Tcl_SetChannelOption( int profile; if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { - encoding = NULL; + encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else { encoding = Tcl_GetEncoding(interp, newValue); if (encoding == NULL) { @@ -8209,7 +8195,7 @@ Tcl_SetChannelOption( * iso2022, the terminated escape sequence must write to the buffer. */ - if ((statePtr->encoding != NULL) + if ((statePtr->encoding != GetBinaryEncoding()) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START) && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; @@ -8304,7 +8290,13 @@ Tcl_SetChannelOption( translation = TCL_TRANSLATE_LF; statePtr->inEofChar = 0; Tcl_FreeEncoding(statePtr->encoding); - statePtr->encoding = NULL; + statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(readMode, "lf") == 0) { translation = TCL_TRANSLATE_LF; } else if (strcmp(readMode, "cr") == 0) { @@ -8353,7 +8345,13 @@ Tcl_SetChannelOption( } else if (strcmp(writeMode, "binary") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; Tcl_FreeEncoding(statePtr->encoding); - statePtr->encoding = NULL; + statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(writeMode, "lf") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; } else if (strcmp(writeMode, "cr") == 0) { @@ -10271,13 +10269,9 @@ Lossless( && outStatePtr->outputTranslation == TCL_TRANSLATE_LF && ( ( - (inStatePtr->encoding == NULL - || inStatePtr->encoding == GetBinaryEncoding() - ) + inStatePtr->encoding == GetBinaryEncoding() && - (outStatePtr->encoding == NULL - || outStatePtr->encoding == GetBinaryEncoding() - ) + outStatePtr->encoding == GetBinaryEncoding() ) || ( diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index a8fec18..df7c3a4 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -813,8 +813,7 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - Tcl_Size i; - size_t len, elemLen; + Tcl_Size i, len, elemLen; char flags; Interp *iPtr = (Interp *)interp; const char *elementStr; @@ -1277,13 +1276,13 @@ PrintUsage( width = 4; for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { - size_t length; + Tcl_Size length; if (infoPtr->keyStr == NULL) { continue; } length = strlen(infoPtr->keyStr); - if (length > (size_t)width) { + if (length > width) { width = length; } } diff --git a/generic/tclObj.c b/generic/tclObj.c index 87b2d6d..88d5098 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1702,7 +1702,7 @@ TclGetStringFromObj( if (lengthPtr != NULL) { if (objPtr->length > INT_MAX) { Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr" - "cannot handle such long strings. Please use 'size_t'"); + " cannot handle such long strings. Please use 'size_t'"); } *lengthPtr = (int)objPtr->length; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 7f310ce..815c64f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -701,7 +701,7 @@ TclGetUnicodeFromObj( if (lengthPtr != NULL) { if (stringPtr->numChars > INT_MAX) { Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr" - "cannot handle such long strings. Please use 'Tcl_Size'"); + " cannot handle such long strings. Please use 'Tcl_Size'"); } *lengthPtr = (int)stringPtr->numChars; } diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index a7b7382..97e0ad2 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -30,10 +30,10 @@ * Forward declarations for functions defined later in this file: */ -static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex); +static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, Tcl_Size varIndex); static int GetVariableIndex(Tcl_Interp *interp, - Tcl_Obj *obj, size_t *indexPtr); -static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr); + Tcl_Obj *obj, Tcl_Size *indexPtr); +static void SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex, Tcl_Obj *objPtr); static Tcl_ObjCmdProc TestbignumobjCmd; static Tcl_ObjCmdProc TestbooleanobjCmd; static Tcl_ObjCmdProc TestdoubleobjCmd; @@ -153,7 +153,7 @@ TestbignumobjCmd( BIGNUM_RADIXSIZE } idx; int index; - size_t varIndex; + Tcl_Size varIndex; const char *string; mp_int bignumValue; Tcl_Obj **varPtr; @@ -344,7 +344,7 @@ TestbooleanobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; int boolValue; const char *subCmd; Tcl_Obj **varPtr; @@ -444,7 +444,7 @@ TestdoubleobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; double doubleValue; const char *subCmd; Tcl_Obj **varPtr; @@ -561,7 +561,7 @@ TestindexobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int allowAbbrev, index, setError, i, result; - Tcl_WideInt index2; + Tcl_Size index2; const char **argv; static const char *const tablePtr[] = {"a", "b", "check", NULL}; @@ -570,8 +570,8 @@ TestindexobjCmd( */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ - TCL_HASH_TYPE offset; /* Offset between table entries. */ - TCL_HASH_TYPE index; /* Selected index into table. */ + Tcl_Size offset; /* Offset between table entries. */ + Tcl_Size index; /* Selected index into table. */ } *indexRep; if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), @@ -582,7 +582,7 @@ TestindexobjCmd( * lookups. */ - if (Tcl_GetWideIntFromObj(interp, objv[2], &index2) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[2], TCL_INDEX_NONE, &index2) != TCL_OK) { return TCL_ERROR; } @@ -592,7 +592,7 @@ TestindexobjCmd( result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); if (result == TCL_OK) { - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(index + 1U)) - 1); } return result; } @@ -620,7 +620,7 @@ TestindexobjCmd( &index); Tcl_Free((void *)argv); if (result == TCL_OK) { - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(index + 1U)) - 1); } return result; } @@ -650,7 +650,7 @@ TestintobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; #if (INT_MAX != LONG_MAX) /* int is not the same size as long */ int i; #endif @@ -895,9 +895,9 @@ TestlistobjCmd( LISTOBJ_GETELEMENTSMEMCHECK, } cmdIndex; - size_t varIndex; /* Variable number converted to binary */ - Tcl_WideInt first; /* First index in the list */ - Tcl_WideInt count; /* Count of elements in a list */ + Tcl_Size varIndex; /* Variable number converted to binary */ + Tcl_Size first; /* First index in the list */ + Tcl_Size count; /* Count of elements in a list */ Tcl_Obj **varPtr; int i, len; @@ -913,7 +913,7 @@ TestlistobjCmd( 0, &cmdIndex) != TCL_OK) { return TCL_ERROR; } - switch (cmdIndex) { + switch(cmdIndex) { case LISTOBJ_SET: if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3); @@ -940,8 +940,8 @@ TestlistobjCmd( "varIndex start count ?element...?"); return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK - || Tcl_GetWideIntFromObj(interp, objv[4], &count) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK + || Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &count) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(varPtr[varIndex])) { @@ -1028,7 +1028,7 @@ TestobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex, destIndex; + Tcl_Size varIndex, destIndex; int i; const Tcl_ObjType *targetType; Tcl_Obj **varPtr; @@ -1199,7 +1199,7 @@ TestobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(varPtr[varIndex]->refCount + 1U)) - 1)); break; case TESTOBJ_TYPE: if (objc != 3) { @@ -1250,9 +1250,9 @@ TeststringobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; - size_t size, varIndex; + Tcl_Size size, varIndex; int option, i; - Tcl_WideInt length; + Tcl_Size length; #define MAX_STRINGS 11 const char *string, *strings[MAX_STRINGS+1]; String *strPtr; @@ -1283,7 +1283,7 @@ TeststringobjCmd( if (objc != 5) { goto wrongNumArgs; } - if (Tcl_GetWideIntFromObj(interp, objv[4], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] == NULL) { @@ -1364,9 +1364,9 @@ TeststringobjCmd( strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->allocated; } else { - length = -1; + length = TCL_INDEX_NONE; } - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(length + 1U)) - 1); break; case 6: /* set */ if (objc != 4) { @@ -1401,7 +1401,7 @@ TeststringobjCmd( if (objc != 4) { goto wrongNumArgs; } - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] != NULL) { @@ -1418,17 +1418,17 @@ TeststringobjCmd( strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { - length = -1; + length = TCL_INDEX_NONE; } - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(length + 1U)) - 1); break; case 10: { /* range */ - Tcl_WideInt first, last; + Tcl_Size first, last; if (objc != 5) { goto wrongNumArgs; } - if ((Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK) - || (Tcl_GetWideIntFromObj(interp, objv[4], &last) != TCL_OK)) { + if ((Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) + || (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &last) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last)); @@ -1453,10 +1453,10 @@ TeststringobjCmd( string = Tcl_GetStringFromObj(varPtr[varIndex], &size); - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) { + if (length == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; @@ -1484,10 +1484,10 @@ TeststringobjCmd( unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size); - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) { + if (length == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; @@ -1540,7 +1540,7 @@ TeststringobjCmd( static void SetVarToObj( Tcl_Obj **varPtr, - size_t varIndex, /* Designates the assignment variable. */ + Tcl_Size varIndex, /* Designates the assignment variable. */ Tcl_Obj *objPtr) /* Points to object to assign to var. */ { if (varPtr[varIndex] != NULL) { @@ -1574,14 +1574,14 @@ GetVariableIndex( Tcl_Obj *obj, /* The variable index * specified as a nonnegative number less than * NUMBER_OF_OBJECT_VARS. */ - size_t *indexPtr) /* Place to store converted result. */ + Tcl_Size *indexPtr) /* Place to store converted result. */ { - Tcl_WideInt index; + Tcl_Size index; - if (Tcl_GetWideIntFromObj(interp, obj, &index) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, obj, NUMBER_OF_OBJECT_VARS - 1, &index) != TCL_OK) { return TCL_ERROR; } - if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) { + if (index == TCL_INDEX_NONE) { Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1); return TCL_ERROR; @@ -1613,7 +1613,7 @@ static int CheckIfVarUnset( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tcl_Obj ** varPtr, - size_t varIndex) /* Index of the test variable to check. */ + Tcl_Size varIndex) /* Index of the test variable to check. */ { if (varPtr[varIndex] == NULL) { char buf[32 + TCL_INTEGER_SPACE]; diff --git a/tests/chanio.test b/tests/chanio.test index c3caa1c..680039c 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -6868,8 +6868,7 @@ test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test chan-io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { - # encoding to binary (=> implies that the internal utf-8 is written) +test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body { set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] chan configure $in -encoding koi8-r -translation lf @@ -6879,7 +6878,8 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { chan close $in chan close $out file size $path(utf8-fcopy.txt) -} 5 +} -returnCodes 1 -match glob -result {error writing "*":\ + invalid or incomplete multibyte or wide character} test chan-io-52.11 {TclCopyChannel & encodings} -setup { set f [open $path(utf8-fcopy.txt) w] fconfigure $f -encoding utf-8 -translation lf diff --git a/tests/io.test b/tests/io.test index 5fd255c..444b3de 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7500,10 +7500,7 @@ test io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { - # encoding to binary (=> implies that the - # internal utf-8 is written) - +test io-52.10 {TclCopyChannel & encodings} -constraints fcopy -body { set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] @@ -7516,7 +7513,8 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { close $out file size $path(utf8-fcopy.txt) -} 5 +} -returnCodes 1 -match glob -result {error writing "*":\ + invalid or incomplete multibyte or wide character} test io-52.11 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf -profile strict @@ -8374,7 +8372,7 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup { catch {close $out} removeFile out rename driver {} -} -result {error reading "*": *} -returnCodes error -match glob +} -result {error reading "rc*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { variable buffer @@ -9264,7 +9262,7 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { removeFile io-75.5 } -result 4181 -test io-75.6 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup { +test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary @@ -9278,7 +9276,8 @@ test io-75.6 {invalid utf-8 encoding gets is not ignored (-profile strict)} -set } -cleanup { close $f removeFile io-75.6 -} -match glob -returnCodes 1 -result {error reading "*": invalid or incomplete multibyte or wide character} +} -match glob -returnCodes 1 -result {error reading "file*":\ + invalid or incomplete multibyte or wide character} test io-75.7 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.7] @@ -9294,7 +9293,8 @@ test io-75.7 {invalid utf-8 encoding gets is not ignored (-profile strict)} -set } -cleanup { close $f removeFile io-75.7 -} -match glob -returnCodes 1 -result {error reading "*": invalid or incomplete multibyte or wide character} +} -match glob -returnCodes 1 -result {error reading "file*":\ + invalid or incomplete multibyte or wide character} test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] @@ -9330,10 +9330,11 @@ test io-75.9 {unrepresentable character write passes and is replaced by ?} -setu removeFile io-75.9 } -match glob -result [list {A} {error writing "*": invalid or incomplete multibyte or wide character}] -# Incomplete sequence test. -# This error may IMHO only be detected with the close. -# But the read already returns the incomplete sequence. -test io-75.10 {incomplete multibyte encoding read is ignored} -setup { +test io-75.10 { + incomplete multibyte encoding read is not ignored because "binary" sets + profile to strict +} -setup { + set res {} set fn [makeFile {} io-75.10] set f [open $fn w+] fconfigure $f -encoding binary @@ -9342,13 +9343,21 @@ test io-75.10 {incomplete multibyte encoding read is ignored} -setup { seek $f 0 fconfigure $f -encoding utf-8 -buffering none } -body { + catch {read $f} errmsg + lappend res $errmsg + seek $f 0 + chan configure $f -profile tcl8 set d [read $f] binary scan $d H* hd - set hd + lappend res $hd + return $res } -cleanup { close $f removeFile io-75.10 -} -result 41c0 + unset result +} -match glob -result {{error reading "file*":\ + invalid or incomplete multibyte or wide character} 41c0} + # The current result returns the orphan byte as byte. # This may be expected due to special utf-8 handling. @@ -9372,9 +9381,14 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup { } -cleanup { close $f removeFile io-75.11 -} -match glob -result {41 1 {error reading "*": invalid or incomplete multibyte or wide character}} +} -match glob -result {41 1 {error reading "file*":\ + invalid or incomplete multibyte or wide character}} -test io-75.12 {invalid utf-8 encoding read is ignored} -setup { +test io-75.12 { + invalid utf-8 encoding read is not ignored because setting the encoding to + "binary" also set the profile to strict +} -setup { + set res {} set fn [makeFile {} io-75.12] set f [open $fn w+] fconfigure $f -encoding binary @@ -9383,13 +9397,20 @@ test io-75.12 {invalid utf-8 encoding read is ignored} -setup { seek $f 0 fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf } -body { + catch {read $f} errmsg + lappend res $errmsg + chan configure $f -profile tcl8 + seek $f 0 set d [read $f] binary scan $d H* hd - set hd + lappend res $hd + return $res } -cleanup { close $f removeFile io-75.12 -} -result 4181 + unset res +} -match glob -result {{error reading "file*":\ + invalid or incomplete multibyte or wide character} 4181} test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.13] set f [open $fn w+] @@ -9407,7 +9428,7 @@ test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -se } -cleanup { close $f removeFile io-75.13 -} -match glob -result {41 1 {error reading "*": invalid or incomplete multibyte or wide character}} +} -match glob -result {41 1 {error reading "file*": invalid or incomplete multibyte or wide character}} # ### ### ### ######### ######### ######### diff --git a/tests/ioCmd.test b/tests/ioCmd.test index cab4745..2df2ca0 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -266,7 +266,7 @@ test iocmd-8.9 {fconfigure command} -setup { fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -profile tcl8 -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile tcl8 -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -496,6 +496,7 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { set result } 5 test iocmd-12.11 {POSIX open access modes: BINARY} -body { + after 100 set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f Ɉ ;# throws an exception } -cleanup { diff --git a/tests/zlib.test b/tests/zlib.test index 720fdd6..93c568b 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -292,7 +292,7 @@ test zlib-8.6 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] @@ -302,7 +302,7 @@ test zlib-8.7 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 7d1f849..cc030f0 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -1005,7 +1005,7 @@ Tcl_MakeFileChannel( TclFile readFile = NULL, writeFile = NULL; BOOL result; - if (mode == 0) { + if ((mode & (TCL_READABLE|TCL_WRITABLE)) == 0) { return NULL; } @@ -1287,7 +1287,7 @@ OpenFileChannel( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; + return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) ? infoPtr->channel : NULL; } } @@ -1300,7 +1300,7 @@ OpenFileChannel( */ infoPtr->nextPtr = NULL; - infoPtr->validMask = permissions; + infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION); infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index f4b1813..b712cfd 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1458,7 +1458,7 @@ TclWinOpenSerialChannel( infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); - infoPtr->validMask = permissions; + infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE); infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->readable = 0; |