Merge 8.7

13 files changed, 49 insertions, 60 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 7beab70..2c976b6 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 2bfd679..3ddcf72 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -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/tclBinary.c b/generic/tclBinary.c
index 3f263bc..d72f1d2 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1363,7 +1363,7 @@ BinaryFormatCmd(
  badField:
     {
 	Tcl_UniChar ch = 0;
-	char buf[TCL_UTF_MAX + 1] = "";
+	char buf[5] = "";
 
 	TclUtfToUniChar(errorString, &ch);
 	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
@@ -1733,7 +1733,7 @@ BinaryScanCmd(
  badField:
     {
 	Tcl_UniChar ch = 0;
-	char buf[TCL_UTF_MAX + 1] = "";
+	char buf[5] = "";
 
 	TclUtfToUniChar(errorString, &ch);
 	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index c833291..394532f 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);
@@ -1978,7 +1978,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 */
@@ -2691,8 +2691,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 e219c34..a2a1d68 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2202,7 +2202,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
@@ -2343,7 +2343,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;
@@ -2359,7 +2359,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;
@@ -2408,15 +2408,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 <= 3
-	    if ((*chPtr >= 0xD800) && (len < 3)) {
-		src += Tcl_UtfToUniChar(src, 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/tclIO.c b/generic/tclIO.c
index c752589..9662421 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4712,14 +4712,14 @@ Tcl_GetsObj(
 		     * Skip the raw bytes that make up the '\n'.
 		     */
 
-		    char tmp[TCL_UTF_MAX];
+		    char tmp[4];
 		    int rawRead;
 
 		    bufPtr = gs.bufPtr;
 		    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
 			    gs.rawRead, statePtr->inputEncodingFlags
 				| TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
-			    TCL_UTF_MAX, &rawRead, NULL, NULL);
+			    4, &rawRead, NULL, NULL);
 		    bufPtr->nextRemoved += rawRead;
 		    gs.rawRead -= rawRead;
 		    gs.bytesWrote--;
@@ -6265,7 +6265,7 @@ ReadChars(
 	     */
 
 	    if (code != TCL_OK) {
-		char buffer[TCL_UTF_MAX + 1];
+		char buffer[5];
 		int read, decoded, count;
 
 		/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 622eeac..77f7adf 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/tclOOMethod.c b/generic/tclOOMethod.c
index 78421e1..88782dd 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -679,11 +679,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 (!((CallContext *)context)->oPtr->namespacePtr ||
+	Tcl_InterpDeleted(interp)
+    ) {
 	return TclNRObjectContextInvokeNext(interp, context, objc, objv,
 		Tcl_ObjectContextSkippedArgs(context));
     }
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 897dbb6..9fa1db4 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -923,7 +923,7 @@ TclParseBackslash(
 	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
 	    count = TclUtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
 	} else {
-	    char utfBytes[TCL_UTF_MAX];
+	    char utfBytes[4];
 
 	    memcpy(utfBytes, p, numBytes - 1);
 	    utfBytes[numBytes - 1] = '\0';
diff --git a/generic/tclScan.c b/generic/tclScan.c
index e0657ea..cc2b362 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -261,7 +261,7 @@ ValidateFormat(
     Tcl_UniChar ch = 0;
     int objIndex, xpgSize, nspace = numVars;
     int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
-    char buf[TCL_UTF_MAX + 1] = "";
+    char buf[5] = "";
     Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
 				 * these are messy operations because we do
 				 * not want to use the formatting engine;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ca9c3e5..c489608 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -299,7 +299,7 @@ void *TclWinGetTclInstance()
 {
     void *hInstance = NULL;
     GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
-	    (const char *)&TclpIsAtty, &hInstance);
+	    (const wchar_t *)&TclpIsAtty, &hInstance);
     return hInstance;
 }
 
@@ -528,7 +528,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
 #   define Tcl_UniCharCaseMatch 0
 #   define Tcl_UniCharLen 0
 #   define Tcl_UniCharNcmp 0
-#   define TclOldFreeObj 0
 #   undef Tcl_StringMatch
 #   define Tcl_StringMatch 0
 #   define TclBN_reverse 0
@@ -563,7 +562,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(
@@ -1068,7 +1066,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 */
@@ -1129,7 +1127,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 */