From 45808db8dcbdfbee40971863bf92da08d2217966 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 7 Nov 2017 09:08:48 +0000
Subject: TIP #422 implementation, Tcl 8.7 part.

---
 generic/tcl.decls     | 10 +++++-----
 generic/tclDecls.h    | 25 +++++++++++++++----------
 generic/tclStubInit.c |  5 +++++
 3 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/generic/tcl.decls b/generic/tcl.decls
index b2b91a9..0bdffec 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -945,10 +945,10 @@ declare 265 {
 declare 266 {
     void Tcl_ValidateAllMemory(const char *file, int line)
 }
-declare 267 {
+declare 267 {deprecated {see TIP #422}} {
     void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
 }
-declare 268 {
+declare 268 {deprecated {see TIP #422}} {
     void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
 }
 declare 269 {
@@ -976,16 +976,16 @@ declare 274 {
     CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
 	    const char *version, int exact)
 }
-declare 275 {
+declare 275 {deprecated {see TIP #422}} {
     void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
 }
-declare 276 {
+declare 276 {deprecated {see TIP #422}} {
     int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
 }
 declare 277 {
     Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
 }
-declare 278 {
+declare 278 {deprecated {see TIP #422}} {
     TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
 }
 declare 279 {
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 464fc0f..dc48dd5 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -812,10 +812,12 @@ EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
 /* 266 */
 EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
 /* 267 */
-EXTERN void		Tcl_AppendResultVA(Tcl_Interp *interp,
+TCL_DEPRECATED("see TIP #422")
+void			Tcl_AppendResultVA(Tcl_Interp *interp,
 				va_list argList);
 /* 268 */
-EXTERN void		Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
+TCL_DEPRECATED("see TIP #422")
+void			Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
 				va_list argList);
 /* 269 */
 EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
@@ -838,14 +840,17 @@ EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
 				const char *name, const char *version,
 				int exact);
 /* 275 */
-EXTERN void		Tcl_SetErrorCodeVA(Tcl_Interp *interp,
+TCL_DEPRECATED("see TIP #422")
+void			Tcl_SetErrorCodeVA(Tcl_Interp *interp,
 				va_list argList);
 /* 276 */
-EXTERN int		Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
+TCL_DEPRECATED("see TIP #422")
+int			Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
 /* 277 */
 EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
 /* 278 */
-EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
+TCL_DEPRECATED("see TIP #422")
+TCL_NORETURN void	Tcl_PanicVA(const char *format, va_list argList);
 /* 279 */
 EXTERN void		Tcl_GetVersion(int *major, int *minor,
 				int *patchLevel, int *type);
@@ -2133,18 +2138,18 @@ typedef struct TclStubs {
     void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
     int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
     void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
-    void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
-    void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
+    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
+    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
     char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
     CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
     CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
     CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
     int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
     CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
-    void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
-    int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
+    TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
+    TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
     Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
-    TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
+    TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
     void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
     void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
     Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ebd2086..24b28e5 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -72,6 +72,11 @@ static int TclSockMinimumBuffersOld(int sock, int size)
 #   define TclBNInitBignumFromWideUInt 0
 #   define TclBNInitBignumFromWideInt 0
 #   define TclBNInitBignumFromLong 0
+#   define Tcl_AppendResultVA 0
+#   define Tcl_AppendStringsToObjVA 0
+#   define Tcl_SetErrorCodeVA 0
+#   define Tcl_PanicVA 0
+#   define Tcl_VarEvalVA 0
 #else
 #define TclSetStartupScriptPath setStartupScriptPath
 static void TclSetStartupScriptPath(Tcl_Obj *path)
-- 
cgit v0.12


From 65007a4d02a35e26d92288bc5a20aa1bfde3696e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 16 Nov 2017 08:39:41 +0000
Subject: No longer document (even though it's only in an example) that
 Tcl_SavedResult is a struct, and that the internal representation of an int
 is stored in the object's internalRep.longValue member. That might no longer
 be true in the future.

---
 doc/Object.3     |  6 +++---
 doc/SaveResult.3 | 11 +++++------
 2 files changed, 8 insertions(+), 9 deletions(-)

diff --git a/doc/Object.3 b/doc/Object.3
index 4df6c1a..a7e06c8 100644
--- a/doc/Object.3
+++ b/doc/Object.3
@@ -3,7 +3,7 @@
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\" 
+'\"
 .TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures"
 .so man.macros
 .BS
@@ -94,7 +94,7 @@ Also, most Tcl values are only read and never modified.
 This is especially true for procedure arguments,
 which can be shared between the caller and the called procedure.
 Assignment and argument binding is done by
-simply assigning a pointer to the value. 
+simply assigning a pointer to the value.
 Reference counting is used to determine when it is safe to
 reclaim an object's storage.
 .PP
@@ -249,7 +249,7 @@ The \fBincr\fR command first gets an integer from \fIx\fR's object
 by calling \fBTcl_GetIntFromObj\fR.
 This procedure checks whether the object is already an integer object.
 Since it is not, it converts the object
-by setting the object's \fIinternalRep.longValue\fR member
+by setting the object's internal representation
 to the integer \fB123\fR
 and setting the object's \fItypePtr\fR
 to point to the integer Tcl_ObjType structure.
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 74da9f4..0a2ee51 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -4,7 +4,7 @@
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\" 
+'\"
 .TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
 .so man.macros
 .BS
@@ -56,9 +56,9 @@ is called, Tcl will take care of memory management.
 .PP
 The second triplet stores the snapshot of only the interpreter
 result (not its complete state) in memory allocated by the caller.
-These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
+These routines are passed a pointer to \fBTcl_SavedResult\fR
 that is used to store enough information to restore the interpreter result.
-This structure can be allocated on the stack of the calling
+\fBTcl_SavedResult\fR can be allocated on the stack of the calling
 procedure.  These routines do not save the state of any error
 information in the interpreter (e.g. the \fB\-errorcode\fR or
 \fB\-errorinfo\fR return options, when an error is in progress).
@@ -69,7 +69,7 @@ a superset of the functions provided by the other routines,
 any new code should only make use of the more powerful routines.
 The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
 and \fBTcl_DiscardResult\fR continue to exist only for the sake
-of existing programs that may already be using them.  
+of existing programs that may already be using them.
 .PP
 \fBTcl_SaveInterpState\fR takes a snapshot of those portions of
 interpreter state that make up the full result of script evaluation.
@@ -118,7 +118,6 @@ uninitialized state and cannot be used until another call to
 Once \fBTcl_SaveResult\fR is called to save the interpreter
 result, either \fBTcl_RestoreResult\fR or
 \fBTcl_DiscardResult\fR must be called to properly clean up the
-memory associated with the saved state.  
-
+memory associated with the saved state.
 .SH KEYWORDS
 result, state, interp
-- 
cgit v0.12


From ac3259b669c253852e4108c8da44a959fb1465a9 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 17 Nov 2017 08:32:16 +0000
Subject: Suggested patch for [4f51e1c5dc]: patch to correct linker flag
 sequence. Same change done for a few other platforms where it might matter.

---
 unix/configure | 8 ++++----
 unix/tcl.m4    | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/unix/configure b/unix/configure
index 39076a4..888fe0c 100755
--- a/unix/configure
+++ b/unix/configure
@@ -6954,7 +6954,7 @@ echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2
 	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
 	    SHLIB_CFLAGS="-fPIC"
 	    SHLIB_SUFFIX=".so"
-	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
+	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS="-lroot"
 	    echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5
@@ -7383,7 +7383,7 @@ fi
 	    # get rid of the warnings.
 	    #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
 
-	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
+	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS="-ldl"
 	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
@@ -7525,7 +7525,7 @@ fi
 		SHLIB_CFLAGS="-fpic"
 		;;
 	    esac
-	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
@@ -7554,7 +7554,7 @@ fi
 	NetBSD-*)
 	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
 	    SHLIB_CFLAGS="-fPIC"
-	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 8a802fb..6ca2047 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1258,7 +1258,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
 	    SHLIB_CFLAGS="-fPIC"
 	    SHLIB_SUFFIX=".so"
-	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
+	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS="-lroot"
 	    AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"])
@@ -1402,7 +1402,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    # get rid of the warnings.
 	    #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
 
-	    SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'
+	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS="-ldl"
 	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
@@ -1473,7 +1473,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 		SHLIB_CFLAGS="-fpic"
 		;;
 	    esac
-	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
@@ -1496,7 +1496,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	NetBSD-*)
 	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
 	    SHLIB_CFLAGS="-fPIC"
-	    SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
-- 
cgit v0.12


From ff436137df3cce5d4e96e59c54a3f1211a3e8a33 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 17 Nov 2017 15:28:09 +0000
Subject: Fix [fab92486a1b05ba6f7cfe8677da95b9efb3beff0|fab92486a1]: Windows
 error 14 "Out of memory" mapping to Posix EFAULT "Bad address in system call
 argument" feels wrong

---
 win/tclWinError.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/win/tclWinError.c b/win/tclWinError.c
index a74d2e2..c569d61 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -32,7 +32,7 @@ static CONST unsigned char errorTable[] = {
     ENOEXEC,	/* ERROR_BAD_FORMAT		11 */
     EACCES,	/* ERROR_INVALID_ACCESS		12 */
     EINVAL,	/* ERROR_INVALID_DATA		13 */
-    EFAULT,	/* ERROR_OUT_OF_MEMORY		14 */
+    ENOMEM,	/* ERROR_OUT_OF_MEMORY		14 */
     ENOENT,	/* ERROR_INVALID_DRIVE		15 */
     EACCES,	/* ERROR_CURRENT_DIRECTORY	16 */
     EXDEV,	/* ERROR_NOT_SAME_DEVICE	17 */
-- 
cgit v0.12


From 3c942c50d91bc8ea58c64065922babf397943e8f Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Fri, 17 Nov 2017 22:30:06 +0000
Subject: Fix [16fe1b5807]: namespace ensemble command named ":" is mistakenly
 given the empty string as its name.

---
 generic/tclBasic.c    | 105 +++++++++++++++++++++++++------------
 generic/tclEnsemble.c | 140 +++++++++++++++++++++++++++++++-------------------
 generic/tclInt.h      |  26 ++++++++++
 generic/tclNamesp.c   |  31 ++++++++++-
 generic/tclProc.c     |  20 +-------
 tests/namespace.test  |  18 +++++--
 6 files changed, 231 insertions(+), 109 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fe29db0..334febc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2098,13 +2098,13 @@ Tcl_CreateCommand(
 
         hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
 
-        if (isNew || deleted) {
+	if (isNew || deleted) {
 	    /*
 	     * isNew - No conflict with existing command.
 	     * deleted - We've already deleted a conflicting command
 	     */
 	    break;
-        }
+	}
 
 	/* An existing command conflicts. Try to delete it.. */
 	cmdPtr = Tcl_GetHashValue(hPtr);
@@ -2245,64 +2245,81 @@ Tcl_CreateObjCommand(
 				 * name. */
     ClientData clientData,	/* Arbitrary value to pass to object
 				 * function. */
-    Tcl_CmdDeleteProc *deleteProc)
+    Tcl_CmdDeleteProc *deleteProc
 				/* If not NULL, gives a function to call when
 				 * this command is deleted. */
+)
 {
     Interp *iPtr = (Interp *) interp;
-    ImportRef *oldRefPtr = NULL;
     Namespace *nsPtr;
-    Command *cmdPtr;
-    Tcl_HashEntry *hPtr;
     const char *tail;
-    int isNew = 0, deleted = 0;
-    ImportedCmdData *dataPtr;
 
     if (iPtr->flags & DELETED) {
 	/*
 	 * The interpreter is being deleted. Don't create any new commands;
 	 * it's not safe to muck with the interpreter anymore.
 	 */
-
 	return (Tcl_Command) NULL;
     }
 
     /*
+     * Determine where the command should reside. If its name contains
+     * namespace qualifiers, we put it in the specified namespace;
+     * otherwise, we always put it in the global namespace.
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+	Namespace *dummy1, *dummy2;
+
+	TclGetNamespaceForQualName(interp, cmdName, NULL,
+	    TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+	if ((nsPtr == NULL) || (tail == NULL)) {
+	    return (Tcl_Command) NULL;
+	}
+    } else {
+	nsPtr = iPtr->globalNsPtr;
+	tail = cmdName;
+    }
+
+    return tclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
+	proc, clientData, deleteProc);
+}
+
+Tcl_Command tclCreateObjCommandInNs (
+    Tcl_Interp *interp,
+    const char *cmdName,	/* Name of command, without any namespace components */
+    Tcl_Namespace *namespace,   /* The namespace to create the command in */
+    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
+				 * name. */
+    ClientData clientData,	/* Arbitrary value to pass to object
+				 * function. */
+    Tcl_CmdDeleteProc *deleteProc
+				/* If not NULL, gives a function to call when
+				 * this command is deleted. */
+) {
+    int deleted = 0, isNew = 0;
+    Command *cmdPtr;
+    ImportRef *oldRefPtr = NULL;
+    ImportedCmdData *dataPtr;
+    Tcl_HashEntry *hPtr;
+    Namespace *nsPtr = (Namespace *) namespace;
+    /*
      * If the command name we seek to create already exists, we need to
      * delete that first.  That can be tricky in the presence of traces.
      * Loop until we no longer find an existing command in the way, or
      * until we've deleted one command and that didn't finish the job.
      */
-
     while (1) {
-        /*
-         * Determine where the command should reside. If its name contains
-         * namespace qualifiers, we put it in the specified namespace;
-	 * otherwise, we always put it in the global namespace.
-         */
-
-        if (strstr(cmdName, "::") != NULL) {
-	    Namespace *dummy1, *dummy2;
-
-	    TclGetNamespaceForQualName(interp, cmdName, NULL,
-		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
-	    if ((nsPtr == NULL) || (tail == NULL)) {
-	        return (Tcl_Command) NULL;
-	    }
-        } else {
-	    nsPtr = iPtr->globalNsPtr;
-	    tail = cmdName;
-        }
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
 
-        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
-
-        if (isNew || deleted) {
+	if (isNew || deleted) {
 	    /*
 	     * isNew - No conflict with existing command.
 	     * deleted - We've already deleted a conflicting command
 	     */
 	    break;
-        }
+	}
+
 
 	/* An existing command conflicts. Try to delete it.. */
 	cmdPtr = Tcl_GetHashValue(hPtr);
@@ -2336,7 +2353,13 @@ Tcl_CreateObjCommand(
 	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
 	}
 
+	/* Make sure namespace doesn't get deallocated. */
+	cmdPtr->nsPtr->refCount++;
+
 	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	nsPtr = (Namespace *) TclEnsureNamespace(interp,
+	    (Tcl_Namespace *)cmdPtr->nsPtr);
+	TclNsDecrRefCount(cmdPtr->nsPtr);
 
 	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
 	    oldRefPtr = cmdPtr->importRefPtr;
@@ -2345,7 +2368,6 @@ Tcl_CreateObjCommand(
 	TclCleanupCommandMacro(cmdPtr);
 	deleted = 1;
     }
-
     if (!isNew) {
 	/*
 	 * If the deletion callback recreated the command, just throw away
@@ -2367,7 +2389,7 @@ Tcl_CreateObjCommand(
 	 * commands.
 	 */
 
-	TclInvalidateCmdLiteral(interp, tail, nsPtr);
+	TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
 
 	/*
 	 * The list of command exported from the namespace might have changed.
@@ -8187,6 +8209,21 @@ Tcl_NRCreateCommand(
     cmdPtr->nreProc = nreProc;
     return (Tcl_Command) cmdPtr;
 }
+
+Tcl_Command tclNRCreateCommandInNs (
+    Tcl_Interp *interp,
+    const char *cmdName,
+    Tcl_Namespace *nsPtr,
+    Tcl_ObjCmdProc *proc,
+    Tcl_ObjCmdProc *nreProc,
+    ClientData clientData,
+    Tcl_CmdDeleteProc *deleteProc) {
+    Command *cmdPtr = (Command *)
+	tclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+
+    cmdPtr->nreProc = nreProc;
+    return (Tcl_Command) cmdPtr;
+}
 
 /****************************************************************************
  * Stuff for the public api
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index f3e8187..28802b0 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -146,10 +146,12 @@ TclNamespaceEnsembleCmd(
     Tcl_Obj *const objv[])
 {
     Tcl_Namespace *namespacePtr;
-    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
+    	*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
     Tcl_Command token;
     Tcl_DictSearch search;
     Tcl_Obj *listObj;
+    const char *simpleName;
     int index, done;
 
     if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
@@ -195,13 +197,8 @@ TclNamespaceEnsembleCmd(
 	objv += 2;
 	objc -= 2;
 
-	/*
-	 * Work out what name to use for the command to create. If supplied,
-	 * it is either fully specified or relative to the current namespace.
-	 * If not supplied, it is exactly the name of the current namespace.
-	 */
-
-	name = nsPtr->fullName;
+	name = nsPtr->name;
+	cxtPtr = (Namespace *) nsPtr->parentPtr;
 
 	/*
 	 * Parse the option list, applying type checks as we go. Note that we
@@ -221,6 +218,7 @@ TclNamespaceEnsembleCmd(
 	    switch ((enum EnsCreateOpts) index) {
 	    case CRT_CMD:
 		name = TclGetString(objv[1]);
+		cxtPtr = nsPtr;
 		continue;
 	    case CRT_SUBCMDS:
 		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
@@ -337,6 +335,10 @@ TclNamespaceEnsembleCmd(
 	    }
 	}
 
+	TclGetNamespaceForQualName(interp, name, cxtPtr,
+	TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
+	&simpleName);
+
 	/*
 	 * Create the ensemble. Note that this might delete another ensemble
 	 * linked to the same namespace, so we must be careful. However, we
@@ -344,8 +346,9 @@ TclNamespaceEnsembleCmd(
 	 * we've created it (and after any deletions have occurred.)
 	 */
 
-	token = Tcl_CreateEnsemble(interp, name, NULL,
-		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+	token = TclCreateEnsembleInNs(interp, simpleName,
+	     (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
+	     (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
 	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
 	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
 	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -636,48 +639,38 @@ TclNamespaceEnsembleCmd(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CreateEnsemble --
+ * TclCreateEnsembleInNs --
  *
- *	Create a simple ensemble attached to the given namespace.
- *
- * Results:
- *	The token for the command created.
- *
- * Side effects:
- *	The ensemble is created and marked for compilation.
+ *	Like Tcl_CreateEnsemble, but additionally accepts as an argument the
+ *	name of the namespace to create the command in.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
-Tcl_CreateEnsemble(
-    Tcl_Interp *interp,
-    const char *name,
-    Tcl_Namespace *namespacePtr,
-    int flags)
+TclCreateEnsembleInNs(
+    Tcl_Interp *interp, 
+			
+    const char *name,   /* Simple name of command to create (no */
+			/* namespace components). */
+    Tcl_Namespace       /* Name of namespace to create the command in. */ 
+    *nameNsPtr,	
+    Tcl_Namespace
+    *ensembleNsPtr,	/* Name of the namespace for the ensemble. */
+    int flags
+    )
 {
-    Namespace *nsPtr = (Namespace *) namespacePtr;
-    EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
-    Tcl_Obj *nameObj = NULL;
-
-    if (nsPtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    }
-
-    /*
-     * Make the name of the ensemble into a fully qualified name. This might
-     * allocate a temporary object.
-     */
+    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
+    EnsembleConfig *ensemblePtr;
+    Tcl_Command token;
 
-    if (!(name[0] == ':' && name[1] == ':')) {
-	nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
-	if (nsPtr->parentPtr == NULL) {
-	    Tcl_AppendStringsToObj(nameObj, name, NULL);
-	} else {
-	    Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
-	}
-	Tcl_IncrRefCount(nameObj);
-	name = TclGetString(nameObj);
+    ensemblePtr = ckalloc(sizeof(EnsembleConfig));
+    token = tclNRCreateCommandInNs(interp, name,
+	(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
+	NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
+    if (token == NULL) {
+	ckfree(ensemblePtr);
+	return NULL;
     }
 
     ensemblePtr->nsPtr = nsPtr;
@@ -690,9 +683,7 @@ Tcl_CreateEnsemble(
     ensemblePtr->numParameters = 0;
     ensemblePtr->parameterList = NULL;
     ensemblePtr->unknownHandler = NULL;
-    ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
-	    NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
-	    ensemblePtr, DeleteEnsembleConfig);
+    ensemblePtr->token = token;
     ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
     nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
 
@@ -709,11 +700,56 @@ Tcl_CreateEnsemble(
 	((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
     }
 
+    return ensemblePtr->token;
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateEnsemble
+ *
+ *	Create a simple ensemble attached to the given namespace.
+ *
+ *	Deprecated by TclCreateEnsembleInNs.
+ *
+ * Value
+ *
+ *	The token for the command created.
+ *
+ * Effect
+ *	The ensemble is created and marked for compilation.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateEnsemble(
+    Tcl_Interp *interp,
+    const char *name,
+    Tcl_Namespace *namespacePtr,
+    int flags)
+{
+    Tcl_Obj *nameObj = NULL;
+    Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
+    	*actualNsPtr;
+    const char * simpleName;
+
+    if (nsPtr == NULL) {
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    }
+
+    TclGetNamespaceForQualName(interp, name, nsPtr, 0,
+    	&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
     if (nameObj != NULL) {
-	TclDecrRefCount(nameObj);
+    	TclDecrRefCount(nameObj);
     }
-    return ensemblePtr->token;
+    return TclCreateEnsembleInNs(interp, simpleName,
+	(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1885,6 +1921,7 @@ NsEnsembleImplementationCmdNR(
 
 	TclSkipTailcall(interp);
 	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
 	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
     }
 
@@ -2635,10 +2672,7 @@ BuildEnsembleConfig(
 			Tcl_Obj *cmdObj, *cmdPrefixObj;
 
 			TclNewObj(cmdObj);
-			Tcl_AppendStringsToObj(cmdObj,
-				ensemblePtr->nsPtr->fullName,
-				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
-				nsCmdName, NULL);
+			Tcl_AppendStringsToObj(cmdObj, nsCmdName, NULL);
 			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
 			Tcl_SetHashValue(hPtr, cmdPrefixObj);
 			Tcl_IncrRefCount(cmdPrefixObj);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 23a20e6..480ae5a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2917,6 +2917,19 @@ MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 			    Tcl_Obj *originObjPtr);
 MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
+MODULE_SCOPE Tcl_Command tclCreateObjCommandInNs (
+			    Tcl_Interp *interp,
+			    const char *cmdName,
+			    Tcl_Namespace *nsPtr,
+			    Tcl_ObjCmdProc *proc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc);
+MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
+			    Tcl_Interp *interp,
+			    const char *name,
+			    Tcl_Namespace *nameNamespacePtr,
+			    Tcl_Namespace *ensembleNamespacePtr,
+			    int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
 MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, int dictLength,
@@ -2945,6 +2958,10 @@ MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
 MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
 MODULE_SCOPE Tcl_Obj *const *	TclFetchEnsembleRoot(Tcl_Interp *interp,
 			    Tcl_Obj *const *objv, int objc, int *objcPtr);
+Tcl_Namespace * 	TclEnsureNamespace(
+			    Tcl_Interp *interp,
+			    Tcl_Namespace *namespacePtr);
+
 MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
 MODULE_SCOPE void	TclFinalizeAsync(void);
 MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
@@ -2971,6 +2988,15 @@ MODULE_SCOPE double	TclFloor(const mp_int *a);
 MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
 MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
 			    const char *attributeName, int *indexPtr);
+MODULE_SCOPE Tcl_Command tclNRCreateCommandInNs (
+			    Tcl_Interp *interp,
+			    const char *cmdName,
+			    Tcl_Namespace *nsPtr,
+			    Tcl_ObjCmdProc *proc,
+			    Tcl_ObjCmdProc *nreProc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc);
+
 MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    const char *encodingName);
 MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index e1bad0e..e7914ad 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -2424,6 +2424,35 @@ TclGetNamespaceForQualName(
 /*
  *----------------------------------------------------------------------
  *
+ * TclEnsureNamespace --
+ *
+ *	Provide a namespace that is not deleted.
+ *
+ * Value
+ *
+ *	namespacePtr, if it is not scheduled for deletion, or a pointer to a
+ *	new namespace with the same name otherwise.
+ *
+ * Effect
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Namespace *
+TclEnsureNamespace(
+    Tcl_Interp *interp,
+    Tcl_Namespace *namespacePtr)
+{
+    Namespace *nsPtr = (Namespace *) namespacePtr;
+    if (!nsPtr->flags & NS_DYING) {
+	    return namespacePtr;
+    }
+    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FindNamespace --
  *
  *	Searches for a namespace.
@@ -2638,7 +2667,7 @@ Tcl_FindCommand(
 	Namespace *nsPtr[2];
 	register int search;
 
-	TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+	TclGetNamespaceForQualName(interp, name, cxtNsPtr,
 		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
 
 	/*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 8fc6dcb..f5f2b03 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -128,7 +128,6 @@ Tcl_ProcObjCmd(
     const char *procName, *procArgs, *procBody;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
-    Tcl_DString ds;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
@@ -180,23 +179,8 @@ Tcl_ProcObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * Now create a command for the procedure. This will initially be in the
-     * current namespace unless the procedure's name included namespace
-     * qualifiers. To create the new command in the right namespace, we
-     * generate a fully qualified name for it.
-     */
-
-    Tcl_DStringInit(&ds);
-    if (nsPtr != iPtr->globalNsPtr) {
-	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-	TclDStringAppendLiteral(&ds, "::");
-    }
-    Tcl_DStringAppend(&ds, procName, -1);
-
-    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
-	    TclNRInterpProc, procPtr, TclProcDeleteProc);
-    Tcl_DStringFree(&ds);
+    cmd = tclNRCreateCommandInNs(interp, procName, (Tcl_Namespace *) nsPtr,
+	TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
 
     /*
      * Now initialize the new procedure's cmdPtr field. This will be used
diff --git a/tests/namespace.test b/tests/namespace.test
index f6f817b..220fa53 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1784,7 +1784,7 @@ test namespace-42.7 {ensembles: nested} -body {
     list [ns x0 z] [ns x1] [ns x2] [ns x3]
 } -cleanup {
     namespace delete ns
-} -result {{1 ::ns::x0::z} 1 2 3}
+} -result {{1 z} 1 2 3}
 test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
     proc demo args {}
     variable target [list [namespace which demo] x]
@@ -2084,7 +2084,7 @@ test namespace-47.1 {ensemble: unknown handler} {
     lappend result [catch {ns c d e} msg] $msg
     lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
     list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
-} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
+} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}}
 test namespace-47.2 {ensemble: unknown handler} {
     namespace eval ns {
 	namespace export {[a-z]*}
@@ -3183,7 +3183,7 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
     1 {wrong # args: should be "ns z1 x a1"}\
     1 {wrong # args: should be "ns z2 x a1 a2"}\
     1 {wrong # args: should be "ns z2 x a1 a2"}\
-    1 {wrong # args: should be "::ns::x::z0"}\
+    1 {wrong # args: should be "z0"}\
     0 {1 v}\
     1 {wrong # args: should be "ns v x z2 a2"}\
     0 {2 v v2}}
@@ -3267,6 +3267,18 @@ test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
 	}
     }
 } {::testing::abc::def ::testing::abc::ghi}
+
+test namespace-56.4 {bug 16fe1b5807: names starting with ":"} {
+namespace eval : {
+    namespace ensemble create
+    namespace export *
+    proc p1 {} {
+	    return 16fe1b5807
+    }
+}
+
+: p1
+} 16fe1b5807
 
 # cleanup
 catch {rename cmd1 {}}
-- 
cgit v0.12


From 42c80667fd7da57b65d92fee77d2b954fba95970 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Fri, 17 Nov 2017 23:42:16 +0000
Subject: Lift the restriction on command names names that begin with ":".

---
 generic/tclBasic.c | 8 --------
 generic/tclProc.c  | 8 --------
 2 files changed, 16 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 334febc..a51578c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -9042,14 +9042,6 @@ TclNRCoroutineObjCmd(
         Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
 	return TCL_ERROR;
     }
-    if ((nsPtr != iPtr->globalNsPtr)
-	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "can't create procedure \"%s\" in non-global namespace with"
-                " name starting with \":\"", procName));
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
-	return TCL_ERROR;
-    }
 
     /*
      * We ARE creating the coroutine command: allocate the corresponding
diff --git a/generic/tclProc.c b/generic/tclProc.c
index f5f2b03..3c30623 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -158,14 +158,6 @@ Tcl_ProcObjCmd(
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
-    if ((nsPtr != iPtr->globalNsPtr)
-	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't create procedure \"%s\" in non-global namespace with"
-		" name starting with \":\"", procName));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
-	return TCL_ERROR;
-    }
 
     /*
      * Create the data structure to represent the procedure.
-- 
cgit v0.12


From 75924256c128fb94dc0cfbddf6d56fc89aeb10e7 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sun, 19 Nov 2017 00:06:51 +0000
Subject: Fix segmentation fault in TclOO that was noted in [16fe1b5807]. 
 Update coroutine and TclOO object creation routines to use
 TclCreateObjCommandInNs.

---
 generic/tclBasic.c    | 46 +++++++++++++++++-----------------------------
 generic/tclEnsemble.c | 12 +++---------
 generic/tclInt.h      |  4 ++--
 generic/tclOO.c       | 37 +++++++++++++++++++++----------------
 generic/tclProc.c     | 22 +++++++++++-----------
 tests/namespace.test  |  2 +-
 6 files changed, 55 insertions(+), 68 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a51578c..2acd2e7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2281,11 +2281,11 @@ Tcl_CreateObjCommand(
 	tail = cmdName;
     }
 
-    return tclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
+    return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
 	proc, clientData, deleteProc);
 }
 
-Tcl_Command tclCreateObjCommandInNs (
+Tcl_Command TclCreateObjCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,	/* Name of command, without any namespace components */
     Tcl_Namespace *namespace,   /* The namespace to create the command in */
@@ -8210,7 +8210,7 @@ Tcl_NRCreateCommand(
     return (Tcl_Command) cmdPtr;
 }
 
-Tcl_Command tclNRCreateCommandInNs (
+Tcl_Command TclNRCreateCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,
     Tcl_Namespace *nsPtr,
@@ -8219,7 +8219,7 @@ Tcl_Command tclNRCreateCommandInNs (
     ClientData clientData,
     Tcl_CmdDeleteProc *deleteProc) {
     Command *cmdPtr = (Command *)
-	tclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+	TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
 
     cmdPtr->nreProc = nreProc;
     return (Tcl_Command) cmdPtr;
@@ -9009,9 +9009,9 @@ TclNRCoroutineObjCmd(
 {
     Command *cmdPtr;
     CoroutineData *corPtr;
-    const char *fullName, *procName;
-    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
-    Tcl_DString ds;
+    const char *procName, *simpleName;
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
+	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
     Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
 
     if (objc < 3) {
@@ -9019,27 +9019,22 @@ TclNRCoroutineObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
-     * something in tclUtil.c to find the FQ name.
-     */
-
-    fullName = TclGetString(objv[1]);
-    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    procName = TclGetString(objv[1]);
+    TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
 
     if (nsPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                 "can't create procedure \"%s\": unknown namespace",
-                fullName));
+                procName));
         Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
 	return TCL_ERROR;
     }
-    if (procName == NULL) {
+    if (simpleName == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                 "can't create procedure \"%s\": bad procedure name",
-                fullName));
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
+                procName));
+        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
 	return TCL_ERROR;
     }
 
@@ -9050,16 +9045,9 @@ TclNRCoroutineObjCmd(
 
     corPtr = ckalloc(sizeof(CoroutineData));
 
-    Tcl_DStringInit(&ds);
-    if (nsPtr != iPtr->globalNsPtr) {
-	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-	TclDStringAppendLiteral(&ds, "::");
-    }
-    Tcl_DStringAppend(&ds, procName, -1);
-
-    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
-	    /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
-    Tcl_DStringFree(&ds);
+    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
+	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
+	    corPtr, DeleteCoroutine);
 
     corPtr->cmdPtr = cmdPtr;
     cmdPtr->refCount++;
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 28802b0..cce7666 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -665,7 +665,7 @@ TclCreateEnsembleInNs(
     Tcl_Command token;
 
     ensemblePtr = ckalloc(sizeof(EnsembleConfig));
-    token = tclNRCreateCommandInNs(interp, name,
+    token = TclNRCreateCommandInNs(interp, name,
 	(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
 	NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
     if (token == NULL) {
@@ -2605,12 +2605,7 @@ BuildEnsembleConfig(
 	     * the programmer's responsibility (or [::unknown] of course).
 	     */
 
-	    cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
-	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
-		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
-	    } else {
-		Tcl_AppendStringsToObj(cmdObj, name, NULL);
-	    }
+	    cmdObj = Tcl_NewStringObj(name, -1);
 	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
 	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
 	    Tcl_IncrRefCount(cmdPrefixObj);
@@ -2671,8 +2666,7 @@ BuildEnsembleConfig(
 		    if (isNew) {
 			Tcl_Obj *cmdObj, *cmdPrefixObj;
 
-			TclNewObj(cmdObj);
-			Tcl_AppendStringsToObj(cmdObj, nsCmdName, NULL);
+			cmdObj = Tcl_NewStringObj(nsCmdName, -1);
 			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
 			Tcl_SetHashValue(hPtr, cmdPrefixObj);
 			Tcl_IncrRefCount(cmdPrefixObj);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 480ae5a..7078ba0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2917,7 +2917,7 @@ MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 			    Tcl_Obj *originObjPtr);
 MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
-MODULE_SCOPE Tcl_Command tclCreateObjCommandInNs (
+MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
 			    Tcl_Interp *interp,
 			    const char *cmdName,
 			    Tcl_Namespace *nsPtr,
@@ -2988,7 +2988,7 @@ MODULE_SCOPE double	TclFloor(const mp_int *a);
 MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
 MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
 			    const char *attributeName, int *indexPtr);
-MODULE_SCOPE Tcl_Command tclNRCreateCommandInNs (
+MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
 			    Tcl_Interp *interp,
 			    const char *cmdName,
 			    Tcl_Namespace *nsPtr,
diff --git a/generic/tclOO.c b/generic/tclOO.c
index e48158c..7feeb5d 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -562,7 +562,10 @@ AllocObject(
     Object *oPtr;
     Command *cmdPtr;
     CommandTrace *tracePtr;
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
+    Tcl_Namespace *inNsPtr;
     int creationEpoch, ignored;
+    const char *simpleName;
 
     oPtr = ckalloc(sizeof(Object));
     memset(oPtr, 0, sizeof(Object));
@@ -652,24 +655,18 @@ AllocObject(
      * command is deleted).
      */
 
-    if (!nameStr) {
-	oPtr->command = Tcl_CreateObjCommand(interp,
-		oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL);
-    } else if (nameStr[0] == ':' && nameStr[1] == ':') {
-	oPtr->command = Tcl_CreateObjCommand(interp, nameStr,
-		PublicObjectCmd, oPtr, NULL);
+    if (nameStr) {
+	inNsPtr = TclGetCurrentNamespace(interp);
     } else {
-	Tcl_DString buffer;
-
-	Tcl_DStringInit(&buffer);
-	Tcl_DStringAppend(&buffer,
-		Tcl_GetCurrentNamespace(interp)->fullName, -1);
-	TclDStringAppendLiteral(&buffer, "::");
-	Tcl_DStringAppend(&buffer, nameStr, -1);
-	oPtr->command = Tcl_CreateObjCommand(interp,
-		Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
-	Tcl_DStringFree(&buffer);
+	nameStr = oPtr->namespacePtr->name;
+	inNsPtr = oPtr->namespacePtr;
     }
+    
+    TclGetNamespaceForQualName(interp, nameStr, (Namespace *) inNsPtr, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
+
+    oPtr->command = TclCreateObjCommandInNs(interp, simpleName,
+	(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
 
     /*
      * Add the NRE command and trace directly. While this breaks a number of
@@ -1795,6 +1792,11 @@ TclNRNewObjectInstance(
     Object *oPtr;
 
     /*
+     * Protect classPtr from getting cleaned up when the command is created.
+     */
+    AddRef(classPtr);
+
+    /*
      * Check if we're going to create an object over an existing command;
      * that's not allowed.
      */
@@ -1841,11 +1843,13 @@ TclNRNewObjectInstance(
 
     if (objc < 0) {
 	*objectPtr = (Tcl_Object) oPtr;
+	DelRef(classPtr);
 	return TCL_OK;
     }
     contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
     if (contextPtr == NULL) {
 	*objectPtr = (Tcl_Object) oPtr;
+	DelRef(classPtr);
 	return TCL_OK;
     }
 
@@ -1869,6 +1873,7 @@ TclNRNewObjectInstance(
     TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
 	    objectPtr);
     TclPushTailcallPoint(interp);
+    DelRef(classPtr);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 3c30623..b89357c 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -124,8 +124,8 @@ Tcl_ProcObjCmd(
 {
     register Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
-    const char *fullName;
-    const char *procName, *procArgs, *procBody;
+    const char *procName;
+    const char *simpleName, *procArgs, *procBody;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
 
@@ -140,21 +140,21 @@ Tcl_ProcObjCmd(
      * namespace.
      */
 
-    fullName = TclGetString(objv[1]);
-    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    procName = TclGetString(objv[1]);
+    TclGetNamespaceForQualName(interp, procName, NULL, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
 
     if (nsPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"can't create procedure \"%s\": unknown namespace",
-		fullName));
+		procName));
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
-    if (procName == NULL) {
+    if (simpleName == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"can't create procedure \"%s\": bad procedure name",
-		fullName));
+		procName));
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
@@ -163,15 +163,15 @@ Tcl_ProcObjCmd(
      * Create the data structure to represent the procedure.
      */
 
-    if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
+    if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3],
 	    &procPtr) != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (creating proc \"");
-	Tcl_AddErrorInfo(interp, procName);
+	Tcl_AddErrorInfo(interp, simpleName);
 	Tcl_AddErrorInfo(interp, "\")");
 	return TCL_ERROR;
     }
 
-    cmd = tclNRCreateCommandInNs(interp, procName, (Tcl_Namespace *) nsPtr,
+    cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
 	TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
 
     /*
diff --git a/tests/namespace.test b/tests/namespace.test
index 220fa53..de96682 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1920,7 +1920,7 @@ test namespace-44.5 {ensemble: errors} -setup {
     foobar foobarcon
 } -cleanup {
     rename foobar {}
-} -returnCodes error -result {invalid command name "::foobarconfigure"}
+} -returnCodes error -result {invalid command name "foobarconfigure"}
 test namespace-44.6 {ensemble: errors} -returnCodes error -body {
     namespace ensemble create gorp
 } -result {wrong # args: should be "namespace ensemble create ?option value ...?"}
-- 
cgit v0.12


From c2eeda3f09a8b05e10e5f8f968fc28bb2dcf3750 Mon Sep 17 00:00:00 2001
From: pspjuth <peter.spjuth@gmail.com>
Date: Sun, 19 Nov 2017 18:40:13 +0000
Subject: Changed math functions min and max to C implementations.

---
 generic/tclBasic.c   | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclExecute.c |  2 --
 generic/tclInt.h     |  2 ++
 library/init.tcl     | 37 ----------------------------
 tests/expr-old.test  | 20 ++++++++++++---
 5 files changed, 87 insertions(+), 43 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index acdcf41..eefb102 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -118,6 +118,8 @@ static Tcl_ObjCmdProc	ExprEntierFunc;
 static Tcl_ObjCmdProc	ExprFloorFunc;
 static Tcl_ObjCmdProc	ExprIntFunc;
 static Tcl_ObjCmdProc	ExprIsqrtFunc;
+static Tcl_ObjCmdProc	ExprMaxFunc;
+static Tcl_ObjCmdProc	ExprMinFunc;
 static Tcl_ObjCmdProc	ExprRandFunc;
 static Tcl_ObjCmdProc	ExprRoundFunc;
 static Tcl_ObjCmdProc	ExprSqrtFunc;
@@ -321,6 +323,8 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
     { "isqrt",	ExprIsqrtFunc,	NULL			},
     { "log",	ExprUnaryFunc,	(ClientData) log	},
     { "log10",	ExprUnaryFunc,	(ClientData) log10	},
+    { "max",	ExprMaxFunc,	NULL			},
+    { "min",	ExprMinFunc,	NULL			},
     { "pow",	ExprBinaryFunc,	(ClientData) pow	},
     { "rand",	ExprRandFunc,	NULL			},
     { "round",	ExprRoundFunc,	NULL			},
@@ -7677,6 +7681,71 @@ ExprWideFunc(
     return TCL_OK;
 }
 
+/*
+ * Common implmentation of max() and min().
+ */
+static int
+ExprMaxMinFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv,	/* Actual parameter vector. */
+    int op)			/* Comparison direction */
+{
+    Tcl_Obj *res;
+    double d;
+    int type, i;
+    ClientData ptr;
+
+    if (objc < 2) {
+	MathFuncWrongNumArgs(interp, 2, objc, objv);
+	return TCL_ERROR;
+    }
+    res = objv[1];
+    for (i = 1; i < objc; i++) {
+        if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (type == TCL_NUMBER_NAN) {
+            /*
+             * Get the error message for NaN.
+             */
+
+            Tcl_GetDoubleFromObj(interp, objv[i], &d);
+            return TCL_ERROR;
+        }
+        if (TclCompareTwoNumbers(objv[i], res) == op)  {
+            res = objv[i];
+        }
+    }
+
+    Tcl_SetObjResult(interp, res);
+    return TCL_OK;
+}
+
+static int
+ExprMaxFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
+}
+
+static int
+ExprMinFunc(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* The interpreter in which to execute the
+				 * function. */
+    int objc,			/* Actual parameter count. */
+    Tcl_Obj *const *objv)	/* Actual parameter vector. */
+{
+    return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
+}
+
 static int
 ExprRandFunc(
     ClientData clientData,	/* Ignored. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 761a23e..c4aa381 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -744,8 +744,6 @@ static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		DeleteExecStack(ExecStack *esPtr);
 static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr);
-MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
-			    Tcl_Obj *value2Ptr);
 static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
 			    int opcode, Tcl_Obj **constants,
 			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 91c8b96..64c60e4 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2878,6 +2878,8 @@ MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
 			    Tcl_Channel chan);
 MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
 MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
+MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
+			    Tcl_Obj *value2Ptr);
 MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
 			    int *loc);
 MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
diff --git a/library/init.tcl b/library/init.tcl
index c31eea3..d5beb69 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -73,43 +73,6 @@ namespace eval tcl {
 	    encoding dirs $Path
         }
     }
-
-    # TIP #255 min and max functions
-    namespace eval mathfunc {
-	proc min {args} {
-	    if {![llength $args]} {
-		return -code error \
-		    "too few arguments to math function \"min\""
-	    }
-	    set val Inf
-	    foreach arg $args {
-		# This will handle forcing the numeric value without
-		# ruining the internal type of a numeric object
-		if {[catch {expr {double($arg)}} err]} {
-		    return -code error $err
-		}
-		if {$arg < $val} {set val $arg}
-	    }
-	    return $val
-	}
-	proc max {args} {
-	    if {![llength $args]} {
-		return -code error \
-		    "too few arguments to math function \"max\""
-	    }
-	    set val -Inf
-	    foreach arg $args {
-		# This will handle forcing the numeric value without
-		# ruining the internal type of a numeric object
-		if {[catch {expr {double($arg)}} err]} {
-		    return -code error $err
-		}
-		if {$arg > $val} {set val $arg}
-	    }
-	    return $val
-	}
-	namespace export min max
-    }
 }
 
 # Windows specific end of initialization
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 06a00ba..262a71b 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -1159,8 +1159,8 @@ test expr-old-40.2 {min math function} -body {
     expr {min(0.0)}
 } -result 0.0
 test expr-old-40.3 {min math function} -body {
-    list [catch {expr {min()}} msg] $msg
-} -result {1 {too few arguments to math function "min"}}
+    expr {min()}
+} -returnCodes error -result {too few arguments for math function "min"}
 test expr-old-40.4 {min math function} -body {
     expr {min(wide(-1) << 30, 4.5, -10)}
 } -result [expr {wide(-1) << 30}]
@@ -1170,6 +1170,12 @@ test expr-old-40.5 {min math function} -body {
 test expr-old-40.6 {min math function} -body {
     expr {min(300, "0xFF")}
 } -result 255
+test expr-old-40.7 {min math function} -body {
+    expr min(1[string repeat 0 10000], 1e300)
+} -result 1e+300
+test expr-old-40.8 {min math function} -body {
+    expr {min(0, "a")}
+} -returnCodes error -match glob -result *
 
 test expr-old-41.1 {max math function} -body {
     expr {max(0)}
@@ -1178,8 +1184,8 @@ test expr-old-41.2 {max math function} -body {
     expr {max(0.0)}
 } -result 0.0
 test expr-old-41.3 {max math function} -body {
-    list [catch {expr {max()}} msg] $msg
-} -result {1 {too few arguments to math function "max"}}
+    expr {max()}
+} -returnCodes error -result {too few arguments for math function "max"}
 test expr-old-41.4 {max math function} -body {
     expr {max(wide(1) << 30, 4.5, -10)}
 } -result [expr {wide(1) << 30}]
@@ -1189,6 +1195,12 @@ test expr-old-41.5 {max math function} -body {
 test expr-old-41.6 {max math function} -body {
     expr {max(200, "0xFF")}
 } -result 255
+test expr-old-41.7 {max math function} -body {
+    expr max(1[string repeat 0 10000], 1e300)
+} -result 1[string repeat 0 10000]
+test expr-old-41.8 {max math function} -body {
+    expr {max(0, "a")}
+} -returnCodes error -match glob -result *
 
 # Special test for Pentium arithmetic bug of 1994:
 
-- 
cgit v0.12


From b946ce971fbde11b9739fc0b77237ed382e24bd0 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Nov 2017 08:58:39 +0000
Subject: Fix [e058307eef73cf21cf6805ad7c778e1024f9eb7d|e058307eef]: Use of
 values.h breaks build of Tk trunk on macOS

---
 unix/configure      | 10 ----------
 unix/tcl.m4         |  2 --
 unix/tclConfig.h.in |  3 ---
 unix/tclUnixPort.h  |  3 ---
 4 files changed, 18 deletions(-)

diff --git a/unix/configure b/unix/configure
index 51d694f..90116c8 100755
--- a/unix/configure
+++ b/unix/configure
@@ -3733,16 +3733,6 @@ $as_echo "#define NO_DIRENT_H 1" >>confdefs.h
 
     fi
 
-    ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default"
-if test "x$ac_cv_header_values_h" = xyes; then :
-
-else
-
-$as_echo "#define NO_VALUES_H 1" >>confdefs.h
-
-fi
-
-
     ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default"
 if test "x$ac_cv_header_stdlib_h" = xyes; then :
   tcl_ok=1
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 9aa3eb2..51459c9 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -2040,7 +2040,6 @@ dnl # preprocessing tests use only CPPFLAGS.
 #
 #	Defines some of the following vars:
 #		NO_DIRENT_H
-#		NO_VALUES_H
 #		NO_STDLIB_H
 #		NO_STRING_H
 #		NO_SYS_WAIT_H
@@ -2078,7 +2077,6 @@ closedir(d);
 	AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
     fi
 
-    AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.h>?])])
     AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
     AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
     AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index 28ce012..4902083 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -331,9 +331,6 @@
 /* Do we have a usable 'union wait'? */
 #undef NO_UNION_WAIT
 
-/* Do we have <values.h>? */
-#undef NO_VALUES_H
-
 /* Do we have wait3() */
 #undef NO_WAIT3
 
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 8b766d6..d464f05 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -182,9 +182,6 @@ extern int TclUnixSetBlockingMode(int fd, int mode);
  */
 
 #include <float.h>
-#ifndef NO_VALUES_H
-#   include <values.h>
-#endif
 
 #ifndef FLT_MAX
 #   ifdef MAXFLOAT
-- 
cgit v0.12


From bc3e198cba9e40c015a6acfa992c69434274dde6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Nov 2017 10:15:59 +0000
Subject: Fix error-message for min/math functions: "to" -> "for", for
 consistancy with the error-messages for other math functions.

---
 library/init.tcl    |  4 ++--
 tests/expr-old.test | 20 ++++++++++++++++----
 2 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/library/init.tcl b/library/init.tcl
index 87d9f14..13a4300 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -79,7 +79,7 @@ namespace eval tcl {
 	proc min {args} {
 	    if {![llength $args]} {
 		return -code error \
-		    "too few arguments to math function \"min\""
+		    "too few arguments for math function \"min\""
 	    }
 	    set val Inf
 	    foreach arg $args {
@@ -95,7 +95,7 @@ namespace eval tcl {
 	proc max {args} {
 	    if {![llength $args]} {
 		return -code error \
-		    "too few arguments to math function \"max\""
+		    "too few arguments for math function \"max\""
 	    }
 	    set val -Inf
 	    foreach arg $args {
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 3adfb63..8c159b2 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -1159,8 +1159,8 @@ test expr-old-40.2 {min math function} -body {
     expr {min(0.0)}
 } -result 0.0
 test expr-old-40.3 {min math function} -body {
-    list [catch {expr {min()}} msg] $msg
-} -result {1 {too few arguments to math function "min"}}
+    expr {min()}
+} -returnCodes error -result {too few arguments for math function "min"}
 test expr-old-40.4 {min math function} -body {
     expr {min(wide(-1) << 30, 4.5, -10)}
 } -result [expr {wide(-1) << 30}]
@@ -1170,6 +1170,12 @@ test expr-old-40.5 {min math function} -body {
 test expr-old-40.6 {min math function} -body {
     expr {min(300, "0xFF")}
 } -result 255
+test expr-old-40.7 {min math function} -body {
+    expr min(1[string repeat 0 10000], 1e300)
+} -result 1e+300
+test expr-old-40.8 {min math function} -body {
+    expr {min(0, "a")}
+} -returnCodes error -match glob -result *
 
 test expr-old-41.1 {max math function} -body {
     expr {max(0)}
@@ -1178,8 +1184,8 @@ test expr-old-41.2 {max math function} -body {
     expr {max(0.0)}
 } -result 0.0
 test expr-old-41.3 {max math function} -body {
-    list [catch {expr {max()}} msg] $msg
-} -result {1 {too few arguments to math function "max"}}
+    expr {max()}
+} -returnCodes error -result {too few arguments for math function "max"}
 test expr-old-41.4 {max math function} -body {
     expr {max(wide(1) << 30, 4.5, -10)}
 } -result [expr {wide(1) << 30}]
@@ -1189,6 +1195,12 @@ test expr-old-41.5 {max math function} -body {
 test expr-old-41.6 {max math function} -body {
     expr {max(200, "0xFF")}
 } -result 255
+test expr-old-41.7 {max math function} -body {
+    expr max(1[string repeat 0 10000], 1e300)
+} -result 1[string repeat 0 10000]
+test expr-old-41.8 {max math function} -body {
+    expr {max(0, "a")}
+} -returnCodes error -match glob -result *
 
 # Special test for Pentium arithmetic bug of 1994:
 
-- 
cgit v0.12


From a1bc5b8a2b3fbc46b0207124137c9b2a5a8cced1 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Nov 2017 12:07:08 +0000
Subject: If Tcl is compiled with -DTCL_NO_DEPRECATED, remove a lot of
 (internal) stub entries which correspond to functions which will be removed
 in Tcl 9. This commit should have been part of [7849f573c0e7d758|this]
 earlier commit. No effect when Tcl is not compiled with -DTCL_NO_DEPRECATED.

---
 generic/tclIO.c       |   2 +
 generic/tclInt.decls  |  28 +++----
 generic/tclIntDecls.h | 200 +++++++++++++++++++-------------------------------
 generic/tclStubInit.c |  67 ++++++++++++-----
 unix/tclUnixThrd.c    |   2 +
 5 files changed, 143 insertions(+), 156 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index df04794..81fd298 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -9032,6 +9032,7 @@ ZeroTransferTimerProc(
  *----------------------------------------------------------------------
  */
 
+#if !defined(TCL_NO_DEPRECATED)
 int
 TclCopyChannelOld(
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -9043,6 +9044,7 @@ TclCopyChannelOld(
     return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
             cmdPtr);
 }
+#endif
 
 int
 TclCopyChannel(
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index b683a29..33bf0b3 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -453,26 +453,26 @@ declare 111 {
 	    Tcl_ResolveCompiledVarProc *compiledVarProc)
 }
 declare 112 {
-    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+    int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 	    Tcl_Obj *objPtr)
 }
 declare 113 {
-    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
+    Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
 	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
 }
 declare 114 {
-    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
+    void TclDeleteNamespace(Tcl_Namespace *nsPtr)
 }
 declare 115 {
-    int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+    int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 	    const char *pattern, int resetListFirst)
 }
 declare 116 {
-    Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+    Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
 	    Tcl_Namespace *contextNsPtr, int flags)
 }
 declare 117 {
-    Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
+    Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name,
 	    Tcl_Namespace *contextNsPtr, int flags)
 }
 declare 118 {
@@ -488,28 +488,28 @@ declare 120 {
 	    Tcl_Namespace *contextNsPtr, int flags)
 }
 declare 121 {
-    int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+    int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 	    const char *pattern)
 }
 declare 122 {
-    Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+    Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
 }
 declare 123 {
-    void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
+    void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
 	    Tcl_Obj *objPtr)
 }
 declare 124 {
-    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
+    Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
 }
 declare 125 {
-    Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
+    Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
 }
 declare 126 {
     void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
 	    Tcl_Obj *objPtr)
 }
 declare 127 {
-    int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+    int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 	    const char *pattern, int allowOverwrite)
 }
 declare 128 {
@@ -724,10 +724,10 @@ declare 177 {
 	    const char *operation, const char *reason)
 }
 declare 178 {
-    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
+    void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
 }
 declare 179 {
-    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
+    Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
 }
 
 # REMOVED
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 4244362..22b8072 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -28,22 +28,6 @@
 #   endif
 #endif
 
-/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
-#undef Tcl_CreateNamespace
-#undef Tcl_DeleteNamespace
-#undef Tcl_AppendExportList
-#undef Tcl_Export
-#undef Tcl_Import
-#undef Tcl_ForgetImport
-#undef Tcl_GetCurrentNamespace
-#undef Tcl_GetGlobalNamespace
-#undef Tcl_FindNamespace
-#undef Tcl_FindCommand
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
-#undef Tcl_SetStartupScript
-#undef Tcl_GetStartupScript
-
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
  * script.  Any modifications to the function declarations below should be made
@@ -287,22 +271,22 @@ EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
 				Tcl_ResolveVarProc *varProc,
 				Tcl_ResolveCompiledVarProc *compiledVarProc);
 /* 112 */
-EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
+EXTERN int		TclAppendExportList(Tcl_Interp *interp,
 				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
 /* 113 */
-EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
+EXTERN Tcl_Namespace *	TclCreateNamespace(Tcl_Interp *interp,
 				const char *name, ClientData clientData,
 				Tcl_NamespaceDeleteProc *deleteProc);
 /* 114 */
-EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
+EXTERN void		TclDeleteNamespace(Tcl_Namespace *nsPtr);
 /* 115 */
-EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+EXTERN int		TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 				const char *pattern, int resetListFirst);
 /* 116 */
-EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+EXTERN Tcl_Command	TclFindCommand(Tcl_Interp *interp, const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
 /* 117 */
-EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
+EXTERN Tcl_Namespace *	TclFindNamespace(Tcl_Interp *interp,
 				const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
 /* 118 */
@@ -317,23 +301,23 @@ EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
 				const char *name,
 				Tcl_Namespace *contextNsPtr, int flags);
 /* 121 */
-EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
+EXTERN int		TclForgetImport(Tcl_Interp *interp,
 				Tcl_Namespace *nsPtr, const char *pattern);
 /* 122 */
-EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
+EXTERN Tcl_Command	TclGetCommandFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 123 */
-EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
+EXTERN void		TclGetCommandFullName(Tcl_Interp *interp,
 				Tcl_Command command, Tcl_Obj *objPtr);
 /* 124 */
-EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
+EXTERN Tcl_Namespace *	TclGetCurrentNamespace_(Tcl_Interp *interp);
 /* 125 */
-EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
+EXTERN Tcl_Namespace *	TclGetGlobalNamespace_(Tcl_Interp *interp);
 /* 126 */
 EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
 				Tcl_Var variable, Tcl_Obj *objPtr);
 /* 127 */
-EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+EXTERN int		TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 				const char *pattern, int allowOverwrite);
 /* 128 */
 EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
@@ -465,10 +449,10 @@ EXTERN void		TclVarErrMsg(Tcl_Interp *interp, const char *part1,
 				const char *part2, const char *operation,
 				const char *reason);
 /* 178 */
-EXTERN void		Tcl_SetStartupScript(Tcl_Obj *pathPtr,
+EXTERN void		TclSetStartupScript(Tcl_Obj *pathPtr,
 				const char *encodingName);
 /* 179 */
-EXTERN Tcl_Obj *	Tcl_GetStartupScript(const char **encodingNamePtr);
+EXTERN Tcl_Obj *	TclGetStartupScript(const char **encodingNamePtr);
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
 /* 182 */
@@ -767,22 +751,22 @@ typedef struct TclIntStubs {
     int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
     int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
     void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
-    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
-    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
-    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
-    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
-    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
-    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
+    int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
+    Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
+    void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
+    int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
+    Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
+    Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
     int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
     int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
     Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
-    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
-    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
-    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
-    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
-    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
+    int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
+    Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
+    void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
+    Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
+    Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
     void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
-    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
+    int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
     void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
     int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
     int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
@@ -833,8 +817,8 @@ typedef struct TclIntStubs {
     int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
     void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
     void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
-    void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
-    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
+    void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
+    Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
     void (*reserved180)(void);
     void (*reserved181)(void);
     TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
@@ -1099,38 +1083,38 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
 #define Tcl_AddInterpResolvers \
 	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
-#define Tcl_AppendExportList \
-	(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
-#define Tcl_CreateNamespace \
-	(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
-#define Tcl_DeleteNamespace \
-	(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
-#define Tcl_Export \
-	(tclIntStubsPtr->tcl_Export) /* 115 */
-#define Tcl_FindCommand \
-	(tclIntStubsPtr->tcl_FindCommand) /* 116 */
-#define Tcl_FindNamespace \
-	(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
+#define TclAppendExportList \
+	(tclIntStubsPtr->tclAppendExportList) /* 112 */
+#define TclCreateNamespace \
+	(tclIntStubsPtr->tclCreateNamespace) /* 113 */
+#define TclDeleteNamespace \
+	(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
+#define TclExport \
+	(tclIntStubsPtr->tclExport) /* 115 */
+#define TclFindCommand \
+	(tclIntStubsPtr->tclFindCommand) /* 116 */
+#define TclFindNamespace \
+	(tclIntStubsPtr->tclFindNamespace) /* 117 */
 #define Tcl_GetInterpResolvers \
 	(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
 #define Tcl_GetNamespaceResolvers \
 	(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
 #define Tcl_FindNamespaceVar \
 	(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
-#define Tcl_ForgetImport \
-	(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
-#define Tcl_GetCommandFromObj \
-	(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
-#define Tcl_GetCommandFullName \
-	(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
-#define Tcl_GetCurrentNamespace \
-	(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
-#define Tcl_GetGlobalNamespace \
-	(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
+#define TclForgetImport \
+	(tclIntStubsPtr->tclForgetImport) /* 121 */
+#define TclGetCommandFromObj \
+	(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
+#define TclGetCommandFullName \
+	(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
+#define TclGetCurrentNamespace_ \
+	(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
+#define TclGetGlobalNamespace_ \
+	(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
 #define Tcl_GetVariableFullName \
 	(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
-#define Tcl_Import \
-	(tclIntStubsPtr->tcl_Import) /* 127 */
+#define TclImport \
+	(tclIntStubsPtr->tclImport) /* 127 */
 #define Tcl_PopCallFrame \
 	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
 #define Tcl_PushCallFrame \
@@ -1221,10 +1205,10 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclCleanupVar) /* 176 */
 #define TclVarErrMsg \
 	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
-#define Tcl_SetStartupScript \
-	(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
-#define Tcl_GetStartupScript \
-	(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
+#define TclSetStartupScript \
+	(tclIntStubsPtr->tclSetStartupScript) /* 178 */
+#define TclGetStartupScript \
+	(tclIntStubsPtr->tclGetStartupScript) /* 179 */
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
 #define TclpLocaltime \
@@ -1361,58 +1345,28 @@ extern const TclIntStubs *tclIntStubsPtr;
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT
 
-#undef TclGetStartupScriptFileName
-#undef TclSetStartupScriptFileName
-#undef TclGetStartupScriptPath
-#undef TclSetStartupScriptPath
-#undef TclBackgroundException
-
 #if defined(USE_TCL_STUBS)
-#   undef Tcl_SetStartupScript
-#   define Tcl_SetStartupScript \
-	    (tclStubsPtr->tcl_SetStartupScript) /* 622 */
-#   undef Tcl_GetStartupScript
-#   define Tcl_GetStartupScript \
-	    (tclStubsPtr->tcl_GetStartupScript) /* 623 */
-#   undef Tcl_CreateNamespace
-#   define Tcl_CreateNamespace \
-	   (tclStubsPtr->tcl_CreateNamespace) /* 506 */
-#   undef Tcl_DeleteNamespace
-#   define Tcl_DeleteNamespace \
-	   (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
-#   undef Tcl_AppendExportList
-#   define Tcl_AppendExportList \
-	   (tclStubsPtr->tcl_AppendExportList) /* 508 */
-#   undef Tcl_Export
-#   define Tcl_Export \
-	   (tclStubsPtr->tcl_Export) /* 509 */
-#   undef Tcl_Import
-#   define Tcl_Import \
-	   (tclStubsPtr->tcl_Import) /* 510 */
-#   undef Tcl_ForgetImport
-#   define Tcl_ForgetImport \
-	   (tclStubsPtr->tcl_ForgetImport) /* 511 */
-#   undef Tcl_GetCurrentNamespace
-#   define Tcl_GetCurrentNamespace \
-	   (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
-#   undef Tcl_GetGlobalNamespace
-#   define Tcl_GetGlobalNamespace \
-	   (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
-#   undef Tcl_FindNamespace
-#   define Tcl_FindNamespace \
-	   (tclStubsPtr->tcl_FindNamespace) /* 514 */
-#   undef Tcl_FindCommand
-#   define Tcl_FindCommand \
-	   (tclStubsPtr->tcl_FindCommand) /* 515 */
-#   undef Tcl_GetCommandFromObj
-#   define Tcl_GetCommandFromObj \
-	   (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
-#   undef Tcl_GetCommandFullName
-#   define Tcl_GetCommandFullName \
-	   (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#   undef TclGetStartupScriptFileName
+#   undef TclSetStartupScriptFileName
+#   undef TclGetStartupScriptPath
+#   undef TclSetStartupScriptPath
+#   undef TclBackgroundException
+#   undef TclSetStartupScript
+#   undef TclGetStartupScript
+#   undef TclCreateNamespace
+#   undef TclDeleteNamespace
+#   undef TclAppendExportList
+#   undef TclExport
+#   undef TclImport
+#   undef TclForgetImport
+#   undef TclGetCurrentNamespace_
+#   undef TclGetGlobalNamespace_
+#   undef TclFindNamespace
+#   undef TclFindCommand
+#   undef TclGetCommandFromObj
+#   undef TclGetCommandFullName
+#   undef TclCopyChannelOld
+#   undef TclSockMinimumBuffersOld
 #endif
 
-#undef TclCopyChannelOld
-#undef TclSockMinimumBuffersOld
-
 #endif /* _TCLINTDECLS */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 24b28e5..d2de021 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -72,11 +72,6 @@ static int TclSockMinimumBuffersOld(int sock, int size)
 #   define TclBNInitBignumFromWideUInt 0
 #   define TclBNInitBignumFromWideInt 0
 #   define TclBNInitBignumFromLong 0
-#   define Tcl_AppendResultVA 0
-#   define Tcl_AppendStringsToObjVA 0
-#   define Tcl_SetErrorCodeVA 0
-#   define Tcl_PanicVA 0
-#   define Tcl_VarEvalVA 0
 #else
 #define TclSetStartupScriptPath setStartupScriptPath
 static void TclSetStartupScriptPath(Tcl_Obj *path)
@@ -371,6 +366,26 @@ static int formatInt(char *buffer, int n){
 #   define TclBackgroundException 0
 #   undef TclpReaddir
 #   define TclpReaddir 0
+#   define TclSetStartupScript 0
+#   define TclGetStartupScript 0
+#   define TclCreateNamespace 0
+#   define TclDeleteNamespace 0
+#   define TclAppendExportList 0
+#   define TclExport 0
+#   define TclImport 0
+#   define TclForgetImport 0
+#   define TclGetCurrentNamespace_ 0
+#   define TclGetGlobalNamespace_ 0
+#   define TclFindNamespace 0
+#   define TclFindCommand 0
+#   define TclGetCommandFromObj 0
+#   define TclGetCommandFullName 0
+#   define TclCopyChannelOld 0
+#   define Tcl_AppendResultVA 0
+#   define Tcl_AppendStringsToObjVA 0
+#   define Tcl_SetErrorCodeVA 0
+#   define Tcl_PanicVA 0
+#   define Tcl_VarEvalVA 0
 #   undef TclpGetDate
 #   define TclpGetDate 0
 #   undef TclpLocaltime
@@ -383,6 +398,20 @@ static int formatInt(char *buffer, int n){
 #   define Tcl_SeekOld seekOld
 #   define Tcl_TellOld tellOld
 #   define TclBackgroundException Tcl_BackgroundException
+#   define TclSetStartupScript Tcl_SetStartupScript
+#   define TclGetStartupScript Tcl_GetStartupScript
+#   define TclCreateNamespace Tcl_CreateNamespace
+#   define TclDeleteNamespace Tcl_DeleteNamespace
+#   define TclAppendExportList Tcl_AppendExportList
+#   define TclExport Tcl_Export
+#   define TclImport Tcl_Import
+#   define TclForgetImport Tcl_ForgetImport
+#   define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
+#   define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
+#   define TclFindNamespace Tcl_FindNamespace
+#   define TclFindCommand Tcl_FindCommand
+#   define TclGetCommandFromObj Tcl_GetCommandFromObj
+#   define TclGetCommandFullName Tcl_GetCommandFullName
 #   define TclpLocaltime_unix TclpLocaltime
 #   define TclpGmtime_unix TclpGmtime
 
@@ -535,22 +564,22 @@ static const TclIntStubs tclIntStubs = {
     TclUpdateReturnInfo, /* 109 */
     TclSockMinimumBuffers, /* 110 */
     Tcl_AddInterpResolvers, /* 111 */
-    Tcl_AppendExportList, /* 112 */
-    Tcl_CreateNamespace, /* 113 */
-    Tcl_DeleteNamespace, /* 114 */
-    Tcl_Export, /* 115 */
-    Tcl_FindCommand, /* 116 */
-    Tcl_FindNamespace, /* 117 */
+    TclAppendExportList, /* 112 */
+    TclCreateNamespace, /* 113 */
+    TclDeleteNamespace, /* 114 */
+    TclExport, /* 115 */
+    TclFindCommand, /* 116 */
+    TclFindNamespace, /* 117 */
     Tcl_GetInterpResolvers, /* 118 */
     Tcl_GetNamespaceResolvers, /* 119 */
     Tcl_FindNamespaceVar, /* 120 */
-    Tcl_ForgetImport, /* 121 */
-    Tcl_GetCommandFromObj, /* 122 */
-    Tcl_GetCommandFullName, /* 123 */
-    Tcl_GetCurrentNamespace, /* 124 */
-    Tcl_GetGlobalNamespace, /* 125 */
+    TclForgetImport, /* 121 */
+    TclGetCommandFromObj, /* 122 */
+    TclGetCommandFullName, /* 123 */
+    TclGetCurrentNamespace_, /* 124 */
+    TclGetGlobalNamespace_, /* 125 */
     Tcl_GetVariableFullName, /* 126 */
-    Tcl_Import, /* 127 */
+    TclImport, /* 127 */
     Tcl_PopCallFrame, /* 128 */
     Tcl_PushCallFrame, /* 129 */
     Tcl_RemoveInterpResolvers, /* 130 */
@@ -601,8 +630,8 @@ static const TclIntStubs tclIntStubs = {
     TclCallVarTraces, /* 175 */
     TclCleanupVar, /* 176 */
     TclVarErrMsg, /* 177 */
-    Tcl_SetStartupScript, /* 178 */
-    Tcl_GetStartupScript, /* 179 */
+    TclSetStartupScript, /* 178 */
+    TclGetStartupScript, /* 179 */
     0, /* 180 */
     0, /* 181 */
     TclpLocaltime, /* 182 */
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index f475aed..6fa837c 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -15,11 +15,13 @@
 
 #ifdef TCL_THREADS
 
+#ifndef TCL_NO_DEPRECATED
 typedef struct {
     char nabuf[16];
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
+#endif
 
 /*
  * masterLock is used to serialize creation of mutexes, condition variables,
-- 
cgit v0.12


From 9b1ecce298fc120bc981d5182cc9c45bcfb0971d Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Thu, 23 Nov 2017 18:24:09 +0000
Subject: Move return type to its own line.

---
 generic/tclBasic.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2acd2e7..2f05425 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2285,7 +2285,8 @@ Tcl_CreateObjCommand(
 	proc, clientData, deleteProc);
 }
 
-Tcl_Command TclCreateObjCommandInNs (
+Tcl_Command
+TclCreateObjCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,	/* Name of command, without any namespace components */
     Tcl_Namespace *namespace,   /* The namespace to create the command in */
@@ -8210,7 +8211,8 @@ Tcl_NRCreateCommand(
     return (Tcl_Command) cmdPtr;
 }
 
-Tcl_Command TclNRCreateCommandInNs (
+Tcl_Command
+TclNRCreateCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,
     Tcl_Namespace *nsPtr,
-- 
cgit v0.12


From 48fb6e2c88c4b6966e52e0a8d34274e91eef47f3 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 25 Nov 2017 16:36:22 +0000
Subject: Fix for issue [4f6a1ebd64]: ensemble: segmentation fault when
 -subcommand and -map values are the same object.

---
 generic/tclEnsemble.c | 14 +++++++++++++-
 tests/namespace.test  | 18 +++++++++++++++++-
 2 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index f3e8187..392f430 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2505,6 +2505,7 @@ BuildEnsembleConfig(
     int i, j, isNew;
     Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
     Tcl_HashEntry *hPtr;
+    Tcl_Obj *subcmdDictCopy = NULL ;
 
     if (hash->numEntries != 0) {
 	/*
@@ -2553,7 +2554,15 @@ BuildEnsembleConfig(
 	     */
 
 	    if (ensemblePtr->subcommandDict != NULL) {
-		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
+		if (subcmdDictCopy == NULL) {
+		    if (ensemblePtr->subcmdList == ensemblePtr->subcommandDict) {
+			subcmdDictCopy = Tcl_DuplicateObj(ensemblePtr->subcommandDict);
+		    } else {
+			subcmdDictCopy = ensemblePtr->subcommandDict; 
+		    }
+		    Tcl_IncrRefCount(subcmdDictCopy);
+		}
+		Tcl_DictObjGet(NULL, subcmdDictCopy, subcmdv[i],
 			&target);
 		if (target != NULL) {
 		    Tcl_SetHashValue(hPtr, target);
@@ -2578,6 +2587,9 @@ BuildEnsembleConfig(
 	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
 	    Tcl_IncrRefCount(cmdPrefixObj);
 	}
+	if (subcmdDictCopy != NULL) {
+	    Tcl_DecrRefCount(subcmdDictCopy);
+	}
     } else if (ensemblePtr->subcommandDict != NULL) {
 	/*
 	 * No subcmd list, but we do have a mapping dictionary so we should
diff --git a/tests/namespace.test b/tests/namespace.test
index f6f817b..623f06d 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1785,7 +1785,10 @@ test namespace-42.7 {ensembles: nested} -body {
 } -cleanup {
     namespace delete ns
 } -result {{1 ::ns::x0::z} 1 2 3}
-test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
+test namespace-42.8 {
+    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
+    struct.
+} -setup {
     proc demo args {}
     variable target [list [namespace which demo] x]
     proc trial args {variable target; string length $target}
@@ -1800,6 +1803,19 @@ test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
     rename foo {}
 } -result {}
 
+test namespace-42.9 {
+    ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a
+    deallocated List struct.
+} -setup {
+    namespace eval n {namespace ensemble create}
+    dict set list one ::two
+    namespace ensemble configure n -subcommands $list -map $list
+} -body {
+    n one
+} -cleanup {
+    namespace delete n
+} -returnCodes error -match glob -result {invalid command name*}
+
 test namespace-43.1 {ensembles: dict-driven} {
     namespace eval ns {
 	namespace export x*
-- 
cgit v0.12


From 811ec68434e9a83c37f1a0fd3ef0a8cae5baac91 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 25 Nov 2017 18:24:10 +0000
Subject: Add missing parenthesis to an expression in TclEnsureNamespace.

---
 generic/tclNamesp.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index e7914ad..d661856 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -2444,7 +2444,7 @@ TclEnsureNamespace(
     Tcl_Namespace *namespacePtr)
 {
     Namespace *nsPtr = (Namespace *) namespacePtr;
-    if (!nsPtr->flags & NS_DYING) {
+    if (!(nsPtr->flags & NS_DYING)) {
 	    return namespacePtr;
     }
     return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
-- 
cgit v0.12


From 20dedcd841ef5caf05a104ccd36929080f8a5645 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 27 Nov 2017 13:52:18 +0000
Subject: Fix test-cases in safe.test, failing due to changes in min/max math
 functions.

---
 generic/tclInterp.c | 4 ----
 tests/safe.test     | 2 +-
 2 files changed, 1 insertion(+), 5 deletions(-)

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index d9dfd37..d4bf465 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -3208,10 +3208,6 @@ Tcl_MakeSafe(
 
 	(void) Tcl_EvalEx(interp,
 		"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
-	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
-		"::tcl::mathfunc::min", 0, NULL);
-	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
-		"::tcl::mathfunc::max", 0, NULL);
     }
 
     iPtr->flags |= SAFE_INTERP;
diff --git a/tests/safe.test b/tests/safe.test
index e43ce12..33ee166 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -74,7 +74,7 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -s
     lsort [a aliases]
 } -cleanup {
     interp delete a
-} -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock}
+} -result {clock}
 
 test safe-3.1 {calling safe::interpInit is safe} -setup {
     catch {safe::interpDelete a}
-- 
cgit v0.12


From d95ab0247a35a1a40f5e39186127a9f6ba4540a9 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 27 Nov 2017 14:11:16 +0000
Subject: missed some more failing test-cases

---
 tests/interp.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/interp.test b/tests/interp.test
index 1389304..4ea04e3 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -1847,7 +1847,7 @@ test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
     lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
 } -cleanup {
     interp delete a
-} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds]
+} -result [list $hidden_cmds {bar clock} $hidden_cmds {bar clock} [lsort [concat $hidden_cmds bar]] {clock} $hidden_cmds]
 
 test interp-24.1 {result resetting on error} -setup {
     catch {interp delete a}
-- 
cgit v0.12


From 293016951704770ca48af42b926e4fada4e2054a Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 27 Nov 2017 19:45:40 +0000
Subject: Streamline TclOO object cleanup routines.

---
 generic/tclOO.c    | 484 ++++++++++++++++++++++-------------------------------
 generic/tclOOInt.h |   4 +
 2 files changed, 208 insertions(+), 280 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 7feeb5d..3fece42 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -4,6 +4,7 @@
  *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
  *
  * Copyright (c) 2005-2012 by Donal K. Fellows
+ * Copyright (c) 2017 by Nathan Coulter
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -82,7 +83,6 @@ static void		ObjectRenamedTrace(ClientData clientData,
 			    const char *newName, int flags);
 static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
 static inline void	SquelchCachedName(Object *oPtr);
-static void		SquelchedNsFirst(ClientData clientData);
 
 static int		PublicObjectCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
@@ -583,8 +583,7 @@ AllocObject(
      */
 
     if (nsNameStr != NULL) {
-	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr,
-		ObjectNamespaceDeleted);
+	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL);
 	if (oPtr->namespacePtr != NULL) {
 	    creationEpoch = ++fPtr->tsdPtr->nsCount;
 	    goto configNamespace;
@@ -596,8 +595,7 @@ AllocObject(
 	char objName[10 + TCL_INTEGER_SPACE];
 
 	sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
-	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr,
-		ObjectNamespaceDeleted);
+	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
 	if (oPtr->namespacePtr != NULL) {
 	    creationEpoch = fPtr->tsdPtr->nsCount;
 	    break;
@@ -637,7 +635,7 @@ AllocObject(
      * access variables in it. [Bug 2950259]
      */
 
-    ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = SquelchedNsFirst;
+    ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = ObjectNamespaceDeleted;
 
     /*
      * Fill in the rest of the non-zero/NULL parts of the structure.
@@ -752,30 +750,6 @@ MyDeleted(
 /*
  * ----------------------------------------------------------------------
  *
- * SquelchedNsFirst --
- *
- *	This callback is triggered when the object's namespace is deleted by
- *	any mechanism. It deletes the object's public command if it has not
- *	already been deleted, so ensuring that destructors get run at an
- *	appropriate time. [Bug 2950259]
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-SquelchedNsFirst(
-    ClientData clientData)
-{
-    Object *oPtr = clientData;
-
-    if (oPtr->command) {
-	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
  * ObjectRenamedTrace --
  *
  *	This callback is triggered when the object is deleted by any
@@ -795,8 +769,6 @@ ObjectRenamedTrace(
     int flags)			/* Why was the object deleted? */
 {
     Object *oPtr = clientData;
-    Foundation *fPtr = oPtr->fPtr;
-
     /*
      * If this is a rename and not a delete of the object, we just flush the
      * cache of the object name.
@@ -808,87 +780,35 @@ ObjectRenamedTrace(
     }
 
     /*
-     * Oh dear, the object really is being deleted. Handle this by running the
-     * destructors and deleting the object's namespace, which in turn causes
-     * the real object structures to be deleted.
-     *
-     * Note that it is possible for the namespace to be deleted before the
-     * command. Because of that case, we must take care here to mark the
-     * command as being deleted so that if we return here we don't run into
-     * reentrancy problems.
-     *
-     * We also do not run destructors on the core class objects when the
-     * interpreter is being deleted; their incestuous nature causes problems
-     * in that case when the destructor is partially deleted before the uses
-     * of it have gone. [Bug 2949397]
-     */
-
-    AddRef(oPtr);
-    AddRef(fPtr->classCls);
-    AddRef(fPtr->objectCls);
-    AddRef(fPtr->classCls->thisPtr);
-    AddRef(fPtr->objectCls->thisPtr);
-    oPtr->command = NULL;
-
-    if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {
-	CallContext *contextPtr =
-		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
-	int result;
-	Tcl_InterpState state;
-
-	oPtr->flags |= DESTRUCTOR_CALLED;
-	if (contextPtr != NULL) {
-	    contextPtr->callPtr->flags |= DESTRUCTOR;
-	    contextPtr->skip = 0;
-	    state = Tcl_SaveInterpState(interp, TCL_OK);
-	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
-		    contextPtr, 0, NULL);
-	    if (result != TCL_OK) {
-		Tcl_BackgroundException(interp, result);
-	    }
-	    Tcl_RestoreInterpState(interp, state);
-	    TclOODeleteContext(contextPtr);
-	}
-    }
-
-    /*
-     * OK, the destructor's been run. Time to splat the class data (if any)
-     * and nuke the namespace (which triggers the final crushing of the object
-     * structure itself).
-     *
-     * The class of objects needs some special care; if it is deleted (and
-     * we're not killing the whole interpreter) we force the delete of the
-     * class of classes now as well. Due to the incestuous nature of those two
-     * classes, if one goes the other must too and yet the tangle can
-     * sometimes not go away automatically; we force it here. [Bug 2962664]
-     */
-
-    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
-	    && !Deleted(fPtr->classCls->thisPtr)) {
-	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
-    }
-
-    if (oPtr->classPtr != NULL) {
-	AddRef(oPtr->classPtr);
-	ReleaseClassContents(interp, oPtr);
-    }
-
-    /*
      * The namespace is only deleted if it hasn't already been deleted. [Bug
-     * 2950259]
+     * 2950259]. If the namespace has already been deleted, then
+     * ObjectNamespaceDeleted() has already cleaned up this command.
      */
 
-    if (oPtr->namespacePtr && ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
-	Tcl_DeleteNamespace(oPtr->namespacePtr);
-    }
-    if (oPtr->classPtr) {
-	DelRef(oPtr->classPtr);
+    if (oPtr->namespacePtr == NULL) {
+	/*
+	 * ObjectNamespaceDeleted() has already done all the cleanup, but
+	 * detected that the command was in the process of being deleted, and
+	 * left the pointer allocated for us.
+	 */
+	DelRef(oPtr);
+    } else {
+	if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc == NULL) {
+	    /*
+	     * ObjectNamespaceDeleted() called us, and still has some work to
+	     * do, so we leave the pointer allocated for it to finish, and then
+	     * it will deallocate the pointer.
+	     */
+	} else {
+	    Tcl_DeleteNamespace(oPtr->namespacePtr);
+	    /*
+	     * ObjectNamespaceDeleted() doesn't know it was us that just
+	     * called, so it left the pointer allocated.
+	     */
+	    DelRef(oPtr);
+	}
     }
-    DelRef(fPtr->classCls->thisPtr);
-    DelRef(fPtr->objectCls->thisPtr);
-    DelRef(fPtr->classCls);
-    DelRef(fPtr->objectCls);
-    DelRef(oPtr);
+    return;
 }
 
 /*
@@ -960,7 +880,9 @@ ReleaseClassContents(
     int i;
     Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr;
     Object *instancePtr;
+    Method *mPtr;
     Foundation *fPtr = oPtr->fPtr;
+    Tcl_Obj *variableObj;
 
     /*
      * Sanity check!
@@ -1151,6 +1073,26 @@ ReleaseClassContents(
 	ckfree(clsPtr->metadataPtr);
 	clsPtr->metadataPtr = NULL;
     }
+
+    ClearMixins(clsPtr);
+    ClearSuperclasses(clsPtr);
+
+    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
+	TclOODelMethodRef(mPtr);
+    }
+    Tcl_DeleteHashTable(&clsPtr->classMethods);
+    TclOODelMethodRef(clsPtr->constructorPtr);
+    TclOODelMethodRef(clsPtr->destructorPtr);
+
+    FOREACH(variableObj, clsPtr->variables) {
+	TclDecrRefCount(variableObj);
+    }
+    if (i) {
+	ckfree(clsPtr->variables.list);
+    }
+
+    DelRef(clsPtr);
+
 }
 
 /*
@@ -1172,36 +1114,92 @@ ObjectNamespaceDeleted(
 				 * being deleted. */
 {
     Object *oPtr = clientData;
+    Foundation *fPtr = oPtr->fPtr;
     FOREACH_HASH_DECLS;
-    Class *clsPtr = oPtr->classPtr, *mixinPtr;
+    Class *mixinPtr;
     Method *mPtr;
     Tcl_Obj *filterObj, *variableObj;
-    int deleteAlreadyInProgress = 0, i;
+    Tcl_Interp *interp = oPtr->fPtr->interp;
+    int finished = 0, i;
+
+
+    AddRef(fPtr->classCls);
+    AddRef(fPtr->objectCls);
+    AddRef(fPtr->classCls->thisPtr);
+    AddRef(fPtr->objectCls->thisPtr);
 
     /*
-     * Instruct everyone to no longer use any allocated fields of the object.
-     * Also delete the commands that refer to the object at this point (if
-     * they still exist) because otherwise their references to the object
-     * point into freed memory, allowing crashes.
+     * We do not run destructors on the core class objects when the
+     * interpreter is being deleted; their incestuous nature causes problems
+     * in that case when the destructor is partially deleted before the uses
+     * of it have gone. [Bug 2949397]
      */
 
-    if (oPtr->command) {
-	if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
-	    /*
-	     * Namespace deletion must have been triggered by a trace on command
-	     * deletion , meaning that ObjectRenamedTrace() is eventually going
-	     * to be called .
-	     */
-	    deleteAlreadyInProgress = 1;
+    if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {
+	CallContext *contextPtr =
+		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
+	int result;
+
+	Tcl_InterpState state;
+
+	oPtr->flags |= DESTRUCTOR_CALLED;
+	if (contextPtr != NULL) {
+	    contextPtr->callPtr->flags |= DESTRUCTOR;
+	    contextPtr->skip = 0;
+	    state = Tcl_SaveInterpState(interp, TCL_OK);
+	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
+		    contextPtr, 0, NULL);
+	    if (result != TCL_OK) {
+		Tcl_BackgroundException(interp, result);
+	    }
+	    Tcl_RestoreInterpState(interp, state);
+	    TclOODeleteContext(contextPtr);
 	}
+    }
 
+    /*
+     * Instruct everyone to no longer use any allocated fields of the object.
+     * Also delete the command that refers to the object at this point (if
+     * it still exists) because otherwise its pointer to the object
+     * points into freed memory.
+     */
+
+    if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
+	/*
+	 * Something has already started the command deletion process. We can
+	 * go ahead and clean up the the namespace,
+	 */
+    } else {
+	/*
+	 * The namespace must have been deleted directly.  Delete the command
+	 * as well.
+	 */
 	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
+	finished = 1;
     }
+    oPtr->command = NULL;
+
     if (oPtr->myCommand) {
 	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
     }
 
     /*
+     * The class of objects needs some special care; if it is deleted (and
+     * we're not killing the whole interpreter) we force the delete of the
+     * class of classes now as well. Due to the incestuous nature of those two
+     * classes, if one goes the other must too and yet the tangle can
+     * sometimes not go away automatically; we force it here. [Bug 2962664]
+     */
+    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
+	    && !Deleted(fPtr->classCls->thisPtr)) {
+	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
+    }
+
+    if (oPtr->classPtr != NULL) {
+	ReleaseClassContents(interp, oPtr);
+    }
+
+    /*
      * Splice the object out of its context. After this, we must *not* call
      * methods on the object.
      */
@@ -1260,77 +1258,27 @@ ObjectNamespaceDeleted(
     }
 
     /*
-     * If this was a class, there's additional deletion work to do.
-     */
-
-    if (clsPtr != NULL) {
-	Tcl_ObjectMetadataType *metadataTypePtr;
-	ClientData value;
-
-	if (clsPtr->metadataPtr != NULL) {
-	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
-		metadataTypePtr->deleteProc(value);
-	    }
-	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
-	    ckfree(clsPtr->metadataPtr);
-	    clsPtr->metadataPtr = NULL;
-	}
-
-	FOREACH(filterObj, clsPtr->filters) {
-	    TclDecrRefCount(filterObj);
-	}
-	if (i) {
-	    ckfree(clsPtr->filters.list);
-	    clsPtr->filters.num = 0;
-	}
-
-	ClearMixins(clsPtr);
-
-	ClearSuperclasses(clsPtr);
-
-	if (clsPtr->subclasses.list) {
-	    ckfree(clsPtr->subclasses.list);
-	    clsPtr->subclasses.list = NULL;
-	    clsPtr->subclasses.num = 0;
-	}
-	if (clsPtr->instances.list) {
-	    ckfree(clsPtr->instances.list);
-	    clsPtr->instances.list = NULL;
-	    clsPtr->instances.num = 0;
-	}
-	if (clsPtr->mixinSubs.list) {
-	    ckfree(clsPtr->mixinSubs.list);
-	    clsPtr->mixinSubs.list = NULL;
-	    clsPtr->mixinSubs.num = 0;
-	}
-
-	FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
-	    TclOODelMethodRef(mPtr);
-	}
-	Tcl_DeleteHashTable(&clsPtr->classMethods);
-	TclOODelMethodRef(clsPtr->constructorPtr);
-	TclOODelMethodRef(clsPtr->destructorPtr);
-
-	FOREACH(variableObj, clsPtr->variables) {
-	    TclDecrRefCount(variableObj);
-	}
-	if (i) {
-	    ckfree(clsPtr->variables.list);
-	}
-
-	DelRef(clsPtr);
-    }
-
-    /*
      * Delete the object structure itself.
      */
 
-    if (deleteAlreadyInProgress) {
-	oPtr->classPtr = NULL;
-	oPtr->namespacePtr = NULL;
-    } else {
+    oPtr->classPtr = NULL;
+    oPtr->namespacePtr = NULL;
+
+    DelRef(fPtr->classCls->thisPtr);
+    DelRef(fPtr->objectCls->thisPtr);
+    DelRef(fPtr->classCls);
+    DelRef(fPtr->objectCls);
+    if (finished) {
+	/*
+	 * ObjectRenamedTrace called us, and not the other way around.
+	 */
 	DelRef(oPtr);
+    } else {
+	/*
+	 * ObjectRenamedTrace will call DelRef(oPtr).
+	 */
     }
+    return;
 
 }
 
@@ -1424,7 +1372,7 @@ TclOOAddToInstances(
 void
 TclOORemoveFromSubclasses(
     Class *subPtr,		/* The subclass to remove. */
-    Class *superPtr)		/* The superclass to (possibly) remove the
+    Class *superPtr)		/* The superclass to possibly remove the
 				 * subclass reference from. */
 {
     int i;
@@ -1495,7 +1443,7 @@ TclOOAddToSubclasses(
 void
 TclOORemoveFromMixinSubs(
     Class *subPtr,		/* The subclass to remove. */
-    Class *superPtr)		/* The superclass to (possibly) remove the
+    Class *superPtr)		/* The superclass to possibly remove the
 				 * subclass reference from. */
 {
     int i;
@@ -1569,7 +1517,7 @@ AllocClass(
 				 * class. */
     Object *useThisObj)		/* Object that is to act as the class
 				 * representation, or NULL if a new object
-				 * (with automatic name) is to be used. */
+				 * with automatic name is to be used. */
 {
     Foundation *fPtr = GetFoundation(interp);
     Class *clsPtr = ckalloc(sizeof(Class));
@@ -1641,7 +1589,6 @@ AllocClass(
  *
  * ----------------------------------------------------------------------
  */
-
 Tcl_Object
 Tcl_NewObjectInstance(
     Tcl_Interp *interp,		/* Interpreter context. */
@@ -1658,54 +1605,14 @@ Tcl_NewObjectInstance(
 				 * constructor. */
 {
     register Class *classPtr = (Class *) cls;
-    Foundation *fPtr = GetFoundation(interp);
     Object *oPtr;
 
-    /*
-     * Check if we're going to create an object over an existing command;
-     * that's not allowed.
-     */
-
-    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
-	    TCL_NAMESPACE_ONLY)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't create object \"%s\": command already exists with"
-		" that name", nameStr));
-	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
-	return NULL;
-    }
-
-    /*
-     * Create the object.
-     */
-
-    oPtr = AllocObject(interp, nameStr, nsNameStr);
-    oPtr->selfCls = classPtr;
-    TclOOAddToInstances(oPtr, classPtr);
-
-    /*
-     * Check to see if we're really creating a class. If so, allocate the
-     * class structure as well.
-     */
-
-    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
-	/*
-	 * Is a class, so attach a class structure. Note that the AllocClass
-	 * function splices the structure into the object, so we don't have
-	 * to. Once that's done, we need to repatch the object to have the
-	 * right class since AllocClass interferes with that.
-	 */
-
-	AllocClass(interp, oPtr);
-	oPtr->selfCls = classPtr;
-	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
-    } else {
-	oPtr->classPtr = NULL;
-    }
+    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
+    if (oPtr == NULL) {return NULL;}
 
     /*
-     * Run constructors, except when objc < 0 (a special flag case used for
-     * object cloning only).
+     * Run constructors, except when objc < 0, which is a special flag case
+     * used for object cloning only.
      */
 
     if (objc >= 0) {
@@ -1733,9 +1640,8 @@ Tcl_NewObjectInstance(
 	    }
 
 	    /*
-	     * It's an error if the object was whacked in the constructor.
-	     * Force this if it isn't already an error (don't want to lose
-	     * errors by accident...) [Bug 2903011]
+	     * Ensure an error if the object was deleted in the constructor.
+	     * Don't want to lose errors by accident. [Bug 2903011]
 	     */
 
 	    if (result != TCL_ERROR && Deleted(oPtr)) {
@@ -1786,7 +1692,6 @@ TclNRNewObjectInstance(
 				 * successful allocation. */
 {
     register Class *classPtr = (Class *) cls;
-    Foundation *fPtr = GetFoundation(interp);
     CallContext *contextPtr;
     Tcl_InterpState state;
     Object *oPtr;
@@ -1796,45 +1701,8 @@ TclNRNewObjectInstance(
      */
     AddRef(classPtr);
 
-    /*
-     * Check if we're going to create an object over an existing command;
-     * that's not allowed.
-     */
-
-    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
-	    TCL_NAMESPACE_ONLY)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't create object \"%s\": command already exists with"
-		" that name", nameStr));
-	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Create the object.
-     */
-
-    oPtr = AllocObject(interp, nameStr, nsNameStr);
-    oPtr->selfCls = classPtr;
-    TclOOAddToInstances(oPtr, classPtr);
-
-    /*
-     * Check to see if we're really creating a class. If so, allocate the
-     * class structure as well.
-     */
-
-    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
-	/*
-	 * Is a class, so attach a class structure. Note that the AllocClass
-	 * function splices the structure into the object, so we don't have
-	 * to. Once that's done, we need to repatch the object to have the
-	 * right class since AllocClass interferes with that.
-	 */
-
-	AllocClass(interp, oPtr);
-	oPtr->selfCls = classPtr;
-	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
-    }
+    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
+    if (oPtr == NULL) {return TCL_ERROR;}
 
     /*
      * Run constructors, except when objc < 0 (a special flag case used for
@@ -1877,6 +1745,62 @@ TclNRNewObjectInstance(
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
 
+
+Object *
+TclNewObjectInstanceCommon(
+    Tcl_Interp *interp,
+    Class *classPtr,
+    const char *nameStr,
+    const char *nsNameStr)
+{
+    Foundation *fPtr = GetFoundation(interp);
+    Object *oPtr;
+
+    /*
+     * Disallow creation of an object over an existing command.
+     */
+
+    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
+	    TCL_NAMESPACE_ONLY)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create object \"%s\": command already exists with"
+		" that name", nameStr));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
+	return NULL;
+    }
+
+    /*
+     * Create the object.
+     */
+
+    oPtr = AllocObject(interp, nameStr, nsNameStr);
+    oPtr->selfCls = classPtr;
+    TclOOAddToInstances(oPtr, classPtr);
+
+    /*
+     * Check to see if we're really creating a class. If so, allocate the
+     * class structure as well.
+     */
+
+    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
+	/*
+	 * Is a class, so attach a class structure. Note that the AllocClass
+	 * function splices the structure into the object, so we don't have
+	 * to. Once that's done, we need to repatch the object to have the
+	 * right class since AllocClass interferes with that.
+	 */
+
+	AllocClass(interp, oPtr);
+	oPtr->selfCls = classPtr;
+	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
+    } else {
+	oPtr->classPtr = NULL;
+    }
+    return oPtr;
+}
+
+
+
 static int
 FinalizeAlloc(
     ClientData data[],
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 11ba698..83b4d58 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -495,6 +495,10 @@ MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
 			    const char *nsNameStr, int objc,
 			    Tcl_Obj *const *objv, int skip,
 			    Tcl_Object *objectPtr);
+MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
+			    Class *classPtr,
+			    const char *nameStr,
+			    const char *nsNameStr);
 MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
 MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
 MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
-- 
cgit v0.12


From a8a602d3ffaf67e797df3e1a1e9a57124c43e267 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 27 Nov 2017 23:30:57 +0000
Subject: Eliminate some duplicate code in tclOO.c/Tcl_NewObjectInstance().

---
 generic/tclOO.c | 39 ++++++++++-----------------------------
 1 file changed, 10 insertions(+), 29 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 3fece42..07a96a7 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1606,6 +1606,7 @@ Tcl_NewObjectInstance(
 {
     register Class *classPtr = (Class *) cls;
     Object *oPtr;
+    ClientData clientData[4];
 
     oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
     if (oPtr == NULL) {return NULL;}
@@ -1639,35 +1640,16 @@ Tcl_NewObjectInstance(
 		TclResetRewriteEnsemble(interp, 1);
 	    }
 
-	    /*
-	     * Ensure an error if the object was deleted in the constructor.
-	     * Don't want to lose errors by accident. [Bug 2903011]
-	     */
+	    clientData[0] = contextPtr;
+	    clientData[1] = oPtr;
+	    clientData[2] = state;
+	    clientData[3] = &oPtr;
 
-	    if (result != TCL_ERROR && Deleted(oPtr)) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"object deleted in constructor", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
-		result = TCL_ERROR;
-	    }
-	    TclOODeleteContext(contextPtr);
+	    AddRef(oPtr);
+	    result = FinalizeAlloc(clientData, interp, result);
 	    if (result != TCL_OK) {
-		Tcl_DiscardInterpState(state);
-
-		/*
-		 * Take care to not delete a deleted object; that would be
-		 * bad. [Bug 2903011] Also take care to make sure that we have
-		 * the name of the command before we delete it. [Bug
-		 * 9dd1bd7a74]
-		 */
-
-		if (!Deleted(oPtr)) {
-		    (void) TclOOObjectName(interp, oPtr);
-		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
-		}
 		return NULL;
 	    }
-	    Tcl_RestoreInterpState(interp, state);
 	}
     }
 
@@ -1726,7 +1708,7 @@ TclNRNewObjectInstance(
     contextPtr->skip = skip;
 
     /*
-     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
+     * Adjust the ensemble tracking record if necessary. [Bug 3514761]
      */
 
     if (TclInitRewriteEnsemble(interp, skip, skip, objv)) {
@@ -1813,9 +1795,8 @@ FinalizeAlloc(
     Tcl_Object *objectPtr = data[3];
 
     /*
-     * It's an error if the object was whacked in the constructor. Force this
-     * if it isn't already an error (don't want to lose errors by accident...)
-     * [Bug 2903011]
+     * Ensure an error if the object was deleted in the constructor.
+     * Don't want to lose errors by accident. [Bug 2903011]
      */
 
     if (result != TCL_ERROR && Deleted(oPtr)) {
-- 
cgit v0.12


From fe65a79d19b49f2cb167f72b3e422a71be69bead Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Tue, 28 Nov 2017 15:43:41 +0000
Subject: Minor refactoring of TclOO object reference count booking during
 object creation.

---
 generic/tclOO.c | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 07a96a7..d7ae349 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1678,11 +1678,6 @@ TclNRNewObjectInstance(
     Tcl_InterpState state;
     Object *oPtr;
 
-    /*
-     * Protect classPtr from getting cleaned up when the command is created.
-     */
-    AddRef(classPtr);
-
     oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
     if (oPtr == NULL) {return TCL_ERROR;}
 
@@ -1693,13 +1688,11 @@ TclNRNewObjectInstance(
 
     if (objc < 0) {
 	*objectPtr = (Tcl_Object) oPtr;
-	DelRef(classPtr);
 	return TCL_OK;
     }
     contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
     if (contextPtr == NULL) {
 	*objectPtr = (Tcl_Object) oPtr;
-	DelRef(classPtr);
 	return TCL_OK;
     }
 
@@ -1723,7 +1716,6 @@ TclNRNewObjectInstance(
     TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
 	    objectPtr);
     TclPushTailcallPoint(interp);
-    DelRef(classPtr);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
 
@@ -1755,7 +1747,15 @@ TclNewObjectInstanceCommon(
      * Create the object.
      */
 
+    /*
+     * The command for the object could have the same name as the command
+     * associated with classPtr, so protect the structure from deallocation
+     * here.
+     */
+    AddRef(classPtr);
+
     oPtr = AllocObject(interp, nameStr, nsNameStr);
+    DelRef(classPtr);
     oPtr->selfCls = classPtr;
     TclOOAddToInstances(oPtr, classPtr);
 
-- 
cgit v0.12


From 8396e878da979c46691b73731c51888f05e7bb77 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Tue, 28 Nov 2017 23:33:14 +0000
Subject: Fix for issue [6cf568a21b]: Tcl_Eval() causes new segfault (TclOO
 object creation by qualified name).

---
 generic/tclOO.c | 60 +++++++++++++++++++++++++++++++--------------------------
 tests/oo.test   |  3 +++
 2 files changed, 36 insertions(+), 27 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index d7ae349..93abf3f 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -59,7 +59,7 @@ static const struct {
 
 static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
 static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
-			    const char *nsNameStr);
+			    Namespace *nsPtr, const char *nsNameStr);
 static void		ClearMixins(Class *clsPtr);
 static void		ClearSuperclasses(Class *clsPtr);
 static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
@@ -380,9 +380,9 @@ InitFoundation(
      */
 
     fPtr->objectCls = AllocClass(interp,
-	    AllocObject(interp, "::oo::object", NULL));
+	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
     fPtr->classCls = AllocClass(interp,
-	    AllocObject(interp, "::oo::class", NULL));
+	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
     fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
     fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
     fPtr->objectCls->flags |= ROOT_OBJECT;
@@ -552,6 +552,8 @@ AllocObject(
 				 * if the OO system should pick the object
 				 * name itself (equal to the namespace
 				 * name). */
+    Namespace *nsPtr,		/* The namespace to create the object in,
+				   or NULL if *nameStr is NULL */
     const char *nsNameStr)	/* The name of the namespace to create, or
 				 * NULL if the OO system should pick a unique
 				 * name itself. If this is non-NULL but names
@@ -562,10 +564,7 @@ AllocObject(
     Object *oPtr;
     Command *cmdPtr;
     CommandTrace *tracePtr;
-    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
-    Tcl_Namespace *inNsPtr;
     int creationEpoch, ignored;
-    const char *simpleName;
 
     oPtr = ckalloc(sizeof(Object));
     memset(oPtr, 0, sizeof(Object));
@@ -653,17 +652,11 @@ AllocObject(
      * command is deleted).
      */
 
-    if (nameStr) {
-	inNsPtr = TclGetCurrentNamespace(interp);
-    } else {
+    if (!nameStr) {
 	nameStr = oPtr->namespacePtr->name;
-	inNsPtr = oPtr->namespacePtr;
+	nsPtr = (Namespace *)oPtr->namespacePtr;
     }
-    
-    TclGetNamespaceForQualName(interp, nameStr, (Namespace *) inNsPtr, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
-
-    oPtr->command = TclCreateObjCommandInNs(interp, simpleName,
+    oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
 	(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
 
     /*
@@ -1528,7 +1521,7 @@ AllocClass(
 
     memset(clsPtr, 0, sizeof(Class));
     if (useThisObj == NULL) {
-	clsPtr->thisPtr = AllocObject(interp, NULL, NULL);
+	clsPtr->thisPtr = AllocObject(interp, NULL, NULL, NULL);
     } else {
 	clsPtr->thisPtr = useThisObj;
     }
@@ -1727,20 +1720,33 @@ TclNewObjectInstanceCommon(
     const char *nameStr,
     const char *nsNameStr)
 {
+    Tcl_HashEntry *hPtr;
     Foundation *fPtr = GetFoundation(interp);
     Object *oPtr;
+    const char *simpleName = NULL;
+    Namespace *nsPtr = NULL, *dummy,
+	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
+    int isNew;
 
-    /*
-     * Disallow creation of an object over an existing command.
-     */
+    if (nameStr) {
+	TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN,
+		&nsPtr, &dummy, &dummy, &simpleName);
 
-    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
-	    TCL_NAMESPACE_ONLY)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't create object \"%s\": command already exists with"
-		" that name", nameStr));
-	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
-	return NULL;
+	/*
+	 * Disallow creation of an object over an existing command.
+	 */
+
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
+	if (isNew) {
+	    /* Just kidding */
+	    Tcl_DeleteHashEntry(hPtr);
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't create object \"%s\": command already exists with"
+		    " that name", nameStr));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
+	    return NULL;
+	}
     }
 
     /*
@@ -1754,7 +1760,7 @@ TclNewObjectInstanceCommon(
      */
     AddRef(classPtr);
 
-    oPtr = AllocObject(interp, nameStr, nsNameStr);
+    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
     DelRef(classPtr);
     oPtr->selfCls = classPtr;
     TclOOAddToInstances(oPtr, classPtr);
diff --git a/tests/oo.test b/tests/oo.test
index b6af1ee..c44ec18 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -128,6 +128,9 @@ test oo-1.3 {basic test of OO functionality: no classes} {
 test oo-1.4 {basic test of OO functionality} -body {
     oo::object create {}
 } -returnCodes 1 -result {object name must not be empty}
+test oo-1.4.1 {fully-qualified nested name} -body {
+    oo::object create ::one::two::three 
+} -result {::one::two::three}
 test oo-1.5 {basic test of OO functionality} -body {
     oo::object doesnotexist
 } -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
-- 
cgit v0.12


From 4fc9a4c991e75f3060fad431f5951cda27377a5a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 29 Nov 2017 11:04:20 +0000
Subject: Update some functions in tclUtf.c to handle surrogate pairs when
 TCL_UTF_MAX == 4. Also update documentation to distinguish better between
 "Tcl_UniChar" and "Unicode character": Those are not necessary the same when
 TCL_UTF_MAX == 4. No change when TCL_UTF_MAX == 4 or TCL_UTF_MAX == 6.

---
 doc/ToUpper.3        |  2 +-
 doc/UniCharIsAlpha.3 |  5 +---
 doc/Utf.3            |  2 +-
 generic/tclUtf.c     | 74 ++++++++++++++++++++++++++++++++++++++++------------
 4 files changed, 61 insertions(+), 22 deletions(-)

diff --git a/doc/ToUpper.3 b/doc/ToUpper.3
index b933e9c..be614e7 100644
--- a/doc/ToUpper.3
+++ b/doc/ToUpper.3
@@ -33,7 +33,7 @@ int
 .SH ARGUMENTS
 .AS char *str in/out
 .AP int ch in
-The Tcl_UniChar to be converted.
+The Unicode character to be converted.
 .AP char *str in/out
 Pointer to UTF-8 string to be converted in place.
 .BE
diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3
index 2336c34..5ba3fc9 100644
--- a/doc/UniCharIsAlpha.3
+++ b/doc/UniCharIsAlpha.3
@@ -53,14 +53,11 @@ The Tcl_UniChar to be examined.
 
 .SH DESCRIPTION
 .PP
-All of the routines described examine Tcl_UniChars and return a
+All of the routines described examine Unicode characters and return a
 boolean value. A non-zero return value means that the character does
 belong to the character class associated with the called routine. The
 rest of this document just describes the character classes associated
 with the various routines.
-.PP
-Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
-fixed-size quantity.
 
 .SH "CHARACTER CLASSES"
 .PP
diff --git a/doc/Utf.3 b/doc/Utf.3
index 378c806..9d0c617 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -77,7 +77,7 @@ int
 Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
 \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
 .AP int ch in
-The Tcl_UniChar to be converted or examined.
+The Unicode character to be converted or examined.
 .AP Tcl_UniChar *chPtr out
 Filled with the Tcl_UniChar represented by the head of the UTF-8 string.
 .AP "const char" *src in
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 3b39226..17f769d 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -404,7 +404,7 @@ Tcl_UtfToUniCharDString(
 				 * appended to this previously initialized
 				 * DString. */
 {
-    Tcl_UniChar ch, *w, *wString;
+    Tcl_UniChar ch = 0, *w, *wString;
     const char *p, *end;
     int oldLength;
 
@@ -528,13 +528,13 @@ Tcl_NumUtfChars(
  *
  * Tcl_UtfFindFirst --
  *
- *	Returns a pointer to the first occurance of the given Tcl_UniChar in
- *	the NULL-terminated UTF-8 string. The NULL terminator is considered
+ *	Returns a pointer to the first occurance of the given Unicode character
+ *	in the NULL-terminated UTF-8 string. The NULL terminator is considered
  *	part of the UTF-8 string. Equivalent to Plan 9 utfrune().
  *
  * Results:
- *	As above. If the Tcl_UniChar does not exist in the given string, the
- *	return value is NULL.
+ *	As above. If the Unicode character does not exist in the given string,
+ *	the return value is NULL.
  *
  * Side effects:
  *	None.
@@ -545,14 +545,21 @@ Tcl_NumUtfChars(
 const char *
 Tcl_UtfFindFirst(
     const char *src,		/* The UTF-8 string to be searched. */
-    int ch)			/* The Tcl_UniChar to search for. */
+    int ch)			/* The Unicode character to search for. */
 {
-    int len;
+    int len, fullchar;
     Tcl_UniChar find = 0;
 
     while (1) {
 	len = TclUtfToUniChar(src, &find);
-	if (find == ch) {
+	fullchar = find;
+#if TCL_UTF_MAX == 4
+	if (!len) {
+	    len += TclUtfToUniChar(src, &find);
+	    fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+	}
+#endif
+	if (find == fullchar) {
 	    return src;
 	}
 	if (*src == '\0') {
@@ -567,8 +574,8 @@ Tcl_UtfFindFirst(
  *
  * Tcl_UtfFindLast --
  *
- *	Returns a pointer to the last occurance of the given Tcl_UniChar in
- *	the NULL-terminated UTF-8 string. The NULL terminator is considered
+ *	Returns a pointer to the last occurance of the given Unicode character
+ *	in the NULL-terminated UTF-8 string. The NULL terminator is considered
  *	part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
  *
  * Results:
@@ -584,16 +591,23 @@ Tcl_UtfFindFirst(
 const char *
 Tcl_UtfFindLast(
     const char *src,		/* The UTF-8 string to be searched. */
-    int ch)			/* The Tcl_UniChar to search for. */
+    int ch)			/* The Unicode character to search for. */
 {
-    int len;
+    int len, fullchar;
     Tcl_UniChar find = 0;
     const char *last;
 
     last = NULL;
     while (1) {
 	len = TclUtfToUniChar(src, &find);
-	if (find == ch) {
+	fullchar = find;
+#if TCL_UTF_MAX == 4
+	if (!len) {
+	    len += TclUtfToUniChar(src, &find);
+	    fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+	}
+#endif
+	if (find == fullchar) {
 	    last = src;
 	}
 	if (*src == '\0') {
@@ -1058,6 +1072,15 @@ Tcl_UtfNcmp(
 
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
+#if TCL_UTF_MAX == 4
+    /* map high surrogate characters to values > 0xffff */
+    if ((ch1 & 0xFC00) == 0xD800) {
+	ch1 += 0x4000;
+    }
+    if ((ch2 & 0xFC00) == 0xD800) {
+	ch2 += 0x4000;
+    }
+#endif
 	if (ch1 != ch2) {
 	    return (ch1 - ch2);
 	}
@@ -1090,6 +1113,7 @@ Tcl_UtfNcasecmp(
     unsigned long numChars)	/* Number of UTF chars to compare. */
 {
     Tcl_UniChar ch1 = 0, ch2 = 0;
+
     while (numChars-- > 0) {
 	/*
 	 * n must be interpreted as chars, not bytes.
@@ -1098,6 +1122,15 @@ Tcl_UtfNcasecmp(
 	 */
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
+#if TCL_UTF_MAX == 4
+    /* map high surrogate characters to values > 0xffff */
+    if ((ch1 & 0xFC00) == 0xD800) {
+	ch1 += 0x4000;
+    }
+    if ((ch2 & 0xFC00) == 0xD800) {
+	ch2 += 0x4000;
+    }
+#endif
 	if (ch1 != ch2) {
 	    ch1 = Tcl_UniCharToLower(ch1);
 	    ch2 = Tcl_UniCharToLower(ch2);
@@ -1112,7 +1145,7 @@ Tcl_UtfNcasecmp(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UtfNcasecmp --
+ * TclUtfCasecmp --
  *
  *	Compare UTF chars of string cs to string ct case insensitively.
  *	Replacement for strcasecmp in Tcl core, in places where UTF-8 should
@@ -1132,11 +1165,20 @@ TclUtfCasecmp(
     const char *cs,		/* UTF string to compare to ct. */
     const char *ct)		/* UTF string cs is compared to. */
 {
-    while (*cs && *ct) {
-	Tcl_UniChar ch1, ch2;
+    Tcl_UniChar ch1 = 0, ch2 = 0;
 
+    while (*cs && *ct) {
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
+#if TCL_UTF_MAX == 4
+    /* map high surrogate characters to values > 0xffff */
+    if ((ch1 & 0xFC00) == 0xD800) {
+	ch1 += 0x4000;
+    }
+    if ((ch2 & 0xFC00) == 0xD800) {
+	ch2 += 0x4000;
+    }
+#endif
 	if (ch1 != ch2) {
 	    ch1 = Tcl_UniCharToLower(ch1);
 	    ch2 = Tcl_UniCharToLower(ch2);
-- 
cgit v0.12


From c032f5043e88e8f54ac32f526413a3b62c9a20f4 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Wed, 29 Nov 2017 12:01:21 +0000
Subject: Fix for [6bca38d59b], TclOO segmentation fault cleaning up objects
 that that have mixed themselves into themselves.

---
 generic/tclOO.c | 128 ++++++++++++++++++++++++++++++++------------------------
 tests/oo.test   |  33 +++++++++++++--
 2 files changed, 103 insertions(+), 58 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 93abf3f..5404abc 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -913,28 +913,30 @@ ReleaseClassContents(
     }
     if (!IsRootClass(oPtr)) {
 	FOREACH(instancePtr, clsPtr->instances) {
-	    int j;
-	    if (instancePtr->selfCls == clsPtr) {
-		instancePtr->flags |= CLASS_GONE;
-	    }
-	    for(j=0 ; j<instancePtr->mixins.num ; j++) {
-		Class *mixin = instancePtr->mixins.list[j];
-		Class *nextMixin = NULL;
-		if (mixin == clsPtr) {
-		    if (j < instancePtr->mixins.num - 1) {
-			nextMixin = instancePtr->mixins.list[j+1];
-		    }
-		    if (j == 0) {
-			instancePtr->mixins.num = 0;
-			instancePtr->mixins.list = NULL;
-		    } else {
-			instancePtr->mixins.list[j-1] = nextMixin;
+	    if (instancePtr != oPtr) {
+		int j;
+		if (instancePtr->selfCls == clsPtr) {
+		    instancePtr->flags |= CLASS_GONE;
+		}
+		for(j=0 ; j<instancePtr->mixins.num ; j++) {
+		    Class *mixin = instancePtr->mixins.list[j];
+		    Class *nextMixin = NULL;
+		    if (mixin == clsPtr) {
+			if (j < instancePtr->mixins.num - 1) {
+			    nextMixin = instancePtr->mixins.list[j+1];
+			}
+			if (j == 0) {
+			    instancePtr->mixins.num = 0;
+			    instancePtr->mixins.list = NULL;
+			} else {
+			    instancePtr->mixins.list[j-1] = nextMixin;
+			}
+			instancePtr->mixins.num -= 1;
 		    }
-		    instancePtr->mixins.num -= 1;
 		}
-	    }
-	    if (instancePtr != NULL && !IsRoot(instancePtr)) {
-		AddRef(instancePtr);
+		if (instancePtr != NULL && !IsRoot(instancePtr)) {
+		    AddRef(instancePtr);
+		}
 	    }
 	}
     }
@@ -944,13 +946,15 @@ ReleaseClassContents(
      */
 
     FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
-	if (!Deleted(mixinSubclassPtr->thisPtr)) {
-	    Tcl_DeleteCommandFromToken(interp,
-		    mixinSubclassPtr->thisPtr->command);
+	if (mixinSubclassPtr != clsPtr) {
+	    if (!Deleted(mixinSubclassPtr->thisPtr)) {
+		Tcl_DeleteCommandFromToken(interp,
+			mixinSubclassPtr->thisPtr->command);
+	    }
+	    ClearMixins(mixinSubclassPtr);
+	    DelRef(mixinSubclassPtr->thisPtr);
+	    DelRef(mixinSubclassPtr);
 	}
-	ClearMixins(mixinSubclassPtr);
-	DelRef(mixinSubclassPtr->thisPtr);
-	DelRef(mixinSubclassPtr);
     }
     if (clsPtr->mixinSubs.list != NULL) {
 	ckfree(clsPtr->mixinSubs.list);
@@ -985,19 +989,21 @@ ReleaseClassContents(
 
     if (!IsRootClass(oPtr)) {
 	FOREACH(instancePtr, clsPtr->instances) {
-	    if (instancePtr == NULL || IsRoot(instancePtr)) {
-		continue;
-	    }
-	    if (!Deleted(instancePtr)) {
-		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
-		/*
-		 * Tcl_DeleteCommandFromToken() may have done to whole
-		 * job for us.  Roll back and check again.
-		 */
-		i--;
-		continue;
+	    if (instancePtr != oPtr) {
+		if (instancePtr == NULL || IsRoot(instancePtr)) {
+		    continue;
+		}
+		if (!Deleted(instancePtr)) {
+		    Tcl_DeleteCommandFromToken(interp, instancePtr->command);
+		    /*
+		     * Tcl_DeleteCommandFromToken() may have done to whole
+		     * job for us.  Roll back and check again.
+		     */
+		    i--;
+		    continue;
+		}
+		DelRef(instancePtr);
 	    }
-	    DelRef(instancePtr);
 	}
     }
     if (clsPtr->instances.list != NULL) {
@@ -1084,6 +1090,10 @@ ReleaseClassContents(
 	ckfree(clsPtr->variables.list);
     }
 
+    /* Tell oPtr that it's class is gone so that it doesn't try to remove
+     * itself from it's classe's list of instances 
+     */ 
+    oPtr->flags |= CLASS_GONE;
     DelRef(clsPtr);
 
 }
@@ -1177,22 +1187,6 @@ ObjectNamespaceDeleted(
     }
 
     /*
-     * The class of objects needs some special care; if it is deleted (and
-     * we're not killing the whole interpreter) we force the delete of the
-     * class of classes now as well. Due to the incestuous nature of those two
-     * classes, if one goes the other must too and yet the tangle can
-     * sometimes not go away automatically; we force it here. [Bug 2962664]
-     */
-    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
-	    && !Deleted(fPtr->classCls->thisPtr)) {
-	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
-    }
-
-    if (oPtr->classPtr != NULL) {
-	ReleaseClassContents(interp, oPtr);
-    }
-
-    /*
      * Splice the object out of its context. After this, we must *not* call
      * methods on the object.
      */
@@ -1202,7 +1196,7 @@ ObjectNamespaceDeleted(
     }
 
     FOREACH(mixinPtr, oPtr->mixins) {
-	if (mixinPtr) {
+	if (mixinPtr && mixinPtr != oPtr->classPtr) {
 	    TclOORemoveFromInstances(oPtr, mixinPtr);
 	}
     }
@@ -1251,6 +1245,30 @@ ObjectNamespaceDeleted(
     }
 
     /*
+     *  Because an object can be a class that is an instance of itself, the
+     *  A class object's class structure should only be cleaned after most of
+     *  the cleanup on the object is done. 
+     */
+
+
+    /*
+     * The class of objects needs some special care; if it is deleted (and
+     * we're not killing the whole interpreter) we force the delete of the
+     * class of classes now as well. Due to the incestuous nature of those two
+     * classes, if one goes the other must too and yet the tangle can
+     * sometimes not go away automatically; we force it here. [Bug 2962664]
+     */
+    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
+	    && !Deleted(fPtr->classCls->thisPtr)) {
+	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
+    }
+
+    if (oPtr->classPtr != NULL) {
+	ReleaseClassContents(interp, oPtr);
+    }
+
+
+    /*
      * Delete the object structure itself.
      */
 
diff --git a/tests/oo.test b/tests/oo.test
index c44ec18..556d529 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1501,7 +1501,7 @@ test oo-11.5 {OO: cleanup} {
 test oo-11.6 {
     OO: cleanup ReleaseClassContents() where class is mixed into one of its
     instances
-} {
+} -body {
     oo::class create obj1
     ::oo::define obj1 {self mixin [self]}
 
@@ -1509,12 +1509,14 @@ test oo-11.6 {
     ::oo::objdefine obj2 {mixin [self]}
 
     ::oo::copy obj2 obj3
-    trace add command obj3 delete [list obj3 dying]
+    rename obj3 {}
     rename obj2 {}
 
     # No segmentation fault
     return done
-} done
+} -cleanup {
+    rename obj1 {}
+} -result done
 
 test oo-12.1 {OO: filters} {
     oo::class create Aclass
@@ -3867,6 +3869,31 @@ test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly}
 } -cleanup {
     base destroy
 } -result {{c d e} {c d e}}
+test oo-35.6 {
+    Bug : teardown of an object that is a class that is an instance of itself
+} -setup {
+    oo::class create obj
+
+    oo::copy obj obj1 obj1
+    oo::objdefine obj1 {
+	mixin obj1 obj
+    }
+    oo::copy obj1 obj2
+    oo::objdefine obj2 {
+	mixin obj2 obj1
+    }
+} -body {
+    rename obj2 {}
+    rename obj1 {}
+    # doesn't crash
+    return done
+} -cleanup {
+    rename obj {}
+} -result done 
+
+
+
+
 test oo-36.1 {TIP #470: introspection within oo::define} {
     oo::define oo::object self
 } ::oo::object
-- 
cgit v0.12


From e87d0bcdf463e1858295c83daaee867dd695dba0 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 29 Nov 2017 12:27:22 +0000
Subject: Fix Tcl_UtfFindFirst()/Tcl_UtfFindLast(), which were broken by
 [83c0c569d6]. Not detected, because those functions aren't used anywhere in
 Tcl. So, added new test-cases, makeing sure this doesn't happen again.

---
 generic/tclTest.c | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclUtf.c  | 14 +++++++-------
 tests/utf.test    | 11 +++++++++--
 3 files changed, 70 insertions(+), 9 deletions(-)

diff --git a/generic/tclTest.c b/generic/tclTest.c
index e8539e8..8a59b83 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -407,6 +407,12 @@ static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
 static int		TestNumUtfCharsCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		TestFindFirstCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		TestFindLastCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		TestHashSystemHashCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -668,6 +674,10 @@ Tcltest_Init(
 	    TestsetobjerrorcodeCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testnumutfchars",
 	    TestNumUtfCharsCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testfindfirst",
+	    TestFindFirstCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testfindlast",
+	    TestFindLastCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
@@ -6680,6 +6690,50 @@ TestNumUtfCharsCmd(
     return TCL_OK;
 }
 
+/*
+ * Used to check correct operation of Tcl_UtfFindFirst
+ */
+
+static int
+TestFindFirstCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc > 1) {
+	int len = -1;
+
+	if (objc > 2) {
+	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
+	}
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
+    }
+    return TCL_OK;
+}
+
+/*
+ * Used to check correct operation of Tcl_UtfFindLast
+ */
+
+static int
+TestFindLastCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc > 1) {
+	int len = -1;
+
+	if (objc > 2) {
+	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
+	}
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
+    }
+    return TCL_OK;
+}
+
 #if defined(HAVE_CPUID) || defined(_WIN32)
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 17f769d..c60e99e 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -100,7 +100,7 @@ static int		UtfCount(int ch);
 
 static inline int
 UtfCount(
-    int ch)			/* The Tcl_UniChar whose size is returned. */
+    int ch)			/* The Unicode character whose size is returned. */
 {
     if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
 	return 1;
@@ -556,10 +556,10 @@ Tcl_UtfFindFirst(
 #if TCL_UTF_MAX == 4
 	if (!len) {
 	    len += TclUtfToUniChar(src, &find);
-	    fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+	    fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
 	}
 #endif
-	if (find == fullchar) {
+	if (fullchar == ch) {
 	    return src;
 	}
 	if (*src == '\0') {
@@ -579,7 +579,7 @@ Tcl_UtfFindFirst(
  *	part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
  *
  * Results:
- *	As above. If the Tcl_UniChar does not exist in the given string, the
+ *	As above. If the Unicode character does not exist in the given string, the
  *	return value is NULL.
  *
  * Side effects:
@@ -604,10 +604,10 @@ Tcl_UtfFindLast(
 #if TCL_UTF_MAX == 4
 	if (!len) {
 	    len += TclUtfToUniChar(src, &find);
-	    fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+	    fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
 	}
 #endif
-	if (find == fullchar) {
+	if (fullchar == ch) {
 	    last = src;
 	}
 	if (*src == '\0') {
@@ -707,7 +707,7 @@ Tcl_UtfPrev(
  *
  * Tcl_UniCharAtIndex --
  *
- *	Returns the Unicode character represented at the specified character
+ *	Returns the Tcl_UniChar represented at the specified character
  *	(not byte) position in the UTF-8 string.
  *
  * Results:
diff --git a/tests/utf.test b/tests/utf.test
index 45f9c0c..d0fa7be 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -86,6 +86,9 @@ test utf-3.1 {Tcl_UtfCharComplete} {
 } {}
 
 testConstraint testnumutfchars [llength [info commands testnumutfchars]]
+testConstraint testfindfirst [llength [info commands testfindfirst]]
+testConstraint testfindlast [llength [info commands testfindlast]]
+
 test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
     testnumutfchars ""
 } {0}
@@ -118,8 +121,12 @@ test utf-4.10 {Tcl_NumUtfChars: #u0000, calc len, overcomplete} {testnumutfchars
     testnumutfchars [testbytestring "\x00"] 2
 } {2}
 
-test utf-5.1 {Tcl_UtfFindFirsts} {
-} {}
+test utf-5.1 {Tcl_UtfFindFirst} {testfindfirst testbytestring} {
+    testfindfirst [testbytestring "abcbc"] 98
+} {bcbc}
+test utf-5.1 {Tcl_UtfFindLast} {testfindlast testbytestring} {
+    testfindlast [testbytestring "abcbc"] 98
+} {bc}
 
 test utf-6.1 {Tcl_UtfNext} {
 } {}
-- 
cgit v0.12


From e68b4918069d622ccc7f9f6f98e8432df3f3baad Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 29 Nov 2017 13:59:42 +0000
Subject: Cherry-picked test-cases from [046a5af026]: fix for issue
 [4f6a1ebd64]: ensemble: segmentation fault when -subcommand and -map values
 are the same object.

---
 tests/namespace.test | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/tests/namespace.test b/tests/namespace.test
index 71b6860..7d41258 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1576,7 +1576,10 @@ test namespace-42.7 {ensembles: nested} {
     namespace delete ns
     set result
 } {{1 ::ns::x0::z} 1 2 3}
-test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
+test namespace-42.8 {
+    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
+    struct.
+} -setup {
     proc demo args {}
     variable target [list [namespace which demo] x]
     proc trial args {variable target; string length $target}
@@ -1591,6 +1594,19 @@ test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
     rename foo {}
 } -result {}
 
+test namespace-42.9 {
+    ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a
+    deallocated List struct.
+} -setup {
+    namespace eval n {namespace ensemble create}
+    dict set list one ::two
+    namespace ensemble configure n -subcommands $list -map $list
+} -body {
+    n one
+} -cleanup {
+    namespace delete n
+} -returnCodes error -match glob -result {invalid command name*}
+
 test namespace-43.1 {ensembles: dict-driven} {
     namespace eval ns {
 	namespace export x*
-- 
cgit v0.12


From c47ba70f4545f7c961160a6beb0a466e3bfd5532 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Wed, 29 Nov 2017 18:35:51 +0000
Subject: Add TCL_CREATE_NS_IF_UNKNOWN back into Tcl_CreateEnsemble().

---
 generic/tclEnsemble.c | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index c5ccd22..a981851 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -732,7 +732,6 @@ Tcl_CreateEnsemble(
     Tcl_Namespace *namespacePtr,
     int flags)
 {
-    Tcl_Obj *nameObj = NULL;
     Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
     	*actualNsPtr;
     const char * simpleName;
@@ -741,11 +740,8 @@ Tcl_CreateEnsemble(
 	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     }
 
-    TclGetNamespaceForQualName(interp, name, nsPtr, 0,
+    TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
     	&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
-    if (nameObj != NULL) {
-    	TclDecrRefCount(nameObj);
-    }
     return TclCreateEnsembleInNs(interp, simpleName,
 	(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
 }
-- 
cgit v0.12


From 72998869a3be3534fec99499faabe2d1557d6bcb Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 30 Nov 2017 13:14:43 +0000
Subject: Fix [8e1e31eac0fd6b6c4452bc108a98ab08c6b64588|8e1e31eac0]: lsort
 treats NUL chars strangely. Also fix various initializations, which only make
 a difference when TCL_UTF_MAX == 4. Add new test-cases which demonstrate the
 fix. For TCL_UTF_MAX == 4, surrogates will now be handled as expected as well
 when sorting.

---
 doc/UniCharIsAlpha.3   |   2 +-
 generic/tclCmdIL.c     |   4 +-
 generic/tclCmdMZ.c     |   2 +-
 generic/tclInt.h       |   3 +-
 generic/tclScan.c      |   2 +-
 generic/tclStringObj.c |  10 ++---
 generic/tclUtf.c       | 103 +++++++++++++++++++++++++++++++++++--------------
 generic/tclUtil.c      |  10 ++---
 tests/cmdIL.test       |  13 +++++++
 win/tclWinSerial.c     |   2 +-
 10 files changed, 105 insertions(+), 46 deletions(-)

diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3
index 5ba3fc9..61490ed 100644
--- a/doc/UniCharIsAlpha.3
+++ b/doc/UniCharIsAlpha.3
@@ -48,7 +48,7 @@ int
 .SH ARGUMENTS
 .AS int ch
 .AP int ch in
-The Tcl_UniChar to be examined.
+The Unicode character to be examined.
 .BE
 
 .SH DESCRIPTION
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 47076ec..b41d312 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2945,7 +2945,7 @@ Tcl_LsearchObjCmd(
     double patDouble, objDouble;
     SortInfo sortInfo;
     Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
-    SortStrCmpFn_t strCmpFn = strcmp;
+    SortStrCmpFn_t strCmpFn = TclUtfCmp;
     Tcl_RegExp regexp = NULL;
     static const char *const options[] = {
 	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
@@ -4263,7 +4263,7 @@ SortCompare(
     int order = 0;
 
     if (infoPtr->sortMode == SORTMODE_ASCII) {
-	order = strcmp(elemPtr1->collationKey.strValuePtr,
+	order = TclUtfCmp(elemPtr1->collationKey.strValuePtr,
 		elemPtr2->collationKey.strValuePtr);
     } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
 	order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index ad1dd5f..a206cc5 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3547,7 +3547,7 @@ TclNRSwitchObjCmd(
 	OPT_LAST
     };
     typedef int (*strCmpFn_t)(const char *, const char *);
-    strCmpFn_t strCmpFn = strcmp;
+    strCmpFn_t strCmpFn = TclUtfCmp;
 
     mode = OPT_EXACT;
     foundmode = 0;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ef88bf5..ad1d9c6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3219,6 +3219,7 @@ MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
 MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
+MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
 MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
 MODULE_SCOPE int	TclUtfCount(int ch);
 MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
@@ -4446,7 +4447,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
  */
 
 #define TclUtfToUniChar(str, chPtr) \
-	((((unsigned char) *(str)) < 0xC0) ?		\
+	((((unsigned char) *(str)) < 0x80) ?		\
 	    ((*(chPtr) = (unsigned char) *(str)), 1)	\
 	    : Tcl_UtfToUniChar(str, chPtr))
 
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 7f71262..e0798df 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -889,7 +889,7 @@ Tcl_ScanObjCmd(
 	    i = (int)sch;
 #if TCL_UTF_MAX == 4
 	    if (!offset) {
-		offset = Tcl_UtfToUniChar(string, &sch);
+		offset = TclUtfToUniChar(string, &sch);
 		i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
 	    }
 #endif
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 547f7c6..b943095 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1869,20 +1869,20 @@ Tcl_AppendFormatToObj(
 	} else if (ch == 'I') {
 	    if ((format[1] == '6') && (format[2] == '4')) {
 		format += (step + 2);
-		step = Tcl_UtfToUniChar(format, &ch);
+		step = TclUtfToUniChar(format, &ch);
 #ifndef TCL_WIDE_INT_IS_LONG
 		useWide = 1;
 #endif
 	    } else if ((format[1] == '3') && (format[2] == '2')) {
 		format += (step + 2);
-		step = Tcl_UtfToUniChar(format, &ch);
+		step = TclUtfToUniChar(format, &ch);
 	    } else {
 		format += step;
-		step = Tcl_UtfToUniChar(format, &ch);
+		step = TclUtfToUniChar(format, &ch);
 	    }
 	} else if ((ch == 't') || (ch == 'z')) {
 	    format += step;
-	    step = Tcl_UtfToUniChar(format, &ch);
+	    step = TclUtfToUniChar(format, &ch);
 #ifndef TCL_WIDE_INT_IS_LONG
 	    if (sizeof(size_t) > sizeof(int)) {
 		useWide = 1;
@@ -1890,7 +1890,7 @@ Tcl_AppendFormatToObj(
 #endif
 	} else if ((ch == 'q') ||(ch == 'j')) {
 	    format += step;
-	    step = Tcl_UtfToUniChar(format, &ch);
+	    step = TclUtfToUniChar(format, &ch);
 #ifndef TCL_WIDE_INT_IS_LONG
 	    useWide = 1;
 #endif
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index a72394d..43636b4 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -720,8 +720,7 @@ Tcl_UniCharAtIndex(
 {
     Tcl_UniChar ch = 0;
 
-    while (index >= 0) {
-	index--;
+    while (index-- >= 0) {
 	src += TclUtfToUniChar(src, &ch);
     }
     return ch;
@@ -751,8 +750,7 @@ Tcl_UtfAtIndex(
 {
     Tcl_UniChar ch = 0;
 
-    while (index > 0) {
-	index--;
+    while (index-- > 0) {
 	src += TclUtfToUniChar(src, &ch);
     }
     return src;
@@ -1066,16 +1064,17 @@ Tcl_UtfNcmp(
 
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
+	if (ch1 != ch2) {
 #if TCL_UTF_MAX == 4
-    /* map high surrogate characters to values > 0xffff */
-    if ((ch1 & 0xFC00) == 0xD800) {
-	ch1 += 0x4000;
-    }
-    if ((ch2 & 0xFC00) == 0xD800) {
-	ch2 += 0x4000;
-    }
+	    /* Surrogates always report higher than non-surrogates */
+	    if (((ch1 & 0xFC00) == 0xD800)) {
+	    if ((ch2 & 0xFC00) != 0xD800) {
+		return ch1;
+	    }
+	    } else if ((ch2 & 0xFC00) == 0xD800) {
+		return -ch2;
+	    }
 #endif
-	if (ch1 != ch2) {
 	    return (ch1 - ch2);
 	}
     }
@@ -1116,16 +1115,17 @@ Tcl_UtfNcasecmp(
 	 */
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
+	if (ch1 != ch2) {
 #if TCL_UTF_MAX == 4
-    /* map high surrogate characters to values > 0xffff */
-    if ((ch1 & 0xFC00) == 0xD800) {
-	ch1 += 0x4000;
-    }
-    if ((ch2 & 0xFC00) == 0xD800) {
-	ch2 += 0x4000;
-    }
+	    /* Surrogates always report higher than non-surrogates */
+	    if (((ch1 & 0xFC00) == 0xD800)) {
+	    if ((ch2 & 0xFC00) != 0xD800) {
+		return ch1;
+	    }
+	    } else if ((ch2 & 0xFC00) == 0xD800) {
+		return -ch2;
+	    }
 #endif
-	if (ch1 != ch2) {
 	    ch1 = Tcl_UniCharToLower(ch1);
 	    ch2 = Tcl_UniCharToLower(ch2);
 	    if (ch1 != ch2) {
@@ -1135,6 +1135,52 @@ Tcl_UtfNcasecmp(
     }
     return 0;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfCmp --
+ *
+ *	Compare UTF chars of string cs to string ct case sensitively.
+ *	Replacement for strcmp in Tcl core, in places where UTF-8 should
+ *	be handled.
+ *
+ * Results:
+ *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUtfCmp(
+    const char *cs,		/* UTF string to compare to ct. */
+    const char *ct)		/* UTF string cs is compared to. */
+{
+    Tcl_UniChar ch1 = 0, ch2 = 0;
+
+    while (*cs && *ct) {
+	cs += TclUtfToUniChar(cs, &ch1);
+	ct += TclUtfToUniChar(ct, &ch2);
+	if (ch1 != ch2) {
+#if TCL_UTF_MAX == 4
+	    /* Surrogates always report higher than non-surrogates */
+	    if (((ch1 & 0xFC00) == 0xD800)) {
+	    if ((ch2 & 0xFC00) != 0xD800) {
+		return ch1;
+	    }
+	    } else if ((ch2 & 0xFC00) == 0xD800) {
+		return -ch2;
+	    }
+#endif
+	    return ch1 - ch2;
+	}
+    }
+    return UCHAR(*cs) - UCHAR(*ct);
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -1164,16 +1210,17 @@ TclUtfCasecmp(
     while (*cs && *ct) {
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
+	if (ch1 != ch2) {
 #if TCL_UTF_MAX == 4
-    /* map high surrogate characters to values > 0xffff */
-    if ((ch1 & 0xFC00) == 0xD800) {
-	ch1 += 0x4000;
-    }
-    if ((ch2 & 0xFC00) == 0xD800) {
-	ch2 += 0x4000;
-    }
+	    /* Surrogates always report higher than non-surrogates */
+	    if (((ch1 & 0xFC00) == 0xD800)) {
+	    if ((ch2 & 0xFC00) != 0xD800) {
+		return ch1;
+	    }
+	    } else if ((ch2 & 0xFC00) == 0xD800) {
+		return -ch2;
+	    }
 #endif
-	if (ch1 != ch2) {
 	    ch1 = Tcl_UniCharToLower(ch1);
 	    ch2 = Tcl_UniCharToLower(ch2);
 	    if (ch1 != ch2) {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 8ebace5..51af016 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1665,6 +1665,7 @@ TclTrimRight(
 {
     const char *p = bytes + numBytes;
     int pInc;
+    Tcl_UniChar ch1 = 0, ch2 = 0;
 
     if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
 	Tcl_Panic("TclTrimRight works only on null-terminated strings");
@@ -1683,7 +1684,6 @@ TclTrimRight(
      */
 
     do {
-	Tcl_UniChar ch1;
 	const char *q = trim;
 	int bytesLeft = numTrim;
 
@@ -1695,7 +1695,6 @@ TclTrimRight(
 	 */
 
 	do {
-	    Tcl_UniChar ch2;
 	    int qInc = TclUtfToUniChar(q, &ch2);
 
 	    if (ch1 == ch2) {
@@ -1745,6 +1744,7 @@ TclTrimLeft(
     int numTrim)		/* ...and its length in bytes */
 {
     const char *p = bytes;
+	Tcl_UniChar ch1 = 0, ch2 = 0;
 
     if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
 	Tcl_Panic("TclTrimLeft works only on null-terminated strings");
@@ -1763,7 +1763,6 @@ TclTrimLeft(
      */
 
     do {
-	Tcl_UniChar ch1;
 	int pInc = TclUtfToUniChar(p, &ch1);
 	const char *q = trim;
 	int bytesLeft = numTrim;
@@ -1773,7 +1772,6 @@ TclTrimLeft(
 	 */
 
 	do {
-	    Tcl_UniChar ch2;
 	    int qInc = TclUtfToUniChar(q, &ch2);
 
 	    if (ch1 == ch2) {
@@ -2107,7 +2105,7 @@ Tcl_StringCaseMatch(
 {
     int p, charLen;
     const char *pstart = pattern;
-    Tcl_UniChar ch1, ch2;
+    Tcl_UniChar ch1 = 0, ch2 = 0;
 
     while (1) {
 	p = *pattern;
@@ -2217,7 +2215,7 @@ Tcl_StringCaseMatch(
 	 */
 
 	if (p == '[') {
-	    Tcl_UniChar startChar, endChar;
+	    Tcl_UniChar startChar = 0, endChar = 0;
 
 	    pattern++;
 	    if (UCHAR(*str) < 0x80) {
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 70ac6bb..df59e6e 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -19,6 +19,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Used for constraining memory leak tests
 testConstraint memory [llength [info commands memory]]
 testConstraint testobj [llength [info commands testobj]]
+testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
 
 test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
     lsort
@@ -147,6 +148,18 @@ test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
 	{{b i g} 12345} {{d e m o} 34512}
     }
 } {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
+test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
+    lsort -ascii [list \0 \x7f \x80 \uffff]
+} [list \0 \x7f \x80 \uffff]
+test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
+    lsort -ascii -nocase [list \0 \x7f \x80 \uffff]
+} [list \0 \x7f \x80 \uffff]
+test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} fullutf {
+    lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff]
+} [list \0 \x7f \x80 \uffff \U01ffff]
+test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} fullutf {
+    lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff]
+} [list \0 \x7f \x80 \uffff \U01ffff]
 
 # Can't think of any good tests for the MergeSort and MergeLists procedures,
 # except a bunch of random lists to sort.
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index ed1a8e5..acfeecb 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1738,7 +1738,7 @@ SerialSetOptionProc(
 	dcb.XonChar = argv[0][0];
 	dcb.XoffChar = argv[1][0];
 	if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
-	    Tcl_UniChar character;
+	    Tcl_UniChar character = 0;
 	    int charLen;
 
 	    charLen = Tcl_UtfToUniChar(argv[0], &character);
-- 
cgit v0.12


From d7d31d6041d72ace8e80d409c12749ab819499ec Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 30 Nov 2017 14:14:01 +0000
Subject: Don't provide the setFromAnyProc through the invalidRealType objType.
 This is a Tcl internal type, extensions shouldn't be able to convert their
 own Tcl_Obj to this. This shouldn't have been exposed to begin with. Tcl
 itself never calls it this way.

---
 generic/tclLink.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclLink.c b/generic/tclLink.c
index 7d1e3a8..6f75849 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -638,7 +638,7 @@ static Tcl_ObjType invalidRealType = {
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
     NULL,				/* updateStringProc */
-    SetInvalidRealFromAny		/* setFromAnyProc */
+    NULL				/* setFromAnyProc */
 };
 
 static int
-- 
cgit v0.12


From 99798b2202f0a40a22c5d5e2d457759a5526005a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 30 Nov 2017 15:24:39 +0000
Subject: Fix build of test-suite, after previous commit

---
 generic/tclIntDecls.h | 63 +++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 51 insertions(+), 12 deletions(-)

diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index f2654c0..c3ee084 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -1354,31 +1354,70 @@ extern const TclIntStubs *tclIntStubsPtr;
 #   undef TclSetStartupScript
 #   undef TclGetStartupScript
 #   undef TclCreateNamespace
-#   define tcl_CreateNamespace tclCreateNamespace
 #   undef TclDeleteNamespace
-#   define tcl_DeleteNamespace tclDeleteNamespace
 #   undef TclAppendExportList
-#   define tcl_AppendExportList tclAppendExportList
 #   undef TclExport
-#   define tcl_Export tclExport
 #   undef TclImport
-#   define tcl_Import tclImport
 #   undef TclForgetImport
-#   define tcl_ForgetImport tclForgetImport
 #   undef TclGetCurrentNamespace_
-#   define tcl_GetCurrentNamespace tclGetCurrentNamespace_
 #   undef TclGetGlobalNamespace_
-#   define tcl_GetGlobalNamespace tclGetGlobalNamespace_
 #   undef TclFindNamespace
-#   define tcl_FindNamespace tclFindNamespace
 #   undef TclFindCommand
-#   define tcl_FindCommand tclFindCommand
 #   undef TclGetCommandFromObj
-#   define tcl_GetCommandFromObj tclGetCommandFromObj
 #   undef TclGetCommandFullName
-#   define tcl_GetCommandFullName tclGetCommandFullName
 #   undef TclCopyChannelOld
 #   undef TclSockMinimumBuffersOld
+
+#if !defined(TCL_NO_DEPRECATED)
+#   undef Tcl_CreateNamespace
+#   define Tcl_CreateNamespace \
+	    (tclIntStubsPtr->tclCreateNamespace) /* 113 */
+#   define tcl_CreateNamespace tclCreateNamespace
+#   undef Tcl_DeleteNamespace
+#   define Tcl_DeleteNamespace \
+	    (tclIntStubsPtr->tclDeleteNamespace) /* 114 */
+#   define tcl_DeleteNamespace tclDeleteNamespace
+#   undef Tcl_AppendExportList
+#   define Tcl_AppendExportList \
+	    (tclIntStubsPtr->tclAppendExportList) /* 112 */
+#   define tcl_AppendExportList tclAppendExportList
+#   undef Tcl_Export
+#   define Tcl_Export \
+	    (tclIntStubsPtr->tclExport) /* 115 */
+#   define tcl_Export tclExport
+#   undef Tcl_Import
+#   define Tcl_Import \
+	    (tclIntStubsPtr->tclImport) /* 127 */
+#   define tcl_Import tclImport
+#   undef Tcl_ForgetImport
+#   define Tcl_ForgetImport \
+	    (tclIntStubsPtr->tclForgetImport) /* 121 */
+#   define tcl_ForgetImport tclForgetImport
+#   undef Tcl_GetCurrentNamespace
+#   define Tcl_GetCurrentNamespace \
+	    (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
+#   define tcl_GetCurrentNamespace tclGetCurrentNamespace_
+#   undef Tcl_GetGlobalNamespace
+#   define Tcl_GetGlobalNamespace \
+	    (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
+#   define tcl_GetGlobalNamespace tclGetGlobalNamespace_
+#   undef Tcl_FindNamespace
+#   define Tcl_FindNamespace \
+	    (tclIntStubsPtr->tclFindNamespace) /* 117 */
+#   define tcl_FindNamespace tclFindNamespace
+#   undef Tcl_FindCommand
+#   define Tcl_FindCommand \
+	    (tclIntStubsPtr->tclFindCommand) /* 116 */
+#   define tcl_FindCommand tclFindCommand
+#   undef Tcl_GetCommandFromObj
+#   define Tcl_GetCommandFromObj \
+	    (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
+#   define tcl_GetCommandFromObj tclGetCommandFromObj
+#   undef Tcl_GetCommandFullName
+#   define Tcl_GetCommandFullName \
+	    (tclIntStubsPtr->tclGetCommandFullName) /* 123 */
+#   define tcl_GetCommandFullName tclGetCommandFullName
+#endif /* !defined(TCL_NO_DEPRECATED) */
 #endif
 
 #endif /* _TCLINTDECLS */
-- 
cgit v0.12


From 0efada5548249fb9f61dcd3a5eea4ceb381e3e52 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 30 Nov 2017 16:03:01 +0000
Subject: Eliminate use of certain unnecessary struct names. Also
 white-spacing. Nothing functional.

---
 generic/tclEncoding.c |  8 ++++----
 generic/tclEnsemble.c | 10 +++++-----
 generic/tclIORTrans.c |  6 +++---
 generic/tclIOUtil.c   |  2 +-
 generic/tclOO.c       |  6 +++---
 tests/oo.test         |  4 ++--
 6 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 1f48a1c..e1e26d3 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src);
  * convert between various character sets and UTF-8.
  */
 
-typedef struct Encoding {
+typedef struct {
     char *name;			/* Name of encoding. Malloced because (1) hash
 				 * table entry that owns this encoding may be
 				 * freed prior to this encoding being freed,
@@ -57,7 +57,7 @@ typedef struct Encoding {
  * encoding.
  */
 
-typedef struct TableEncodingData {
+typedef struct {
     int fallback;		/* Character (in this encoding) to substitute
 				 * when this encoding cannot represent a UTF-8
 				 * character. */
@@ -91,7 +91,7 @@ typedef struct TableEncodingData {
  * for switching character sets.
  */
 
-typedef struct EscapeSubTable {
+typedef struct {
     unsigned sequenceLen;	/* Length of following string. */
     char sequence[16];		/* Escape code that marks this encoding. */
     char name[32];		/* Name for encoding. */
@@ -100,7 +100,7 @@ typedef struct EscapeSubTable {
 				 * yet. */
 } EscapeSubTable;
 
-typedef struct EscapeEncodingData {
+typedef struct {
     int fallback;		/* Character (in this encoding) to substitute
 				 * when this encoding cannot represent a UTF-8
 				 * character. */
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index a981851..972c33e 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -649,12 +649,12 @@ TclNamespaceEnsembleCmd(
 
 Tcl_Command
 TclCreateEnsembleInNs(
-    Tcl_Interp *interp, 
-			
+    Tcl_Interp *interp,
+
     const char *name,   /* Simple name of command to create (no */
 			/* namespace components). */
-    Tcl_Namespace       /* Name of namespace to create the command in. */ 
-    *nameNsPtr,	
+    Tcl_Namespace       /* Name of namespace to create the command in. */
+    *nameNsPtr,
     Tcl_Namespace
     *ensembleNsPtr,	/* Name of the namespace for the ensemble. */
     int flags
@@ -2591,7 +2591,7 @@ BuildEnsembleConfig(
 		    if (ensemblePtr->subcmdList == ensemblePtr->subcommandDict) {
 			subcmdDictCopy = Tcl_DuplicateObj(ensemblePtr->subcommandDict);
 		    } else {
-			subcmdDictCopy = ensemblePtr->subcommandDict; 
+			subcmdDictCopy = ensemblePtr->subcommandDict;
 		    }
 		    Tcl_IncrRefCount(subcmdDictCopy);
 		}
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index f198c69..fe2e458 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = {
  * layers upon reading from the channel, plus the functions to manage such.
  */
 
-typedef struct _ResultBuffer_ {
+typedef struct {
     unsigned char *buf;		/* Reference to the buffer area. */
     int allocated;		/* Allocated size of the buffer area. */
     int used;			/* Number of bytes in the buffer,
@@ -253,7 +253,7 @@ typedef enum {
  * sharing problems.
  */
 
-typedef struct ForwardParamBase {
+typedef struct {
     int code;			/* O: Ok/Fail of the cmd handler */
     char *msgStr;		/* O: Error message for handler failure */
     int mustFree;		/* O: True if msgStr is allocated, false if
@@ -298,7 +298,7 @@ typedef struct ForwardingResult ForwardingResult;
  * General event structure, with reference to operation specific data.
  */
 
-typedef struct ForwardingEvent {
+typedef struct {
     Tcl_Event event;		/* Basic event data, has to be first item */
     ForwardingResult *resultPtr;
     ForwardedOperation op;	/* Forwarded driver operation */
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 4f2288e..8fb3aa8 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -245,7 +245,7 @@ static Tcl_ThreadDataKey fsDataKey;
  * code.
  */
 
-typedef struct FsDivertLoad {
+typedef struct {
     Tcl_LoadHandle loadHandle;
     Tcl_FSUnloadFileProc *unloadProcPtr;
     Tcl_Obj *divertedFile;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 5404abc..84380e0 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1091,8 +1091,8 @@ ReleaseClassContents(
     }
 
     /* Tell oPtr that it's class is gone so that it doesn't try to remove
-     * itself from it's classe's list of instances 
-     */ 
+     * itself from it's classe's list of instances
+     */
     oPtr->flags |= CLASS_GONE;
     DelRef(clsPtr);
 
@@ -1247,7 +1247,7 @@ ObjectNamespaceDeleted(
     /*
      *  Because an object can be a class that is an instance of itself, the
      *  A class object's class structure should only be cleaned after most of
-     *  the cleanup on the object is done. 
+     *  the cleanup on the object is done.
      */
 
 
diff --git a/tests/oo.test b/tests/oo.test
index 556d529..b9c5067 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -129,7 +129,7 @@ test oo-1.4 {basic test of OO functionality} -body {
     oo::object create {}
 } -returnCodes 1 -result {object name must not be empty}
 test oo-1.4.1 {fully-qualified nested name} -body {
-    oo::object create ::one::two::three 
+    oo::object create ::one::two::three
 } -result {::one::two::three}
 test oo-1.5 {basic test of OO functionality} -body {
     oo::object doesnotexist
@@ -3889,7 +3889,7 @@ test oo-35.6 {
     return done
 } -cleanup {
     rename obj {}
-} -result done 
+} -result done
 
 
 
-- 
cgit v0.12


From 4bbfdee3db6fbfb19e5d19f48bac51280d2e55fa Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 30 Nov 2017 17:10:37 +0000
Subject: [5808081213] Permit all bytearrays (including impure ones) to report
 length without shimmering

---
 generic/tclStringObj.c | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index d43cc45..0f238cf 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -418,12 +418,16 @@ Tcl_GetCharLength(
     int numChars;
 
     /*
-     * Optimize the case where we're really dealing with a bytearray object
-     * without string representation; we don't need to convert to a string to
-     * perform the get-length operation.
+     * Optimize the case where we're really dealing with a bytearray object;
+     * we don't need to convert to a string to perform the get-length operation.
+     *
+     * NOTE that we do not need the bytearray to be "pure".  A ByteArray value
+     * with a string rep cannot be trusted to represent the same value as the
+     * string rep, but it *can* be trusted to have the same character length
+     * as the string rep, which is all this routine cares about.
      */
 
-    if (TclIsPureByteArray(objPtr)) {
+    if (objPtr->typePtr == &tclByteArrayType) {
 	int length;
 
 	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
-- 
cgit v0.12


From 1a237e67df1f72fce66636d7efcd7cffa82bd0b8 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 1 Dec 2017 10:38:04 +0000
Subject: Simpler solution for Itcl 3.4 build (compatibilty) problem. Thanks to
 Don Porter for bringing this to my attention!

---
 generic/tclIntDecls.h | 67 ++++++++++++---------------------------------------
 1 file changed, 16 insertions(+), 51 deletions(-)

diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index c3ee084..5848bb3 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -28,6 +28,22 @@
 #   endif
 #endif
 
+#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
+/* Those macro's are especially for Itcl 3.4 compatibility */
+#   define tclCreateNamespace tcl_CreateNamespace
+#   define tclDeleteNamespace tcl_DeleteNamespace
+#   define tclAppendExportList tcl_AppendExportList
+#   define tclExport tcl_Export
+#   define tclImport tcl_Import
+#   define tclForgetImport tcl_ForgetImport
+#   define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
+#   define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
+#   define tclFindNamespace tcl_FindNamespace
+#   define tclFindCommand tcl_FindCommand
+#   define tclGetCommandFromObj tcl_GetCommandFromObj
+#   define tclGetCommandFullName tcl_GetCommandFullName
+#endif /* !defined(TCL_NO_DEPRECATED) */
+
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
  * script.  Any modifications to the function declarations below should be made
@@ -1367,57 +1383,6 @@ extern const TclIntStubs *tclIntStubsPtr;
 #   undef TclGetCommandFullName
 #   undef TclCopyChannelOld
 #   undef TclSockMinimumBuffersOld
-
-#if !defined(TCL_NO_DEPRECATED)
-#   undef Tcl_CreateNamespace
-#   define Tcl_CreateNamespace \
-	    (tclIntStubsPtr->tclCreateNamespace) /* 113 */
-#   define tcl_CreateNamespace tclCreateNamespace
-#   undef Tcl_DeleteNamespace
-#   define Tcl_DeleteNamespace \
-	    (tclIntStubsPtr->tclDeleteNamespace) /* 114 */
-#   define tcl_DeleteNamespace tclDeleteNamespace
-#   undef Tcl_AppendExportList
-#   define Tcl_AppendExportList \
-	    (tclIntStubsPtr->tclAppendExportList) /* 112 */
-#   define tcl_AppendExportList tclAppendExportList
-#   undef Tcl_Export
-#   define Tcl_Export \
-	    (tclIntStubsPtr->tclExport) /* 115 */
-#   define tcl_Export tclExport
-#   undef Tcl_Import
-#   define Tcl_Import \
-	    (tclIntStubsPtr->tclImport) /* 127 */
-#   define tcl_Import tclImport
-#   undef Tcl_ForgetImport
-#   define Tcl_ForgetImport \
-	    (tclIntStubsPtr->tclForgetImport) /* 121 */
-#   define tcl_ForgetImport tclForgetImport
-#   undef Tcl_GetCurrentNamespace
-#   define Tcl_GetCurrentNamespace \
-	    (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
-#   define tcl_GetCurrentNamespace tclGetCurrentNamespace_
-#   undef Tcl_GetGlobalNamespace
-#   define Tcl_GetGlobalNamespace \
-	    (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
-#   define tcl_GetGlobalNamespace tclGetGlobalNamespace_
-#   undef Tcl_FindNamespace
-#   define Tcl_FindNamespace \
-	    (tclIntStubsPtr->tclFindNamespace) /* 117 */
-#   define tcl_FindNamespace tclFindNamespace
-#   undef Tcl_FindCommand
-#   define Tcl_FindCommand \
-	    (tclIntStubsPtr->tclFindCommand) /* 116 */
-#   define tcl_FindCommand tclFindCommand
-#   undef Tcl_GetCommandFromObj
-#   define Tcl_GetCommandFromObj \
-	    (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
-#   define tcl_GetCommandFromObj tclGetCommandFromObj
-#   undef Tcl_GetCommandFullName
-#   define Tcl_GetCommandFullName \
-	    (tclIntStubsPtr->tclGetCommandFullName) /* 123 */
-#   define tcl_GetCommandFullName tclGetCommandFullName
-#endif /* !defined(TCL_NO_DEPRECATED) */
 #endif
 
 #endif /* _TCLINTDECLS */
-- 
cgit v0.12


From 92f8ce13dfb1299030dc844252d7478caaaa7687 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 4 Dec 2017 18:36:14 +0000
Subject: [4f6a1ebd64] Different fix for the problem. Re-order the filling of
 the subcommand table so there is no longer a conflict where multiple intreps
 of a single value are sought. If the mapDict and exportList are the same,
 then each key in the mapDict is known to be an element of the exportList
 without needing to check.

---
 generic/tclNamesp.c  | 115 +++++++++++++++++++++++++--------------------------
 tests/namespace.test |  19 ++++++++-
 2 files changed, 73 insertions(+), 61 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 4b72e03..18cd07c 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -6582,6 +6582,8 @@ BuildEnsembleConfig(
     int i, j, isNew;
     Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
     Tcl_HashEntry *hPtr;
+    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
+    Tcl_Obj *exportList = ensemblePtr->subcmdList;
 
     if (hash->numEntries != 0) {
 	/*
@@ -6601,51 +6603,67 @@ BuildEnsembleConfig(
 	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
     }
 
-    /*
-     * See if we've got an export list. If so, we will only export exactly
-     * those commands, which may be either implemented by the prefix in the
-     * subcommandDict or mapped directly onto the namespace's commands.
-     */
-
-    if (ensemblePtr->subcmdList != NULL) {
-	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
-	int subcmdc;
+    if (mapDict) {
+	/*
+	 * We have a mapping dictionary to direct filling of the subcommand
+	 * table.  Every key, value in the dict should go into the table
+	 * unless we have an export list that holds some of the keys back.
+	 */
 
-	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
-		&subcmdv);
-	for (i=0 ; i<subcmdc ; i++) {
-	    char *name = TclGetString(subcmdv[i]);
+	Tcl_DictSearch dictSearch;
+	Tcl_Obj *keyObj, *valueObj;
+	int done;
 
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+	Tcl_DictObjFirst(NULL, mapDict, &dictSearch, &keyObj, &valueObj, &done);
+	while (!done) {
+	    int nameLen, insert = 1;
+	    char *name = TclGetStringFromObj(keyObj, &nameLen);
+
+	    if (exportList && (exportList != mapDict)) {
+		Tcl_Obj **subv;
+		int subc;
+
+		insert = 0;
+		TclListObjGetElements(NULL, exportList, &subc, &subv);
+		for (i = 0; i < subc; i++) {
+		    int compareLen;
+		    const char *compare
+			    = TclGetStringFromObj(subv[i], &compareLen);
+
+		    if ((nameLen == compareLen)
+			    && (memcmp(name, compare, (size_t)nameLen) == 0)) {
+			insert = 1;
+			break;
+		    }
+		}
+	    }
+	    if (insert) {
+		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+		Tcl_SetHashValue(hPtr, valueObj);
+		Tcl_IncrRefCount(valueObj);
+	    }
+	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
+	}
+    }
+    if (exportList) {
+	/*
+	 * We have an export list. Put into the table each element that's
+	 * not already there.
+	 */
+	int subc;
+	Tcl_Obj **subv, *cmdObj, *cmdPrefixObj;
 
-	    /*
-	     * Skip non-unique cases.
-	     */
+	TclListObjGetElements(NULL, exportList, &subc, &subv); 
+	for (i=0 ; i<subc ; i++) {
+	    char *name = TclGetString(subv[i]);
 
+	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
 	    if (!isNew) {
+		/* Subcommand already in the table, from the mapDict. */
 		continue;
 	    }
 
-	    /*
-	     * Look in our dictionary (if present) for the command.
-	     */
-
-	    if (ensemblePtr->subcommandDict != NULL) {
-		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
-			&target);
-		if (target != NULL) {
-		    Tcl_SetHashValue(hPtr, target);
-		    Tcl_IncrRefCount(target);
-		    continue;
-		}
-	    }
-
-	    /*
-	     * Not there, so map onto the namespace. Note in this case that we
-	     * do not guarantee that the command is actually there; that is
-	     * the programmer's responsibility (or [::unknown] of course).
-	     */
-
+	    /* Need to put entry in table, but it's not in mapDict */
 	    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
 	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
 		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
@@ -6656,28 +6674,7 @@ BuildEnsembleConfig(
 	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
 	    Tcl_IncrRefCount(cmdPrefixObj);
 	}
-    } else if (ensemblePtr->subcommandDict != NULL) {
-	/*
-	 * No subcmd list, but we do have a mapping dictionary so we should
-	 * use the keys of that. Convert the dictionary's contents into the
-	 * form required for the ensemble's internal hashtable.
-	 */
-
-	Tcl_DictSearch dictSearch;
-	Tcl_Obj *keyObj, *valueObj;
-	int done;
-
-	Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
-		&keyObj, &valueObj, &done);
-	while (!done) {
-	    char *name = TclGetString(keyObj);
-
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-	    Tcl_SetHashValue(hPtr, valueObj);
-	    Tcl_IncrRefCount(valueObj);
-	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
-	}
-    } else {
+    } else if (mapDict == NULL) {
 	/*
 	 * Discover what commands are actually exported by the namespace.
 	 * What we have is an array of patterns and a hash table whose keys
diff --git a/tests/namespace.test b/tests/namespace.test
index 7d41258..0ad8451 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1599,14 +1599,29 @@ test namespace-42.9 {
     deallocated List struct.
 } -setup {
     namespace eval n {namespace ensemble create}
-    dict set list one ::two
-    namespace ensemble configure n -subcommands $list -map $list
+    set lst [dict create one ::two]
+    namespace ensemble configure n -subcommands $lst -map $lst
 } -body {
     n one
 } -cleanup {
     namespace delete n
+    unset -nocomplain lst
 } -returnCodes error -match glob -result {invalid command name*}
 
+test namespace-42.10 {
+    ensembles: [Bug 4f6a1ebd64] segmentation fault due to pointer to a
+    deallocated List struct (this time with duplicate of one in "dict").
+} -setup {
+    namespace eval n {namespace ensemble create}
+    set lst [list one ::two one ::three]
+    namespace ensemble configure n -subcommands $lst -map $lst
+} -body {
+    n one
+} -cleanup {
+    namespace delete n
+    unset -nocomplain lst
+} -returnCodes error -match glob -result {invalid command name *three*}
+
 test namespace-43.1 {ensembles: dict-driven} {
     namespace eval ns {
 	namespace export x*
-- 
cgit v0.12


From 8a44c35e8c34860fe2ea418899c8f62fc25e06bb Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 5 Dec 2017 14:36:33 +0000
Subject: Another revised fix, much closer to sebres' patch now.

---
 generic/tclNamesp.c | 152 +++++++++++++++++++++++++++++++---------------------
 1 file changed, 90 insertions(+), 62 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 18cd07c..1556ec9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -6583,7 +6583,7 @@ BuildEnsembleConfig(
     Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
     Tcl_HashEntry *hPtr;
     Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
-    Tcl_Obj *exportList = ensemblePtr->subcmdList;
+    Tcl_Obj *subList = ensemblePtr->subcmdList;
 
     if (hash->numEntries != 0) {
 	/*
@@ -6603,78 +6603,106 @@ BuildEnsembleConfig(
 	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
     }
 
-    if (mapDict) {
+    if (subList) {
+	int subc;
+	Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
+	char *name;
+
 	/*
-	 * We have a mapping dictionary to direct filling of the subcommand
-	 * table.  Every key, value in the dict should go into the table
-	 * unless we have an export list that holds some of the keys back.
+	 * There is a list of exactly what subcommands go in the table.
+	 * Must determine the target for each.
 	 */
 
-	Tcl_DictSearch dictSearch;
-	Tcl_Obj *keyObj, *valueObj;
-	int done;
-
-	Tcl_DictObjFirst(NULL, mapDict, &dictSearch, &keyObj, &valueObj, &done);
-	while (!done) {
-	    int nameLen, insert = 1;
-	    char *name = TclGetStringFromObj(keyObj, &nameLen);
-
-	    if (exportList && (exportList != mapDict)) {
-		Tcl_Obj **subv;
-		int subc;
-
-		insert = 0;
-		TclListObjGetElements(NULL, exportList, &subc, &subv);
-		for (i = 0; i < subc; i++) {
-		    int compareLen;
-		    const char *compare
-			    = TclGetStringFromObj(subv[i], &compareLen);
-
-		    if ((nameLen == compareLen)
-			    && (memcmp(name, compare, (size_t)nameLen) == 0)) {
-			insert = 1;
-			break;
-		    }
+	Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
+	if (subList == mapDict) {
+	    /*
+	     * Strange case where explicit list of subcommands is same value
+	     * as the dict mapping to targets.
+	     */
+
+	    for (i = 0; i < subc; i += 2) {
+		name = TclGetString(subv[i]);
+		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+		if (!isNew) {
+		    cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
+		    Tcl_DecrRefCount(cmdObj);
 		}
-	    }
-	    if (insert) {
+		Tcl_SetHashValue(hPtr, subv[i+1]);
+		Tcl_IncrRefCount(subv[i+1]);
+
+		name = TclGetString(subv[i+1]);
 		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-		Tcl_SetHashValue(hPtr, valueObj);
-		Tcl_IncrRefCount(valueObj);
+		if (isNew) {
+		    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+		    if (ensemblePtr->nsPtr->parentPtr != NULL) {
+			Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
+		    } else {
+			Tcl_AppendStringsToObj(cmdObj, name, NULL);
+		    }
+		    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+		    Tcl_SetHashValue(hPtr, cmdPrefixObj);
+		    Tcl_IncrRefCount(cmdPrefixObj);
+		}
 	    }
-	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
-	}
-    }
-    if (exportList) {
-	/*
-	 * We have an export list. Put into the table each element that's
-	 * not already there.
-	 */
-	int subc;
-	Tcl_Obj **subv, *cmdObj, *cmdPrefixObj;
+	} else {
+	    /* Usual case where we can freely act on the list and dict. */
 
-	TclListObjGetElements(NULL, exportList, &subc, &subv); 
-	for (i=0 ; i<subc ; i++) {
-	    char *name = TclGetString(subv[i]);
+	    for (i = 0; i < subc; i++) {
+		name = TclGetString(subv[i]);
+		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+		if (!isNew) {
+		    continue;
+		}
 
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-	    if (!isNew) {
-		/* Subcommand already in the table, from the mapDict. */
-		continue;
-	    }
+		/* Lookup target in the dictionary */
+		if (mapDict) {
+		    Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
+		    if (target) {
+			Tcl_SetHashValue(hPtr, target);
+			Tcl_IncrRefCount(target);
+			continue;
+		    }
+		}
 
-	    /* Need to put entry in table, but it's not in mapDict */
-	    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
-	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
-		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
-	    } else {
-		Tcl_AppendStringsToObj(cmdObj, name, NULL);
+		/*
+		 * target was not in the dictionary so map onto the namespace.
+		 * Note in this case that we do not guarantee that the
+		 * command is actually there; that is the programmer's
+		 * responsibility (or [::unknown] of course).
+		 */
+		cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+		if (ensemblePtr->nsPtr->parentPtr != NULL) {
+		    Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
+		} else {
+		    Tcl_AppendStringsToObj(cmdObj, name, NULL);
+		}
+		cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+		Tcl_SetHashValue(hPtr, cmdPrefixObj);
+		Tcl_IncrRefCount(cmdPrefixObj);
 	    }
-	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
-	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
-	    Tcl_IncrRefCount(cmdPrefixObj);
 	}
-    } else if (mapDict == NULL) {
+    } else if (mapDict) {
+        /*
+         * No subcmd list, but we do have a mapping dictionary so we should
+         * use the keys of that. Convert the dictionary's contents into the
+         * form required for the ensemble's internal hashtable.
+         */
+
+        Tcl_DictSearch dictSearch;
+        Tcl_Obj *keyObj, *valueObj;
+        int done;
+
+        Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
+                &keyObj, &valueObj, &done);
+        while (!done) {
+            char *name = TclGetString(keyObj);
+
+            hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+            Tcl_SetHashValue(hPtr, valueObj);
+            Tcl_IncrRefCount(valueObj);
+            Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
+        }
+    } else {
 	/*
 	 * Discover what commands are actually exported by the namespace.
 	 * What we have is an array of patterns and a hash table whose keys
-- 
cgit v0.12


From 3eef9fcea1274b68161aa2c5ebfb6a975ac7143a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 5 Dec 2017 15:12:05 +0000
Subject: Factor clearing of ensemble subcommand table into utility routine.

---
 generic/tclNamesp.c | 52 +++++++++++++++++++++++-----------------------------
 1 file changed, 23 insertions(+), 29 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 1556ec9..a2e625e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -6480,13 +6480,31 @@ MakeCachedEnsembleCommand(
  */
 
 static void
+ClearTable(
+    EnsembleConfig *ensemblePtr)
+{
+    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
+
+    if (hash->numEntries != 0) {
+	Tcl_HashSearch search;
+	Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);
+
+	while (hPtr != NULL) {
+	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
+	    Tcl_DecrRefCount(prefixObj);
+	    hPtr = Tcl_NextHashEntry(&search);
+	}
+	ckfree((char *) ensemblePtr->subcommandArrayPtr);
+    }
+    Tcl_DeleteHashTable(hash);
+}
+
+static void
 DeleteEnsembleConfig(
     ClientData clientData)
 {
     EnsembleConfig *ensemblePtr = clientData;
     Namespace *nsPtr = ensemblePtr->nsPtr;
-    Tcl_HashSearch search;
-    Tcl_HashEntry *hEnt;
 
     /*
      * Unlink from the ensemble chain if it has not been marked as having been
@@ -6519,17 +6537,8 @@ DeleteEnsembleConfig(
      * Kill the pointer-containing fields.
      */
 
-    if (ensemblePtr->subcommandTable.numEntries != 0) {
-	ckfree((char *) ensemblePtr->subcommandArrayPtr);
-    }
-    hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
-    while (hEnt != NULL) {
-	Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
+    ClearTable(ensemblePtr);
 
-	Tcl_DecrRefCount(prefixObj);
-	hEnt = Tcl_NextHashEntry(&search);
-    }
-    Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
     if (ensemblePtr->subcmdList != NULL) {
 	Tcl_DecrRefCount(ensemblePtr->subcmdList);
     }
@@ -6585,23 +6594,8 @@ BuildEnsembleConfig(
     Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
     Tcl_Obj *subList = ensemblePtr->subcmdList;
 
-    if (hash->numEntries != 0) {
-	/*
-	 * Remove pre-existing table.
-	 */
-
-	Tcl_HashSearch search;
-
-	ckfree((char *) ensemblePtr->subcommandArrayPtr);
-	hPtr = Tcl_FirstHashEntry(hash, &search);
-	while (hPtr != NULL) {
-	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
-	    Tcl_DecrRefCount(prefixObj);
-	    hPtr = Tcl_NextHashEntry(&search);
-	}
-	Tcl_DeleteHashTable(hash);
-	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
-    }
+    ClearTable(ensemblePtr);
+    Tcl_InitHashTable(hash, TCL_STRING_KEYS);
 
     if (subList) {
 	int subc;
-- 
cgit v0.12