Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge trunk |
|---|---|
| Timelines: | family | ancestors | descendants | both | novem |
| Files: | files | file ages | folders |
| SHA3-256: |
fc81e3975620457b3da4c5487b4022eb |
| User & Date: | dgp 2022-11-20 22:51:23.404 |
Context
|
2022-11-22
| ||
| 23:49 | merge trunk check-in: bdb510aae1 user: dgp tags: novem | |
|
2022-11-20
| ||
| 22:51 | merge trunk check-in: fc81e39756 user: dgp tags: novem | |
| 22:37 | merge 8.7 check-in: 38b9a3dc90 user: dgp tags: trunk, main | |
|
2022-11-16
| ||
| 13:49 | merge trunk check-in: 92253f73ad user: dgp tags: novem | |
Changes
Changes to doc/DString.3.
| ︙ | ︙ | |||
35 36 37 38 39 40 41 42 43 44 45 46 47 48 | \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) .sp \fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR) .SH ARGUMENTS .AS Tcl_DString newLength in/out .AP Tcl_DString *dsPtr in/out Pointer to structure that is used to manage a dynamic string. .AP "const char" *bytes in Pointer to characters to append to dynamic string. .AP "const char" *element in | > > > > | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) .sp \fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR) .sp Tcl_Obj * \fBTcl_DStringToObj\fR(\fIdsPtr\fR) .sp .SH ARGUMENTS .AS Tcl_DString newLength in/out .AP Tcl_DString *dsPtr in/out Pointer to structure that is used to manage a dynamic string. .AP "const char" *bytes in Pointer to characters to append to dynamic string. .AP "const char" *element in |
| ︙ | ︙ | |||
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | .PP \fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of the dynamic string given by \fIdsPtr\fR. It does this by moving a pointer from \fIdsPtr\fR to the interpreter's result. This saves the cost of allocating new memory and copying the string. \fBTcl_DStringResult\fR also reinitializes the dynamic string to an empty string. .PP \fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR. It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and it clears \fIinterp\fR's result. If possible it does this by moving a pointer rather than by copying the string. .SH KEYWORDS append, dynamic string, free, result | > > > > > > > > > > > > > | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 | .PP \fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of the dynamic string given by \fIdsPtr\fR. It does this by moving a pointer from \fIdsPtr\fR to the interpreter's result. This saves the cost of allocating new memory and copying the string. \fBTcl_DStringResult\fR also reinitializes the dynamic string to an empty string. Since the dynamic string is reinitialized, there is no need to further call \fBTcl_DStringFree\fR on it and it can be reused without calling \fBTcl_DStringInit\fR. .PP \fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR. It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and it clears \fIinterp\fR's result. If possible it does this by moving a pointer rather than by copying the string. .PP \fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of the dynamic string given by \fIdsPtr\fR. It does this by moving a pointer from \fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR and reinitializing to dynamic string to an empty string. This saves the cost of allocating new memory and copying the string. Since the dynamic string is reinitialized, there is no need to further call \fBTcl_DStringFree\fR on it and it can be reused without calling \fBTcl_DStringInit\fR. The returned \fBTcl_Obj\fR has a reference count of 0. .SH KEYWORDS append, dynamic string, free, result |
Changes to doc/ObjectType.3.
| ︙ | ︙ | |||
105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
.CS
typedef struct Tcl_ObjType {
const char *\fIname\fR;
Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
Tcl_UpdateStringProc *\fIupdateStringProc\fR;
Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type. For unregistered
| > | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 |
.CS
typedef struct Tcl_ObjType {
const char *\fIname\fR;
Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
Tcl_UpdateStringProc *\fIupdateStringProc\fR;
Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
size_t \fIversion\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type. For unregistered
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 256 257 258 259 260 261 262 | the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR member. .PP Note that if a subsidiary value has its reference count reduced to zero during the running of a \fIfreeIntRepProc\fR, that value may be not freed immediately, in order to limit stack usage. However, the value will be freed before the outermost current \fBTcl_DecrRefCount\fR returns. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared value; this function will not modify the reference count of that value, but will modify its contents. If \fIobjPtr\fR is not (interpretable as) a list, this function will set the interpreter result and produce an error; using an unshared empty value is strongly recommended. | > > > > | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR member. .PP Note that if a subsidiary value has its reference count reduced to zero during the running of a \fIfreeIntRepProc\fR, that value may be not freed immediately, in order to limit stack usage. However, the value will be freed before the outermost current \fBTcl_DecrRefCount\fR returns. .SS "THE VERSION FIELD" .PP The \fIversion\fR member provides for future extensibility of the structure and should be set to \fITCL_OBJTYPE_V0\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared value; this function will not modify the reference count of that value, but will modify its contents. If \fIobjPtr\fR is not (interpretable as) a list, this function will set the interpreter result and produce an error; using an unshared empty value is strongly recommended. |
| ︙ | ︙ |
Changes to doc/OpenFileChnl.3.
| ︙ | ︙ | |||
402 403 404 405 406 407 408 | .SH "TCL_READCHARS AND TCL_READ" .PP \fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes to UTF-8 based on the channel's encoding and storing the produced data in \fIreadObjPtr\fR's string representation. The return value of \fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR, that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the | | | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 | .SH "TCL_READCHARS AND TCL_READ" .PP \fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes to UTF-8 based on the channel's encoding and storing the produced data in \fIreadObjPtr\fR's string representation. The return value of \fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR, that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the return value is TCL_INDEX_NONE and \fBTcl_ReadChars\fR records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. .PP Setting \fIcharsToRead\fR to TCL_INDEX_NONE will cause the command to read all characters currently available (non-blocking) or everything until eof (blocking mode). .PP The return value may be smaller than the value to read, indicating that less data than requested was available. This is called a \fIshort read\fR. In blocking mode, this can only happen on an end-of-file. In nonblocking mode, a short read can also occur if there is not enough input currently |
| ︙ | ︙ | |||
467 468 469 470 471 472 473 | channel is treated as an individual Unicode character. All of the characters of the line except for the terminating end-of-line character(s) are appended to \fIlineObjPtr\fR's string representation. The end-of-line character(s) are read and discarded. .PP If a line was successfully read, the return value is greater than or equal to zero and indicates the number of bytes stored in \fIlineObjPtr\fR. If an | | | | | | | | | | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 | channel is treated as an individual Unicode character. All of the characters of the line except for the terminating end-of-line character(s) are appended to \fIlineObjPtr\fR's string representation. The end-of-line character(s) are read and discarded. .PP If a line was successfully read, the return value is greater than or equal to zero and indicates the number of bytes stored in \fIlineObjPtr\fR. If an error occurs, \fBTcl_GetsObj\fR returns TCL_INDEX_NONE and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. \fBTcl_GetsObj\fR also returns TCL_INDEX_NONE if the end of the file is reached; the \fBTcl_Eof\fR procedure can be used to distinguish an error from an end-of-file condition. .PP If the channel is in nonblocking mode, the return value can also be TCL_INDEX_NONE if no data was available or the data that was available did not contain an end-of-line character. When TCL_INDEX_NONE is returned, the \fBTcl_InputBlocked\fR procedure may be invoked to determine if the channel is blocked because of input unavailability. .PP \fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting characters are appended to the dynamic string given by \fIlineRead\fR rather than a Tcl value. .SH "TCL_UNGETS" .PP \fBTcl_Ungets\fR is used to add data to the input queue of a channel, at either the head or tail of the queue. The pointer \fIinput\fR points to the data that is to be added. The length of the input to add is given by \fIinputLen\fR. A non-zero value of \fIaddAtEnd\fR indicates that the data is to be added at the end of queue; otherwise it will be added at the head of the queue. If \fIchannel\fR has a .QW sticky EOF set, no data will be added to the input queue. \fBTcl_Ungets\fR returns \fIinputLen\fR or TCL_INDEX_NONE if an error occurs. .SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE" .PP \fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at \fIcharBuf\fR. The UTF-8 characters in the buffer are converted to the channel's encoding and queued for output to \fIchannel\fR. If \fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR to be null-terminated and it outputs everything up to the null. .PP Data queued for output may not appear on the output device immediately, due to internal buffering. If the data should appear immediately, call \fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the \fB\-buffering\fR option on the channel to \fBnone\fR. If you wish the data to appear as soon as a complete line is accepted for output, set the \fB\-buffering\fR option on the channel to \fBline\fR mode. .PP The return value of \fBTcl_WriteChars\fR is a count of how many bytes were accepted for output to the channel. This is either TCL_INDEX_NONE to indicate that an error occurred or another number greater than zero to indicate success. If an error occurs, \fBTcl_WriteChars\fR records a POSIX error code that may be retrieved with \fBTcl_GetErrno\fR. .PP Newline characters in the output data are translated to platform-specific end-of-line sequences according to the \fB\-translation\fR option for the channel. This is done even if the channel has no encoding. .PP \fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it accepts a Tcl value whose contents will be output to the channel. The |
| ︙ | ︙ |
Changes to doc/ToUpper.3.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 | .sp int \fBTcl_UniCharToLower\fR(\fIch\fR) .sp int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp | | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | .sp int \fBTcl_UniCharToLower\fR(\fIch\fR) .sp int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp size_t \fBTcl_UtfToUpper\fR(\fIstr\fR) .sp size_t \fBTcl_UtfToLower\fR(\fIstr\fR) .sp size_t \fBTcl_UtfToTitle\fR(\fIstr\fR) .SH ARGUMENTS .AS char *str in/out .AP int ch in The Unicode character to be converted. .AP char *str in/out Pointer to UTF-8 string to be converted in place. |
| ︙ | ︙ |
Changes to doc/Utf.3.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 | Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp | | | | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp size_t \fBTcl_UniCharToUtf\fR(\fIch, buf\fR) .sp size_t \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp size_t \fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR) .sp size_t \fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR) .sp char * \fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR) .sp char * \fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR) |
| ︙ | ︙ |
Changes to generic/tcl.decls.
| ︙ | ︙ | |||
1204 1205 1206 1207 1208 1209 1210 |
declare 322 {
int Tcl_UniCharToTitle(int ch)
}
declare 323 {
int Tcl_UniCharToUpper(int ch)
}
declare 324 {
| | | 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 |
declare 322 {
int Tcl_UniCharToTitle(int ch)
}
declare 323 {
int Tcl_UniCharToUpper(int ch)
}
declare 324 {
Tcl_Size Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
const char *TclUtfAtIndex(const char *src, Tcl_Size index)
}
declare 326 {
int TclUtfCharComplete(const char *src, Tcl_Size length)
}
|
| ︙ | ︙ | |||
1238 1239 1240 1241 1242 1243 1244 |
int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr)
}
declare 334 {
| | | | | | 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 |
int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr)
}
declare 334 {
Tcl_Size Tcl_UtfToLower(char *src)
}
declare 335 {
Tcl_Size Tcl_UtfToTitle(char *src)
}
declare 336 {
Tcl_Size Tcl_UtfToChar16(const char *src, unsigned short *chPtr)
}
declare 337 {
Tcl_Size Tcl_UtfToUpper(char *src)
}
declare 338 {
Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, Tcl_Size srcLen)
}
declare 339 {
Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
|
| ︙ | ︙ | |||
2452 2453 2454 2455 2456 2457 2458 |
declare 645 {
int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Size endValue, Tcl_Size *indexPtr)
}
# TIP #548
declare 646 {
| | | 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 |
declare 645 {
int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Size endValue, Tcl_Size *indexPtr)
}
# TIP #548
declare 646 {
Tcl_Size Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 647 {
char *Tcl_UniCharToUtfDString(const int *uniStr,
Tcl_Size uniLength, Tcl_DString *dsPtr)
}
declare 648 {
int *Tcl_UtfToUniCharDString(const char *src,
|
| ︙ | ︙ | |||
2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 |
# TIP #650 (reserved)
#declare 686 {
# int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
# Tcl_WideUInt *uwidePtr)
#}
# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.
| > > > > | 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 |
# TIP #650 (reserved)
#declare 686 {
# int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
# Tcl_WideUInt *uwidePtr)
#}
# TIP 651
declare 687 {
Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr)
}
# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.
|
| ︙ | ︙ |
Changes to generic/tcl.h.
| ︙ | ︙ | |||
594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 |
Tcl_UpdateStringProc *updateStringProc;
/* Called to update the string rep from the
* type's internal representation. */
Tcl_SetFromAnyProc *setFromAnyProc;
/* Called to convert the object's internal rep
* to this type. Frees the internal rep of the
* old type. Returns TCL_ERROR on failure. */
} Tcl_ObjType;
/*
* The following structure stores an internal representation (internalrep) for
* a Tcl value. An internalrep is associated with an Tcl_ObjType when both
* are stored in the same Tcl_Obj. The routines of the Tcl_ObjType govern
* the handling of the internalrep.
*/
| > > > > > | 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 |
Tcl_UpdateStringProc *updateStringProc;
/* Called to update the string rep from the
* type's internal representation. */
Tcl_SetFromAnyProc *setFromAnyProc;
/* Called to convert the object's internal rep
* to this type. Frees the internal rep of the
* old type. Returns TCL_ERROR on failure. */
size_t version;
} Tcl_ObjType;
#define TCL_OBJTYPE_V0 0 /* Pre-Tcl 9. Set to 0 so compiler will auto-init
* when existing code that does not init this
* field is compiled with Tcl9 headers */
#define TCL_OBJTYPE_CURRENT TCL_OBJTYPE_V0
/*
* The following structure stores an internal representation (internalrep) for
* a Tcl value. An internalrep is associated with an Tcl_ObjType when both
* are stored in the same Tcl_Obj. The routines of the Tcl_ObjType govern
* the handling of the internalrep.
*/
|
| ︙ | ︙ |
Changes to generic/tclArithSeries.c.
| ︙ | ︙ | |||
71 72 73 74 75 76 77 |
*/
const Tcl_ObjType tclArithSeriesType = {
"arithseries", /* name */
FreeArithSeriesInternalRep, /* freeIntRepProc */
DupArithSeriesInternalRep, /* dupIntRepProc */
UpdateStringOfArithSeries, /* updateStringProc */
| | > | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
*/
const Tcl_ObjType tclArithSeriesType = {
"arithseries", /* name */
FreeArithSeriesInternalRep, /* freeIntRepProc */
DupArithSeriesInternalRep, /* dupIntRepProc */
UpdateStringOfArithSeries, /* updateStringProc */
SetArithSeriesFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
*----------------------------------------------------------------------
*
* ArithSeriesLen --
*
|
| ︙ | ︙ |
Changes to generic/tclAssembly.c.
| ︙ | ︙ | |||
321 322 323 324 325 326 327 |
static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
DupAssembleCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 |
static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
DupAssembleCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* Source instructions recognized in the Tcl Assembly Language (TAL)
*/
static const TalInstDesc TalInstructionTable[] = {
|
| ︙ | ︙ |
Changes to generic/tclBinary.c.
| ︙ | ︙ | |||
158 159 160 161 162 163 164 |
*/
static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeProperByteArrayInternalRep,
DupProperByteArrayInternalRep,
UpdateStringOfByteArray,
| | > | 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 |
*/
static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeProperByteArrayInternalRep,
DupProperByteArrayInternalRep,
UpdateStringOfByteArray,
NULL,
TCL_OBJTYPE_V0
};
/*
* The following structure is the internal rep for a ByteArray object. Keeps
* track of how much memory has been used and how much has been allocated for
* the byte array to enable growing and shrinking of the ByteArray object with
* fewer mallocs.
|
| ︙ | ︙ |
Changes to generic/tclCmdAH.c.
| ︙ | ︙ | |||
507 508 509 510 511 512 513 |
}
/*
* Note that we cannot use Tcl_DStringResult here because it will
* truncate the string at the first null byte.
*/
| | | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 |
}
/*
* Note that we cannot use Tcl_DStringResult here because it will
* truncate the string at the first null byte.
*/
Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));
/*
* We're done with the encoding
*/
Tcl_FreeEncoding(encoding);
return TCL_OK;
|
| ︙ | ︙ | |||
1908 1909 1910 1911 1912 1913 1914 |
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
return TCL_ERROR;
}
| | | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 |
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* PathNormalizeCmd --
|
| ︙ | ︙ |
Changes to generic/tclCompile.c.
| ︙ | ︙ | |||
711 712 713 714 715 716 717 |
*/
const Tcl_ObjType tclByteCodeType = {
"bytecode", /* name */
FreeByteCodeInternalRep, /* freeIntRepProc */
DupByteCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > > | 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 |
*/
const Tcl_ObjType tclByteCodeType = {
"bytecode", /* name */
FreeByteCodeInternalRep, /* freeIntRepProc */
DupByteCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetByteCodeFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* subtCodeType provides the standard type managemnt procedures for the
* substcode type, which represents substiution within a Tcl value.
*/
static const Tcl_ObjType substCodeType = {
"substcode", /* name */
FreeSubstCodeInternalRep, /* freeIntRepProc */
DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2
/*
* Helper macros.
*/
|
| ︙ | ︙ |
Changes to generic/tclDecls.h.
| ︙ | ︙ | |||
843 844 845 846 847 848 849 | /* 321 */ TCLAPI int Tcl_UniCharToLower(int ch); /* 322 */ TCLAPI int Tcl_UniCharToTitle(int ch); /* 323 */ TCLAPI int Tcl_UniCharToUpper(int ch); /* 324 */ | | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 | /* 321 */ TCLAPI int Tcl_UniCharToLower(int ch); /* 322 */ TCLAPI int Tcl_UniCharToTitle(int ch); /* 323 */ TCLAPI int Tcl_UniCharToUpper(int ch); /* 324 */ TCLAPI Tcl_Size Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ TCLAPI const char * TclUtfAtIndex(const char *src, Tcl_Size index); /* 326 */ TCLAPI int TclUtfCharComplete(const char *src, Tcl_Size length); /* 327 */ TCLAPI Tcl_Size Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); |
| ︙ | ︙ | |||
871 872 873 874 875 876 877 | Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ TCLAPI char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr); /* 334 */ | | | | | | 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 | Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ TCLAPI char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr); /* 334 */ TCLAPI Tcl_Size Tcl_UtfToLower(char *src); /* 335 */ TCLAPI Tcl_Size Tcl_UtfToTitle(char *src); /* 336 */ TCLAPI Tcl_Size Tcl_UtfToChar16(const char *src, unsigned short *chPtr); /* 337 */ TCLAPI Tcl_Size Tcl_UtfToUpper(char *src); /* 338 */ TCLAPI Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 339 */ TCLAPI Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ TCLAPI char * Tcl_GetString(Tcl_Obj *objPtr); |
| ︙ | ︙ | |||
1718 1719 1720 1721 1722 1723 1724 | const char *varName, void *addr, int type, Tcl_Size size); /* 645 */ TCLAPI int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 646 */ | | | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 | const char *varName, void *addr, int type, Tcl_Size size); /* 645 */ TCLAPI int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 646 */ TCLAPI Tcl_Size Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ TCLAPI char * Tcl_UniCharToUtfDString(const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 648 */ TCLAPI int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ |
| ︙ | ︙ | |||
1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 |
size_t numBytes, void **clientDataPtr,
int *typePtr);
/* 682 */
TCLAPI int Tcl_RemoveChannelMode(Tcl_Interp *interp,
Tcl_Channel chan, int mode);
/* 683 */
TCLAPI int Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
const struct TclOOStubs *tclOOStubs;
const struct TclOOIntStubs *tclOOIntStubs;
| > > > > > | 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 |
size_t numBytes, void **clientDataPtr,
int *typePtr);
/* 682 */
TCLAPI int Tcl_RemoveChannelMode(Tcl_Interp *interp,
Tcl_Channel chan, int mode);
/* 683 */
TCLAPI int Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
/* Slot 684 is reserved */
/* Slot 685 is reserved */
/* Slot 686 is reserved */
/* 687 */
TCLAPI Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
const struct TclOOStubs *tclOOStubs;
const struct TclOOIntStubs *tclOOIntStubs;
|
| ︙ | ︙ | |||
2172 2173 2174 2175 2176 2177 2178 |
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, int position); /* 319 */
int (*tcl_UniCharAtIndex) (const char *src, Tcl_Size index); /* 320 */
int (*tcl_UniCharToLower) (int ch); /* 321 */
int (*tcl_UniCharToTitle) (int ch); /* 322 */
int (*tcl_UniCharToUpper) (int ch); /* 323 */
| | | | | | | 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 |
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, int position); /* 319 */
int (*tcl_UniCharAtIndex) (const char *src, Tcl_Size index); /* 320 */
int (*tcl_UniCharToLower) (int ch); /* 321 */
int (*tcl_UniCharToTitle) (int ch); /* 322 */
int (*tcl_UniCharToUpper) (int ch); /* 323 */
Tcl_Size (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
const char * (*tclUtfAtIndex) (const char *src, Tcl_Size index); /* 325 */
int (*tclUtfCharComplete) (const char *src, Tcl_Size length); /* 326 */
Tcl_Size (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
const char * (*tclUtfNext) (const char *src); /* 330 */
const char * (*tclUtfPrev) (const char *src, const char *start); /* 331 */
int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr); /* 333 */
Tcl_Size (*tcl_UtfToLower) (char *src); /* 334 */
Tcl_Size (*tcl_UtfToTitle) (char *src); /* 335 */
Tcl_Size (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */
Tcl_Size (*tcl_UtfToUpper) (char *src); /* 337 */
Tcl_Size (*tcl_WriteChars) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 338 */
Tcl_Size (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
void (*reserved341)(void);
void (*reserved342)(void);
void (*tcl_AlertNotifier) (void *clientData); /* 343 */
void (*tcl_ServiceModeHook) (int mode); /* 344 */
|
| ︙ | ︙ | |||
2494 2495 2496 2497 2498 2499 2500 |
void (*tcl_StoreInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 639 */
int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */
int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */
| | | 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 |
void (*tcl_StoreInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 639 */
int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */
int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */
Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */
int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */
char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */
|
| ︙ | ︙ | |||
2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 |
Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
#ifdef __cplusplus
}
#endif
| > > > > | 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 |
Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
void (*reserved684)(void);
void (*reserved685)(void);
void (*reserved686)(void);
Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 687 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 | (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */ #define Tcl_GetNumber \ (tclStubsPtr->tcl_GetNumber) /* 681 */ #define Tcl_RemoveChannelMode \ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef _WIN32 # undef Tcl_CreateFileHandler | > > > > > | 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 | (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */ #define Tcl_GetNumber \ (tclStubsPtr->tcl_GetNumber) /* 681 */ #define Tcl_RemoveChannelMode \ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ /* Slot 684 is reserved */ /* Slot 685 is reserved */ /* Slot 686 is reserved */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 687 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef _WIN32 # undef Tcl_CreateFileHandler |
| ︙ | ︙ | |||
4112 4113 4114 4115 4116 4117 4118 | # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ | | | | 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 | # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ : tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) |
| ︙ | ︙ | |||
4153 4154 4155 4156 4157 4158 4159 | # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ | | | | 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 | # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) #if !defined(BUILD_tcl) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ : (Tcl_ListObjGetElements)((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) |
| ︙ | ︙ |
Changes to generic/tclDictObj.c.
| ︙ | ︙ | |||
142 143 144 145 146 147 148 |
*/
const Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
| | > | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 |
*/
const Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define DictSetInternalRep(objPtr, dictRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (dictRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
|
| ︙ | ︙ |
Changes to generic/tclDisassemble.c.
| ︙ | ︙ | |||
38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
static const Tcl_ObjType instNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
};
#define InstNameSetInternalRep(objPtr, inst) \
do { \
Tcl_ObjInternalRep ir; \
ir.wideValue = (inst); \
Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \
| > | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
static const Tcl_ObjType instNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define InstNameSetInternalRep(objPtr, inst) \
do { \
Tcl_ObjInternalRep ir; \
ir.wideValue = (inst); \
Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \
|
| ︙ | ︙ |
Changes to generic/tclEncoding.c.
| ︙ | ︙ | |||
232 233 234 235 236 237 238 |
/*
* A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
* of the internalrep. This should help the lifetime of encodings be more useful.
* See concerns raised in [Bug 1077262].
*/
static const Tcl_ObjType encodingType = {
| > | > > > > > | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 |
/*
* A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
* of the internalrep. This should help the lifetime of encodings be more useful.
* See concerns raised in [Bug 1077262].
*/
static const Tcl_ObjType encodingType = {
"encoding",
FreeEncodingInternalRep,
DupEncodingInternalRep,
NULL,
NULL,
TCL_OBJTYPE_V0
};
#define EncodingSetInternalRep(objPtr, encoding) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (encoding); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \
} while (0)
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
77 78 79 80 81 82 83 |
*/
static const Tcl_ObjType ensembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
*/
static const Tcl_ObjType ensembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define ECRSetInternalRep(objPtr, ecRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (ecRepPtr); \
ir.twoPtrValue.ptr2 = NULL; \
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
659 660 661 662 663 664 665 |
*/
static const Tcl_ObjType exprCodeType = {
"exprcode",
FreeExprCodeInternalRep, /* freeIntRepProc */
DupExprCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | | 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 |
*/
static const Tcl_ObjType exprCodeType = {
"exprcode",
FreeExprCodeInternalRep, /* freeIntRepProc */
DupExprCodeInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* Custom object type only used in this file; values of its type should never
* be seen by user scripts.
*/
static const Tcl_ObjType dictIteratorType = {
"dictIterator",
ReleaseDictIterator,
NULL, NULL, NULL, TCL_OBJTYPE_V0
};
/*
*----------------------------------------------------------------------
*
* ReleaseDictIterator --
*
|
| ︙ | ︙ |
Changes to generic/tclFileName.c.
| ︙ | ︙ | |||
425 426 427 428 429 430 431 |
const char *rootEnd;
Tcl_DStringInit(&ds);
rootEnd = ExtractWinRoot(path, &ds, 0, &type);
if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
*driveNameLengthPtr = rootEnd - path;
if (driveNameRef != NULL) {
| | | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 |
const char *rootEnd;
Tcl_DStringInit(&ds);
rootEnd = ExtractWinRoot(path, &ds, 0, &type);
if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
*driveNameLengthPtr = rootEnd - path;
if (driveNameRef != NULL) {
*driveNameRef = Tcl_DStringToObj(&ds);
Tcl_IncrRefCount(*driveNameRef);
}
}
Tcl_DStringFree(&ds);
break;
}
}
|
| ︙ | ︙ | |||
698 699 700 701 702 703 704 |
p = ExtractWinRoot(path, &buf, 0, &type);
/*
* Terminate the root portion, if we matched something.
*/
if (p != path) {
| | | 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 |
p = ExtractWinRoot(path, &buf, 0, &type);
/*
* Terminate the root portion, if we matched something.
*/
if (p != path) {
Tcl_ListObjAppendElement(NULL, result, Tcl_DStringToObj(&buf));
}
Tcl_DStringFree(&buf);
/*
* Split on slashes.
*/
|
| ︙ | ︙ | |||
2238 2239 2240 2241 2242 2243 2244 |
}
/*
* Common for all platforms.
*/
if (pathPtr == NULL) {
| | | 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 |
}
/*
* Common for all platforms.
*/
if (pathPtr == NULL) {
joinedPtr = Tcl_DStringToObj(&append);
} else if (flags) {
joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
Tcl_DStringLength(&append));
} else {
joinedPtr = Tcl_DuplicateObj(pathPtr);
if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
/*
|
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
328 329 330 331 332 333 334 |
static void FreeChannelInternalRep(Tcl_Obj *objPtr);
static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelInternalRep, /* freeIntRepProc */
DupChannelInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 |
static void FreeChannelInternalRep(Tcl_Obj *objPtr);
static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelInternalRep, /* freeIntRepProc */
DupChannelInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define ChanSetInternalRep(objPtr, resPtr) \
do { \
Tcl_ObjInternalRep ir; \
(resPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (resPtr); \
|
| ︙ | ︙ |
Changes to generic/tclIndexObj.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 |
*/
static const Tcl_ObjType indexType = {
"index", /* name */
FreeIndex, /* freeIntRepProc */
DupIndex, /* dupIntRepProc */
UpdateStringOfIndex, /* updateStringProc */
| | > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
*/
static const Tcl_ObjType indexType = {
"index", /* name */
FreeIndex, /* freeIntRepProc */
DupIndex, /* dupIntRepProc */
UpdateStringOfIndex, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* The definition of the internal representation of the "index" object; The
* internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
* pointer to one of these structures.
*
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
3109 3110 3111 3112 3113 3114 3115 | void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); | < | 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 | void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, size_t objc, size_t *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); |
| ︙ | ︙ |
Changes to generic/tclIntPlatDecls.h.
| ︙ | ︙ | |||
301 302 303 304 305 306 307 |
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
| | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 |
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
void *(*tclpReaddir) (void *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
int (*tclpIsAtty) (int fd); /* 16 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
|
| ︙ | ︙ | |||
447 448 449 450 451 452 453 | (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ #define TclWinSetSockOpt \ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ | < < | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 | (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ #define TclWinSetSockOpt \ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ (tclIntPlatStubsPtr->tclpCloseFile) /* 12 */ #define TclpCreateCommandChannel \ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */ #define TclpCreatePipe \ |
| ︙ | ︙ |
Changes to generic/tclLink.c.
| ︙ | ︙ | |||
110 111 112 113 114 115 116 |
*/
static Tcl_ObjType invalidRealType = {
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
*/
static Tcl_ObjType invalidRealType = {
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* Convenience macro for accessing the value of the C variable pointed to by a
* link. Note that this macro produces something that may be regarded as an
* lvalue or rvalue; it may be assigned to as well as read. Also note that
* this macro assumes the name of the variable being accessed (linkPtr); this
|
| ︙ | ︙ | |||
525 526 527 528 529 530 531 532 533 |
if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
if (type == TCL_NUMBER_INT) {
*widePtr = *((const Tcl_WideInt *) clientData);
return (*widePtr < 0);
} else if (type == TCL_NUMBER_BIG) {
mp_int *numPtr = (mp_int *)clientData;
Tcl_WideUInt value = 0;
size_t numBytes;
| > > > > > | | > > > > > > > > > > | 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 |
if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
if (type == TCL_NUMBER_INT) {
*widePtr = *((const Tcl_WideInt *) clientData);
return (*widePtr < 0);
} else if (type == TCL_NUMBER_BIG) {
mp_int *numPtr = (mp_int *)clientData;
Tcl_WideUInt value = 0;
union {
Tcl_WideUInt value;
unsigned char bytes[sizeof(Tcl_WideUInt)];
} scratch;
size_t numBytes;
unsigned char *bytes = scratch.bytes;
if (numPtr->sign || (MP_OKAY != mp_to_ubin(numPtr,
bytes, sizeof(Tcl_WideUInt), &numBytes))) {
/*
* If the sign bit is set (a negative value) or if the value
* can't possibly fit in the bits of an unsigned wide, there's
* no point in doing further conversion.
*/
return 1;
}
#ifndef WORDS_BIGENDIAN
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
#else /* WORDS_BIGENDIAN */
/*
* Big-endian can read the value directly.
*/
value = scratch.value;
#endif /* WORDS_BIGENDIAN */
*uwidePtr = value;
return 0;
}
}
/*
* Evil edge case fallback.
|
| ︙ | ︙ |
Changes to generic/tclListObj.c.
| ︙ | ︙ | |||
151 152 153 154 155 156 157 |
*/
const Tcl_ObjType tclListType = {
"list", /* name */
FreeListInternalRep, /* freeIntRepProc */
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
| | > | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 |
*/
const Tcl_ObjType tclListType = {
"list", /* name */
FreeListInternalRep, /* freeIntRepProc */
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
SetListFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/* Macros to manipulate the List internal rep */
#define ListRepIncrRefs(repPtr_) \
do { \
(repPtr_)->storePtr->refCount++; \
if ((repPtr_)->spanPtr) \
|
| ︙ | ︙ |
Changes to generic/tclMain.c.
| ︙ | ︙ | |||
51 52 53 54 55 56 57 |
#ifdef UNICODE
Tcl_DStringInit(&ds);
Tcl_WCharToUtfDString(string, -1, &ds);
#else
(void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
| | | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
#ifdef UNICODE
Tcl_DStringInit(&ds);
Tcl_WCharToUtfDString(string, -1, &ds);
#else
(void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
return Tcl_DStringToObj(&ds);
}
/*
* Declarations for various library functions and variables (don't want to
* include tclPort.h here, because people might copy this file out of the Tcl
* source directory to make their own modified versions).
*/
|
| ︙ | ︙ |
Changes to generic/tclNamesp.c.
| ︙ | ︙ | |||
126 127 128 129 130 131 132 |
*/
static const Tcl_ObjType nsNameType = {
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
*/
static const Tcl_ObjType nsNameType = {
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetNsNameFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define NsNameSetInternalRep(objPtr, nnPtr) \
do { \
Tcl_ObjInternalRep ir; \
(nnPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (nnPtr); \
|
| ︙ | ︙ |
Changes to generic/tclOOCall.c.
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
*/
static const Tcl_ObjType methodNameType = {
"TclOO method name",
FreeMethodNameRep,
DupMethodNameRep,
NULL,
| | > | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 |
*/
static const Tcl_ObjType methodNameType = {
"TclOO method name",
FreeMethodNameRep,
DupMethodNameRep,
NULL,
NULL,
TCL_OBJTYPE_V0
};
/*
* ----------------------------------------------------------------------
*
* TclOODeleteContext --
|
| ︙ | ︙ |
Changes to generic/tclObj.c.
| ︙ | ︙ | |||
226 227 228 229 230 231 232 |
*/
const Tcl_ObjType tclBooleanType = {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | > | > | > | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 |
*/
const Tcl_ObjType tclBooleanType = {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
const Tcl_ObjType tclDoubleType = {
"double", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
const Tcl_ObjType tclIntType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
const Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
DupBignum, /* dupIntRepProc */
UpdateStringOfBignum, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* The structure below defines the Tcl obj hash key type.
*/
const Tcl_HashKeyType tclObjHashKeyType = {
|
| ︙ | ︙ | |||
291 292 293 294 295 296 297 |
*/
Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 |
*/
Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetCmdNameFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* Structure containing a cached pointer to a command that is the result of
* resolving the command's name in some namespace. It is the internal
* representation for a cmdName object. It contains the pointer along with
* some information that is used to check the pointer's validity.
|
| ︙ | ︙ | |||
2674 2675 2676 2677 2678 2679 2680 |
* when auto-narrowing is enabled. Only those values in the signed
* long range get auto-narrowed to tclIntType, while all the
* values in the unsigned long range will fit in a long.
*/
{
mp_int big;
| | > | | > > | 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 |
* when auto-narrowing is enabled. Only those values in the signed
* long range get auto-narrowed to tclIntType, while all the
* values in the unsigned long range will fit in a long.
*/
{
mp_int big;
unsigned long scratch, value = 0;
unsigned char *bytes = (unsigned char *) &scratch;
size_t numBytes;
TclUnpackBignum(objPtr, big);
if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
if (value <= 1 + (unsigned long)LONG_MAX) {
*longPtr = (long)(-value);
return TCL_OK;
}
} else {
if (value <= (unsigned long)ULONG_MAX) {
|
| ︙ | ︙ | |||
2911 2912 2913 2914 2915 2916 2917 2918 2919 | * Must check for those bignum values that can fit in a * Tcl_WideInt, even when auto-narrowing is enabled. */ mp_int big; Tcl_WideUInt value = 0; size_t numBytes; TclUnpackBignum(objPtr, big); | > > | | > > | 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 |
* Must check for those bignum values that can fit in a
* Tcl_WideInt, even when auto-narrowing is enabled.
*/
mp_int big;
Tcl_WideUInt value = 0;
size_t numBytes;
Tcl_WideInt scratch;
unsigned char *bytes = (unsigned char *) &scratch;
TclUnpackBignum(objPtr, big);
if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
*wideIntPtr = (Tcl_WideInt)(-value);
return TCL_OK;
}
} else {
if (value <= (Tcl_WideUInt)WIDE_MAX) {
|
| ︙ | ︙ | |||
2987 2988 2989 2990 2991 2992 2993 |
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
mp_int big;
mp_err err;
| | > < | > > > | 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 |
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
mp_int big;
mp_err err;
Tcl_WideUInt value = 0, scratch;
size_t numBytes;
unsigned char *bytes = (unsigned char *) &scratch;
Tcl_GetBignumFromObj(NULL, objPtr, &big);
err = mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
if (err == MP_OKAY) {
err = mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes);
}
if (err != MP_OKAY) {
return TCL_ERROR;
}
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
*wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
mp_clear(&big);
return TCL_OK;
}
} while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
|
| ︙ | ︙ | |||
3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 |
void
Tcl_SetBignumObj(
Tcl_Obj *objPtr, /* Object to set */
void *big) /* Value to store */
{
Tcl_WideUInt value = 0;
size_t numBytes;
mp_int *bignumValue = (mp_int *) big;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
}
| > > < | > > > | 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 |
void
Tcl_SetBignumObj(
Tcl_Obj *objPtr, /* Object to set */
void *big) /* Value to store */
{
Tcl_WideUInt value = 0;
size_t numBytes;
Tcl_WideUInt scratch;
unsigned char *bytes = (unsigned char *) &scratch;
mp_int *bignumValue = (mp_int *) big;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
}
if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) {
goto tooLargeForWide;
}
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
goto tooLargeForWide;
}
if (bignumValue->sign) {
TclSetIntObj(objPtr, (Tcl_WideInt)(-value));
} else {
TclSetIntObj(objPtr, (Tcl_WideInt)value);
|
| ︙ | ︙ |
Changes to generic/tclPathObj.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 |
*/
static const Tcl_ObjType fsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
UpdateStringOfFsPath, /* updateStringProc */
| | > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
*/
static const Tcl_ObjType fsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
UpdateStringOfFsPath, /* updateStringProc */
SetFsPathFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* struct FsPath --
*
* Internal representation of a Tcl_Obj of fsPathType
*/
|
| ︙ | ︙ | |||
2509 2510 2511 2512 2513 2514 2515 |
const char *user) /* User name. NULL -> current user */
{
Tcl_DString dirString;
if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) {
return NULL;
}
| | | 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 |
const char *user) /* User name. NULL -> current user */
{
Tcl_DString dirString;
if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) {
return NULL;
}
return Tcl_DStringToObj(&dirString);
}
/*
*----------------------------------------------------------------------
*
* TclResolveTildePath --
*
|
| ︙ | ︙ | |||
2581 2582 2583 2584 2585 2586 2587 |
&resolvedPath)
!= TCL_OK) {
Tcl_DStringFree(&userName);
return NULL;
}
Tcl_DStringFree(&userName);
}
| | | 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 |
&resolvedPath)
!= TCL_OK) {
Tcl_DStringFree(&userName);
return NULL;
}
Tcl_DStringFree(&userName);
}
return Tcl_DStringToObj(&resolvedPath);
}
/*
*----------------------------------------------------------------------
*
* TclResolveTildePathList --
*
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
59 60 61 62 63 64 65 |
const Tcl_ObjType tclProcBodyType = {
"procbody", /* name for this type */
ProcBodyFree, /* FreeInternalRep function */
ProcBodyDup, /* DupInternalRep function */
NULL, /* UpdateString function; Tcl_GetString and
* Tcl_GetStringFromObj should panic
* instead. */
| | > | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
const Tcl_ObjType tclProcBodyType = {
"procbody", /* name for this type */
ProcBodyFree, /* FreeInternalRep function */
ProcBodyDup, /* DupInternalRep function */
NULL, /* UpdateString function; Tcl_GetString and
* Tcl_GetStringFromObj should panic
* instead. */
NULL, /* SetFromAny function; Tcl_ConvertToType
* should panic instead. */
TCL_OBJTYPE_V0
};
#define ProcSetInternalRep(objPtr, procPtr) \
do { \
Tcl_ObjInternalRep ir; \
(procPtr)->refCount++; \
ir.twoPtrValue.ptr1 = (procPtr); \
|
| ︙ | ︙ | |||
89 90 91 92 93 94 95 |
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
static const Tcl_ObjType levelReferenceType = {
"levelReference",
| | | > | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 |
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
static const Tcl_ObjType levelReferenceType = {
"levelReference",
NULL, NULL, NULL, NULL, TCL_OBJTYPE_V0
};
/*
* The type of lambdas. Note that every lambda will *always* have a string
* representation.
*
* Internally, ptr1 is a pointer to a Proc instance that is not bound to a
* command name, and ptr2 is a pointer to the namespace that the Proc instance
* will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
*/
static const Tcl_ObjType lambdaType = {
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetLambdaFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (procPtr); \
ir.twoPtrValue.ptr2 = (nsObjPtr); \
|
| ︙ | ︙ |
Changes to generic/tclRegexp.c.
| ︙ | ︙ | |||
103 104 105 106 107 108 109 |
*/
const Tcl_ObjType tclRegexpType = {
"regexp", /* name */
FreeRegexpInternalRep, /* freeIntRepProc */
DupRegexpInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
*/
const Tcl_ObjType tclRegexpType = {
"regexp", /* name */
FreeRegexpInternalRep, /* freeIntRepProc */
DupRegexpInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetRegexpFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define RegexpSetInternalRep(objPtr, rePtr) \
do { \
Tcl_ObjInternalRep ir; \
(rePtr)->refCount++; \
ir.twoPtrValue.ptr1 = (rePtr); \
|
| ︙ | ︙ | |||
955 956 957 958 959 960 961 |
* Convert RE to a glob pattern equivalent, if any, and cache it. If this
* is not possible, then globObjPtr will be NULL. This is used by
* Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
*/
if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
NULL) == TCL_OK) {
| | | 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 |
* Convert RE to a glob pattern equivalent, if any, and cache it. If this
* is not possible, then globObjPtr will be NULL. This is used by
* Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
*/
if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
NULL) == TCL_OK) {
regexpPtr->globObjPtr = Tcl_DStringToObj(&stringBuf);
Tcl_IncrRefCount(regexpPtr->globObjPtr);
} else {
regexpPtr->globObjPtr = NULL;
}
/*
* Allocate enough space for all of the subexpressions, plus one extra for
|
| ︙ | ︙ |
Changes to generic/tclStringObj.c.
| ︙ | ︙ | |||
85 86 87 88 89 90 91 |
*/
const Tcl_ObjType tclStringType = {
"string", /* name */
FreeStringInternalRep, /* freeIntRepPro */
DupStringInternalRep, /* dupIntRepProc */
UpdateStringOfString, /* updateStringProc */
| | > | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 |
*/
const Tcl_ObjType tclStringType = {
"string", /* name */
FreeStringInternalRep, /* freeIntRepPro */
DupStringInternalRep, /* dupIntRepProc */
UpdateStringOfString, /* updateStringProc */
SetStringFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* TCL STRING GROWTH ALGORITHM
*
* When growing strings (during an append, for example), the following growth
* algorithm is used:
|
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
| ︙ | ︙ | |||
1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 |
Tcl_CreateObjTrace2, /* 677 */
Tcl_NRCreateCommand2, /* 678 */
Tcl_NRCallObjProc2, /* 679 */
Tcl_GetNumberFromObj, /* 680 */
Tcl_GetNumber, /* 681 */
Tcl_RemoveChannelMode, /* 682 */
Tcl_GetEncodingNulLength, /* 683 */
};
/* !END!: Do not edit above this line. */
| > > > > | 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 |
Tcl_CreateObjTrace2, /* 677 */
Tcl_NRCreateCommand2, /* 678 */
Tcl_NRCallObjProc2, /* 679 */
Tcl_GetNumberFromObj, /* 680 */
Tcl_GetNumber, /* 681 */
Tcl_RemoveChannelMode, /* 682 */
Tcl_GetEncodingNulLength, /* 683 */
0, /* 684 */
0, /* 685 */
0, /* 686 */
Tcl_DStringToObj, /* 687 */
};
/* !END!: Do not edit above this line. */
|
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 |
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_DStringResult(interp, &dstring);
} else if (strcmp(argv[1], "trunc") == 0) {
if (argc != 3) {
goto wrongNumArgs;
}
if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
return TCL_ERROR;
}
Tcl_DStringSetLength(&dstring, count);
} else if (strcmp(argv[1], "start") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_DStringStartSublist(&dstring);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
| > > > > > | | | 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 |
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_DStringResult(interp, &dstring);
} else if (strcmp(argv[1], "toobj") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_SetObjResult(interp, Tcl_DStringToObj(&dstring));
} else if (strcmp(argv[1], "trunc") == 0) {
if (argc != 3) {
goto wrongNumArgs;
}
if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
return TCL_ERROR;
}
Tcl_DStringSetLength(&dstring, count);
} else if (strcmp(argv[1], "start") == 0) {
if (argc != 2) {
goto wrongNumArgs;
}
Tcl_DStringStartSublist(&dstring);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be append, element, end, free, get, gresult, length, "
"result, start, toobj, or trunc", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
* The procedure below is used as a special freeProc to test how well
|
| ︙ | ︙ |
Changes to generic/tclUtf.c.
| ︙ | ︙ | |||
205 206 207 208 209 210 211 | * Side effects: * None. * *--------------------------------------------------------------------------- */ #undef Tcl_UniCharToUtf | | | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 |
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
#undef Tcl_UniCharToUtf
size_t
Tcl_UniCharToUtf(
int ch, /* The Tcl_UniChar to be stored in the
* buffer. Can be or'ed with flag TCL_COMBINE */
char *buf) /* Buffer in which the UTF-8 representation of
* the Tcl_UniChar is stored. Buffer must be
* large enough to hold the UTF-8 character
* (at most 4 bytes). */
|
| ︙ | ︙ | |||
443 444 445 446 447 448 449 |
0x20AC, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F,
0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178
};
#undef Tcl_UtfToUniChar
| | | 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 |
0x20AC, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F,
0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178
};
#undef Tcl_UtfToUniChar
size_t
Tcl_UtfToUniChar(
const char *src, /* The UTF-8 string. */
int *chPtr)/* Filled with the Unicode character represented by
* the UTF-8 string. */
{
int byte;
|
| ︙ | ︙ | |||
526 527 528 529 530 531 532 |
*/
}
*chPtr = byte;
return 1;
}
| | | 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 |
*/
}
*chPtr = byte;
return 1;
}
size_t
Tcl_UtfToChar16(
const char *src, /* The UTF-8 string. */
unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
* the UTF-8 string. This could be a surrogate too. */
{
unsigned short byte;
|
| ︙ | ︙ | |||
1331 1332 1333 1334 1335 1336 1337 | * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ | | | 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 |
*
* Side effects:
* Writes a terminating null after the last converted character.
*
*----------------------------------------------------------------------
*/
size_t
Tcl_UtfToUpper(
char *str) /* String to convert in place. */
{
int ch, upChar;
char *src, *dst;
size_t len;
|
| ︙ | ︙ | |||
1384 1385 1386 1387 1388 1389 1390 | * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ | | | 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 |
*
* Side effects:
* Writes a terminating null after the last converted character.
*
*----------------------------------------------------------------------
*/
size_t
Tcl_UtfToLower(
char *str) /* String to convert in place. */
{
int ch, lowChar;
char *src, *dst;
size_t len;
|
| ︙ | ︙ | |||
1438 1439 1440 1441 1442 1443 1444 | * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ | | | 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 |
*
* Side effects:
* Writes a terminating null after the last converted character.
*
*----------------------------------------------------------------------
*/
size_t
Tcl_UtfToTitle(
char *str) /* String to convert in place. */
{
int ch, titleChar, lowChar;
char *src, *dst;
size_t len;
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
123 124 125 126 127 128 129 |
*/
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
| | > | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 |
*/
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
/*
* * STRING REPRESENTATION OF LISTS * * *
*
* The next several routines implement the conversions of strings to and from
* Tcl lists. To understand their operation, the rules of parsing and
|
| ︙ | ︙ | |||
2867 2868 2869 2870 2871 2872 2873 |
void
Tcl_DStringResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
| | | 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 |
void
Tcl_DStringResult(
Tcl_Interp *interp, /* Interpreter whose result is to be reset. */
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
Tcl_SetObjResult(interp, Tcl_DStringToObj(dsPtr));
}
/*
*----------------------------------------------------------------------
*
* Tcl_DStringGetResult --
*
|
| ︙ | ︙ | |||
2907 2908 2909 2910 2911 2912 2913 |
Tcl_DStringAppend(dsPtr, bytes, obj->length);
Tcl_ResetResult(interp);
}
/*
*----------------------------------------------------------------------
*
| | | | 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 |
Tcl_DStringAppend(dsPtr, bytes, obj->length);
Tcl_ResetResult(interp);
}
/*
*----------------------------------------------------------------------
*
* Tcl_DStringToObj --
*
* This function moves a dynamic string's contents to a new Tcl_Obj. Be
* aware that this function does *not* check that the encoding of the
* contents of the dynamic string is correct; this is the caller's
* responsibility to enforce.
*
* Results:
* The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
* reference count of zero.
*
* Side effects:
* The string is "moved" to the object. dsPtr is reinitialized to an
* empty string; it does not need to be Tcl_DStringFree'd after this if
* not used further.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_DStringToObj(
Tcl_DString *dsPtr)
{
Tcl_Obj *result;
if (dsPtr->string == dsPtr->staticSpace) {
if (dsPtr->length == 0) {
TclNewObj(result);
|
| ︙ | ︙ |
Changes to generic/tclVar.c.
| ︙ | ︙ | |||
241 242 243 244 245 246 247 |
* scalar variable
* twoPtrValue.ptr2: pointer to the element name string (owned by this
* Tcl_Obj), or NULL if it is a scalar variable
*/
static const Tcl_ObjType localVarNameType = {
"localVarName",
| | | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
* scalar variable
* twoPtrValue.ptr2: pointer to the element name string (owned by this
* Tcl_Obj), or NULL if it is a scalar variable
*/
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0
};
#define LocalSetInternalRep(objPtr, index, namePtr) \
do { \
Tcl_ObjInternalRep ir; \
Tcl_Obj *ptr = (namePtr); \
if (ptr) {Tcl_IncrRefCount(ptr);} \
|
| ︙ | ︙ | |||
264 265 266 267 268 269 270 |
irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \
(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \
(index) = irPtr ? PTR2UINT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \
} while (0)
static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
| | | 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 |
irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \
(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \
(index) = irPtr ? PTR2UINT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \
} while (0)
static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0
};
#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
do { \
Tcl_ObjInternalRep ir; \
Tcl_Obj *ptr1 = (arrayPtr); \
Tcl_Obj *ptr2 = (elem); \
|
| ︙ | ︙ |
Changes to generic/tclZlib.c.
| ︙ | ︙ | |||
545 546 547 548 549 550 551 |
if (latin1enc == NULL) {
Tcl_Panic("no latin-1 encoding");
}
}
Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->comment, -1,
TCL_ENCODING_NOCOMPLAIN, &tmp);
| | | | 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 |
if (latin1enc == NULL) {
Tcl_Panic("no latin-1 encoding");
}
}
Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->comment, -1,
TCL_ENCODING_NOCOMPLAIN, &tmp);
SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp));
}
SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
if (headerPtr->name != Z_NULL) {
if (latin1enc == NULL) {
/*
* RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
*/
latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
if (latin1enc == NULL) {
Tcl_Panic("no latin-1 encoding");
}
}
Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->name, -1,
TCL_ENCODING_NOCOMPLAIN, &tmp);
SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp));
}
if (headerPtr->os != 255) {
SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os));
}
if (headerPtr->time != 0 /* magic - no time */) {
SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time));
}
|
| ︙ | ︙ |
Changes to macosx/tclMacOSXFCmd.c.
| ︙ | ︙ | |||
84 85 86 87 88 89 90 |
static void UpdateStringOfOSType(Tcl_Obj *objPtr);
static const Tcl_ObjType tclOSTypeType = {
"osType", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOSType, /* updateStringProc */
| | > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 |
static void UpdateStringOfOSType(Tcl_Obj *objPtr);
static const Tcl_ObjType tclOSTypeType = {
"osType", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOSType, /* updateStringProc */
SetOSTypeFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
enum {
kIsInvisible = 0x4000,
};
#define kFinfoIsInvisible (OSSwapHostToBigConstInt16(kIsInvisible))
|
| ︙ | ︙ |
Changes to tests/chanio.test.
| ︙ | ︙ | |||
35 36 37 38 39 40 41 |
variable expected
catch {
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]
set ::tcltestlib [info loaded {} Tcltest]
}
| | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
variable expected
catch {
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]
set ::tcltestlib [info loaded {} Tcltest]
}
source [file join [file dirname [info script]] tcltests.tcl]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testservicemode [llength [info commands testservicemode]]
|
| ︙ | ︙ |
Changes to tests/dstring.test.
| ︙ | ︙ | |||
469 470 471 472 473 474 475 476 477 478 479 480 481 482 |
set result {}
lappend result [testdstring gresult special]
testdstring append z 1
lappend result [testdstring get]
} -cleanup {
testdstring free
} -result {{} {This is a specially-allocated stringz}}
# cleanup
if {[testConstraint testdstring]} {
testdstring free
}
::tcltest::cleanupTests
return
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 |
set result {}
lappend result [testdstring gresult special]
testdstring append z 1
lappend result [testdstring get]
} -cleanup {
testdstring free
} -result {{} {This is a specially-allocated stringz}}
test dstring-7.1 {copying to Tcl_Obj} -constraints testdstring -setup {
testdstring free
} -body {
testdstring append xyz -1
list [testdstring toobj] [testdstring length]
} -cleanup {
testdstring free
} -result {xyz 0}
test dstring-7.2 {copying to a Tcl_Obj} -constraints testdstring -setup {
testdstring free
unset -nocomplain a
} -body {
foreach l {a b c d e f g h i j k l m n o p} {
testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
}
set a [testdstring toobj]
testdstring append abc -1
list $a [testdstring get]
} -cleanup {
testdstring free
} -result {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
eeeeeeeeeeeeeeeeeeeee
fffffffffffffffffffff
ggggggggggggggggggggg
hhhhhhhhhhhhhhhhhhhhh
iiiiiiiiiiiiiiiiiiiii
jjjjjjjjjjjjjjjjjjjjj
kkkkkkkkkkkkkkkkkkkkk
lllllllllllllllllllll
mmmmmmmmmmmmmmmmmmmmm
nnnnnnnnnnnnnnnnnnnnn
ooooooooooooooooooooo
ppppppppppppppppppppp
} abc}
# cleanup
if {[testConstraint testdstring]} {
testdstring free
}
::tcltest::cleanupTests
return
|
| ︙ | ︙ |
Changes to tests/env.test.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 |
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
| | < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]
# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
global printenvScript
catch {exec [interpreter] $printenvScript} out
if {$out eq "child process exited abnormally"} {
|
| ︙ | ︙ |
Changes to tests/exec.test.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 |
# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
| | < < < < < < | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]
# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]
unset -nocomplain path
# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
|
| ︙ | ︙ |
Changes to tests/fileSystemEncoding.test.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
variable fname1 登鸛鵲樓
| < < < < < < < < < < < < | < | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
variable fname1 登鸛鵲樓
source [file join [file dirname [info script]] tcltests.tcl]
test filesystemEncoding-1.0 {
issue bcd100410465
} -body {
set dir [tcltests::tempdir]
set saved [encoding system]
encoding system iso8859-1
|
| ︙ | ︙ |
Changes to tests/io.test.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 |
variable expected
catch {
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]
set ::tcltestlib [info loaded {} Tcltest]
}
| | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
variable expected
catch {
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]
set ::tcltestlib [info loaded {} Tcltest]
}
source [file join [file dirname [info script]] tcltests.tcl]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testobj [llength [info commands testobj]]
|
| ︙ | ︙ |
Changes to tests/ioCmd.test.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
| > < < | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
# Custom constraints used in this file
testConstraint testchannel [llength [info commands testchannel]]
#----------------------------------------------------------------------
test iocmd-1.1 {puts command} {
list [catch {puts} msg] $msg
|
| ︙ | ︙ |
Changes to tests/listRep.test.
| ︙ | ︙ | |||
468 469 470 471 472 473 474 |
} -body {
lrange { 1 2 3 4 } $zero $end
} -result {1 2 3 4}
test listrep-1.11 {
Append elements to large unshared list is optimized as lappend
so no free space in front - lreplace version
| | | | | | | | | | | | | | | | | | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 |
} -body {
lrange { 1 2 3 4 } $zero $end
} -result {1 2 3 4}
test listrep-1.11 {
Append elements to large unshared list is optimized as lappend
so no free space in front - lreplace version
} -constraints testlistrep -body {
# Note $end, not end else byte code compiler short-cuts
set l [lreplace [freeSpaceNone 1000] $end+1 $end+1 1000]
validate $l
list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]
test listrep-1.11.1 {
Append elements to large unshared list is optimized as lappend
so no free space in front - linsert version
} -constraints testlistrep -body {
# Note $end, not end else byte code compiler short-cuts
set l [linsert [freeSpaceNone 1000] $end+1 1000]
validate $l
list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]
test listrep-1.11.2 {
Append elements to large unshared list leaves no free space in front
- lappend version
} -constraints testlistrep -body {
# Note $end, not end else byte code compiler short-cuts
set l [freeSpaceNone 1000]
lappend l 1000 1001
validate $l
list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1001] 0 1 0]
test listrep-1.12 {
Replacement of elements at front with same number elements in unshared list
is in-place - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $zero $one 10 11]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 0 0]
test listrep-1.12.1 {
Replacement of elements at front with same number elements in unshared list
is in-place - lset version
} -constraints testlistrep -body {
set l [freeSpaceNone]
lset l 0 -1
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {-1 1 2 3 4 5 6 7} 0 0]
test listrep-1.13 {
Replacement of elements at front with fewer elements in unshared list
results in a spanned list with space only in front
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $zero $four 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 4 0]
test listrep-1.14 {
Replacement of elements at front with more elements in unshared list
results in a reallocated spanned list with space at front and back
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $zero $one 10 11 12]
validate $l
list $l [spaceEqual $l]
} -result [list {10 11 12 2 3 4 5 6 7} 1]
test listrep-1.15 {
Replacement of elements in middle with same number elements in unshared list
is in-place - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $one $two 10 11]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 11 3 4 5 6 7} 0 0]
test listrep-1.15.1 {
Replacement of elements in middle with same number elements in unshared list
is in-place - lset version
} -constraints testlistrep -body {
set l [freeSpaceNone]
lset l $two -1
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 -1 3 4 5 6 7} 0 0]
test listrep-1.16 {
Replacement of elements in front half with fewer elements in unshared list
results in a spanned list with space only in front since smaller segment moved
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $one $four 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 5 6 7} 3 0]
test listrep-1.17 {
Replacement of elements in back half with fewer elements in unshared list
results in a spanned list with space only at back
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] end-$four end-$one 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 10 7} 0 3]
test listrep-1.18 {
Replacement of elements in middle more elements in unshared list
results in a reallocated spanned list with space at front and back
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $one $two 10 11 12]
validate $l
list $l [spaceEqual $l]
} -result [list {0 10 11 12 3 4 5 6 7} 1]
test listrep-1.19 {
Replacement of elements at back with same number elements in unshared list
is in-place - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $end-1 $end 10 11]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 0 0]
test listrep-1.19.1 {
Replacement of elements at back with same number elements in unshared list
is in-place - lset version
} -constraints testlistrep -body {
set l [freeSpaceNone]
lset l $end 10
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 0 0]
test listrep-1.20 {
Replacement of elements at back with fewer elements in unshared list
is in-place with space only at the back
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $end-2 $end 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 0 2]
test listrep-1.21 {
Replacement of elements at back with more elements in unshared list
allocates new representation with equal space at front and back
} -constraints testlistrep -body {
set l [lreplace [freeSpaceNone] $end-1 $end 10 11 12]
validate $l
list $l [spaceEqual $l]
} -result [list {0 1 2 3 4 5 10 11 12} 1]
#
# listrep-2.* tests all operate on shared list reps with no free space. Note the
|
| ︙ | ︙ | |||
1663 1664 1665 1666 1667 1668 1669 |
validate $l
list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]
test listrep-3.23 {
Replacement of elements at front with same number elements in unshared
spanned list is in-place - lreplace version
| | | | | | 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 |
validate $l
list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]
test listrep-3.23 {
Replacement of elements at front with same number elements in unshared
spanned list is in-place - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $zero $one 10 11]
list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 3 3]
test listrep-3.23.1 {
Replacement of elements at front with same number elements in unshared
spanned list is in-place - lset version
} -constraints testlistrep -body {
set l [freeSpaceBoth]
lset l $zero 10
list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 1 2 3 4 5 6 7} 3 3]
test listrep-3.24 {
Replacement of elements at front with fewer elements in unshared
spanned list expands leading space - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $zero $four 10]
list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 7 3]
test listrep-3.25 {
Replacement of elements at front with more elements in unshared
spanned list with sufficient leading space shrinks leading space
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $zero $one 10 11 12]
list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 12 2 3 4 5 6 7} 2 3]
test listrep-3.26 {
Replacement of elements at front with more elements in unshared
spanned list with insufficient leading space but sufficient total
|
| ︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 |
validate $l
list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 14 2 3 4 5 6 7} 6 5 1]
test listrep-3.28 {
Replacement of elements at back with same number of elements in unshared
spanned list is in-place - lreplace version
| | | | | | | | | | | | | | | | | | 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 |
validate $l
list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 14 2 3 4 5 6 7} 6 5 1]
test listrep-3.28 {
Replacement of elements at back with same number of elements in unshared
spanned list is in-place - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $end-1 $end 10 11]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 3 3]
test listrep-3.28.1 {
Replacement of elements at back with same number of elements in unshared
spanned list is in-place - lset version
} -constraints testlistrep -body {
set l [freeSpaceBoth]
lset l $end 10
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 3 3]
test listrep-3.29 {
Replacement of elements at back with fewer elements in unshared
spanned list expands tail space
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $end-2 $end 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 3 5]
test listrep-3.30 {
Replacement of elements at back with more elements in unshared
spanned list with sufficient tail space shrinks tailspace
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $end-1 $end 10 11 12]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12} 3 2]
test listrep-3.31 {
Replacement of elements at back with more elements in unshared spanned list
with insufficient tail space but enough total free space moves up the span
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth 8 2 2] $end-1 $end 10 11 12 13 14]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 0 1]
test listrep-3.32 {
Replacement of elements at back with more elements in unshared spanned list
with insufficient total space reallocates with more room in the tail because
of realloc()
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 10]
test listrep-3.33 {
Replacement of elements in the middle in an unshared spanned list with
the same number of elements - lreplace version
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $two $four 10 11 12]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 12 5 6 7} 3 3]
test listrep-3.33.1 {
Replacement of elements in the middle in an unshared spanned list with
the same number of elements - lset version
} -constraints testlistrep -body {
set l [freeSpaceBoth]
lset l $two 10
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 3 4 5 6 7} 3 3]
test listrep-3.34 {
Replacement of elements in an unshared spanned list with fewer elements
in the front half moves the front (smaller) segment
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $two $four 10 11]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 5 6 7} 4 3]
test listrep-3.35 {
Replacement of elements in an unshared spanned list with fewer elements
in the back half moves the tail (smaller) segment
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $end-2 $end-1 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10 7} 3 4]
test listrep-3.36 {
Replacement of elements in an unshared spanned list with more elements
when both front and back have room should move the smaller segment
(front case)
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $one $two 8 9 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 3 4 5 6 7} 2 3]
test listrep-3.37 {
Replacement of elements in an unshared spanned list with more elements
when both front and back have room should move the smaller segment
(back case)
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $end-2 $end-1 8 9 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 8 9 10 7} 3 2]
test listrep-3.38 {
Replacement of elements in an unshared spanned list with more elements
when only front has room
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth 8 3 1] $end-1 $end-1 8 9 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 8 9 10 7} 1 1]
test listrep-3.39 {
Replacement of elements in an unshared spanned list with more elements
when only back has room
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth 8 1 3] $one $one 8 9 10]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 2 3 4 5 6 7} 1 1]
test listrep-3.40 {
Replacement of elements in an unshared spanned list with more elements
when neither send has enough room by itself
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth] $one $one 8 9 10 11 12]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 1]
test listrep-3.41 {
Replacement of elements in an unshared spanned list with more elements
when there is not enough free space results in new allocation. The back
end has more space because of realloc()
} -constraints testlistrep -body {
set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12]
validate $l
list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 11]
#
# 4.* - tests on shared spanned lists
|
| ︙ | ︙ |
Changes to tests/platform.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2.5
namespace eval ::tcl::test::platform {
namespace import ::tcltest::testConstraint
namespace import ::tcltest::test
namespace import ::tcltest::cleanupTests
# This is not how [variable] works. See TIP 276.
#variable ::tcl_platform
namespace upvar :: tcl_platform tcl_platform
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
| > < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]
namespace eval ::tcl::test::platform {
namespace import ::tcltest::testConstraint
namespace import ::tcltest::test
namespace import ::tcltest::cleanupTests
# This is not how [variable] works. See TIP 276.
#variable ::tcl_platform
namespace upvar :: tcl_platform tcl_platform
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]
test platform-1.0 {tcl_platform(engine)} {
set tcl_platform(engine)
} {Tcl}
|
| ︙ | ︙ |
Changes to tests/regexp.test.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
unset -nocomplain foo
| | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
unset -nocomplain foo
source [file join [file dirname [info script]] tcltests.tcl]
testConstraint exec [llength [info commands exec]]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc memtest script {
set end [lindex [split [memory info] \n] 3 3]
|
| ︙ | ︙ |
Changes to tests/string.test.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
| > | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
source [file join [file dirname [info script]] tcltests.tcl]
# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
|
| ︙ | ︙ |
Changes to tests/tcltests.tcl.
1 2 3 4 5 6 7 8 |
#! /usr/bin/env tclsh
package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
| > > > | 1 2 3 4 5 6 7 8 9 10 11 |
#! /usr/bin/env tclsh
# Don't overwrite tcltests facilities already present
if {[package provide tcltests] ne {}} return
package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
|
| ︙ | ︙ |
Changes to tests/thread.test.
| ︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 |
package require tcltest 2.5
namespace import -force ::tcltest::*
}
# when thread::release is used, -wait is passed in order allow the thread to
# be fully finalized, which avoids valgrind "still reachable" reports.
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
| > > > < | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
package require tcltest 2.5
namespace import -force ::tcltest::*
}
# when thread::release is used, -wait is passed in order allow the thread to
# be fully finalized, which avoids valgrind "still reachable" reports.
package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
# Some tests require the testthread command
testConstraint testthread [expr {[info commands testthread] ne {}}]
set threadSuperKillScript {
|
| ︙ | ︙ |
Changes to tests/unixInit.test.
| ︙ | ︙ | |||
342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 |
close $f
set enc
} -cleanup {
unset -nocomplain env(LANG)
} -match regexp -result {^(iso8859-15?|utf-8)$}
test unixInit-3.2 {TclpSetInitialEncodings} -setup {
catch {set oldlc_all $env(LC_ALL)}
} -constraints {unix stdio} -body {
set env(LANG) japanese
set env(LC_ALL) japanese
set f [open "|[list [interpreter]]" w+]
chan configure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
set validEncodings [list euc-jp]
if {[string match HP-UX $tcl_platform(os)]} {
# Some older HP-UX systems need us to accept this as valid Bug 453883
# reports that newer HP-UX systems report euc-jp like everybody else.
lappend validEncodings shiftjis
}
expr {$enc ni $validEncodings}
} -cleanup {
unset -nocomplain env(LANG) env(LC_ALL)
catch {set env(LC_ALL) $oldlc_all}
} -result 0
test unixInit-4.1 {TclpSetVariables} {unix} {
# just make sure they exist
set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
set tcl_platform(platform)
| > > > | 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 |
close $f
set enc
} -cleanup {
unset -nocomplain env(LANG)
} -match regexp -result {^(iso8859-15?|utf-8)$}
test unixInit-3.2 {TclpSetInitialEncodings} -setup {
catch {set oldlc_all $env(LC_ALL)}
catch {set oldtcl_library $env(TCL_LIBRARY)}
unset -nocomplain env(TCL_LIBRARY)
} -constraints {unix stdio} -body {
set env(LANG) japanese
set env(LC_ALL) japanese
set f [open "|[list [interpreter]]" w+]
chan configure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
set validEncodings [list euc-jp]
if {[string match HP-UX $tcl_platform(os)]} {
# Some older HP-UX systems need us to accept this as valid Bug 453883
# reports that newer HP-UX systems report euc-jp like everybody else.
lappend validEncodings shiftjis
}
expr {$enc ni $validEncodings}
} -cleanup {
unset -nocomplain env(LANG) env(LC_ALL)
catch {set env(LC_ALL) $oldlc_all}
catch {set env(TCL_LIBRARY) $oldtcl_library}
} -result 0
test unixInit-4.1 {TclpSetVariables} {unix} {
# just make sure they exist
set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
set tcl_platform(platform)
|
| ︙ | ︙ |
Changes to tests/winDde.test.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
| | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]
testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
set ::ddever [package require dde 1.4.4]
set ::ddelib [info loaded {} Dde]}]} {
|
| ︙ | ︙ |
Changes to unix/tclUnixFCmd.c.
| ︙ | ︙ | |||
1421 1422 1423 1424 1425 1426 1427 |
if (pwPtr == NULL) {
TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
} else {
Tcl_DString ds;
Tcl_ExternalToUtfDStringEx(NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
| | | 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 |
if (pwPtr == NULL) {
TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
} else {
Tcl_DString ds;
Tcl_ExternalToUtfDStringEx(NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
*attributePtrPtr = Tcl_DStringToObj(&ds);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
2341 2342 2343 2344 2345 2346 2347 |
/*
* The template has been updated. Tell the caller what it was.
*/
Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ),
Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp);
Tcl_DStringFree(&templ);
| | | 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 |
/*
* The template has been updated. Tell the caller what it was.
*/
Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ),
Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp);
Tcl_DStringFree(&templ);
return Tcl_DStringToObj(&tmp);
}
#if defined(__CYGWIN__)
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
|
| ︙ | ︙ |
Changes to unix/tclUnixFile.c.
| ︙ | ︙ | |||
993 994 995 996 997 998 999 |
length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
if (length < 0) {
return NULL;
}
Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, &ds);
| | | 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 |
length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
if (length < 0) {
return NULL;
}
Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, &ds);
linkPtr = Tcl_DStringToObj(&ds);
Tcl_IncrRefCount(linkPtr);
return linkPtr;
}
}
#endif /* S_IFLNK */
/*
|
| ︙ | ︙ | |||
1058 1059 1060 1061 1062 1063 1064 |
Tcl_Obj *
TclpNativeToNormalized(
ClientData clientData)
{
Tcl_DString ds;
Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
| | | 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 |
Tcl_Obj *
TclpNativeToNormalized(
ClientData clientData)
{
Tcl_DString ds;
Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
return Tcl_DStringToObj(&ds);
}
/*
*---------------------------------------------------------------------------
*
* TclNativeCreateNativeRep --
*
|
| ︙ | ︙ |
Changes to unix/tclUnixInit.c.
| ︙ | ︙ | |||
506 507 508 509 510 511 512 | * specified directory to make it refer to this installation by * removing the old "tclX.Y" and substituting the current version * string. */ pathv[pathc - 1] = installLib + 4; str = Tcl_JoinPath(pathc, pathv, &ds); | | | 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 |
* specified directory to make it refer to this installation by
* removing the old "tclX.Y" and substituting the current version
* string.
*/
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds));
}
Tcl_Free(pathv);
}
/*
* Finally, look for the library relative to the compiled-in path. This is
* needed when users install Tcl with an exec-prefix that is different
|
| ︙ | ︙ |
Changes to win/Makefile.in.
| ︙ | ︙ | |||
146 147 148 149 150 151 152 |
TCL_VFS_ROOT = libtcl.vfs
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX}
| | | | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 |
TCL_VFS_ROOT = libtcl.vfs
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE8 = tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8 = tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE = tcltest${EXESUFFIX}
TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}]];\
package ifneeded registry 1.3.6 [list load [file normalize ${REG_DLL_FILE}]]
|
| ︙ | ︙ | |||
588 589 590 591 592 593 594 |
@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest
${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest
| | | | | | 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 |
@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest
${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest
${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
@MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest
${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest
${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest
|
| ︙ | ︙ | |||
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 |
tclWinPipe.${OBJEXT}: tclWinPipe.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinReg.${OBJEXT}: tclWinReg.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinDde.${OBJEXT}: tclWinDde.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclAppInit.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
tclMainW.${OBJEXT}: tclMain.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
# TIP #430, ZipFS Support
| > > > > > > | 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 |
tclWinPipe.${OBJEXT}: tclWinPipe.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinReg.${OBJEXT}: tclWinReg.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tcl8WinReg.${OBJEXT}: tclWinReg.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclWinDde.${OBJEXT}: tclWinDde.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tcl8WinDde.${OBJEXT}: tclWinDde.c
$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
tclAppInit.${OBJEXT}: tclAppInit.c
$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
tclMainW.${OBJEXT}: tclMain.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
# TIP #430, ZipFS Support
|
| ︙ | ︙ |
Changes to win/tclWinDde.c.
| ︙ | ︙ | |||
113 114 115 116 117 118 119 | static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | | | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 # define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) # define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString # endif |
| ︙ | ︙ |
Changes to win/tclWinFCmd.c.
| ︙ | ︙ | |||
998 999 1000 1001 1002 1003 1004 |
if (ret != TCL_OK) {
if (Tcl_DStringLength(&ds) > 0) {
if (normPtr != NULL &&
!strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
| | | 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 |
if (ret != TCL_OK) {
if (Tcl_DStringLength(&ds) > 0) {
if (normPtr != NULL &&
!strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
*errorPtr = Tcl_DStringToObj(&ds);
}
Tcl_IncrRefCount(*errorPtr);
}
Tcl_DStringFree(&ds);
}
return ret;
|
| ︙ | ︙ | |||
1711 1712 1713 1714 1715 1716 1717 | * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); */ Tcl_DStringInit(&dsTemp); Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); | | | 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 |
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
*/
Tcl_DStringInit(&dsTemp);
Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
Tcl_DStringFree(&ds);
tempPath = Tcl_DStringToObj(&dsTemp);
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
FindClose(handle);
}
}
*attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
|
| ︙ | ︙ | |||
2065 2066 2067 2068 2069 2070 2071 |
* We actually made the directory, so we're done! Report what we made back
* as a (clean) Tcl_Obj.
*/
Tcl_DStringInit(&name);
Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name);
Tcl_DStringFree(&base);
| | | 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 |
* We actually made the directory, so we're done! Report what we made back
* as a (clean) Tcl_Obj.
*/
Tcl_DStringInit(&name);
Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name);
Tcl_DStringFree(&base);
return Tcl_DStringToObj(&name);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to win/tclWinFile.c.
| ︙ | ︙ | |||
2479 2480 2481 2482 2483 2484 2485 |
if (found == 0) {
return NULL;
} else {
Tcl_DString ds;
Tcl_DStringInit(&ds);
Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds);
| | | 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 |
if (found == 0) {
return NULL;
} else {
Tcl_DString ds;
Tcl_DStringInit(&ds);
Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds);
return Tcl_DStringToObj(&ds);
}
#undef VOL_BUF_SIZE
}
/*
* This define can be turned on to experiment with a different way of
* normalizing paths (using a different Windows API). Unfortunately the new
|
| ︙ | ︙ |
Changes to win/tclWinInit.c.
| ︙ | ︙ | |||
251 252 253 254 255 256 257 | * directory to make it refer to this installation by removing the * old "tclX.Y" and substituting the current version string. */ pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); (void) Tcl_JoinPath(pathc, pathv, &ds); | | | 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 |
* directory to make it refer to this installation by removing the
* old "tclX.Y" and substituting the current version string.
*/
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
(void) Tcl_JoinPath(pathc, pathv, &ds);
objPtr = Tcl_DStringToObj(&ds);
} else {
objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_Free((void *)pathv);
}
}
|
| ︙ | ︙ |
Changes to win/tclWinReg.c.
| ︙ | ︙ | |||
120 121 122 123 124 125 126 | static int RegistryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); | | | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | static int RegistryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 # define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) # define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString # endif |
| ︙ | ︙ |