diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-12-03 16:12:14 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-12-03 16:12:14 (GMT) |
commit | d8fd9552b555513cd62d8be2ae422a92c7be9d0e (patch) | |
tree | f98fdd0861795e17610ebd5020f3e7b4c4f30980 | |
parent | d33f396b9985896f717cbfa81422b28ac486eadd (diff) | |
parent | 28d5df364efed067ead97734d5e619615bfd8cde (diff) | |
download | tcl-d8fd9552b555513cd62d8be2ae422a92c7be9d0e.zip tcl-d8fd9552b555513cd62d8be2ae422a92c7be9d0e.tar.gz tcl-d8fd9552b555513cd62d8be2ae422a92c7be9d0e.tar.bz2 |
Merge 8.7
58 files changed, 919 insertions, 677 deletions
@@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 8.7a2** source distribution. +This is the **Tcl 8.7a4** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). @@ -8796,6 +8796,55 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich) --- Released 8.6.7, August 9, 2017 --- https://core.tcl-lang.org/tcl/ for details +Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7, +plus the following, which focuses on the high-level feature changes +in this changeset (new minor version) rather than bug fixes: + +2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter) + *** POTENTIAL INCOMPATIBILITY *** + +2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter) + +2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans) + +2016-07-19 (bug)[0363f0] Partial array search ID reform (porter) + +2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter) + *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") *** + +2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max) + +2016-11-25 [array names -regexp] supports backrefs (goth) + +2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy) + +2017-01-04 (TIP 459) New subcommand [package files] (nijtmans) + +2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans) + +2017-01-30 Add to Win shell builtins: assoc ftype move (ashok) + +2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans) + +2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans) + +2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz) + +2017-05-31 Purge build support for SunOS-4.* (stu) + +2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows) + +2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows) +=> TclOO 1.2.0 + +2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) + +2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) + +2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) + +--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details + 2017-08-10 [array names -regexp] supports backrefs (goth) 2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows) @@ -8895,58 +8944,179 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich) - Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ - -Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7, +2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres) + +2018-12-30 (bug)[3cf3a9] variable 'timezone' deprecated in vc2017 (nijtmans) + +2019-01-09 (bug)[cc1e91] [list [list {*}[set a " "]]] regression (sebres) + +2019-02-01 (bug)[e3f481] tests var-1.2[01] (sebres) + +2019-03-01 (new) Update to Unicode 12.0 (nijtmans) + +2019-03-05 (new)[TIP 527] New command [timerate] (sebres) + +2019-03-08 (bug)[39fed4] [package require] memory validity (hume,porter) + +2019-04-23 (new) New command tcl::unsupported::corotype (fellows) + +2019-05-04 (bug) memlink when namespace deletion kills linked var (porter) + +2019-05-28 (new) README file converted to README.md in Markdown (nijtmans) + +2019-06-17 (bug)[8b9854] [info level 0] regression with ensembles (porter) + +2019-06-20 (bug)[6bdadf] crash multi-arg write-traced [lappend] (fellows,porter) + +2019-06-21 (bug)[f8a33c] crash Tcl_Exit before init (brooks,sebres) + +2019-08-27 (bug)[fa6bf3] Bytecode fails epoch recovery at numLevel=0 (sebres) + +2019-08-29 (bug)[fec0c1] C stack overflow compiling bytecode (ade,sebres) + +2019-09-12 tzdata updated to Olson's tzdata2019c (jima) + +2019-09-20 (new) registry/dde no longer need -DUNICODE (nijtmans) +=> registry 1.3.4 +=> dde 1.4.2 + +2019-10-02 (bug)[16768d] Fix [info hostname] on NetBSD (rytaro) + +2019-10-23 (new) libtommath updated to release 1.2.0 (nijtmans) + +2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer) + +2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter) + +2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres) + +- Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ - + +Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10, plus the following, which focuses on the high-level feature changes in this changeset (new minor version) rather than bug fixes: -2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter) - *** POTENTIAL INCOMPATIBILITY *** +2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter) -2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter) +2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter) -2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans) +2017-11-04 (bug)[0d902e] [string first] on ASCII stored as Unicode (fellows) -2016-07-19 (bug)[0363f0] Partial array search ID reform (porter) +2017-11-17 [TIP 422] Mark all Tcl_*VA() routines deprecated. (nijtmans) -2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter) - *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") *** +2017-11-20 (support) Ended use of the obsolete values.h header (culler) -2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max) +2017-11-30 (bug)[8e1e31] [lsort] ordering of U+0000 (nijtmans) -2016-11-25 [array names -regexp] supports backrefs (goth) +2017-12-07 [TIP 487] Terminate support for pre-XP Windows (nijtmans) -2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy) +2017-12-08 [TIP 477] Reform of nmake build (nadkarni) -2017-01-04 (TIP 459) New subcommand [package files] (nijtmans) +2017-12-20 (bug)[ba1419] Crash: complex ensemble delete, namespace-7.8 (coulter) -2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans) +2018-01-17 [TIP 485] Removal of many deprecated features (nijtmans) -2017-01-30 Add to Win shell builtins: assoc ftype move (ashok) +2018-01-27 (bug) Crash in [join $l $l], join-4.1 (porter) -2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans) +2018-02-06 [TIP 493] Cease Distribution of http 1.0 (porter) -2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans) +2018-02-06 [TIP 484] internal rep for native ints are all 64-bit (nijtmans) -2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz) +2018-02-14 [TIP 476] Scan/Printf consistency (nijtmans) -2017-05-31 Purge build support for SunOS-4.* (stu) +2018-03-05 [TIP 351] [lsearch] striding -2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows) +2018-03-05 [TIPs 330,336] tighten access to Interp fields (porter) -2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows) -=> TclOO 1.2.0 +2018-03-12 [TIP 462] [::tcl::process] -2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) +2018-03-12 [TIP 490] add oo support for msgcat => msgcat 1.7.0 (oehlmann) -2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) +2018-03-12 [TIP 499] custom locale preference list (oehlmann) +=> msgcat 1.7.0 -2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) +2018-03-20 [TIP 503] End CONST84 support for Tcl 8.3 (porter) ---- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details +2018-03-30 Refactored [lrange] (spjuth) -2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann) +2018-04-20 [TIP 389] Unicode beyond BMP (nijtmans) -2018-03-12 (TIP 499) custom locale preference list (oehlmann) -=> msgcat 1.7.0 +2018-04-20 [TIP 421] [array for] + +2018-05-11 [TIP 425] Windows panic callback use of UTF-8 + +2018-05-17 [TIP 491] Phase out --disable-threads support + +2018-06-03 [TIP 500] TclOO Private Methods and Variables + +2018-07-26 (bug)[ba921a] [string cat] of bytearrays (coulter,porter) + +2018-09-02 [TIP 478] Many new features in TclOO (lester,fellows) + +2018-09-04 (bug)[540bed] [binary format w] from bignum (nijtmans) + +2018-09-12 [TIP 430] zipfs and embedded script library (woods) + +2018-09-26 [TIP 508] [array default] (bonnet,fellows) + +2018-09-27 [TIP 515] level value reform (nijtmans) + +2018-09-27 [TIP 516] More OO slot operations (fellows) + +2018-09-27 [TIP 426] [info cmdtype] (fellows) + +2018-09-28 [TIP 509] Cross platform reentrant mutex + +2018-10-08 [TIP 514] native integers are 64-bit + +2018-10-12 [TIP 502] index value reform (porter) + +2018-11-06 [TIP 406] http cookies (fellows) + +2018-11-06 [TIP 445] Tcl_ObjType utilities (migrate to Tcl 9) (porter) + +2018-11-06 [TIP 501] [string is dict] + +2018-11-06 [TIP 519] inline export/unexport option for [oo::define] + +2018-11-06 [TIP 523] [lpop] + +2018-11-06 [TIP 524] TclOO custom dialects + +2018-11-06 [TIP 506] Tcl_(Incr|Decr)RefCount macros -> functions (porter) + +2018-11-15 [TIP 512] No stub for Tcl_SetExitProc() + +2019-04-08 (bug)[45b9fa] crash in [try] (coulter) + +2019-04-14 [TIP 160] terminal and serial channel controls + +2019-04-14 [TIP 312] more types for Tcl_LinkVar + +2019-04-14 [TIP 367] [lremove] + +2019-04-14 [TIP 504] [string insert] + +2019-04-16 [TIP 342] [dict getwithdefault] + +2019-05-25 [TIP 431] [file tempdir] + +2019-05-25 [TIP 383] [coroinject], [coroprobe] + +2019-05-31 [TIP 544] Tcl_GetIntForIndex() + +2019-06-12 Replace TclOffset() with offsetof() + +2019-06-15 [TIP 461] string compare operators for [expr] + +2019-06-16 [TIP 521] floating point classification functions for [expr] + +2019-06-20 (bug)[6bdadf] crash multi-arg traced [lappend] (fellows) + +2019-06-28 [TIP 547] New encodings utf-16, ucs-2 + +2019-09-14 [TIP 414] Tcl_InitSubsystems() + +2019-09-14 [TIP 548] wchar_t conversion functions -- Released 8.7a3, Nov 30, 2018 --- http://core.tcl-lang.org/tcl/ for details - +- Released 8.7a3, Nov 21, 2019 --- http://core.tcl-lang.org/tcl/ for details - diff --git a/generic/tcl.decls b/generic/tcl.decls index 910c29e..8555ac2 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -132,9 +132,8 @@ declare 28 { declare 29 { Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr) } -# Only available as stub-entry, for backwards-compatible stub-enabled extensions declare 30 { - void TclOldFreeObj(Tcl_Obj *objPtr) + void TclFreeObj(Tcl_Obj *objPtr) } declare 31 { int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr) diff --git a/generic/tcl.h b/generic/tcl.h index 11b4ee1..2825bb6 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -51,10 +51,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 7 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 2 +#define TCL_RELEASE_SERIAL 4 #define TCL_VERSION "8.7" -#define TCL_PATCH_LEVEL "8.7a2" +#define TCL_PATCH_LEVEL "8.7a4" #if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) /* @@ -1729,7 +1729,7 @@ typedef struct Tcl_Filesystem { * arbitrary additional data to files in a * filesystem. */ Tcl_FSFileAttrsGetProc *fileAttrsGetProc; - /* Called by 'Tcl_FSFileAttrsGet()' and by + /* Called by 'Tcl_FSFileAttrsGet()' and by * 'file attributes'. */ Tcl_FSFileAttrsSetProc *fileAttrsSetProc; /* Called by 'Tcl_FSFileAttrsSet()' and by @@ -2452,14 +2452,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) -#elif (!defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS)) -/* - * When compiling stub-enabled extensions without -DTCL_NO_DEPRECATED, - * those extensions are expected to run fine with Tcl 8.6 as well. - * This means we must continue to use macro's for the above 3 functions, - * and the old stub entry for TclFreeObj. All other usage of TclFreeObj() - * is forbidden now, therefore it is changed to be MODULE_SCOPE internal. - */ +#else # undef Tcl_IncrRefCount # define Tcl_IncrRefCount(objPtr) \ ++(objPtr)->refCount @@ -2472,7 +2465,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); do { \ Tcl_Obj *_objPtr = (objPtr); \ if ((_objPtr)->refCount-- <= 1) { \ - TclOldFreeObj(_objPtr); \ + TclFreeObj(_objPtr); \ } \ } while(0) # undef Tcl_IsShared diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1e81f96..5c7aca6 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -143,7 +143,7 @@ EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); /* 30 */ -EXTERN void TclOldFreeObj(Tcl_Obj *objPtr); +EXTERN void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); @@ -1970,7 +1970,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ - void (*tclOldFreeObj) (Tcl_Obj *objPtr); /* 30 */ + void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ @@ -2683,8 +2683,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbNewStringObj) /* 28 */ #define Tcl_DuplicateObj \ (tclStubsPtr->tcl_DuplicateObj) /* 29 */ -#define TclOldFreeObj \ - (tclStubsPtr->tclOldFreeObj) /* 30 */ +#define TclFreeObj \ + (tclStubsPtr->tclFreeObj) /* 30 */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 7dddcc0..ae3e011 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1723,7 +1723,7 @@ LoadEncodingFile( * not be created because the file contained invalid data. * * Side effects: - * See Tcl_CreateEncoding(). + * See Tcl_CreateEncoding(). * *------------------------------------------------------------------------- */ @@ -2206,7 +2206,7 @@ BinaryProc( /* *------------------------------------------------------------------------- * - * UtfExtToUtfIntProc -- + * UtfIntToUtfExtProc -- * * Convert from UTF-8 to UTF-8. While converting null-bytes from the * Tcl's internal representation (0xc0, 0x80) to the official @@ -2347,7 +2347,7 @@ UtfToUtfProc( * output buffer. */ int pureNullMode) /* Convert embedded nulls from internal * representation to real null-bytes or vice - * versa. */ + * versa. Also combine or separate surrogate pairs */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; @@ -2364,7 +2364,7 @@ UtfToUtfProc( srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { - srcClose -= TCL_UTF_MAX; + srcClose -= 6; } if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; @@ -2413,15 +2413,21 @@ UtfToUtfProc( src += 1; dst += Tcl_UniCharToUtf(*chPtr, dst); } else { - int len = TclUtfToUniChar(src, chPtr); - src += len; - dst += Tcl_UniCharToUtf(*chPtr, dst); -#if TCL_UTF_MAX <= 4 - if ((*chPtr >= 0xD800) && (len < 3)) { - src += TclUtfToUniChar(src + len, chPtr); - dst += Tcl_UniCharToUtf(*chPtr, dst); + src += TclUtfToUniChar(src, chPtr); + if ((*chPtr & 0xFC00) == 0xD800) { + /* A high surrogate character is detected, handle especially */ + Tcl_UniChar low = *chPtr; + if (src <= srcEnd-3) { + Tcl_UtfToUniChar(src, &low); + } + if ((low & 0xFC00) != 0xDC00) { + *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF); + *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF); + *dst++ = (char) ((*chPtr | 0x80) & 0xBF); + continue; + } } -#endif + dst += Tcl_UniCharToUtf(*chPtr, dst); } } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index e612c3f..4eed34c 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -619,7 +619,7 @@ FsGetFirstFilesystem(void) } /* - * The epoch can is changed when a filesystems is added or removed, when + * The epoch can is changed when a filesystems is added or removed, when * "system encoding" changes, and when env(HOME) changes. */ @@ -958,7 +958,7 @@ Tcl_FSUnregister( * Search in the given pathname for files matching the given pattern. * Used by [glob]. Processes just one pattern for one directory. Callers * such as TclGlob and DoGlob implement manage the searching of multiple - * directories in cases such as + * directories in cases such as * glob -dir $dir -join * pkgIndex.tcl * * Results: @@ -1221,7 +1221,7 @@ FsAddMountsToGlobResult( * * The reason for the exception in 2,3 for the native filesystem is that * the native filesystem claims every file without determining whether - * whether the file exists, or even whether the pathname makes sense. + * whether the file exists, or even whether the pathname makes sense. * *---------------------------------------------------------------------- */ @@ -1239,7 +1239,7 @@ Tcl_FSMountsChanged( /* * Increment the filesystem epoch to invalidate every existing cached - * internal representation. + * internal representation. */ Tcl_MutexLock(&filesystemMutex); @@ -1474,7 +1474,7 @@ TclGetOpenModeEx( const char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */ int *seekFlagPtr, /* Sets this to 1 to tell the the caller to seek to * EOF after opening the file, and 0 otherwise. */ - int *binaryPtr) /* Sets this to 1 to tell the caller to + int *binaryPtr) /* Sets this to 1 to tell the caller to * configure the channel for binary * operations after opening the file. */ { @@ -1717,7 +1717,7 @@ Tcl_FSEvalFileEx( } /* - * The eof character is \32 (^Z). This is standard on Windows, and Tcl + * The eof character is \32 (^Z). This is standard on Windows, and Tcl * uses it on every platform to allow for scripted documents. [Bug: 2040] */ @@ -1853,7 +1853,7 @@ TclNREvalFile( TclPkgFileSeen(interp, Tcl_GetString(pathPtr)); /* - * The eof character is \32 (^Z). This is standard on Windows, and Tcl + * The eof character is \32 (^Z). This is standard on Windows, and Tcl * uses it on every platform to allow for scripted documents. [Bug: 2040] */ @@ -2063,7 +2063,7 @@ Tcl_PosixError( *---------------------------------------------------------------------- * * Tcl_FSStat -- - * Calls 'statProc' of the filesystem corresponding to pathPtr. + * Calls 'statProc' of the filesystem corresponding to pathPtr. * * Replaces the standard library routines stat. * @@ -2097,7 +2097,7 @@ Tcl_FSStat( *---------------------------------------------------------------------- * * Tcl_FSLstat -- - * Calls the 'lstatProc' of the filesystem corresponding to pathPtr. + * Calls the 'lstatProc' of the filesystem corresponding to pathPtr. * * Replaces the library version of lstat. If the filesystem doesn't * provide lstatProc but does provide statProc, Tcl falls back to @@ -2197,7 +2197,7 @@ Tcl_FSOpenFileChannel( if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { /* - * Return the correct error message. + * Return the correct error message. */ return NULL; } @@ -2651,7 +2651,7 @@ Tcl_FSGetCwd( norm = TclFSNormalizeAbsolutePath(interp,retVal); if (norm != NULL) { /* - * Assign to global storage the pathname of the current directory + * Assign to global storage the pathname of the current directory * and copy it into thread-local storage as well. * * At system startup multiple threads could in principle @@ -2954,7 +2954,7 @@ Tcl_FSChdir( */ FsUpdateCwd(normDirName, cd); - } + } } else { /* * Tcl_FSGetCwd() synchronizes the file-global cwdPathPtr if @@ -3018,7 +3018,7 @@ Tcl_FSLoadFile( /* Places to store pointers to the functions * named by sym1 and sym2. */ Tcl_LoadHandle *handlePtr, /* A place to store the token for the loaded - * object. Can be passed to + * object. Can be passed to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) /* A place to store a pointer to the function @@ -3051,7 +3051,7 @@ Tcl_FSLoadFile( * * Load a dynamic shared object by calling 'loadFileProc' of the * filesystem corresponding to the given pathname, and then finds within - * the loaded object the functions named in symbols[]. + * the loaded object the functions named in symbols[]. * * The given pathname is passed unmodified to `loadFileProc`, which * decides how to resolve it. On POSIX systems the native filesystem @@ -3199,7 +3199,7 @@ Tcl_LoadFile( } /* - * The filesystem doesn't support 'load'. Fall to the following: + * The filesystem doesn't support 'load'. Fall to the following: */ /* @@ -3382,7 +3382,7 @@ Tcl_LoadFile( /* * This is the filesystem for the temporary file the object was loaded * from. A reference to copyToPtr is already stored in - * tvdlPtr->divertedFile, so need need to increment the refCount again. + * tvdlPtr->divertedFile, so need need to increment the refCount again. */ tvdlPtr->divertedFilesystem = copyFsPtr; @@ -3725,7 +3725,7 @@ TclFSUnloadTempFile( Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Pathaname of file. */ - Tcl_Obj *toPtr, /* + Tcl_Obj *toPtr, /* * NULL or the pathname of a file to link to. */ int linkAction) /* Action to perform. */ @@ -3808,7 +3808,7 @@ Tcl_FSListVolumes(void) * * FsListMounts -- * - * Lists the mounts mathing the given pattern in the given directory. + * Lists the mounts mathing the given pattern in the given directory. * * Results: * A list, having a refCount of 0, of the matching mounts, or NULL if no @@ -4213,7 +4213,7 @@ Tcl_FSCopyFile( * TclCrossFilesystemCopy -- * * Helper for Tcl_FSCopyFile and Tcl_FSLoadFile. Copies a file from one - * filesystem to another, overwiting any file that already exists. + * filesystem to another, overwiting any file that already exists. * * Results: * A standard Tcl return code. @@ -4518,7 +4518,7 @@ Tcl_FSGetFileSystemForPath( /* * Call each of the "pathInFilesystem" functions in succession until the * corresponding filesystem is found. - */ + */ for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) { ClientData clientData = NULL; diff --git a/generic/tclInt.h b/generic/tclInt.h index 4f013bf..560849a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4130,7 +4130,6 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, */ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); -MODULE_SCOPE void TclFreeObj(Tcl_Obj *objPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); diff --git a/generic/tclOO.c b/generic/tclOO.c index 37551a9..2d09f3a 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -175,7 +175,7 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; * ROOT_CLASS respectively. */ -#define Deleted(oPtr) ((oPtr)->flags & OBJECT_DELETED) +#define Destructing(oPtr) ((oPtr)->flags & OBJECT_DESTRUCTING) #define IsRootObject(ocPtr) ((ocPtr)->flags & ROOT_OBJECT) #define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS) #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) @@ -844,7 +844,7 @@ ObjectRenamedTrace( * 2950259]. */ - if (!Deleted(oPtr)) { + if (!Destructing(oPtr)) { Tcl_DeleteNamespace(oPtr->namespacePtr); } oPtr->command = NULL; @@ -884,7 +884,7 @@ TclOODeleteDescendants( * clsPtr */ - if (!Deleted(mixinSubclassPtr->thisPtr) + if (!Destructing(mixinSubclassPtr->thisPtr) && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); @@ -904,7 +904,7 @@ TclOODeleteDescendants( if (clsPtr->subclasses.num > 0) { while (clsPtr->subclasses.num > 0) { subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1]; - if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr) + if (!Destructing(subclassPtr->thisPtr) && !IsRoot(subclassPtr) && !(subclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); @@ -930,7 +930,7 @@ TclOODeleteDescendants( * This condition also covers the case where instancePtr == oPtr */ - if (!Deleted(instancePtr) && !IsRoot(instancePtr) && + if (!Destructing(instancePtr) && !IsRoot(instancePtr) && !(instancePtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } @@ -972,7 +972,7 @@ TclOOReleaseClassContents( * Sanity check! */ - if (!Deleted(oPtr)) { + if (!Destructing(oPtr)) { if (IsRootClass(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::class"); @@ -1091,7 +1091,7 @@ TclOOReleaseClassContents( ckfree(clsPtr->privateVariables.list); } - if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) { + if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) { Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command); } } @@ -1124,7 +1124,7 @@ ObjectNamespaceDeleted( Tcl_Interp *interp = oPtr->fPtr->interp; int i; - if (Deleted(oPtr)) { + if (Destructing(oPtr)) { /* * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, * this guard could be removed. @@ -1139,7 +1139,7 @@ ObjectNamespaceDeleted( * records. This is the flag that */ - oPtr->flags |= OBJECT_DELETED; + oPtr->flags |= OBJECT_DESTRUCTING; /* * Let the dominoes fall! @@ -1284,7 +1284,7 @@ ObjectNamespaceDeleted( * sometimes not go away automatically; we force it here. [Bug 2962664] */ - if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr) + if (IsRootObject(oPtr) && !Destructing(fPtr->classCls->thisPtr) && !Tcl_InterpDeleted(interp)) { Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } @@ -1335,6 +1335,20 @@ TclOODecrRefCount( /* * ---------------------------------------------------------------------- * + * TclOOObjectDestroyed -- + * + * Returns TCL_OK if an object is entirely deleted, i.e. the destruction + * sequence has completed. + * + * ---------------------------------------------------------------------- + */ +int TclOOObjectDestroyed(Object *oPtr) { + return (oPtr->namespacePtr == NULL); +} + +/* + * ---------------------------------------------------------------------- + * * TclOORemoveFromInstances -- * * Utility function to remove an object from the list of instances within @@ -1477,7 +1491,7 @@ TclOOAddToSubclasses( * is assumed that the class is not already * present as a subclass in the superclass. */ { - if (Deleted(superPtr->thisPtr)) { + if (Destructing(superPtr->thisPtr)) { return; } if (superPtr->subclasses.num >= superPtr->subclasses.size) { @@ -1542,7 +1556,7 @@ TclOOAddToMixinSubs( * is assumed that the class is not already * present as a subclass in the superclass. */ { - if (Deleted(superPtr->thisPtr)) { + if (Destructing(superPtr->thisPtr)) { return; } if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) { @@ -1851,7 +1865,7 @@ FinalizeAlloc( * want to lose errors by accident. [Bug 2903011] */ - if (result != TCL_ERROR && Deleted(oPtr)) { + if (result != TCL_ERROR && Destructing(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "object deleted in constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); @@ -1866,7 +1880,7 @@ FinalizeAlloc( * command before we delete it. [Bug 9dd1bd7a74] */ - if (!Deleted(oPtr)) { + if (!Destructing(oPtr)) { (void) TclOOObjectName(interp, oPtr); Tcl_DeleteCommandFromToken(interp, oPtr->command); } @@ -2011,7 +2025,7 @@ Tcl_CopyObjectInstance( */ o2Ptr->flags = oPtr->flags & ~( - OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); + OBJECT_DESTRUCTING | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 635869e..db4b7f1 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -213,14 +213,11 @@ typedef struct Object { * command. */ } Object; -#define OBJECT_DELETED 1 /* Flag to say that an object has been - * destroyed. */ -#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been - * called. */ -#define CLASS_GONE 4 /* Obsolete. Indicates that the class of this - * object has been deleted, and so the object - * should not attempt to remove itself from its - * class. */ +#define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has + * been destroyed */ +#define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor script for the + object has began */ +#define OO_UNUSED_4 4 /* No longer used. */ #define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of * the class hierarchy and should be treated * specially during teardown. */ @@ -563,6 +560,7 @@ MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, const char *nameStr, const char *nsNameStr); MODULE_SCOPE int TclOODecrRefCount(Object *oPtr); +MODULE_SCOPE int TclOOObjectDestroyed(Object *oPtr); MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr); MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr); MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr); diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 5144176..01e2c00 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -681,11 +681,13 @@ InvokeProcedureMethod( * call frame's lifetime). */ /* - * If the interpreter was deleted, we just skip to the next thing in the - * chain. + * If the object namespace (or interpreter) were deleted, we just skip to + * the next thing in the chain. */ - if (Tcl_InterpDeleted(interp)) { + if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) || + Tcl_InterpDeleted(interp) + ) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } diff --git a/generic/tclParse.c b/generic/tclParse.c index 49f158e..44c1a74 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -816,7 +816,7 @@ TclParseBackslash( count = 2; switch (*p) { /* - * Note: in the conversions below, use absolute values (e.g., 0xa) + * Note: in the conversions below, use absolute values (e.g., 0xA) * rather than symbolic values (e.g. \n) that get converted by the * compiler. It's possible that compilers on some platforms will do * the symbolic conversions differently, which could result in @@ -830,19 +830,19 @@ TclParseBackslash( result = 0x8; break; case 'f': - result = 0xc; + result = 0xC; break; case 'n': - result = 0xa; + result = 0xA; break; case 'r': - result = 0xd; + result = 0xD; break; case 't': result = 0x9; break; case 'v': - result = 0xb; + result = 0xB; break; case 'x': count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result); @@ -866,6 +866,16 @@ TclParseBackslash( * No hexdigits -> This is just "u". */ result = 'u'; + } else if (((result & 0xDC00) == 0xD800) && (count == 6) + && (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) { + /* If high surrogate is immediately followed by a low surrogate + * escape, combine them into one character. */ + int low; + int count2 = TclParseHex(p+7, 4, &low); + if ((count2 == 4) && ((low & 0xDC00) == 0xDC00)) { + result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000; + count += count2 + 2; + } } break; case 'U': @@ -875,6 +885,9 @@ TclParseBackslash( * No hexdigits -> This is just "U". */ result = 'U'; + } else if ((result | 0x7FF) == 0xDFFF) { + /* Upper or lower surrogate, not allowed in this syntax. */ + result = 0xFFFD; } break; case '\n': diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 5436c01..7accfa2 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -47,7 +47,7 @@ static const Tcl_ObjType fsPathType = { /* * struct FsPath -- * - * Internal representation of a Tcl_Obj of fsPathType + * Internal representation of a Tcl_Obj of fsPathType */ typedef struct FsPath { @@ -124,7 +124,7 @@ typedef struct FsPath { * None (beyond the memory allocation for the result). * * Special note: - * Originally based on code from Matt Newman and Jean-Claude Wippler. + * Originally based on code from Matt Newman and Jean-Claude Wippler. * Totally rewritten later by Vince Darley to handle symbolic links. * *--------------------------------------------------------------------------- @@ -2030,7 +2030,7 @@ Tcl_FSGetInternalRep( * * TclFSEnsureEpochOk -- * - * Ensure that the path is a valid path, and that it has a + * Ensure that the path is a valid path, and that it has a * fsPathType internal representation that is not stale. * * Results: diff --git a/generic/tclScan.c b/generic/tclScan.c index 5d5406e..5cf404f 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -938,7 +938,7 @@ Tcl_ScanObjCmd( Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else { - mp_set_ull(&big, (Tcl_WideUInt)wideValue); + mp_set_ull(&big, (Tcl_WideUInt)wideValue); Tcl_SetBignumObj(objPtr, &big); } } else { diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 88a1044..53823b1 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -513,7 +513,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig # define Tcl_SetPanicProc 0 # define Tcl_FindExecutable 0 # define Tcl_GetUnicode 0 -# define TclOldFreeObj 0 # undef Tcl_StringMatch # define Tcl_StringMatch 0 # define TclBN_reverse 0 @@ -548,7 +547,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig # define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime -# define TclOldFreeObj TclFreeObj static int seekOld( @@ -1053,7 +1051,7 @@ const TclTomMathStubs tclTomMathStubs = { TclBN_mp_tc_or, /* 74 */ TclBN_mp_tc_xor, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ - TclBN_mp_get_bit, /* 77 */ + 0, /* 77 */ TclBN_mp_to_ubin, /* 78 */ 0, /* 79 */ TclBN_mp_to_radix, /* 80 */ @@ -1114,7 +1112,7 @@ const TclStubs tclStubs = { Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ - TclOldFreeObj, /* 30 */ + TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ Tcl_GetByteArrayFromObj, /* 33 */ diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index 964b5a7..d4fe95f 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -75,7 +75,7 @@ declare 16 { mp_err MP_WUR TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) } declare 17 {deprecated {is private function in libtommath}} { - mp_err MP_WUR TclBN_mp_div_3(const mp_int *a, mp_int *q, unsigned int *r) + mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, unsigned int *r) } declare 18 { void TclBN_mp_exch(mp_int *a, mp_int *b) @@ -144,7 +144,7 @@ declare 39 { void TclBN_mp_set(mp_int *a, unsigned int b) } declare 40 {nostub {is private function in libtommath}} { - mp_err MP_WUR TclBN_mp_sqr(const mp_int *a, mp_int *b) + mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b) } declare 41 { mp_err MP_WUR TclBN_mp_sqrt(const mp_int *a, mp_int *b) @@ -267,9 +267,6 @@ declare 75 { declare 76 { mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) } -declare 77 {deprecated {is private function in libtommath}} { - mp_bool TclBN_mp_get_bit(const mp_int *a, unsigned int b) -} # Added in libtommath 1.2.0 declare 78 { diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index 7588d96..b6e2fbd 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -79,7 +79,6 @@ MODULE_SCOPE mp_err TclBN_s_mp_expt_u32(const mp_int *a, unsigned int b, mp_int #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_u32 #define mp_expt_d_ex TclBN_mp_expt_d_ex -#define mp_get_bit TclBN_mp_get_bit #define mp_get_mag_ul TclBN_mp_get_mag_ul #define mp_get_mag_ull TclBN_mp_get_mag_ull #define mp_grow TclBN_mp_grow @@ -129,7 +128,6 @@ MODULE_SCOPE mp_err TclBN_s_mp_expt_u32(const mp_int *a, unsigned int b, mp_int #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_balance_mul TclBN_mp_balance_mul -#define s_mp_get_bit TclBN_mp_get_bit #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs @@ -210,8 +208,8 @@ EXTERN mp_err TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; /* 17 */ TCL_DEPRECATED("is private function in libtommath") -mp_err MP_WUR TclBN_mp_div_3(const mp_int *a, mp_int *q, - unsigned int *r) MP_WUR; +mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, + unsigned int *r); /* 18 */ EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ @@ -264,7 +262,7 @@ EXTERN mp_err TclBN_mp_shrink(mp_int *a) MP_WUR; /* 39 */ EXTERN void TclBN_mp_set(mp_int *a, unsigned int b); /* 40 */ -EXTERN mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b) MP_WUR; +EXTERN mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b); /* 41 */ EXTERN mp_err TclBN_mp_sqrt(const mp_int *a, mp_int *b) MP_WUR; /* 42 */ @@ -371,9 +369,7 @@ EXTERN mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, /* 76 */ EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR; -/* 77 */ -TCL_DEPRECATED("is private function in libtommath") -mp_bool TclBN_mp_get_bit(const mp_int *a, unsigned int b); +/* Slot 77 is reserved */ /* 78 */ EXTERN int TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; @@ -403,7 +399,7 @@ typedef struct TclTomMathStubs { mp_err (*tclBN_mp_div_d) (const mp_int *a, unsigned int b, mp_int *q, unsigned int *r) MP_WUR; /* 14 */ mp_err (*tclBN_mp_div_2) (const mp_int *a, mp_int *q) MP_WUR; /* 15 */ mp_err (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; /* 16 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, unsigned int *r) MP_WUR; /* 17 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, unsigned int *r); /* 17 */ void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */ mp_err (*tclBN_mp_expt_u32) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 19 */ mp_err (*tclBN_mp_grow) (mp_int *a, int size) MP_WUR; /* 20 */ @@ -426,7 +422,7 @@ typedef struct TclTomMathStubs { void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */ mp_err (*tclBN_mp_shrink) (mp_int *a) MP_WUR; /* 38 */ void (*tclBN_mp_set) (mp_int *a, unsigned int b); /* 39 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_sqr) (const mp_int *a, mp_int *b) MP_WUR; /* 40 */ + TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */ mp_err (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b) MP_WUR; /* 41 */ mp_err (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 42 */ mp_err (*tclBN_mp_sub_d) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 43 */ @@ -463,7 +459,7 @@ typedef struct TclTomMathStubs { mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 74 */ mp_err (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 75 */ mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_bool (*tclBN_mp_get_bit) (const mp_int *a, unsigned int b); /* 77 */ + void (*reserved77)(void); int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */ void (*reserved79)(void); int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */ @@ -635,8 +631,7 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ -#define TclBN_mp_get_bit \ - (tclTomMathStubsPtr->tclBN_mp_get_bit) /* 77 */ +/* Slot 77 is reserved */ #define TclBN_mp_to_ubin \ (tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */ /* Slot 79 is reserved */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 7404663..8bc4d49 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1067,7 +1067,7 @@ Tcl_UtfBackslash( * We ate a whole line. Pay the price of a strlen() */ - result = TclParseBackslash(src, (int)strlen(src), &numRead, dst); + result = TclParseBackslash(src, strlen(src), &numRead, dst); } if (readPtr != NULL) { *readPtr = numRead; diff --git a/library/http/cookiejar.tcl b/library/cookiejar/cookiejar.tcl index 2eae877..c8b495a 100644 --- a/library/http/cookiejar.tcl +++ b/library/cookiejar/cookiejar.tcl @@ -54,7 +54,7 @@ namespace eval [info object namespace ::http::cookiejar] { # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles - variable version 0.1 + variable version 0.2.0 variable domainlist \ http://publicsuffix.org/list/effective_tld_names.dat diff --git a/library/http/effective_tld_names.txt.gz b/library/cookiejar/effective_tld_names.txt.gz Binary files differindex 13e08bb..13e08bb 100644 --- a/library/http/effective_tld_names.txt.gz +++ b/library/cookiejar/effective_tld_names.txt.gz diff --git a/library/http/idna.tcl b/library/cookiejar/idna.tcl index 2a7d289..1ab9fc4 100644 --- a/library/http/idna.tcl +++ b/library/cookiejar/idna.tcl @@ -284,7 +284,7 @@ namespace eval ::tcl::idna { } } -package provide tcl::idna 1.0 +package provide tcl::idna 1.0.1 # Local variables: # mode: tcl diff --git a/library/cookiejar/pkgIndex.tcl b/library/cookiejar/pkgIndex.tcl new file mode 100644 index 0000000..b1853aa --- /dev/null +++ b/library/cookiejar/pkgIndex.tcl @@ -0,0 +1,3 @@ +if {![package vsatisfies [package provide Tcl] 8.6-]} {return} +package ifneeded cookiejar 0.2.0 [list source [file join $dir cookiejar.tcl]] +package ifneeded tcl::idna 1.0.1 [list source [file join $dir idna.tcl]] diff --git a/library/http/http.tcl b/library/http/http.tcl index 7236bae..baa3caa 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.0 +package provide http 2.9.1 namespace eval http { # Allow resourcing to not clobber existing data @@ -3020,7 +3020,7 @@ proc http::IsBinaryContentType {type} { # and so on. if {$major eq "application"} { set minor [string trimright $minor] - if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} { + if {$minor in {"json" "xml" "xml-external-parsed-entity" "xml-dtd"}} { return false } } diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 3bc111f..f9f1176 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,4 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] -package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]] -package ifneeded tcl::idna 1.0 [list source [file join $dir idna.tcl]] +package ifneeded http 2.9.1 [list tclPkgSetup $dir http 2.9.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index a26d788..c6ef7a2 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -19,7 +19,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.7a2 +package require -exact Tcl 8.7a4 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/library/manifest.txt b/library/manifest.txt index 307302f..620f8b8 100644 --- a/library/manifest.txt +++ b/library/manifest.txt @@ -5,9 +5,11 @@ apply {{dir} { set ::test [info script] set isafe [interp issafe] foreach {safe package version file} { - 0 http 2.9.0 {http http.tcl} + 0 http 2.9.1 {http http.tcl} 1 msgcat 1.7.0 {msgcat msgcat.tcl} 1 opt 0.4.7 {opt optparse.tcl} + 0 cookiejar 0.2.0 {cookiejar cookiejar.tcl} + 0 tcl::idna 1.0.1 {cookiejar idna.tcl} 0 platform 1.0.14 {platform platform.tcl} 0 platform::shell 1.1.4 {platform shell.tcl} 1 tcltest 2.5.1 {tcltest tcltest.tcl} diff --git a/library/safe.tcl b/library/safe.tcl index 7b165d2..470cfa3 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -20,7 +20,7 @@ # # Needed utilities package -package require opt 0.4.1 +package require opt 0.4.7 # Create the safe namespace namespace eval ::safe { diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index ca93725..4aa3970 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded tcltest 2.5.1 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.5.2 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index a7a68c7..28c50ef 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.5.1 + variable Version 2.5.2 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1983,7 +1983,9 @@ proc tcltest::test {name description args} { } # First, run the setup script - set code [catch {uplevel 1 $setup} setupMsg] + set code [catch { + uplevel 1 [list [namespace which SetupTest] $setup] + } setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup) $::errorCode @@ -2067,7 +2069,9 @@ proc tcltest::test {name description args} { } # Always run the cleanup script - set code [catch {uplevel 1 $cleanup} cleanupMsg] + set code [catch { + uplevel 1 [list [namespace which CleanupTest] $cleanup] + } cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo set errorCodeRes(cleanup) $::errorCode @@ -2338,6 +2342,8 @@ proc tcltest::Skipped {name constraints} { return 0 } + + # RunTest -- # # This is where the body of a test is evaluated. The combination of @@ -2354,11 +2360,38 @@ proc tcltest::RunTest {name script} { memory tag $name } - set code [catch {uplevel 1 $script} actualAnswer] + set code [catch {uplevel 1 [list [ + namespace origin EvalTest] $script]} actualAnswer copts] return [list $actualAnswer $code] } + +proc tcltest::EvalTest script { + set code [catch {uplevel 1 $script} cres copts] + dict set copts -code $code + dict incr copts -level + return -options $copts $cres +} + + + +# SetupTest -- +# +# Evaluates the -setup script for a test + +proc tcltest::SetupTest setup { + uplevel 1 $setup +} + + +# CleanupTest -- +# +# Evaluates the -cleanup script for a test +proc tcltest::CleanupTest cleanup { + uplevel 1 $cleanup +} + ##################################################################### # tcltest::cleanupTestsHook -- diff --git a/macosx/README b/macosx/README index 62b3a99..f28c055 100644 --- a/macosx/README +++ b/macosx/README @@ -57,7 +57,7 @@ No nroff manpages are installed by default by the GNUmakefile. - The Tcl framework can be installed in any of the system's standard framework directories: - $HOME/Library/Frameworks /Library/Frameworks /System/Library/Frameworks + $HOME/Library/Frameworks /Library/Frameworks 3. Building Tcl on Mac OS X diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index a76e8df..43b3703 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -344,9 +344,13 @@ test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} -test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { - expr {[lindex [time {_nrt_sleep 0.01}] 0] < [lindex [time {_nrt_sleep 10.0}] 0]} -} 1 +test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} -body { + set m1 [lindex [time {_nrt_sleep 0.01}] 0] + set m2 [lindex [time {_nrt_sleep 10.0}] 0] + list \ + [expr {$m1 < $m2}] \ + $m1 $m2; # interesting only in error case. +} -match glob -result [list 1 *] test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo @@ -397,11 +401,10 @@ test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 -test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { - lassign [timerate {_nrt_sleep 0} 50] ovh - set m1 [timerate -overhead $ovh {_nrt_sleep 0.01} 50] - set m2 [timerate -overhead $ovh {_nrt_sleep 1.00} 50] - list \ +test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} -body { + set m1 [timerate {_nrt_sleep 0.01} 50] + set m2 [timerate {_nrt_sleep 1.00} 50] + list [list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ @@ -410,8 +413,9 @@ test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains [expr {[lindex $m1 4] > 10000}] \ [expr {[lindex $m2 4] < 10000}] \ [expr {[lindex $m1 6] > 5 && [lindex $m1 6] < 100}] \ - [expr {[lindex $m2 6] > 5 && [lindex $m2 6] < 100}] -} [lrepeat 9 1] + [expr {[lindex $m2 6] > 5 && [lindex $m2 6] < 100}] \ + ] $m1 $m2; # interesting only in error case. +} -match glob -result [list [lrepeat 9 1] *] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo } {1 foo {foo @@ -424,35 +428,38 @@ test cmdMZ-6.7.1 {Tcl_TimeRateObjCmd: return from timerate} { proc r1 {} {upvar x x; timerate {incr x; return "r1"; incr x} 1000 10} list [r1] $x } {r1 1} -test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { +test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} -body { set m1 [timerate {break}] - list \ + list [list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ - [expr {[lindex $m1 6] < 10}] -} {1 1 1 1} -test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} { + [expr {[lindex $m1 6] < 10}] \ + ] $m1; # interesting only in error case. +} -match glob -result [list {1 1 1 1} *] +test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} -body { set m1 [timerate {continue; return -code error "unexpected"} 1000 10] - list \ + list [list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 10}] \ [expr {[lindex $m1 4] > 1000}] \ - [expr {[lindex $m1 6] < 100}] -} {1 1 1 1} + [expr {[lindex $m1 6] < 100}] \ + ] $m1; # interesting only in error case. +} -match glob -result [list {1 1 1 1} *] test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} -test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { +test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} -body { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] - list \ + list [list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ - [expr {[lindex $m1 6] <= 0.001}] -} {1 1 1 1} + [expr {[lindex $m1 6] <= 0.001}] \ + ] $m1; # interesting only in error case. +} -match glob -result [list {1 1 1 1} *] test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} { set m1 {set m2 ok} if 1 $m1 diff --git a/tests/encoding.test b/tests/encoding.test index da34f03..a58303b 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -321,6 +321,46 @@ test encoding-15.3 {UtfToUtfProc null character input} teststringbytes { binary scan [teststringbytes $y] H* z set z } c080 +test encoding-15.4 {UtfToUtfProc emoji character input} { + set x \xED\xA0\xBD\xED\xB8\x82 + set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82] + list [string length $x] $y +} "6 \U1F602" +test encoding-15.5 {UtfToUtfProc emoji character input} { + set x \xF0\x9F\x98\x82 + set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82] + list [string length $x] $y +} "4 \U1F602" +test encoding-15.6 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\uDE02\uD83D + set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D] + binary scan $y H* z + list [string length $y] $z +} {10 edb882f09f9882eda0bd} +test encoding-15.7 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\uD83D + set y [encoding convertto utf-8 \uDE02\uD83D\uD83D] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 9 edb882eda0bdeda0bd} +test encoding-15.8 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\xE9 + set y [encoding convertto utf-8 \uDE02\uD83D\xE9] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 8 edb882eda0bdc3a9} +test encoding-15.9 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83DX + set y [encoding convertto utf-8 \uDE02\uD83DX] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 7 edb882eda0bd58} +test encoding-15.10 {UtfToUtfProc emoji character output} { + set x \U1F602 + set y [encoding convertto utf-8 \U1F602] + binary scan $y H* z + list [string length $y] $z +} {4 f09f9882} test encoding-16.1 {Utf16ToUtfProc} -body { set val [encoding convertfrom utf-16 NN] diff --git a/tests/fileSystemEncoding.test b/tests/fileSystemEncoding.test index fa67646..0f8a2a7 100644 --- a/tests/fileSystemEncoding.test +++ b/tests/fileSystemEncoding.test @@ -38,11 +38,12 @@ namespace eval ::tcl::test::fileSystemEncoding { makeFile {} $utf8name set globbed [lindex [glob -directory $dir *] 0] encoding system utf-8 - lappend res [file exists $globbed] + set res [file exists $globbed] encoding system iso8859-1 lappend res [file exists $globbed] return $res } -cleanup { + removeFile $utf8name file delete -force $dir encoding system $saved } -result {0 1} diff --git a/tests/http.test b/tests/http.test index 2184449..8eac3c3 100644 --- a/tests/http.test +++ b/tests/http.test @@ -670,7 +670,7 @@ test http-7.4 {http::formatQuery} -setup { http::config -urlencoding $enc } -result {%3F} -package require -exact tcl::idna 1.0 +package require tcl::idna 1.0 test http-idna-1.1 {IDNA package: basics} -returnCodes error -body { ::tcl::idna @@ -680,7 +680,7 @@ test http-idna-1.2 {IDNA package: basics} -returnCodes error -body { } -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} test http-idna-1.3 {IDNA package: basics} -body { ::tcl::idna version -} -result 1.0 +} -result 1.0.1 test http-idna-1.4 {IDNA package: basics} -returnCodes error -body { ::tcl::idna version what } -result {wrong # args: should be "::tcl::idna version"} diff --git a/tests/httpcookie.test b/tests/httpcookie.test index a6b193f..b3c5412 100644 --- a/tests/httpcookie.test +++ b/tests/httpcookie.test @@ -25,48 +25,48 @@ testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch { package require cookiejar }]}] -set COOKIEJAR_VERSION 0.1 -test http-cookiejar-1.1 "cookie storage: packaging" {notOSXtravis sqlite3 cookiejar} { +set COOKIEJAR_VERSION 0.2.0 +test http-cookiejar-1.1 "cookie storage: packaging" {cookiejar} { package require cookiejar } $COOKIEJAR_VERSION -test http-cookiejar-1.2 "cookie storage: packaging" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-1.2 "cookie storage: packaging" {cookiejar} { package require cookiejar package require cookiejar } $COOKIEJAR_VERSION test http-cookiejar-2.1 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar } -result {wrong # args: should be "http::cookiejar method ?arg ...?"} test http-cookiejar-2.2 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar ? } -result {unknown method "?": must be configure, create, destroy or new} test http-cookiejar-2.3 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -body { http::cookiejar configure } -result {-domainfile -domainlist -domainrefresh -loglevel -offline -purgeold -retain -vacuumtrigger} test http-cookiejar-2.4 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar configure a b c d e } -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"} test http-cookiejar-2.5 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar configure a } -result {bad option "a": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger} test http-cookiejar-2.6 "cookie storage: basics" -constraints { - notOSXtravis sqlite3 cookiejar + cookiejar } -returnCodes error -body { http::cookiejar configure -d } -result {ambiguous option "-d": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger} test http-cookiejar-2.7 "cookie storage: basics" -setup { set old [http::cookiejar configure -loglevel] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [http::cookiejar configure -loglevel] \ [http::cookiejar configure -loglevel debug] \ [http::cookiejar configure -loglevel] \ @@ -77,7 +77,7 @@ test http-cookiejar-2.7 "cookie storage: basics" -setup { } -result {info debug debug error error} test http-cookiejar-2.8 "cookie storage: basics" -setup { set old [http::cookiejar configure -loglevel] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [http::cookiejar configure -loglevel] \ [http::cookiejar configure -loglevel d] \ [http::cookiejar configure -loglevel i] \ @@ -88,38 +88,38 @@ test http-cookiejar-2.8 "cookie storage: basics" -setup { } -result {info debug info warn error} test http-cookiejar-2.9 "cookie storage: basics" -body { http::cookiejar configure -off -} -constraints {notOSXtravis sqlite3 cookiejar} -match glob -result * +} -constraints {cookiejar} -match glob -result * test http-cookiejar-2.10 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline true } -cleanup { catch {http::cookiejar configure -offline $oldval} } -result 1 test http-cookiejar-2.11 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline nonbool } -cleanup { catch {http::cookiejar configure -offline $oldval} } -returnCodes error -result {expected boolean value but got "nonbool"} test http-cookiejar-2.12 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -purgeold] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -purge nonint } -cleanup { catch {http::cookiejar configure -purgeold $oldval} } -returnCodes error -result {expected positive integer but got "nonint"} test http-cookiejar-2.13 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -domainrefresh] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -domainref nonint } -cleanup { catch {http::cookiejar configure -domainrefresh $oldval} } -returnCodes error -result {expected positive integer but got "nonint"} test http-cookiejar-2.14 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -domainrefresh] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -domainref -42 } -cleanup { catch {http::cookiejar configure -domainrefresh $oldval} @@ -128,7 +128,7 @@ test http-cookiejar-2.15 "cookie storage: basics" -setup { set oldval [http::cookiejar configure -domainrefresh] set result unset set tracer [http::cookiejar create tracer] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { oo::objdefine $tracer method PostponeRefresh {} { set ::result set next @@ -140,28 +140,28 @@ test http-cookiejar-2.15 "cookie storage: basics" -setup { catch {http::cookiejar configure -domainrefresh $oldval} } -result set -test http-cookiejar-3.1 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.1 "cookie storage: class" {cookiejar} { info object isa object http::cookiejar } 1 -test http-cookiejar-3.2 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.2 "cookie storage: class" {cookiejar} { info object isa class http::cookiejar } 1 -test http-cookiejar-3.3 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.3 "cookie storage: class" {cookiejar} { lsort [info object methods http::cookiejar] } {configure} -test http-cookiejar-3.4 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} { +test http-cookiejar-3.4 "cookie storage: class" {cookiejar} { lsort [info object methods http::cookiejar -all] } {configure create destroy new} test http-cookiejar-3.5 "cookie storage: class" -setup { catch {rename ::cookiejar ""} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { namespace eval :: {http::cookiejar create cookiejar} } -cleanup { catch {rename ::cookiejar ""} } -result ::cookiejar test http-cookiejar-3.6 "cookie storage: class" -setup { catch {rename ::cookiejar ""} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [http::cookiejar create ::cookiejar] [info commands ::cookiejar] \ [::cookiejar destroy] [info commands ::cookiejar] } -cleanup { @@ -169,7 +169,7 @@ test http-cookiejar-3.6 "cookie storage: class" -setup { } -result {::cookiejar ::cookiejar {} {}} test http-cookiejar-3.7 "cookie storage: class" -setup { catch {rename ::cookiejar ""} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar foo bar } -returnCodes error -cleanup { catch {rename ::cookiejar ""} @@ -178,7 +178,7 @@ test http-cookiejar-3.8 "cookie storage: class" -setup { catch {rename ::cookiejar ""} set f [makeFile "" cookiejar] file delete $f -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { list [file exists $f] [http::cookiejar create ::cookiejar $f] \ [file exists $f] } -cleanup { @@ -188,7 +188,7 @@ test http-cookiejar-3.8 "cookie storage: class" -setup { test http-cookiejar-3.9 "cookie storage: class" -setup { catch {rename ::cookiejar ""} set f [makeFile "bogus content for a database" cookiejar] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $f } -returnCodes error -cleanup { catch {rename ::cookiejar ""} @@ -197,7 +197,7 @@ test http-cookiejar-3.9 "cookie storage: class" -setup { test http-cookiejar-3.10 "cookie storage: class" -setup { catch {rename ::cookiejar ""} set dir [makeDirectory cookiejar] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $dir } -returnCodes error -cleanup { catch {rename ::cookiejar ""} @@ -206,49 +206,49 @@ test http-cookiejar-3.10 "cookie storage: class" -setup { test http-cookiejar-4.1 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar method ?arg ...?"} test http-cookiejar-4.2 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar ? } -returnCodes error -cleanup { ::cookiejar destroy } -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup, policyAllow or storeCookie} test http-cookiejar-4.3 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lsort [info object methods cookiejar -all] } -cleanup { ::cookiejar destroy } -result {destroy forceLoadDomainData getCookies lookup policyAllow storeCookie} test http-cookiejar-4.4 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar getCookies } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar getCookies proto host path"} test http-cookiejar-4.5 "cookie storage" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar getCookies http www.example.com / } -cleanup { ::cookiejar destroy } -result {} test http-cookiejar-4.6 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie } -returnCodes error -cleanup { ::cookiejar destroy } -result {wrong # args: should be "cookiejar storeCookie options"} test http-cookiejar-4.7 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar @@ -264,7 +264,7 @@ test http-cookiejar-4.7 "cookie storage: instance" -setup { test http-cookiejar-4.8 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar @@ -282,7 +282,7 @@ test http-cookiejar-4.8 "cookie storage: instance" -setup { test http-cookiejar-4.9 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar @@ -299,7 +299,7 @@ test http-cookiejar-4.9 "cookie storage: instance" -setup { } -result 0 test http-cookiejar-4.10 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie [dict replace { key foo value bar @@ -315,7 +315,7 @@ test http-cookiejar-4.10 "cookie storage: instance" -setup { test http-cookiejar-4.11 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie [dict replace { key foo value bar @@ -333,7 +333,7 @@ test http-cookiejar-4.11 "cookie storage: instance" -setup { test http-cookiejar-4.12 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar oo::objdefine ::cookiejar export Database -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie [dict replace { key foo value bar @@ -351,7 +351,7 @@ test http-cookiejar-4.12 "cookie storage: instance" -setup { test http-cookiejar-4.13 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo @@ -369,7 +369,7 @@ test http-cookiejar-4.13 "cookie storage: instance" -setup { test http-cookiejar-4.14 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie [dict replace { key foo @@ -387,7 +387,7 @@ test http-cookiejar-4.14 "cookie storage: instance" -setup { test http-cookiejar-4.15 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo @@ -414,7 +414,7 @@ test http-cookiejar-4.15 "cookie storage: instance" -setup { test http-cookiejar-4.16 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo1 @@ -440,7 +440,7 @@ test http-cookiejar-4.16 "cookie storage: instance" -setup { } -result {{} {foo1 bar foo2 bar}} test http-cookiejar-4.17 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar lookup a b c d } -returnCodes error -cleanup { ::cookiejar destroy @@ -448,7 +448,7 @@ test http-cookiejar-4.17 "cookie storage: instance" -setup { test http-cookiejar-4.18 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { lappend result [cookiejar lookup] lappend result [cookiejar lookup www.example.com] lappend result [catch {cookiejar lookup www.example.com foo} value] $value @@ -470,7 +470,7 @@ test http-cookiejar-4.18 "cookie storage: instance" -setup { test http-cookiejar-4.19 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar @@ -500,7 +500,7 @@ test http-cookiejar-4.19 "cookie storage: instance" -setup { test http-cookiejar-4.20 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value bar1 @@ -529,7 +529,7 @@ test http-cookiejar-4.20 "cookie storage: instance" -setup { test http-cookiejar-4.21 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value bar1 @@ -558,7 +558,7 @@ test http-cookiejar-4.21 "cookie storage: instance" -setup { test http-cookiejar-4.22 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar forceLoadDomainData x y z } -returnCodes error -cleanup { ::cookiejar destroy @@ -566,14 +566,14 @@ test http-cookiejar-4.22 "cookie storage: instance" -setup { test http-cookiejar-4.23 "cookie storage: instance" -setup { http::cookiejar create ::cookiejar set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar forceLoadDomainData } -cleanup { ::cookiejar destroy } -result {} test http-cookiejar-4.23.a {cookie storage: instance} -setup { set off [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline 1 [http::cookiejar create ::cookiejar] destroy } -cleanup { @@ -582,7 +582,7 @@ test http-cookiejar-4.23.a {cookie storage: instance} -setup { } -result {} test http-cookiejar-4.23.b {cookie storage: instance} -setup { set off [http::cookiejar configure -offline] -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar configure -offline 0 [http::cookiejar create ::cookiejar] destroy } -cleanup { @@ -593,7 +593,7 @@ test http-cookiejar-4.23.b {cookie storage: instance} -setup { test http-cookiejar-5.1 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar @@ -610,7 +610,7 @@ test http-cookiejar-5.1 "cookie storage: constraints" -setup { test http-cookiejar-5.2 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar @@ -627,7 +627,7 @@ test http-cookiejar-5.2 "cookie storage: constraints" -setup { test http-cookiejar-5.3 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value bar @@ -653,7 +653,7 @@ test http-cookiejar-5.3 "cookie storage: constraints" -setup { test http-cookiejar-5.4 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo value bar1 @@ -679,7 +679,7 @@ test http-cookiejar-5.4 "cookie storage: constraints" -setup { test http-cookiejar-5.5 "cookie storage: constraints" -setup { http::cookiejar create ::cookiejar cookiejar forceLoadDomainData -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { cookiejar storeCookie { key foo1 value 1 @@ -777,7 +777,7 @@ test http-cookiejar-6.1 "cookie storage: expiry and lookup" -setup { global result lappend result [lsort [lmap {k v} $cookies {set v}]] } -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { values [cookiejar getCookies http www.example.com /] cookiejar storeCookie { key foo @@ -833,7 +833,7 @@ test http-cookiejar-7.1 "cookie storage: persistence of persistent cookies" -set catch {rename ::cookiejar ""} set f [makeFile "" cookiejar] file delete $f -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $f ::cookiejar destroy http::cookiejar create ::cookiejar $f @@ -846,7 +846,7 @@ test http-cookiejar-7.2 "cookie storage: persistence of persistent cookies" -set set f [makeFile "" cookiejar] file delete $f set result {} -} -constraints {notOSXtravis sqlite3 cookiejar} -body { +} -constraints {cookiejar} -body { http::cookiejar create ::cookiejar $f cookiejar storeCookie [dict replace { key foo diff --git a/tests/info.test b/tests/info.test index ce51523..1f3584c 100644 --- a/tests/info.test +++ b/tests/info.test @@ -735,28 +735,28 @@ proc etrace {} { test info-22.0 {info frame, levels} {!singleTestInterp} { info frame -} 7 +} 9 test info-22.1 {info frame, bad level relative} {!singleTestInterp} { # catch is another level!, i.e. we have 8, not 7 - catch {info frame -8} msg + catch {info frame -10} msg set msg -} {bad level "-8"} +} {bad level "-10"} test info-22.2 {info frame, bad level absolute} {!singleTestInterp} { # catch is another level!, i.e. we have 8, not 7 - catch {info frame 9} msg + catch {info frame 11} msg set msg -} {bad level "9"} +} {bad level "11"} test info-22.3 {info frame, current, relative} -match glob -body { info frame 0 -} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-22.4 {info frame, current, relative, nested} -match glob -body { set res [info frame 0] -} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res} +} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::EvalTest} -cleanup {unset res} test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body { - reduce [info frame 7] -} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest} + reduce [info frame 9] +} -result {type source line 756 file info.test cmd {info frame 9} proc ::tcltest::EvalTest} test info-22.6 {info frame, global, relative} {!singleTestInterp} { - reduce [info frame -6] + reduce [info frame -8] } {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0} test info-22.7 {info frame, global, absolute} {!singleTestInterp} { reduce [info frame 1] @@ -764,8 +764,8 @@ test info-22.7 {info frame, global, absolute} {!singleTestInterp} { test info-22.8 {info frame, basic trace} -match glob -body { join [lrange [etrace] 0 2] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} -* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest} -* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}} +* {type source line 765 file info.test cmd etrace proc ::tcltest::EvalTest} +* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::EvalTest}} unset -nocomplain msg @@ -792,20 +792,20 @@ test info-23.3 {eval'd info frame, literal} -match glob -body { eval { info frame 0 } -} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::EvalTest} test info-23.4 {eval'd info frame, semi-dynamic} { eval info frame 0 -} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} +} {type eval line 1 cmd {info frame 0} proc ::tcltest::EvalTest} test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body { set script {info frame 0} eval $script -} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::EvalTest} test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body { set script {etrace} join [lrange [eval $script] 0 2] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} -* {type eval line 1 cmd etrace proc ::tcltest::RunTest} -* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}} +* {type eval line 1 cmd etrace proc ::tcltest::EvalTest} +* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::EvalTest}} # ------------------------------------------------------------------------- @@ -1024,7 +1024,7 @@ test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body { # offsets of all bs+nl sequences in literal words, then using the # information in the bcc and other places to bump line numbers when # parsing over the location. Also affected: testcases 22.8 and 23.6. -} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} # ------------------------------------------------------------------------- # See 24.0 - 24.5 for similar situations, using literal scripts. @@ -1042,36 +1042,36 @@ test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body { if 1 $body return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest} test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body { if 1 then $body return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest} test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body { set flag 1 while {$flag} $body return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest} # .3 - proc - scoping prevent return of result ... test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body { foreach var val $body set res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest} test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body { set flag 1 for {} {$flag} {} $body return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest} test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body { eval $body return $res -} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest} # ------------------------------------------------------------------------- @@ -1319,8 +1319,8 @@ test info-37.0 {eval pure list, single line} -match glob -body { eval $cmd return $res } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} -* {type eval line 2 cmd etrace proc ::tcltest::RunTest} -* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c} +* {type eval line 2 cmd etrace proc ::tcltest::EvalTest} +* {type eval line 1 cmd foreac proc ::tcltest::EvalTest}} -cleanup {unset foo cmd res b c} # ------------------------------------------------------------------------- @@ -1360,8 +1360,8 @@ test info-38.1 {location information for uplevel, dv, direct-var} -match glob -b } join [lrange [uplevel \#0 $script] 0 2] \n } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} -* {type eval line 3 cmd etrace proc ::tcltest::RunTest} -* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y} +* {type eval line 3 cmd etrace proc ::tcltest::EvalTest} +* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::EvalTest}} -cleanup {unset script y} # 38.2 moved to bottom to not disturb other tests with the necessary changes to this one. @@ -1381,7 +1381,7 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g } -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0} * {type eval line 3 cmd etrace proc ::control} * {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control} -* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y} +* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::EvalTest}} -cleanup {unset script y} # 38.4 moved to bottom to not disturb other tests with the necessary changes to this one. @@ -1399,7 +1399,7 @@ test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glo * {type eval line 3 cmd etrace proc ::control} * {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control} * {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1} -* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}} +* {type source line 1397 file info.test cmd datav proc ::tcltest::EvalTest}} # 38.6 moved to bottom to not disturb other tests with the necessary changes to this one. @@ -1413,9 +1413,9 @@ testConstraint testevalex [llength [info commands testevalex]] test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body { join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n } -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0} -* {type eval line 1 cmd etrace proc ::tcltest::RunTest} -* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest} -* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}} +* {type eval line 1 cmd etrace proc ::tcltest::EvalTest} +* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::EvalTest} +* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::EvalTest}} # ------------------------------------------------------------------------- # literal sharing @@ -1463,7 +1463,7 @@ test info-30.3 {bs+nl in literal words, namespace multi-word script} { namespace eval xxx variable res \ [list [reduce [info frame 0]]];# line 1464 return $xxx::res -} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body { eval { @@ -1471,7 +1471,7 @@ test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body [reduce [info frame 0]];# line 1471 } return $res -} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.5 {bs+nl in literal words, eval script, with nested words} -body { eval { @@ -1482,12 +1482,12 @@ test info-30.5 {bs+nl in literal words, eval script, with nested words} -body { } } return $res -} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body { set res "\ [reduce [info frame 0]]";# line 1489 -} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.7 {bs+nl in computed word, in proc} -body { proc abra {} { @@ -1505,7 +1505,7 @@ test info-30.8 {bs+nl in computed word, nested eval} -body { res "\ [reduce [info frame 0]]";# line 1506 } -} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.9 {bs+nl in computed word, nested eval} -body { eval { @@ -1514,7 +1514,7 @@ test info-30.9 {bs+nl in computed word, nested eval} -body { [reduce \ [info frame 0]]";# line 1515 } -} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.10 {bs+nl in computed word, key to array} -body { set tmp([set \ @@ -1523,14 +1523,14 @@ test info-30.10 {bs+nl in computed word, key to array} -body { [info frame 0]]"]) x ; #1523 unset tmp set res -} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.11 {bs+nl in subst arguments} -body { subst {[set \ res "\ [reduce \ [info frame 0]]"]} ; #1532 -} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.12 {bs+nl in computed word, nested eval} -body { eval { @@ -1540,7 +1540,7 @@ test info-30.12 {bs+nl in computed word, nested eval} -body { [reduce \ [info frame 0]]";# line 1541 } -} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body { subinterp ; set res [interp eval sub { uplevel #0 { @@ -1601,7 +1601,7 @@ test info-30.17 {bs+nl in multi-body switch, direct} { ^key { reduce [info frame 0] ;# 1601 } \ \t### { } \ {[0-9]*} { } -} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} { proc abra {script} { @@ -1644,7 +1644,7 @@ test info-30.20 {bs+nl in single-body switch, direct} { \t### { } {[0-9]*} { } } -} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.21 {bs+nl in if, full compiled} { proc a {value} { @@ -1710,71 +1710,71 @@ type source line 1700 file info.test cmd {info frame 0} proc ::a level 0} test info-30.25 {TIP 280 for compiled [subst]} { subst {[reduce [info frame 0]]} ; # 1712 -} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.26 {TIP 280 for compiled [subst]} { subst \ {[reduce [info frame 0]]} ; # 1716 -} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.27 {TIP 280 for compiled [subst]} { subst { [reduce [info frame 0]]} ; # 1720 } { -type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.28 {TIP 280 for compiled [subst]} { subst {\ [reduce [info frame 0]]} ; # 1725 -} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.29 {TIP 280 for compiled [subst]} { subst {foo\ [reduce [info frame 0]]} ; # 1729 -} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.30 {TIP 280 for compiled [subst]} { subst {foo [reduce [info frame 0]]} ; # 1733 } {foo -type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.31 {TIP 280 for compiled [subst]} { subst {[][reduce [info frame 0]]} ; # 1737 -} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.32 {TIP 280 for compiled [subst]} { subst {[\ ][reduce [info frame 0]]} ; # 1741 -} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.33 {TIP 280 for compiled [subst]} { subst {[ ][reduce [info frame 0]]} ; # 1745 -} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.34 {TIP 280 for compiled [subst]} { subst {[format %s {} ][reduce [info frame 0]]} ; # 1749 -} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.35 {TIP 280 for compiled [subst]} { subst {[format %s {} ] [reduce [info frame 0]]} ; # 1754 } { -type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.36 {TIP 280 for compiled [subst]} { subst { [format %s {}][reduce [info frame 0]]} ; # 1759 } { -type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.37 {TIP 280 for compiled [subst]} { subst { [format %s {}] [reduce [info frame 0]]} ; # 1765 } { -type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.38 {TIP 280 for compiled [subst]} { subst {\ [format %s {}][reduce [info frame 0]]} ; # 1771 -} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.39 {TIP 280 for compiled [subst]} { subst {\ [format %s {}]\ [reduce [info frame 0]]} ; # 1776 -} { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.40 {TIP 280 for compiled [subst]} -setup { unset -nocomplain empty } -body { @@ -1782,7 +1782,7 @@ test info-30.40 {TIP 280 for compiled [subst]} -setup { subst {$empty[reduce [info frame 0]]} ; # 1782 } -cleanup { unset empty -} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.41 {TIP 280 for compiled [subst]} -setup { unset -nocomplain empty } -body { @@ -1792,7 +1792,7 @@ test info-30.41 {TIP 280 for compiled [subst]} -setup { } -cleanup { unset empty } -result { -type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.42 {TIP 280 for compiled [subst]} -setup { unset -nocomplain empty } -body { @@ -1800,25 +1800,25 @@ test info-30.42 {TIP 280 for compiled [subst]} -setup { [reduce [info frame 0]]} ; # 1800 } -cleanup { unset empty -} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.43 {TIP 280 for compiled [subst]} -body { unset -nocomplain a\nb set a\nb {} subst {${a b}[reduce [info frame 0]]} ; # 1808 -} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.44 {TIP 280 for compiled [subst]} { unset -nocomplain a set a(\n) {} subst {$a( )[reduce [info frame 0]]} ; # 1814 -} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.45 {TIP 280 for compiled [subst]} { unset -nocomplain a set a() {} subst {$a([ return -level 0])[reduce [info frame 0]]} ; # 1820 -} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest} +} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::EvalTest} test info-30.46 {TIP 280 for compiled [subst]} { unset -nocomplain a set a(1825) YES; set a(1824) 1824; set a(1826) 1826 @@ -1835,7 +1835,7 @@ unset -nocomplain a test info-30.48 {Bug 2850901} testevalex { testevalex {return -level 0 [format %s {} ][reduce [info frame 0]]} ; # line 2 of the eval -} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest} +} {type eval line 2 cmd {info frame 0} proc ::tcltest::EvalTest} # ------------------------------------------------------------------------- diff --git a/tests/io.test b/tests/io.test index 519191f..73481ca 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7447,7 +7447,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} { close $f set result } "ready line1 line2 {done\n}" -test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileevent fcopy} { +test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { diff --git a/tests/oo.test b/tests/oo.test index c8f4b21..235a90d 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1422,6 +1422,35 @@ test oo-7.9 {OO: defining inheritance in namespaces} -setup { return } } -result {} +test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { + set ::result "" + oo::class create c1 { + method m1 {} { + lappend ::result c1::m1 + } + } + oo::class create c2 { + superclass c1 + destructor { + lappend ::result c2::destructor + my m1 + lappend ::result /c2::destructor + } + method m1 {} { + lappend ::result c2::m1 + rename [self] {} + lappend ::result no-self + next + lappend ::result /c2::m1 + } + } +} -body { + c2 create o + lappend ::result [catch {o m1} msg] $msg +} -cleanup { + c1 destroy + unset ::result +} -result {c2::m1 c2::destructor c2::m1 no-self c1::m1 /c2::m1 /c2::destructor no-self 1 {no next method implementation}} test oo-8.1 {OO: global must work in methods} { oo::object create foo diff --git a/tests/opt.test b/tests/opt.test index 2732d40..14a6e04 100644 --- a/tests/opt.test +++ b/tests/opt.test @@ -17,7 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } # the package we are going to test -package require opt 0.4.6 +package require opt 0.4.7 # we are using implementation specifics to test the package diff --git a/tests/string.test b/tests/string.test index f077164..e15787a 100644 --- a/tests/string.test +++ b/tests/string.test @@ -121,10 +121,10 @@ test string-2.11.$noComp {string compare, unicode} { run {string compare ab\u7266 ab\u7267} } -1 test string-2.11.1.$noComp {string compare, unicode} { - run {string compare \334 \u00dc} + run {string compare \334 \xDC} } 0 test string-2.11.2.$noComp {string compare, unicode} { - run {string compare \334 \u00fc} + run {string compare \334 \xFC} } -1 test string-2.11.3.$noComp {string compare, unicode} { run {string compare \334\334\334\374\374 \334\334\334\334\334} @@ -151,10 +151,10 @@ test string-2.15.$noComp {string compare -nocase} { run {string compare -nocase abcde abcde} } 0 test string-2.15.1.$noComp {string compare -nocase} { - run {string compare -nocase \334 \u00dc} + run {string compare -nocase \334 \xDC} } 0 test string-2.15.2.$noComp {string compare -nocase} { - run {string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334} + run {string compare -nocase \334\334\334\374\xFC \334\334\334\334\334} } 0 test string-2.16.$noComp {string compare -nocase with length} { run {string compare -length 2 -nocase abcde Abxyz} @@ -276,10 +276,10 @@ test string-3.16.$noComp {string equal, unicode} { run {string equal ab\u7266 ab\u7267} } 0 test string-3.17.$noComp {string equal, unicode} { - run {string equal \334 \u00dc} + run {string equal \334 \xDC} } 1 test string-3.18.$noComp {string equal, unicode} { - run {string equal \334 \u00fc} + run {string equal \334 \xFC} } 0 test string-3.19.$noComp {string equal, unicode} { run {string equal \334\334\334\374\374 \334\334\334\334\334} @@ -297,10 +297,10 @@ test string-3.21.$noComp {string equal -nocase} { run {string equal -nocase abcde Abdef} } 0 test string-3.22.$noComp {string equal, -nocase unicode} { - run {string equal -nocase \334 \u00dc} + run {string equal -nocase \334 \xDC} } 1 test string-3.23.$noComp {string equal, -nocase unicode} { - run {string equal -nocase \334\334\334\374\u00fc \334\334\334\334\334} + run {string equal -nocase \334\334\334\374\xFC \334\334\334\334\334} } 1 test string-3.24.$noComp {string equal -nocase with length} { run {string equal -length 2 -nocase abcde Abxyz} @@ -411,7 +411,7 @@ test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. - set uchar \u057e ;# character with two-byte encoding in utf-8 + set uchar \u057E ;# character with two-byte encoding in utf-8 run {string first % %#$uchar$uchar#$uchar$uchar#% 3} } 8 test string-4.16.$noComp {string first, normal string vs pure unicode string} { @@ -559,7 +559,7 @@ test string-6.12.$noComp {string is alnum, true} { test string-6.13.$noComp {string is alnum, false} { list [run {string is alnum -failindex var abc1.23}] $var } {0 4} -test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xfc}" 1 +test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xFC}" 1 test string-6.15.$noComp {string is alpha, true} { run {string is alpha abc} } 1 @@ -570,10 +570,10 @@ test string-6.17.$noComp {string is alpha, unicode} { run {string is alpha abc\374} } 1 test string-6.18.$noComp {string is ascii, true} { - run {string is ascii abc\u007Fend\u0000} + run {string is ascii abc\x7Fend\x00} } 1 test string-6.19.$noComp {string is ascii, false} { - list [run {string is ascii -fail var abc\u0000def\u0080more}] $var + list [run {string is ascii -fail var abc\x00def\x80more}] $var } {0 7} test string-6.20.$noComp {string is boolean, true} { run {string is boolean true} @@ -591,7 +591,7 @@ test string-6.24.$noComp {string is digit, true} { run {string is digit 0123456789} } 1 test string-6.25.$noComp {string is digit, false} { - list [run {string is digit -fail var 0123\u00dc567}] $var + list [run {string is digit -fail var 0123\xDC567}] $var } {0 4} test string-6.26.$noComp {string is digit, false} { list [run {string is digit -fail var +123567}] $var @@ -714,7 +714,7 @@ test string-6.60.$noComp {string is lower, true} { run {string is lower abc} } 1 test string-6.61.$noComp {string is lower, unicode true} { - run {string is lower abc\u00fcue} + run {string is lower abc\xFCue} } 1 test string-6.62.$noComp {string is lower, false} { list [run {string is lower -fail var aBc}] $var @@ -723,7 +723,7 @@ test string-6.63.$noComp {string is lower, false} { list [run {string is lower -fail var abc1}] $var } {0 3} test string-6.64.$noComp {string is lower, unicode false} { - list [run {string is lower -fail var ab\u00dcUE}] $var + list [run {string is lower -fail var ab\xDCUE}] $var } {0 2} test string-6.65.$noComp {string is space, true} { run {string is space " \t\n\v\f"} @@ -761,7 +761,7 @@ test string-6.75.$noComp {string is upper, true} { run {string is upper ABC} } 1 test string-6.76.$noComp {string is upper, unicode true} { - run {string is upper ABC\u00dcUE} + run {string is upper ABC\xDCUE} } 1 test string-6.77.$noComp {string is upper, false} { list [run {string is upper -fail var AbC}] $var @@ -770,19 +770,19 @@ test string-6.78.$noComp {string is upper, false} { list [run {string is upper -fail var AB2C}] $var } {0 2} test string-6.79.$noComp {string is upper, unicode false} { - list [run {string is upper -fail var ABC\u00fcue}] $var + list [run {string is upper -fail var ABC\xFCue}] $var } {0 3} test string-6.80.$noComp {string is wordchar, true} { run {string is wordchar abc_123} } 1 test string-6.81.$noComp {string is wordchar, unicode true} { - run {string is wordchar abc\u00fcab\u00dcAB\u5001} + run {string is wordchar abc\xFCab\xDCAB\u5001} } 1 test string-6.82.$noComp {string is wordchar, false} { list [run {string is wordchar -fail var abcd.ef}] $var } {0 4} test string-6.83.$noComp {string is wordchar, unicode false} { - list [run {string is wordchar -fail var abc\u0080def}] $var + list [run {string is wordchar -fail var abc\x80def}] $var } {0 3} test string-6.84.$noComp {string is control} { ## Control chars are in the ranges @@ -798,14 +798,14 @@ test string-6.86.$noComp {string is graph} { } {0 14} test string-6.87.$noComp {string is print} { ## basically any printable char - list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"}] $var + list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\x10"}] $var } {0 15} test string-6.88.$noComp {string is punct} { ## any graph char that isn't alnum - list [run {string is punct -fail var "_!@#\u00beq0"}] $var + list [run {string is punct -fail var "_!@#\xBEq0"}] $var } {0 4} test string-6.89.$noComp {string is xdigit} { - list [run {string is xdigit -fail var 0123456789\u0061bcdefABCDEFg}] $var + list [run {string is xdigit -fail var 0123456789\x61bcdefABCDEFg}] $var } {0 22} test string-6.90.$noComp {string is integer, bad integers} { @@ -895,7 +895,7 @@ test string-6.108.$noComp {string is double, Bug 1382287} { run {string is double $x} } 0 test string-6.109.$noComp {string is double, Bug 1360532} { - run {string is double 1\u00a0} + run {string is double 1\xA0} } 0 test string-6.110.$noComp {string is entier, true} { run {string is entier +1234567890} @@ -1030,7 +1030,7 @@ test string-8.2.$noComp {string bytelength} { list [catch {run {string bytelength a b}} msg] $msg } {1 {wrong # args: should be "string bytelength string"}} test string-8.3.$noComp {string bytelength} { - run {string bytelength "\u00c7"} + run {string bytelength "\xC7"} } 2 test string-8.4.$noComp {string bytelength} { run {string b ""} @@ -1378,7 +1378,7 @@ test string-11.51.$noComp {string match; *, -nocase and UTF-8} { test string-11.52.$noComp {string match, null char in string} { set out "" set ptn "*abc*" - foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] { + foreach elem [list "\x00@abc" "@abc" "\x00@abc\x00" "blahabcblah"] { lappend out [run {string match $ptn $elem}] } set out @@ -1386,11 +1386,11 @@ test string-11.52.$noComp {string match, null char in string} { test string-11.53.$noComp {string match, null char in pattern} { set out "" foreach {ptn elem} [list \ - "*\u0000abc\u0000" "\u0000abc\u0000" \ - "*\u0000abc\u0000" "\u0000abc\u0000ef" \ - "*\u0000abc\u0000*" "\u0000abc\u0000ef" \ - "*\u0000abc\u0000" "@\u0000abc\u0000ef" \ - "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \ + "*\x00abc\x00" "\x00abc\x00" \ + "*\x00abc\x00" "\x00abc\x00ef" \ + "*\x00abc\x00*" "\x00abc\x00ef" \ + "*\x00abc\x00" "@\x00abc\x00ef" \ + "*\x00abc\x00*" "@\x00abc\x00ef" \ ] { lappend out [run {string match $ptn $elem}] } @@ -1399,14 +1399,14 @@ test string-11.53.$noComp {string match, null char in pattern} { test string-11.54.$noComp {string match, failure} { set longString "" for {set i 0} {$i < 10} {incr i} { - append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123" + append longString "abcdefghijklmnopqrstuvwxy\x00z01234567890123" } run {string first $longString 123} list [run {string match *cba* $longString}] \ - [run {string match *a*l*\u0000* $longString}] \ - [run {string match *a*l*\u0000*123 $longString}] \ - [run {string match *a*l*\u0000*123* $longString}] \ - [run {string match *a*l*\u0000*cba* $longString}] \ + [run {string match *a*l*\x00* $longString}] \ + [run {string match *a*l*\x00*123 $longString}] \ + [run {string match *a*l*\x00*123* $longString}] \ + [run {string match *a*l*\x00*cba* $longString}] \ [run {string match *===* $longString}] } {0 1 1 1 0 0} test string-11.55.$noComp {string match, invalid binary optimization} { @@ -1479,8 +1479,8 @@ test string-12.19.$noComp {string range, bytearray object} { run {string equal $r1 $r2} } 1 test string-12.20.$noComp {string range, out of bounds indices} { - run {string range \u00ff 0 1} -} \u00ff + run {string range \xFF 0 1} +} \xFF # Bug 1410553 test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} { set bytes "\x00 \x03 \x41" @@ -1648,7 +1648,7 @@ test stringComp-14.24.$noComp {Bug 1af8de570511} { }} 4 x } 0x00 test stringComp-14.25.$noComp {} { - string length [string replace [string repeat a\u00fe 2] 3 end {}] + string length [string replace [string repeat a\xFE 2] 3 end {}] } 3 test string-15.1.$noComp {string tolower too few args} { @@ -1679,8 +1679,8 @@ test string-15.9.$noComp {string tolower} { run {string tolower ABC 0 end-1} } abC test string-15.10.$noComp {string tolower, unicode} { - run {string tolower ABCabc\xc7\xe7} -} "abcabc\xe7\xe7" + run {string tolower ABCabc\xC7\xE7} +} "abcabc\xE7\xE7" test string-15.11.$noComp {string tolower, compiled} { lindex [run {string tolower [list A B [list C]]}] 1 } b @@ -1713,8 +1713,8 @@ test string-16.9.$noComp {string toupper} { run {string toupper abc 0 end-1} } ABc test string-16.10.$noComp {string toupper, unicode} { - run {string toupper ABCabc\xc7\xe7} -} "ABCABC\xc7\xc7" + run {string toupper ABCabc\xC7\xE7} +} "ABCABC\xC7\xC7" test string-16.11.$noComp {string toupper, compiled} { lindex [run {string toupper [list a b [list c]]}] 1 } B @@ -1735,11 +1735,11 @@ test string-17.5.$noComp {string totitle} { run {string totitle {123#$&*()}} } {123#$&*()} test string-17.6.$noComp {string totitle, unicode} { - run {string totitle ABCabc\xc7\xe7} -} "Abcabc\xe7\xe7" + run {string totitle ABCabc\xC7\xE7} +} "Abcabc\xE7\xE7" test string-17.7.$noComp {string totitle, unicode} { - run {string totitle \u01f3BCabc\xc7\xe7} -} "\u01f2bcabc\xe7\xe7" + run {string totitle \u01F3BCabc\xC7\xE7} +} "\u01F2bcabc\xE7\xE7" test string-17.8.$noComp {string totitle, compiled} { lindex [run {string totitle [list aa bb [list cc]]}] 0 } Aa @@ -1779,10 +1779,10 @@ test string-18.10.$noComp {string trim} { run {string trim ABC DEF} } {ABC} test string-18.11.$noComp {string trim, unicode} { - run {string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8} -} " AB\xe7C " + run {string trim "\xE7\xE8 AB\xE7C \xE8\xE7" \xE7\xE8} +} " AB\xE7C " test string-18.12.$noComp {string trim, unicode default} { - run {string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000} + run {string trim \uFEFF\x00\x85\xA0\u1680\u180EABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 test string-19.1.$noComp {string trimleft} { @@ -1792,7 +1792,7 @@ test string-19.2.$noComp {string trimleft} { run {string trimleft " XYZ "} } {XYZ } test string-19.3.$noComp {string trimleft, unicode default} { - run {string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC} + run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC} } \u1361ABC test string-20.1.$noComp {string trimright errors} { @@ -1811,7 +1811,7 @@ test string-20.5.$noComp {string trimright} { run {string trimright ""} } {} test string-20.6.$noComp {string trimright, unicode default} { - run {string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000} + run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000} } ABC\u1361 test string-21.1.$noComp {string wordend} { @@ -1842,19 +1842,19 @@ test string-21.9.$noComp {string wordend} { run {string worde "x.y" end-1} } 2 test string-21.10.$noComp {string wordend, unicode} { - run {string wordend "xyz\u00c7de fg" 0} + run {string wordend "xyz\xC7de fg" 0} } 6 test string-21.11.$noComp {string wordend, unicode} { - run {string wordend "xyz\uc700de fg" 0} + run {string wordend "xyz\uC700de fg" 0} } 6 test string-21.12.$noComp {string wordend, unicode} { - run {string wordend "xyz\u203fde fg" 0} + run {string wordend "xyz\u203Fde fg" 0} } 6 test string-21.13.$noComp {string wordend, unicode} { run {string wordend "xyz\u2045de fg" 0} } 3 test string-21.14.$noComp {string wordend, unicode} { - run {string wordend "\uc700\uc700 abc" 8} + run {string wordend "\uC700\uC700 abc" 8} } 6 test string-22.1.$noComp {string wordstart} { @@ -1888,13 +1888,13 @@ test string-22.10.$noComp {string wordstart} { run {string wordstart "one two three" end-5} } 7 test string-22.11.$noComp {string wordstart, unicode} { - run {string wordstart "one tw\u00c7o three" 7} + run {string wordstart "one tw\xC7o three" 7} } 4 test string-22.12.$noComp {string wordstart, unicode} { - run {string wordstart "ab\uc700\uc700 cdef ghi" 12} + run {string wordstart "ab\uC700\uC700 cdef ghi" 12} } 10 test string-22.13.$noComp {string wordstart, unicode} { - run {string wordstart "\uc700\uc700 abc" 8} + run {string wordstart "\uC700\uC700 abc" 8} } 3 test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj { @@ -1965,40 +1965,40 @@ test string-24.4.$noComp {string reverse command - unshared string} { run {string reverse $x$y} } edcba test string-24.5.$noComp {string reverse command - shared unicode string} { - set x abcde\ud0ad + set x abcde\uD0AD run {string reverse $x} -} \ud0adedcba +} \uD0ADedcba test string-24.6.$noComp {string reverse command - unshared string} { set x abc - set y de\ud0ad + set y de\uD0AD run {string reverse $x$y} -} \ud0adedcba +} \uD0ADedcba test string-24.7.$noComp {string reverse command - simple case} { run {string reverse a} } a test string-24.8.$noComp {string reverse command - simple case} { - run {string reverse \ud0ad} -} \ud0ad + run {string reverse \uD0AD} +} \uD0AD test string-24.9.$noComp {string reverse command - simple case} { run {string reverse {}} } {} test string-24.10.$noComp {string reverse command - corner case} { - set x \ubeef\ud0ad + set x \uBEEF\uD0AD run {string reverse $x} -} \ud0ad\ubeef +} \uD0AD\uBEEF test string-24.11.$noComp {string reverse command - corner case} { - set x \ubeef - set y \ud0ad + set x \uBEEF + set y \uD0AD run {string reverse $x$y} -} \ud0ad\ubeef +} \uD0AD\uBEEF test string-24.12.$noComp {string reverse command - corner case} { - set x \ubeef - set y \ud0ad + set x \uBEEF + set y \uD0AD run {string is ascii [run {string reverse $x$y}]} } 0 test string-24.13.$noComp {string reverse command - pure Unicode string} { - run {string reverse [run {string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5}]} -} \ud0ad\ubeef\ud0ad\ubeef\ud0ad + run {string reverse [run {string range \uBEEF\uD0AD\uBEEF\uD0AD\uBEEF\uD0AD 1 5}]} +} \uD0AD\uBEEF\uD0AD\uBEEF\uD0AD test string-24.14.$noComp {string reverse command - pure bytearray} { binary scan [run {string reverse [binary format H* 010203]}] H* x set x @@ -2054,7 +2054,7 @@ test string-25.13.$noComp {string is list} { } {0 2} test string-25.14.$noComp {string is list} { set x {} - list [run {string is list -failindex x "\uabcd {b c}d e"}] $x + list [run {string is list -failindex x "\uABCD {b c}d e"}] $x } {0 2} test string-26.1.$noComp {tcl::prefix, too few args} -body { @@ -2475,7 +2475,7 @@ test string-32.13.$noComp {string is dict} { } {0 2} test string-32.14.$noComp {string is dict} { set x {} - list [string is dict -failindex x "\uabcd {b c}d e"] $x + list [string is dict -failindex x "\uABCD {b c}d e"] $x } {0 2} test string-32.15.$noComp {string is dict, valid dict} { string is dict {a b c d e f} diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index c3c8650..b0aa054 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -24,7 +24,7 @@ namespace eval ::tcltests { proc tempdir_alternate {} { - file tempfile tempfile + close [file tempfile tempfile] set tmpdir [file dirname $tempfile] set execname [info nameofexecutable] regsub -all {[^[:alpha:][:digit:]]} $execname _ execname diff --git a/tests/utf.test b/tests/utf.test index f75d19e..f830110 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -27,34 +27,40 @@ test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring { expr {"\x01" eq [testbytestring "\x01"]} } 1 test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { - expr {"\x00" eq [testbytestring "\xc0\x80"]} + expr {"\x00" eq [testbytestring "\xC0\x80"]} } 1 test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { - expr {"\xe0" eq [testbytestring "\xc3\xa0"]} + expr {"\xE0" eq [testbytestring "\xC3\xA0"]} } 1 test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring { - expr {"\u4e4e" eq [testbytestring "\xe4\xb9\x8e"]} + expr {"\u4E4E" eq [testbytestring "\xE4\xB9\x8E"]} } 1 test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { - expr {[format %c 0x110000] eq [testbytestring "\xef\xbf\xbd"]} + expr {[format %c 0x110000] eq [testbytestring "\xEF\xBF\xBD"]} } 1 test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { - expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]} + expr {[format %c -1] eq [testbytestring "\xEF\xBF\xBD"]} } 1 test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints testbytestring -body { - expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]} + expr {"\U014E4E" eq [testbytestring "\xF0\x94\xB9\x8E"]} } -result 1 test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { - expr {"\ud842" eq [testbytestring "\xed\xa1\x82"]} + expr {"\uD842" eq [testbytestring "\xED\xA1\x82"]} } 1 test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { - expr {"\udc42" eq [testbytestring "\xed\xb1\x82"]} + expr {"\uDC42" eq [testbytestring "\xED\xB1\x82"]} } 1 test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring { - expr {[format %c 0xd842] eq [testbytestring "\xed\xa1\x82"]} + expr {[format %c 0xD842] eq [testbytestring "\xED\xA1\x82"]} } 1 test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { - expr {[format %c 0xdc42] eq [testbytestring "\xed\xb1\x82"]} + expr {[format %c 0xDC42] eq [testbytestring "\xED\xB1\x82"]} +} 1 +test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} testbytestring { + expr {"\uD842\uDC42" eq [testbytestring "\xF0\xA0\xA1\x82"]} +} 1 +test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} testbytestring { + expr {"\UD842" eq [testbytestring "\xEF\xBF\xBD"]} } 1 test utf-2.1 {Tcl_UtfToUniChar: low ascii} { @@ -67,7 +73,7 @@ test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} testbytestr string length [testbytestring "\xC2"] } {1} test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} testbytestring { - string length [testbytestring "\xC2\xa2"] + string length [testbytestring "\xC2\xA2"] } {1} test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} testbytestring { string length [testbytestring "\xE2"] @@ -76,7 +82,7 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestrin string length [testbytestring "\xE2\xA2"] } {2} test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring { - string length [testbytestring "\xE4\xb9\x8e"] + string length [testbytestring "\xE4\xB9\x8E"] } {1} test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body { string length [testbytestring "\xF0\x90\x80\x80"] @@ -150,27 +156,27 @@ test utf-8.1 {Tcl_UniCharAtIndex: index = 0} { string index abcd 0 } {a} test utf-8.2 {Tcl_UniCharAtIndex: index = 0} { - string index \u4e4e\u25a 0 -} "\u4e4e" + string index \u4E4E\u25A 0 +} "\u4E4E" test utf-8.3 {Tcl_UniCharAtIndex: index > 0} { string index abcd 2 } {c} test utf-8.4 {Tcl_UniCharAtIndex: index > 0} { - string index \u4e4e\u25a\xff\u543 2 -} "\uff" + string index \u4E4E\u25A\xFF\u543 2 +} "\uFF" test utf-8.5 {Tcl_UniCharAtIndex: high surrogate} { - string index \ud842 0 -} "\ud842" + string index \uD842 0 +} "\uD842" test utf-8.6 {Tcl_UniCharAtIndex: low surrogate} { - string index \udc42 0 -} "\udc42" + string index \uDC42 0 +} "\uDC42" test utf-9.1 {Tcl_UtfAtIndex: index = 0} { string range abcd 0 2 } {abc} test utf-9.2 {Tcl_UtfAtIndex: index > 0} { - string range \u4e4e\u25a\xff\u543klmnop 1 5 -} "\u25a\xff\u543kl" + string range \u4E4E\u25A\xFF\u543klmnop 1 5 +} "\u25A\xFF\u543kl" test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { @@ -178,22 +184,22 @@ test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { } { } test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring { - expr {"\ua2" eq [testbytestring "\xc2\xa2"]} + expr {"\uA2" eq [testbytestring "\xC2\xA2"]} } 1 test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring { - expr {"\u4e21" eq [testbytestring "\xe4\xb8\xa1"]} + expr {"\u4E21" eq [testbytestring "\xE4\xB8\xA1"]} } 1 test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring { - expr {"\u4e2k" eq "[testbytestring \xd3\xa2]k"} + expr {"\u4E2k" eq "[testbytestring \xD3\xA2]k"} } 1 test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring { - expr {"\u4e216" eq "[testbytestring \xe4\xb8\xa1]6"} + expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"} } 1 test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} testbytestring { - expr {"\U1e2165" eq "[testbytestring \xf0\x9e\x88\x96]5"} + expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"} } 1 test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} testbytestring { - expr {"\U10e2165" eq "[testbytestring \xf4\x8e\x88\x96]5"} + expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"} } 1 proc bsCheck {char num} { global errNum @@ -239,8 +245,8 @@ bsCheck \u41 65 bsCheck \ua 10 bsCheck \uA 10 bsCheck \340 224 -bsCheck \ua1 161 -bsCheck \u4e21 20001 +bsCheck \uA1 161 +bsCheck \u4E21 20001 bsCheck \741 60 bsCheck \U 85 bsCheck \Uk 85 @@ -248,10 +254,10 @@ bsCheck \U41 65 bsCheck \Ua 10 bsCheck \UA 10 bsCheck \Ua1 161 -bsCheck \U4e21 20001 -bsCheck \U004e21 20001 -bsCheck \U00004e21 20001 -bsCheck \U0000004e21 78 +bsCheck \U4E21 20001 +bsCheck \U004E21 20001 +bsCheck \U00004E21 20001 +bsCheck \U0000004E21 78 bsCheck \U00110000 69632 bsCheck \U01100000 69632 bsCheck \U11000000 69632 @@ -267,17 +273,17 @@ test utf-11.2 {Tcl_UtfToUpper} { string toupper abc } ABC test utf-11.3 {Tcl_UtfToUpper} { - string toupper \u00e3ab -} \u00c3AB + string toupper \xE3AB +} \xC3AB test utf-11.4 {Tcl_UtfToUpper} { - string toupper \u01e3ab -} \u01e2AB + string toupper \u01E3AB +} \u01E2AB test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} { - string toupper \u10d0\u1c90 -} \u1c90\u1c90 + string toupper \u10D0\u1C90 +} \u1C90\u1C90 test utf-11.6 {Tcl_UtfToUpper low/high surrogate)} { - string toupper \udc24\ud824 -} \udc24\ud824 + string toupper \uDC24\uD824 +} \uDC24\uD824 test utf-12.1 {Tcl_UtfToLower} { string tolower {} @@ -286,17 +292,17 @@ test utf-12.2 {Tcl_UtfToLower} { string tolower ABC } abc test utf-12.3 {Tcl_UtfToLower} { - string tolower \u00c3AB -} \u00e3ab + string tolower \xC3AB +} \xE3ab test utf-12.4 {Tcl_UtfToLower} { - string tolower \u01e2AB -} \u01e3ab + string tolower \u01E2AB +} \u01E3ab test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { - string tolower \u10d0\u1c90 -} \u10d0\u10d0 + string tolower \u10D0\u1C90 +} \u10D0\u10D0 test utf-12.6 {Tcl_UtfToUpper low/high surrogate)} { - string tolower \udc24\ud824 -} \udc24\ud824 + string tolower \uDC24\uD824 +} \uDC24\uD824 test utf-13.1 {Tcl_UtfToTitle} { string totitle {} @@ -305,20 +311,20 @@ test utf-13.2 {Tcl_UtfToTitle} { string totitle abc } Abc test utf-13.3 {Tcl_UtfToTitle} { - string totitle \u00e3ab -} \u00c3ab + string totitle \xE3AB +} \xC3ab test utf-13.4 {Tcl_UtfToTitle} { - string totitle \u01f3ab -} \u01f2ab + string totitle \u01F3AB +} \u01F2ab test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { - string totitle \u10d0\u1c90 -} \u10d0\u1c90 + string totitle \u10D0\u1C90 +} \u10D0\u1C90 test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { - string totitle \u1c90\u10d0 -} \u1c90\u10d0 + string totitle \u1C90\u10D0 +} \u1C90\u10D0 test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} { - string totitle \udc24\ud824 -} \udc24\ud824 + string totitle \uDC24\uD824 +} \uDC24\uD824 test utf-14.1 {Tcl_UtfNcasecmp} { string compare -nocase a b @@ -337,7 +343,7 @@ test utf-15.1 {Tcl_UniCharToUpper, negative delta} { string toupper aA } AA test utf-15.2 {Tcl_UniCharToUpper, positive delta} { - string toupper \u0178\u00ff + string toupper \u0178\xFF } \u0178\u0178 test utf-15.3 {Tcl_UniCharToUpper, no delta} { string toupper ! @@ -347,24 +353,24 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} { string tolower aA } aa test utf-16.2 {Tcl_UniCharToLower, positive delta} { - string tolower \u0178\u00ff\uA78D\u01c5\U10400 -} \u00ff\u00ff\u0265\u01c6\U10428 + string tolower \u0178\xFF\uA78D\u01C5\U10400 +} \xFF\xFF\u0265\u01C6\U10428 test utf-17.1 {Tcl_UniCharToLower, no delta} { string tolower ! } ! test utf-18.1 {Tcl_UniCharToTitle, add one for title} { - string totitle \u01c4 -} \u01c5 + string totitle \u01C4 +} \u01C5 test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} { - string totitle \u01c6 -} \u01c5 + string totitle \u01C6 +} \u01C5 test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} { - string totitle \u017f -} \u0053 + string totitle \u017F +} \x53 test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} { - string totitle \u00ff + string totitle \xFF } \u0178 test utf-18.5 {Tcl_UniCharToTitle, no delta} { string totitle ! @@ -381,15 +387,15 @@ test utf-20.1 {TclUniCharNcmp} { test utf-21.1 {TclUniCharIsAlnum} { # this returns 1 with Unicode 7 compliance - string is alnum \u1040\u021f\u0220 + string is alnum \u1040\u021F\u0220 } {1} test utf-21.2 {unicode alnum char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220_\u203f\u2040\u2054\ufe33\ufe34\ufe4d\ufe4e\ufe4f\uff3f] + list [regexp {^[[:alnum:]]+$} \u1040\u021F\u0220] [regexp {^\w+$} \u1040\u021F\u0220_\u203F\u2040\u2054\uFE33\uFE34\uFE4D\uFE4E\uFE4F\uFF3F] } {1 1} test utf-21.3 {unicode print char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - regexp {^[[:print:]]+$} \ufbc1 + regexp {^[[:print:]]+$} \uFBC1 } 1 test utf-21.4 {TclUniCharIsGraph} { # [Bug 3464428] @@ -401,65 +407,65 @@ test utf-21.5 {unicode graph char in regc_locale.c} { } {1} test utf-21.6 {TclUniCharIsGraph} { # [Bug 3464428] - string is graph \u00a0 + string is graph \xA0 } {0} test utf-21.7 {unicode graph char in regc_locale.c} { # [Bug 3464428] - regexp {[[:graph:]]} \u0020\u00a0\u2028\u2029 + regexp {[[:graph:]]} \x20\xA0\u2028\u2029 } {0} test utf-21.8 {TclUniCharIsPrint} { # [Bug 3464428] - string is print \u0009 + string is print \x09 } {0} test utf-21.9 {unicode print char in regc_locale.c} { # [Bug 3464428] - regexp {[[:print:]]} \u0009 + regexp {[[:print:]]} \x09 } {0} test utf-21.10 {unicode print char in regc_locale.c} { # [Bug 3464428] - regexp {[[:print:]]} \u0009 + regexp {[[:print:]]} \x09 } {0} test utf-21.11 {TclUniCharIsControl} { # [Bug 3464428] - string is control \u0000\u001f\u00ad\u0605\u061c\u180e\u2066\ufeff + string is control \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF } {1} test utf-21.12 {unicode control char in regc_locale.c} { # [Bug 3464428], [Bug a876646efe] - regexp {^[[:cntrl:]]*$} \u0000\u001f\u00ad\u0605\u061c\u180e\u2066\ufeff + regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF } {1} test utf-22.1 {TclUniCharIsWordChar} { string wordend "xyz123_bar fg" 0 } 10 test utf-22.2 {TclUniCharIsWordChar} { - string wordend "x\u5080z123_bar\u203c fg" 0 + string wordend "x\u5080z123_bar\u203C fg" 0 } 10 test utf-23.1 {TclUniCharIsAlpha} { # this returns 1 with Unicode 7 compliance - string is alpha \u021f\u0220\u037f\u052f + string is alpha \u021F\u0220\u037F\u052F } {1} test utf-23.2 {unicode alpha char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - regexp {^[[:alpha:]]+$} \u021f\u0220\u037f\u052f + regexp {^[[:alpha:]]+$} \u021F\u0220\u037F\u052F } {1} test utf-24.1 {TclUniCharIsDigit} { # this returns 1 with Unicode 7 compliance - string is digit \u1040\uabf0 + string is digit \u1040\uABF0 } {1} test utf-24.2 {unicode digit char in regc_locale.c} { # this returns 1 with Unicode 7 compliance - list [regexp {^[[:digit:]]+$} \u1040\uabf0] [regexp {^\d+$} \u1040\uabf0] + list [regexp {^[[:digit:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0] } {1 1} test utf-24.3 {TclUniCharIsSpace} { # this returns 1 with Unicode 7/TIP 413 compliance - string is space \u0085\u1680\u180e\u200b\u202f\u2060 + string is space \x85\u1680\u180E\u200B\u202F\u2060 } {1} test utf-24.4 {unicode space char in regc_locale.c} { # this returns 1 with Unicode 7/TIP 413 compliance - list [regexp {^[[:space:]]+$} \u0085\u1680\u180e\u200b\u202f\u2060] [regexp {^\s+$} \u0085\u1680\u180e\u200b\u202f\u2060] + list [regexp {^[[:space:]]+$} \x85\u1680\u180E\u200B\u202F\u2060] [regexp {^\s+$} \x85\u1680\u180E\u200B\u202F\u2060] } {1 1} testConstraint teststringobj [llength [info commands teststringobj]] diff --git a/unix/Makefile.in b/unix/Makefile.in index 218d48d..838da2a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -328,7 +328,7 @@ TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \ bn_mp_cnt_lsb.o bn_mp_copy.o \ bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \ bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o bn_mp_expt_u32.o \ - bn_s_mp_get_bit.o bn_mp_get_mag_ul.o bn_mp_grow.o bn_mp_init.o \ + bn_mp_get_mag_ul.o bn_mp_grow.o bn_mp_init.o \ bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \ bn_mp_init_size.o bn_mp_init_ul.o bn_s_mp_karatsuba_mul.o \ bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_ull.o \ @@ -772,12 +772,12 @@ ${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} @mkdir -p ${TCL_VFS_PATH} @echo "creating ${TCL_VFS_PATH} (prepare compression)" @if \ - ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/ && \ - ln ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ + ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/; \ then : ; else \ cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \ - cp -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \ fi + mv ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl + rm -rf ${TCL_VFS_PATH}/dde ${TCL_VFS_PATH}/reg @find ${TCL_VFS_ROOT} -type d -empty -delete @echo "creating ${TCL_ZIP_FILE} from ${TCL_VFS_PATH}" @(zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}' || \ @@ -1014,7 +1014,7 @@ install-libraries: libraries $(INSTALL_DATA_DIR) "$$i"; \ fi; \ done - @for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7; do \ + @for i in opt0.4 cookiejar0.2 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7; do \ if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \ @@ -1025,19 +1025,26 @@ install-libraries: libraries $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ done - @echo "Installing package http 2.9.0 as a Tcl Module" + @echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/" + @for i in $(TOP_DIR)/library/cookiejar/*.tcl; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/cookiejar0.2; \ + done + @for i in $(TOP_DIR)/library/cookiejar/*.gz; do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/cookiejar0.2; \ + done + @echo "Installing package http 2.9.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl8/8.6/http-2.9.0.tm - @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" + "$(MODULE_INSTALL_DIR)"/tcl8/8.6/http-2.9.1.tm + @echo "Installing package opt 0.4.7" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done @echo "Installing package msgcat 1.7.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.7/msgcat-1.7.0.tm - @echo "Installing package tcltest 2.5.0 as a Tcl Module" + @echo "Installing package tcltest 2.5.2 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)"/tcl8/8.5/tcltest-2.5.1.tm + "$(MODULE_INSTALL_DIR)"/tcl8/8.5/tcltest-2.5.2.tm @echo "Installing package platform 1.0.14 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform-1.0.14.tm @@ -1611,9 +1618,6 @@ bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS) bn_mp_expt_u32.o: $(TOMMATH_DIR)/bn_mp_expt_u32.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_u32.c -bn_s_mp_get_bit.o: $(TOMMATH_DIR)/bn_s_mp_get_bit.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_get_bit.c - bn_mp_get_mag_ul.o: $(TOMMATH_DIR)/bn_mp_get_mag_ul.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_mag_ul.c @@ -2223,7 +2227,7 @@ DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) -BUILTIN_PACKAGE_LIST = http opt msgcat reg dde tcltest platform +BUILTIN_PACKAGE_LIST = cookiejar http opt msgcat reg dde tcltest platform $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \ $(UNIX_DIR)/aclocal.m4 @@ -2265,6 +2269,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in \ mkdir $(DISTDIR)/library/$$i;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done + cp -p $(TOP_DIR)/library/cookiejar/*.txt.gz $(DISTDIR)/library/cookiejar @mkdir $(DISTDIR)/library/encoding cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding @mkdir $(DISTDIR)/library/msgs diff --git a/unix/configure b/unix/configure index 6b3b930..927f4bd 100755 --- a/unix/configure +++ b/unix/configure @@ -2382,7 +2382,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -3894,14 +3894,6 @@ $as_echo "#define NO_DLFCN_H 1" >>confdefs.h fi - ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" -if test "x$ac_cv_header_stdbool_h" = xyes; then : - -$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h - -fi - - # OS/390 lacks sys/param.h (and doesn't need it, by chance). for ac_header in sys/param.h @@ -6581,6 +6573,15 @@ $as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi + ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default" +if test "x$ac_cv_header_stdbool_h" = xyes; then : + +$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h + +fi + + + # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. @@ -10392,7 +10393,7 @@ VERSION=${TCL_VERSION} if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ - TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" + TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then diff --git a/unix/configure.ac b/unix/configure.ac index 6614f5a..c791df4 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -930,7 +930,7 @@ VERSION=${TCL_VERSION} if test "$FRAMEWORK_BUILD" = "1" ; then test -z "$TCL_PACKAGE_PATH" && \ - TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" + TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks" test -z "$TCL_MODULE_PATH" && \ TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl" elif test "$prefix/lib" != "$libdir"; then diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 6ca3e21..4cd6dc3 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1873,6 +1873,8 @@ dnl # preprocessing tests use only CPPFLAGS. [Defined when compiler supports casting to union type.]) fi + AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],) + # FIXME: This subst was left in only because the TCL_DL_LIBS # entry in tclConfig.sh uses it. It is not clear why someone # would use TCL_DL_LIBS instead of TCL_LIBS. @@ -1933,7 +1935,6 @@ dnl # preprocessing tests use only CPPFLAGS. # NO_SYS_WAIT_H # NO_DLFCN_H # HAVE_SYS_PARAM_H -# HAVE_STDBOOL_H # HAVE_STRING_H ? # #-------------------------------------------------------------------- @@ -1984,7 +1985,6 @@ closedir(d); AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H, 1, [Do we have <sys/wait.h>?])]) AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H, 1, [Do we have <dlfcn.h>?])]) - AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],) # OS/390 lacks sys/param.h (and doesn't need it, by chance). AC_HAVE_HEADERS(sys/param.h) diff --git a/unix/tcl.spec b/unix/tcl.spec index 265e4df..e148f36 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.7a2 +Version: 8.7a3 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 290596f..574c920 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -4,9 +4,6 @@ #ifndef _TCLCONFIG #define _TCLCONFIG -/* Define if building universal (internal helper macro) */ -#undef AC_APPLE_UNIVERSAL_BUILD - /* Is gettimeofday() actually declared in <sys/time.h>? */ #undef GETTOD_NOT_DECLARED @@ -235,10 +232,10 @@ /* Is 'struct stat64' in <sys/stat.h>? */ #undef HAVE_STRUCT_STAT64 -/* Define to 1 if `st_blksize' is a member of `struct stat'. */ +/* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE -/* Define to 1 if `st_blocks' is a member of `struct stat'. */ +/* Define to 1 if `st_blocks' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLOCKS /* Define to 1 if you have the <sys/epoll.h> header file. */ @@ -391,9 +388,6 @@ /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME -/* Define to the home page for this package. */ -#undef PACKAGE_URL - /* Define to the version of this package. */ #undef PACKAGE_VERSION @@ -463,17 +457,9 @@ /* Should we use vfork() instead of fork()? */ #undef USE_VFORK -/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most - significant byte first (like Motorola and SPARC, unlike Intel). */ -#if defined AC_APPLE_UNIVERSAL_BUILD -# if defined __BIG_ENDIAN__ -# define WORDS_BIGENDIAN 1 -# endif -#else -# ifndef WORDS_BIGENDIAN -# undef WORDS_BIGENDIAN -# endif -#endif +/* Define to 1 if your processor stores words with the most significant byte + first (like Motorola and SPARC, unlike Intel and VAX). */ +#undef WORDS_BIGENDIAN /* Are we building with zipfs enabled? */ #undef ZIPFS_BUILD @@ -531,7 +517,7 @@ /* Define to `int' if <sys/types.h> does not define. */ #undef pid_t -/* Define to `unsigned int' if <sys/types.h> does not define. */ +/* Define to `unsigned' if <sys/types.h> does not define. */ #undef size_t /* Define as int if socklen_t is not available */ diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 463f642..3ee116e 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -2037,7 +2037,7 @@ TclpObjNormalizePath( } /* - * Call 'realpath' to obtain a canonical path. + * Call 'realpath' to obtain a canonical path. */ #ifndef NO_REALPATH @@ -2047,7 +2047,7 @@ TclpObjNormalizePath( * The path contains at most one component, e.g. '/foo' or '/', so * so there is nothing to resolve. Also, on some platforms * 'Realpath' transforms an empty string into the normalized pwd, - * which is the wrong answer. + * which is the wrong answer. */ return 0; @@ -2093,7 +2093,7 @@ TclpObjNormalizePath( if (path[nextCheckpoint] != '\0') { /* - * Append the remaining path components. + * Append the remaining path components. */ int normLen = Tcl_DStringLength(&ds); diff --git a/win/Makefile.in b/win/Makefile.in index 55744eb..3a952bd 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -420,7 +420,6 @@ TOMMATH_OBJS = \ bn_mp_zero.${OBJEXT} \ bn_s_mp_add.${OBJEXT} \ bn_s_mp_balance_mul.$(OBJEXT) \ - bn_s_mp_get_bit.${OBJEXT} \ bn_s_mp_karatsuba_mul.${OBJEXT} \ bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ @@ -851,7 +850,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7; \ + @for i in opt0.4 cookiejar0.2 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ @@ -864,17 +863,22 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; - @echo "Installing package http 2.9.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm; - @echo "Installing library opt0.4 directory"; + @echo "Installing package cookiejar 0.2" + @for j in $(ROOT_DIR)/library/cookiejar/*.{tcl,txt.gz}; \ + do \ + $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ + done; + @echo "Installing package http 2.9.1 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.1.tm; + @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.0 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.7/msgcat-1.7.0.tm; - @echo "Installing package tcltest 2.4.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.1.tm; + @echo "Installing package tcltest 2.5.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.2.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; diff --git a/win/configure b/win/configure index 1c0b265..71bbdeb 100755 --- a/win/configure +++ b/win/configure @@ -1620,83 +1620,6 @@ fi } # ac_fn_c_try_run -# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES -# --------------------------------------------- -# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR -# accordingly. -ac_fn_c_check_decl () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - as_decl_name=`echo $2|sed 's/ *(.*//'` - as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 -$as_echo_n "checking whether $as_decl_name is declared... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -#ifndef $as_decl_name -#ifdef __cplusplus - (void) $as_decl_use; -#else - (void) $as_decl_name; -#endif -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_decl - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_compile - # ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists, giving a warning if it cannot be compiled using @@ -1784,6 +1707,37 @@ fi } # ac_fn_c_check_header_mongrel +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + # ac_fn_c_check_type LINENO TYPE VAR INCLUDES # ------------------------------------------- # Tests whether TYPE exists after having included INCLUDES, setting cache @@ -2199,7 +2153,7 @@ SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_PATCH_LEVEL="a4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -4358,29 +4312,15 @@ $as_echo "using shared flags" >&6; } LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" - # This is a 2-stage check to make sure we have the 64-bit SDK - # We have to know where the SDK is installed. - # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs if test "$do64bit" != "no" ; then - if test "x${MSSDK}x" = "xx" ; then - MSSDK="C:/Progra~1/Microsoft Platform SDK" - fi - MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` - PATH64="" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" - PATH64="${MSSDK}/Bin/Win64" ;; esac - if test ! -d "${PATH64}" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK" >&5 -$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;} - fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 $as_echo " Using 64-bit $MACHINE mode" >&6; } fi @@ -4396,26 +4336,12 @@ $as_echo " Using 64-bit $MACHINE mode" >&6; } esac if test "$do64bit" != "no" ; then - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. TEA has the - # TEA_PATH_NOSPACE to avoid this issue. - # Check if _WIN64 is already recognized, and if so we don't - # need to modify CC. - ac_fn_c_check_decl "$LINENO" "_WIN64" "ac_cv_have_decl__WIN64" "$ac_includes_default" -if test "x$ac_cv_have_decl__WIN64" = xyes; then : - -else - CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ - -I\"${MSSDK}/Include/crt\" \ - -I\"${MSSDK}/Include/crt/sys\"" -fi - - RC="\"${MSSDK}/bin/rc.exe\"" + RC="rc" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" - LINKBIN="\"${PATH64}/link.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE}" + LINKBIN="link" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="$LIBS bufferoverflowU.lib" diff --git a/win/configure.ac b/win/configure.ac index 82d713a..37a9a28 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a2" +TCL_PATCH_LEVEL="a4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/makefile.vc b/win/makefile.vc index 216d5d9..26504bc 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -154,6 +154,12 @@ VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) !if [echo PKG_HTTP_VER = \>> versions.vc] \
&& [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!endif
+!if [echo PKG_OPT_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\opt\pkgIndex.tcl opt >> versions.vc]
+!endif
+!if [echo PKG_COOKIEJAR_VER = \>> versions.vc] \
+ && [nmakehlp -V ..\library\cookiejar\pkgIndex.tcl cookiejar >> versions.vc]
+!endif
!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
&& [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
!endif
@@ -376,7 +382,6 @@ TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_zero.obj \
$(TMP_DIR)\bn_s_mp_add.obj \
$(TMP_DIR)\bn_s_mp_balance_mul.obj \
- $(TMP_DIR)\bn_s_mp_get_bit.obj \
$(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \
$(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \
$(TMP_DIR)\bn_s_mp_mul_digs.obj \
@@ -426,7 +431,7 @@ PKGSDIR = $(ROOT)\pkgs # Additional include and C macro definitions for the implicit rules
# defined in rules.vc
PRJ_INCLUDES = -I"$(TOMMATHDIR)"
-PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS /DMP_NO_STDINT /DMP_WUR=
+PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS /DMP_WUR=
# Additional Link libraries needed beyond those in rules.vc
PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib
@@ -882,6 +887,10 @@ install-binaries: install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
@if not exist "$(SCRIPT_INSTALL_DIR)" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2"
@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4" \
@@ -904,8 +913,6 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
@echo Installing library files to $(SCRIPT_INSTALL_DIR)
@$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
@$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
@@ -923,7 +930,12 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @$(CPY) "$(WIN_DIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(WIN_DIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\"
- @echo Installing library opt0.4 directory
+ @echo Installing package cookiejar $(PKG_COOKIEJAR_VER)
+ @$(CPY) "$(ROOT)\library\cookiejar\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
+ @$(CPY) "$(ROOT)\library\cookiejar\*.gz" \
+ "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
+ @echo Installing package opt $(PKG_OPT_VER)
@$(CPY) "$(ROOT)\library\opt\*.tcl" \
"$(SCRIPT_INSTALL_DIR)\opt0.4\"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
diff --git a/win/rules.vc b/win/rules.vc index 2b11b01..1206677 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -24,7 +24,7 @@ _RULES_VC = 1 # For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
-RULES_VERSION_MINOR = 4
+RULES_VERSION_MINOR = 6
# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
@@ -976,6 +976,19 @@ VERSION = $(DOTVERSION:.=) !endif # $(DOING_TCL) ... etc.
+# Windows RC files have 3 version components. Ensure this irrespective
+# of how many components the package has specified. Basically, ensure
+# minimum 4 components by appending 4 0's and then pick out the first 4.
+# Also take care of the fact that DOTVERSION may have "a" or "b" instead
+# of "." separating the version components.
+DOTSEPARATED=$(DOTVERSION:a=.)
+DOTSEPARATED=$(DOTSEPARATED:b=.)
+!if [echo RCCOMMAVERSION = \> versions.vc] \
+ || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc]
+!error *** Could not generate RCCOMMAVERSION ***
+!endif
+!include versions.vc
+
################################################################
# 10. Construct output directory and file paths
# Figure-out how to name our intermediate and output directories.
@@ -1269,6 +1282,17 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include # define PRJ_LIBS before including rules.rc if additional libs are needed
OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS
+!if $(VCVERSION) >= 1600
+OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1
+!else
+OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1
+!endif
+!if $(VCVERSION) >= 1700
+OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1
+!endif
+!if $(VCVERSION) >= 1800
+OPTDEFINES = $(OPTDEFINES) /DHAVE_STDBOOL_H=1
+!endif
!if $(TCL_MEM_DEBUG)
OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG
@@ -1490,7 +1514,7 @@ GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
$(TCL_INCLUDES) \
/DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
- /DCOMMAVERSION=$(DOTVERSION:.=,),0 \
+ /DCOMMAVERSION=$(RCCOMMAVERSION) \
/DDOTVERSION=\"$(DOTVERSION)\" \
/DVERSION=\"$(VERSION)\" \
/DSUFX=\"$(SUFX:t=)\" \
@@ -764,28 +764,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LIBSUFFIX="\${DBGX}.lib" LIBFLAGSUFFIX="\${DBGX}" - # This is a 2-stage check to make sure we have the 64-bit SDK - # We have to know where the SDK is installed. - # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs if test "$do64bit" != "no" ; then - if test "x${MSSDK}x" = "xx" ; then - MSSDK="C:/Progra~1/Microsoft Platform SDK" - fi - MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` - PATH64="" case "$do64bit" in amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build - PATH64="${MSSDK}/Bin/Win64/x86/AMD64" ;; ia64) MACHINE="IA64" - PATH64="${MSSDK}/Bin/Win64" ;; esac - if test ! -d "${PATH64}" ; then - AC_MSG_WARN([Could not find 64-bit $MACHINE SDK]) - fi AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi @@ -800,21 +787,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ esac if test "$do64bit" != "no" ; then - # The space-based-path will work for the Makefile, but will - # not work if AC_TRY_COMPILE is called. TEA has the - # TEA_PATH_NOSPACE to avoid this issue. - # Check if _WIN64 is already recognized, and if so we don't - # need to modify CC. - AC_CHECK_DECL([_WIN64], [], - [CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ - -I\"${MSSDK}/Include/crt\" \ - -I\"${MSSDK}/Include/crt/sys\""]) - RC="\"${MSSDK}/bin/rc.exe\"" + RC="rc" CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" - lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" - LINKBIN="\"${PATH64}/link.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE}" + LINKBIN="link" # Avoid 'unresolved external symbol __security_cookie' errors. # c.f. http://support.microsoft.com/?id=894573 LIBS="$LIBS bufferoverflowU.lib" diff --git a/win/tclWinDde.c b/win/tclWinDde.c index cbbcdae..267ee6e 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -119,8 +119,8 @@ static int DdeObjCmd(void *clientData, #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) +# 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 diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 6b27d16..49b1a67 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -83,6 +83,9 @@ typedef DWORD_PTR * PDWORD_PTR; #include <malloc.h> #include <process.h> #include <signal.h> +#ifdef HAVE_INTTYPES_H +# include <inttypes.h> +#endif #include <limits.h> #ifdef HAVE_STDINT_H # include <stdint.h> diff --git a/win/tclWinReg.c b/win/tclWinReg.c index b66282a..2c1b8a5 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -126,8 +126,8 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) +# 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 |