Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge trunk |
|---|---|
| Timelines: | family | ancestors | descendants | both | dgp-refactor |
| Files: | files | file ages | folders |
| SHA3-256: |
bc2c47a6a83e61d0e5700d1168ec527e |
| User & Date: | dgp 2022-10-27 00:25:34.276 |
Context
|
2022-10-28
| ||
| 18:32 | merge trunk check-in: 23e1d51bd6 user: dgp tags: dgp-refactor | |
|
2022-10-27
| ||
| 00:25 | merge trunk check-in: bc2c47a6a8 user: dgp tags: dgp-refactor | |
|
2022-10-26
| ||
| 09:55 | TIP #646: Change -eofchar handling check-in: 55e62999de user: jan.nijtmans tags: trunk, main | |
|
2022-10-23
| ||
| 14:47 | merge-mark check-in: 5f24d0c063 user: jan.nijtmans tags: dgp-refactor | |
Changes
Changes to changes.
| ︙ | ︙ | |||
9248 9249 9250 9251 9252 9253 9254 | => opt 0.4.8 2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans) 2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans) => tcltest 2.5.3 | | | 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 |
=> opt 0.4.8
2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans)
2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans)
=> tcltest 2.5.3
2020-09-25 (new) force -eofchar \x1A when evaluating library scripts (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans)
2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans)
2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans)
|
| ︙ | ︙ |
Changes to doc/chan.n.
| ︙ | ︙ | |||
139 140 141 142 143 144 145 | .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 interface with the operating system, .RE .TP \fB\-eofchar\fR \fIchar\fR | < < < | < < < | | < | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
.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
interface with the operating system,
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.
\fIchar\fR signals the end of the data when it is encountered in the input.
If \fIchar\fR is the empty string, there is no special character that marks
the end of the data.
The default value is the empty string. The acceptable range is \ex01 -
\ex7f. A value outside this range results in an error.
.TP
\fB\-translation\fR \fItranslation\fR
.TP
\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR
.
In Tcl a single line feed (\en) represents the end of a line. However,
|
| ︙ | ︙ |
Changes to doc/fconfigure.n.
| ︙ | ︙ | |||
98 99 100 101 102 103 104 | .PP The default encoding for newly opened channels is the same platform- and locale-dependent system encoding used for interfacing with the operating system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR | < < | < < < < < < < | < | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
.PP
The default encoding for newly opened channels is the same platform- and
locale-dependent system encoding used for interfacing with the operating
system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.
This option supports DOS file systems that use Control-z (\ex1A) as an
end of file marker. If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.
If \fIchar\fR is the empty string, then there is no special end of file
character marker. The default value for \fB\-eofchar\fR is the empty
string.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7F;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
|
| ︙ | ︙ |
Changes to generic/tclCompile.h.
| ︙ | ︙ | |||
1473 1474 1475 1476 1477 1478 1479 |
TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
(envPtr));
/*
* Convenience macros for use when pushing literals. The ANSI C "prototype" for
* these macros are:
*
* static void PushLiteral(CompileEnv *envPtr,
| | | | | 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 |
TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
(envPtr));
/*
* Convenience macros for use when pushing literals. The ANSI C "prototype" for
* these macros are:
*
* static void PushLiteral(CompileEnv *envPtr,
* const char *string, Tcl_Size length);
* static void PushStringLiteral(CompileEnv *envPtr,
* const char *string);
*/
#define PushLiteral(envPtr, string, length) \
TclEmitPush(TclRegisterLiteral((envPtr), (string), (length), 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
PushLiteral((envPtr), (string), sizeof(string "") - 1)
/*
* Macro to advance to the next token; it is more mnemonic than the address
* arithmetic that it replaces. The ANSI C "prototype" for this macro is:
*
* static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
*/
|
| ︙ | ︙ | |||
1510 1511 1512 1513 1514 1515 1516 | /* * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the * maximal depth of nested CATCH ranges in order to alloc runtime * memory. These macros should compute precisely that? OTOH, the nesting depth * of LOOP ranges is an interesting datum for debugging purposes, and that is * what we compute now. * | | | | | | 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 |
/*
* Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
* maximal depth of nested CATCH ranges in order to alloc runtime
* memory. These macros should compute precisely that? OTOH, the nesting depth
* of LOOP ranges is an interesting datum for debugging purposes, and that is
* what we compute now.
*
* static int ExceptionRangeStarts(CompileEnv *envPtr, Tcl_Size index);
* static void ExceptionRangeEnds(CompileEnv *envPtr, Tcl_Size index);
* static void ExceptionRangeTarget(CompileEnv *envPtr, Tcl_Size index, LABEL);
*/
#define ExceptionRangeStarts(envPtr, index) \
(((envPtr)->exceptDepth++), \
((envPtr)->maxExceptDepth = \
TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
#define ExceptionRangeEnds(envPtr, index) \
(((envPtr)->exceptDepth--), \
((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
CurrentOffset(envPtr) - (int)(envPtr)->exceptArrayPtr[(index)].codeOffset))
#define ExceptionRangeTarget(envPtr, index, targetType) \
((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
|
| ︙ | ︙ | |||
1571 1572 1573 1574 1575 1576 1577 |
* change during the course of the function.
*
* Macro to encapsulate the variable definition and setup.
*/
#define DefineLineInformation \
ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
| | | 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 |
* change during the course of the function.
*
* Macro to encapsulate the variable definition and setup.
*/
#define DefineLineInformation \
ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
Tcl_Size eclIndex = mapPtr->nuloc - 1
#define SetLineInformation(word) \
envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
#define PushVarNameWord(i,v,e,f,l,sc,word) \
SetLineInformation(word); \
|
| ︙ | ︙ | |||
1749 1750 1751 1752 1753 1754 1755 |
#define TCL_DTRACE_DEBUG_LOG() \
int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \
int tclDTraceDebugIndent = 0; \
FILE *tclDTraceDebugLog = NULL; \
void TclDTraceOpenDebugLog(void) { \
char n[35]; \
| | | | 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 |
#define TCL_DTRACE_DEBUG_LOG() \
int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \
int tclDTraceDebugIndent = 0; \
FILE *tclDTraceDebugLog = NULL; \
void TclDTraceOpenDebugLog(void) { \
char n[35]; \
sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \
(size_t) getpid()); \
tclDTraceDebugLog = fopen(n, "a"); \
}
#define TclDTraceDbgMsg(p, m, ...) \
do { \
if (tclDTraceDebugEnabled) { \
int _l, _t = 0; \
|
| ︙ | ︙ |
Changes to generic/tclDecls.h.
| ︙ | ︙ | |||
4006 4007 4008 4009 4010 4011 4012 | (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ | | | | 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 | (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)(void *)(sizePtr))) #if TCL_MAJOR_VERSION > 8 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ |
| ︙ | ︙ | |||
4039 4040 4041 4042 4043 4044 4045 | (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ | | | | 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 | (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetStringFromObj)(objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ |
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
1684 1685 1686 1687 1688 1689 1690 |
* output, so that Tcl does not look for an in-file EOF indicator (e.g.,
* ^Z) and does not append an EOF indicator to files.
*/
statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
statePtr->inEofChar = 0;
| < | 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 |
* output, so that Tcl does not look for an in-file EOF indicator (e.g.,
* ^Z) and does not append an EOF indicator to files.
*/
statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
statePtr->inEofChar = 0;
statePtr->unreportedError = 0;
statePtr->refCount = 0;
statePtr->closeCbPtr = NULL;
statePtr->curOutPtr = NULL;
statePtr->outQueueHead = NULL;
statePtr->outQueueTail = NULL;
|
| ︙ | ︙ | |||
3072 3073 3074 3075 3076 3077 3078 |
* The caller guarantees that there are no more buffers queued for output.
*/
if (statePtr->outQueueHead != NULL) {
Tcl_Panic("TclFlush, closed channel: queued output left");
}
| < < < < < < < < < < < < | 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 |
* The caller guarantees that there are no more buffers queued for output.
*/
if (statePtr->outQueueHead != NULL) {
Tcl_Panic("TclFlush, closed channel: queued output left");
}
/*
* TIP #219, Tcl Channel Reflection API.
* Move a leftover error message in the channel bypass into the
* interpreter bypass. Just clear it if there is no interpreter.
*/
if (statePtr->chanMsg != NULL) {
|
| ︙ | ︙ | |||
3848 3849 3850 3851 3852 3853 3854 |
*/
if (statePtr->outQueueHead != NULL) {
Tcl_Panic("ClosechanHalf, closed write-side of channel: "
"queued output left");
}
| < < < < < < < < < < < < | 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 |
*/
if (statePtr->outQueueHead != NULL) {
Tcl_Panic("ClosechanHalf, closed write-side of channel: "
"queued output left");
}
/*
* TIP #219, Tcl Channel Reflection API.
* Move a leftover error message in the channel bypass into the
* interpreter bypass. Just clear it if there is no interpreter.
*/
if (statePtr->chanMsg != NULL) {
|
| ︙ | ︙ | |||
7954 7955 7956 7957 7958 7959 7960 |
return TCL_OK;
}
}
if (len == 0 || HaveOpt(2, "-eofchar")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-eofchar");
}
| < < < < < | | | | | | < < < < < < < < < < < < < < < < < < < < < < | 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 7944 7945 7946 7947 7948 7949 |
return TCL_OK;
}
}
if (len == 0 || HaveOpt(2, "-eofchar")) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-eofchar");
}
if (!(flags & TCL_READABLE) || (statePtr->inEofChar == 0)) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
sprintf(buf, "%c", statePtr->inEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
if (len > 0) {
return TCL_OK;
}
}
if (len == 0 || HaveOpt(1, "-nocomplainencoding")) {
if (len == 0) {
|
| ︙ | ︙ | |||
8109 8110 8111 8112 8113 8114 8115 |
{
Channel *chanPtr = (Channel *) chan;
/* The real IO channel. */
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
size_t len; /* Length of optionName string. */
size_t argc;
| | | 8057 8058 8059 8060 8061 8062 8063 8064 8065 8066 8067 8068 8069 8070 8071 |
{
Channel *chanPtr = (Channel *) chan;
/* The real IO channel. */
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
size_t len; /* Length of optionName string. */
size_t argc;
const char **argv = NULL;
/*
* If the channel is in the middle of a background copy, fail.
*/
if (statePtr->csPtrR || statePtr->csPtrW) {
if (interp) {
|
| ︙ | ︙ | |||
8225 8226 8227 8228 8229 8230 8231 |
statePtr->inputEncodingFlags = TCL_ENCODING_START;
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
return TCL_OK;
} else if (HaveOpt(2, "-eofchar")) {
| > > > > | < | < < | | < < < | 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 |
statePtr->inputEncodingFlags = TCL_ENCODING_START;
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
return TCL_OK;
} else if (HaveOpt(2, "-eofchar")) {
if (!newValue[0] || (!(newValue[0] & 0x80) && !newValue[1])) {
if (GotFlag(statePtr, TCL_READABLE)) {
statePtr->inEofChar = newValue[0];
}
} else if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
} else if (argc == 0) {
statePtr->inEofChar = 0;
} else if (argc == 1 || argc == 2) {
int inValue = (int) argv[0][0];
int outValue = (argc == 2) ? (int) argv[1][0] : 0;
if (inValue & 0x80 || (inValue && argv[0][1]) || outValue) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -eofchar: must be non-NUL ASCII"
" character", -1));
}
Tcl_Free((void *)argv);
return TCL_ERROR;
}
if (GotFlag(statePtr, TCL_READABLE)) {
statePtr->inEofChar = inValue;
}
} else {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -eofchar: should be a list of zero,"
" one, or two elements", -1));
}
Tcl_Free((void *)argv);
|
| ︙ | ︙ | |||
8383 8384 8385 8386 8387 8388 8389 |
if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else {
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
}
} else if (strcmp(writeMode, "binary") == 0) {
| < | 8329 8330 8331 8332 8333 8334 8335 8336 8337 8338 8339 8340 8341 8342 |
if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else {
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
}
} else if (strcmp(writeMode, "binary") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_LF;
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = NULL;
} else if (strcmp(writeMode, "lf") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_LF;
} else if (strcmp(writeMode, "cr") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CR;
|
| ︙ | ︙ |
Changes to generic/tclIO.h.
| ︙ | ︙ | |||
154 155 156 157 158 159 160 161 |
/* What translation to apply for end of line
* sequences on input? */
TclEolTranslation outputTranslation;
/* What translation to use for generating end
* of line sequences in output? */
int inEofChar; /* If nonzero, use this as a signal of EOF on
* input. */
int outEofChar; /* If nonzero, append this to the channel when
| > | > | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 |
/* What translation to apply for end of line
* sequences on input? */
TclEolTranslation outputTranslation;
/* What translation to use for generating end
* of line sequences in output? */
int inEofChar; /* If nonzero, use this as a signal of EOF on
* input. */
#if TCL_MAJOR_VERSION < 9
int outEofChar; /* If nonzero, append this to the channel when
* it is closed if it is open for writing. For Tcl 8.x only */
#endif
int unreportedError; /* Non-zero if an error report was deferred
* because it happened in the background. The
* value is the POSIX error code. */
size_t refCount; /* How many interpreters hold references to
* this IO channel? */
struct CloseCallback *closeCbPtr;
/* Callbacks registered to be called when the
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
4726 4727 4728 4729 4730 4731 4732 | /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- * -sensitive points where it pays to avoid a function call in the common case * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: * | | | | 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 |
/*
*----------------------------------------------------------------
* Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
* -sensitive points where it pays to avoid a function call in the common case
* of counting along a string of all one-byte characters. The ANSI C
* "prototype" for this macro is:
*
* MODULE_SCOPE void TclNumUtfCharsM(int numChars, const char *bytes,
* int numBytes);
*----------------------------------------------------------------
*/
#define TclNumUtfCharsM(numChars, bytes, numBytes) \
do { \
size_t _count, _i = (numBytes); \
unsigned char *_str = (unsigned char *) (bytes); \
|
| ︙ | ︙ |
Changes to generic/tclStringRep.h.
| ︙ | ︙ | |||
47 48 49 50 51 52 53 |
* Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
* restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
* can be officially modified by altering the definition of Tcl_UniChar in
* tcl.h, but do not do that unless you are sure what you're doing!
*/
typedef struct {
| | | | | | | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
* Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
* restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
* can be officially modified by altering the definition of Tcl_UniChar in
* tcl.h, but do not do that unless you are sure what you're doing!
*/
typedef struct {
Tcl_Size numChars; /* The number of chars in the string.
* TCL_INDEX_NONE means this value has not been
* calculated. Any other means that there is a valid
* Unicode rep, or that the number of UTF bytes ==
* the number of chars. */
Tcl_Size allocated; /* The amount of space actually allocated for
* the UTF string (minus 1 byte for the
* termination char). */
Tcl_Size maxChars; /* Max number of chars that can fit in the
* space allocated for the unicode array. */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
* of this field depends on the 'maxChars'
* field above. */
} String;
|
| ︙ | ︙ |
Changes to library/auto.tcl.
| ︙ | ︙ | |||
298 299 300 301 302 303 304 |
if {![llength $args]} {
set args *.tcl
}
foreach file [lsort [glob -- {*}$args]] {
set f ""
set error [catch {
set f [open $file]
| | | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 |
if {![llength $args]} {
set args *.tcl
}
foreach file [lsort [glob -- {*}$args]] {
set f ""
set error [catch {
set f [open $file]
fconfigure $f -encoding utf-8 -eofchar \x1A
while {[gets $f line] >= 0} {
if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
set procName [lindex [auto_qualify $procName "::"] 0]
append index "set [list auto_index($procName)]"
append index " \[list source \[file join \$dir [list $file]\]\]\n"
}
}
|
| ︙ | ︙ | |||
410 411 412 413 414 415 416 |
variable scriptFile
variable contextStack
variable imports
set scriptFile $file
set fid [open $file]
| | | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 |
variable scriptFile
variable contextStack
variable imports
set scriptFile $file
set fid [open $file]
fconfigure $fid -encoding utf-8 -eofchar \x1A
set contents [read $fid]
close $fid
# There is one problem with sourcing files into the safe interpreter:
# references like "$x" will fail since code is not really being executed
# and variables do not really exist. To avoid this, we replace all $ with
# \0 (literally, the null char) later, when getting proc names we will
|
| ︙ | ︙ |
Changes to library/init.tcl.
| ︙ | ︙ | |||
446 447 448 449 450 451 452 |
set f ""
if {$issafe} {
catch {source [file join $dir tclIndex]}
} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
continue
} else {
set error [catch {
| | | 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
set f ""
if {$issafe} {
catch {source [file join $dir tclIndex]}
} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
continue
} else {
set error [catch {
fconfigure $f -encoding utf-8 -eofchar \x1A
set id [gets $f]
if {$id eq "# Tcl autoload index file, version 2.0"} {
eval [read $f]
} elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} {
while {[gets $f line] >= 0} {
if {([string index $line 0] eq "#") \
|| ([llength $line] != 2)} {
|
| ︙ | ︙ |
Changes to library/install.tcl.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
###
set package [lindex [split $fname -] 0]
set version [lindex [split $fname -] 1]
###
# Read the file, and override assumptions as needed
###
set fin [open $file r]
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
###
set package [lindex [split $fname -] 0]
set version [lindex [split $fname -] 1]
###
# Read the file, and override assumptions as needed
###
set fin [open $file r]
fconfigure $fin -encoding utf-8 -eofchar "\x1A {}"
set dat [read $fin]
close $fin
# Look for a teapot style Package statement
foreach line [split $dat \n] {
set line [string trim $line]
if { [string range $line 0 9] != "# Package " } continue
set package [lindex $line 2]
|
| ︙ | ︙ | |||
55 56 57 58 59 60 61 |
break
}
append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
}
foreach file [glob -nocomplain $path/*.tcl] {
if { [file tail $file] == "version_info.tcl" } continue
set fin [open $file r]
| | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
break
}
append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
}
foreach file [glob -nocomplain $path/*.tcl] {
if { [file tail $file] == "version_info.tcl" } continue
set fin [open $file r]
fconfigure $fin -encoding utf-8 -eofchar "\x1A {}"
set dat [read $fin]
close $fin
if {![regexp "package provide" $dat]} continue
set fname [file rootname [file tail $file]]
# Look for a package provide statement
foreach line [split $dat \n] {
set line [string trim $line]
if { [string range $line 0 14] != "package provide" } continue
set package [lindex $line 2]
set version [lindex $line 3]
if {[string index $package 0] in "\$ \[ @"} continue
if {[string index $version 0] in "\$ \[ @"} continue
append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
break
}
}
return $buffer
}
set fin [open $pkgidxfile r]
fconfigure $fin -encoding utf-8 -eofchar "\x1A {}"
set dat [read $fin]
close $fin
set trace 0
#if {[file tail $path] eq "tool"} {
# set trace 1
#}
set thisline {}
|
| ︙ | ︙ |
Changes to library/manifest.txt.
1 2 3 4 5 6 7 8 9 10 11 12 |
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
0 http 2.10a4 {http http.tcl}
1 msgcat 1.7.1 {msgcat msgcat.tcl}
1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
0 tcl::idna 1.0.1 {cookiejar idna.tcl}
| | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
0 http 2.10a4 {http http.tcl}
1 msgcat 1.7.1 {msgcat msgcat.tcl}
1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
0 tcl::idna 1.0.1 {cookiejar idna.tcl}
0 platform 1.0.19 {platform platform.tcl}
0 platform::shell 1.1.4 {platform shell.tcl}
1 tcltest 2.5.5 {tcltest tcltest.tcl}
} {
if {$isafe && !$safe} continue
package ifneeded $package $version [list source [file join $dir {*}$file]]
}
}} $dir
|
Changes to library/platform/pkgIndex.tcl.
|
| | | 1 2 3 | package ifneeded platform 1.0.19 [list source [file join $dir platform.tcl]] package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]] |
Changes to library/platform/platform.tcl.
| ︙ | ︙ | |||
360 361 362 363 364 365 366 367 368 369 370 371 372 373 |
default { set alt {} }
}
if {$v ne ""} {
foreach {major minor} [split $v .] break
set res {}
if {$major eq 12} {
# Add 12.0 to 12.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
| > > > > > > > > > > > | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 |
default { set alt {} }
}
if {$v ne ""} {
foreach {major minor} [split $v .] break
set res {}
if {$major eq 13} {
# Add 13.0 to 13.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
}
set major 12
set minor 5
}
if {$major eq 12} {
# Add 12.0 to 12.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
|
| ︙ | ︙ | |||
416 417 418 419 420 421 422 |
return $res
}
# ### ### ### ######### ######### #########
## Ready
| | | 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 |
return $res
}
# ### ### ### ######### ######### #########
## Ready
package provide platform 1.0.19
# ### ### ### ######### ######### #########
## Demo application
if {[info exists argv0] && ($argv0 eq [info script])} {
puts ====================================
parray tcl_platform
|
| ︙ | ︙ |
Changes to library/safe.tcl.
| ︙ | ︙ | |||
1072 1073 1074 1075 1076 1077 1078 |
# Passed all the tests, lets source it. Note that we do this all manually
# because we want to control [info script] in the child so information
# doesn't leak so much. [Bug 2913625]
set old [::interp eval $child {info script}]
set replacementMsg "script error"
set code [catch {
set f [open $realfile]
| | | 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 |
# Passed all the tests, lets source it. Note that we do this all manually
# because we want to control [info script] in the child so information
# doesn't leak so much. [Bug 2913625]
set old [::interp eval $child {info script}]
set replacementMsg "script error"
set code [catch {
set f [open $realfile]
fconfigure $f -encoding $encoding -eofchar \x1A
set contents [read $f]
close $f
::interp eval $child [list info script $file]
} msg opt]
if {$code == 0} {
set code [catch {::interp eval $child $contents} msg opt]
set replacementMsg $msg
|
| ︙ | ︙ |
Changes to tests/chan.test.
| ︙ | ︙ | |||
57 58 59 60 61 62 63 |
chan configure stdout -eofchar [list \x27 {}]
} -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
chan configure stdout -eofchar [list \x27 \x80]
} -returnCodes error -match glob -result {bad value for -eofchar:*}
test chan-4.6 {chan command: check no inValue, valid outValue} -body {
chan configure stdout -eofchar [list {} \x27]
| | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
chan configure stdout -eofchar [list \x27 {}]
} -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
chan configure stdout -eofchar [list \x27 \x80]
} -returnCodes error -match glob -result {bad value for -eofchar:*}
test chan-4.6 {chan command: check no inValue, valid outValue} -body {
chan configure stdout -eofchar [list {} \x27]
} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} -cleanup {chan configure stdout -eofchar [list {} {}]}
test chan-5.1 {chan command: copy subcommand} -body {
chan copy foo
} -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\""
test chan-6.1 {chan command: eof subcommand} -body {
chan eof foo bar
|
| ︙ | ︙ |
Changes to tests/chanio.test.
| ︙ | ︙ | |||
1885 1886 1887 1888 1889 1890 1891 |
chan close $a
} -result {ascii}
test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
| | | | 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 |
chan close $a
} -result {ascii}
test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
} -result {{{}} {auto crlf}}
test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
} -result {{{}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
} -constraints {stdio notWinCI} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
set f1 [}
|
| ︙ | ︙ | |||
4653 4654 4655 4656 4657 4658 4659 |
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
| | | | | | | | 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 |
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 8 1}
test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 8 1}
test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 8 1}
test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {8 8 1}
test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {10 8 1}
test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
} -result {10 8 1}
test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar {}
chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
chan close $f
|
| ︙ | ︙ | |||
5284 5285 5286 5287 5288 5289 5290 |
} -result {auto crlf}
test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
set l ""
} -constraints {unix} -body {
set f1 [open $path(test1) w+]
lappend l [chan configure $f1 -eofchar]
| | | | | | 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 |
} -result {auto crlf}
test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
set l ""
} -constraints {unix} -body {
set f1 [open $path(test1) w+]
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar {O {}}
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar D
lappend l [chan configure $f1 -eofchar]
} -cleanup {
chan close $f1
} -result {{{}} O D}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
file delete $path(test1)
set l [list]
} -body {
set f1 [open $path(test1) w+]
chan configure $f1 -eofchar {O {}}
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar D
lappend l [chan configure $f1 -eofchar]
lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg]
} -cleanup {
chan close $f1
} -result {O D {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
writeable, it should still have valid -eofchar and -translation options} -setup {
set l [list]
} -body {
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
lappend l [chan configure $sock -eofchar] \
[chan configure $sock -translation]
|
| ︙ | ︙ |
Changes to tests/env.test.
| ︙ | ︙ | |||
102 103 104 105 106 107 108 |
variable keep {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
ProgramFiles(x86) CommonProgramW6432 ProgramW6432
| > | < | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 |
variable keep {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
ProgramFiles(x86) CommonProgramW6432 ProgramW6432
PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432 USERPROFILE
WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
}
variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
encoding system iso8859-1
proc lrem {listname name} {
upvar $listname list
set i [lsearch -nocase $list $name]
|
| ︙ | ︙ |
Changes to tests/io.test.
| ︙ | ︙ | |||
2089 2090 2091 2092 2093 2094 2095 |
set x
} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
| | | | 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 |
set x
} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
} {{{}} {auto crlf}}
test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
} {{{}} {auto lf}}
set path(stdout) [makeFile {} stdout]
test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio {
set f [open $path(script) w]
puts -nonewline $f {
close stdout
set f1 [}
puts $f [list open $path(stdout) w]]
|
| ︙ | ︙ | |||
5034 5035 5036 5037 5038 5039 5040 |
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
| | | | | | | | 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 |
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
} {8 8 1}
test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar \x1A
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
} {8 8 1}
test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar \x1A
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
} {8 8 1}
test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar \x1A
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
} {8 8 1}
test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar \x1A
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
} {10 8 1}
test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar \x1A
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1A
set l [string length [read $f]]
set e [eof $f]
close $f
list $s $l $e
} {10 8 1}
test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set i [format abc\ndef\n%cqrs\nuvw 26]
puts $f $i
close $f
|
| ︙ | ︙ | |||
5222 5223 5224 5225 5226 5227 5228 |
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1A
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
list $s $l $e [scan [string index $in end] %c]
| | | | 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 |
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1A
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
list $s $l $e [scan [string index $in end] %c]
} -result {8 8 1 13}
test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar \x1A
puts $f {}
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1A
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
list $s $l $e [scan [string index $in end] %c]
} -result {1 1 1 13}
test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f {}
close $f
set s [file size $path(test1)]
|
| ︙ | ︙ | |||
5757 5758 5759 5760 5761 5762 5763 |
set modes
} {auto crlf}
test io-39.22 {Tcl_SetChannelOption, invariance} {unix} {
file delete $path(test1)
set f1 [open $path(test1) w+]
set l ""
lappend l [fconfigure $f1 -eofchar]
| | | | | | 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 |
set modes
} {auto crlf}
test io-39.22 {Tcl_SetChannelOption, invariance} {unix} {
file delete $path(test1)
set f1 [open $path(test1) w+]
set l ""
lappend l [fconfigure $f1 -eofchar]
fconfigure $f1 -eofchar {O {}}
lappend l [fconfigure $f1 -eofchar]
fconfigure $f1 -eofchar D
lappend l [fconfigure $f1 -eofchar]
close $f1
set l
} {{{}} O D}
test io-39.22a {Tcl_SetChannelOption, invariance} {
file delete $path(test1)
set f1 [open $path(test1) w+]
set l [list]
fconfigure $f1 -eofchar {O {}}
lappend l [fconfigure $f1 -eofchar]
fconfigure $f1 -eofchar D
lappend l [fconfigure $f1 -eofchar]
lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
close $f1
set l
} {O D {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
writeable, it should still have valid -eofchar and -translation options } {
set l [list]
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
set l
|
| ︙ | ︙ |
Changes to tests/ioCmd.test.
| ︙ | ︙ | |||
1359 1360 1361 1362 1363 1364 1365 |
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
note [fconfigure $c]
close $c
rename foo {}
set res
| | | | | 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 |
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
set c [chan create {r w} foo]
note [fconfigure $c]
close $c
rename foo {}
set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
set res {}
proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
set c [chan create {r w} foo]
note [fconfigure $c]
close $c
rename foo {}
set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
set res {}
proc foo {args} {
oninit cget cgetall; onfinal; track
return "-bar foo -snarf x"
}
set c [chan create {r w} foo]
note [fconfigure $c]
close $c
rename foo {}
set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *} -bar foo -snarf x}}
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
set res {}
proc foo {args} {
oninit cget cgetall; onfinal; track
return "-bar"
}
set c [chan create {r w} foo]
|
| ︙ | ︙ |
Changes to tests/main.test.
| ︙ | ︙ | |||
602 603 604 605 606 607 608 |
Tcl_Main handles stdin EOF in mid-command
} -constraints {
exec
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
catch {chan configure $f -blocking 0}
} -body {
| | | 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 |
Tcl_Main handles stdin EOF in mid-command
} -constraints {
exec
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
catch {chan configure $f -blocking 0}
} -body {
type $f "chan configure stdin -eofchar \\x1A
if 1 \{\n\x1A"
variable wait
chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
set id [after 5000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
|
| ︙ | ︙ |
Changes to unix/Makefile.in.
| ︙ | ︙ | |||
1057 1058 1059 1060 1061 1062 1063 | done @echo "Installing package msgcat 1.7.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm" @echo "Installing package tcltest 2.5.5 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm" | | | | 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 | done @echo "Installing package msgcat 1.7.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm" @echo "Installing package tcltest 2.5.5 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm" @echo "Installing package platform 1.0.19 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm" @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" @for i in $(TOP_DIR)/library/encoding/*.enc; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \ done |
| ︙ | ︙ |
Changes to unix/README.
1 2 3 4 5 6 7 8 9 10 | Tcl UNIX README --------------- This is the directory where you configure, compile, test, and install UNIX versions of Tcl. This directory also contains source files for Tcl that are specific to UNIX. Some of the files in this directory are used on the PC or MacOSX platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and some of them only make sense under UNIX. Updated forms of the information found in this file is available at: | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | Tcl UNIX README --------------- This is the directory where you configure, compile, test, and install UNIX versions of Tcl. This directory also contains source files for Tcl that are specific to UNIX. Some of the files in this directory are used on the PC or MacOSX platform too, but they all depend on UNIX (POSIX/ANSI C) interfaces and some of them only make sense under UNIX. Updated forms of the information found in this file is available at: https://www.tcl-lang.org/doc/howto/compile.html#unix For information on platforms where Tcl is known to compile, along with any porting notes for getting it to work on those platforms, see: https://www.tcl-lang.org/software/tcltk/platforms.html The rest of this file contains instructions on how to do this. The release should compile and run either "out of the box" or with trivial changes on any UNIX-like system that approximates POSIX, BSD, or System V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for a PC running Windows, see the README file in the directory ../win. To compile for MacOSX, see the README file in |
| ︙ | ︙ |
Changes to unix/tcl.pc.in.
1 2 3 4 5 6 7 8 9 10 | # tcl pkg-config source file prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ libfile=@TCL_LIB_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
# tcl pkg-config source file
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
libfile=@TCL_LIB_FILE@
Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: https://www.tcl-lang.org/
Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
Requires.private: zlib >= 1.2.3, libtommath >= 1.2.0
Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@
Libs.private: @TCL_LIBS@
Cflags: -I${includedir}
|
Changes to win/Makefile.in.
| ︙ | ︙ | |||
917 918 919 920 921 922 923 | @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"; @echo "Installing package tcltest 2.5.5 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm"; | | | | 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 | @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"; @echo "Installing package tcltest 2.5.5 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm"; @echo "Installing package platform 1.0.19 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm"; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; |
| ︙ | ︙ |
Changes to win/rules.vc.
| ︙ | ︙ | |||
703 704 705 706 707 708 709 | !endif !if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] !endif !if defined(_TK_H) !if [echo TK_MAJOR_VERSION = \>> versions.vc] \ | | | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 | !endif !if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] !endif !if defined(_TK_H) !if [echo TK_MAJOR_VERSION = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) "define TK_MAJOR_VERSION" >> versions.vc] !endif !if [echo TK_MINOR_VERSION = \>> versions.vc] \ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] !endif !if [echo TK_RELEASE_SERIAL = \>> versions.vc] \ && [nmakehlp -V "$(_TK_H)" TK_RELEASE_SERIAL >> versions.vc] !endif |
| ︙ | ︙ |
Changes to win/tclWinChan.c.
| ︙ | ︙ | |||
1234 1235 1236 1237 1238 1239 1240 |
}
/*
* Set up the normal channel options for stdio handles.
*/
if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
| < | 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 |
}
/*
* Set up the normal channel options for stdio handles.
*/
if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
Tcl_CloseEx(NULL, channel, 0);
return (Tcl_Channel) NULL;
}
return channel;
}
|
| ︙ | ︙ | |||
1311 1312 1313 1314 1315 1316 1317 |
/*
* Files have default translation of AUTO and ^Z eof char, which means
* that a ^Z will be accepted as EOF when reading.
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
| < | 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 |
/*
* Files have default translation of AUTO and ^Z eof char, which means
* that a ^Z will be accepted as EOF when reading.
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to win/tclWinConsole.c.
| ︙ | ︙ | |||
2196 2197 2198 2199 2200 2201 2202 |
/*
* Consoles have default translation of auto and ^Z eof char, which means
* that a ^Z will be accepted as EOF when reading.
*/
Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-translation", "auto");
| < | 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 |
/*
* Consoles have default translation of auto and ^Z eof char, which means
* that a ^Z will be accepted as EOF when reading.
*/
Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-encoding", "utf-16");
return chanInfoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to win/tclWinPipe.c.
| ︙ | ︙ | |||
1823 1824 1825 1826 1827 1828 1829 |
* unique, in case channels share handles (stdin/stdout).
*/
sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
infoPtr, infoPtr->validMask);
| < < < < < < < | 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 |
* unique, in case channels share handles (stdin/stdout).
*/
sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
infoPtr, infoPtr->validMask);
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreatePipe --
|
| ︙ | ︙ |
Changes to win/tclWinSerial.c.
| ︙ | ︙ | |||
1504 1505 1506 1507 1508 1509 1510 |
infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
infoPtr->evWritable), 0, NULL);
}
| < < < < < < | 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 |
infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
infoPtr->evWritable), 0, NULL);
}
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |