From 422670d42865358d830bc1a65fc7aa48904a2d71 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 21 May 2008 13:26:14 +0000
Subject: Backport of fixes to Tcl_SetNamespaceUnknownHandler

---
 ChangeLog            |  6 ++++++
 generic/tclNamesp.c  | 61 +++++++++++++++++++++++++++++++---------------------
 tests/namespace.test | 11 +++++++++-
 3 files changed, 53 insertions(+), 25 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index a30bea6..7d880e3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-05-21  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd
+	logic for handling installation of namespace unknown handlers which
+	could lead too very strange things happening in the error case.
+
 2008-05-16  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclCompile.c: fix crash with tcl_traceExec. Found and
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f7fa9c1..c51ea08 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.162 2008/03/02 18:46:39 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.162.2.1 2008/05/21 13:26:16 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -4296,45 +4296,58 @@ Tcl_SetNamespaceUnknownHandler(
     Tcl_Namespace *nsPtr,	/* Namespace which is being updated. */
     Tcl_Obj *handlerPtr)	/* The new handler, or NULL to reset. */
 {
-    int lstlen;
+    int lstlen = 0;
     Namespace *currNsPtr = (Namespace *)nsPtr;
 
-    if (currNsPtr->unknownHandlerPtr != NULL) {
-	/*
-	 * Remove old handler first.
-	 */
+    /*
+     * Ensure that we check for errors *first* before we change anything.
+     */
 
-	Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr);
-	currNsPtr->unknownHandlerPtr = NULL;
+    if (handlerPtr != NULL) {
+	if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
+	    /*
+	     * Not a list.
+	     */
+
+	    return TCL_ERROR;
+	}
+	if (lstlen > 0) {
+	    /*
+	     * We are going to be saving this handler. Increment the reference
+	     * count before decrementing the refcount on the previous handler,
+	     * so that nothing strange can happen if we are told to set the
+	     * handler to the previous value.
+	     */
+
+	    Tcl_IncrRefCount(handlerPtr);
+	}
     }
 
     /*
-     * If NULL or an empty list is passed, then reset to the default
-     * handler.
+     * Remove old handler next.
      */
 
-    if (handlerPtr == NULL) {
-	currNsPtr->unknownHandlerPtr = NULL;
-    } else if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
-	/*
-	 * Not a list.
-	 */
+    if (currNsPtr->unknownHandlerPtr != NULL) {
+	Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr);
+    }
 
-	return TCL_ERROR;
-    } else if (lstlen == 0) {
+    /*
+     * Install the new handler.
+     */
+
+    if (lstlen > 0) {
 	/*
-	 * Empty list - reset to default.
+	 * Just store the handler. It already has the correct reference count.
 	 */
 
-	currNsPtr->unknownHandlerPtr = NULL;
+	currNsPtr->unknownHandlerPtr = handlerPtr;
     } else {
 	/*
-	 * Increment ref count and store. The reference count is decremented
-	 * either in the code above, or when the namespace is deleted.
+	 * If NULL or an empty list is passed, this resets to the default
+	 * handler.
 	 */
 
-	Tcl_IncrRefCount(handlerPtr);
-	currNsPtr->unknownHandlerPtr = handlerPtr;
+	currNsPtr->unknownHandlerPtr = NULL;
     }
     return TCL_OK;
 }
diff --git a/tests/namespace.test b/tests/namespace.test
index e445189..efb72db 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.70 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.70.2.1 2008/05/21 13:26:17 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -2619,6 +2619,15 @@ test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
     rename unknown.save ::unknown
     namespace eval :: [list namespace unknown $handler]
 } -result SUCCESS
+test namespace-52.12 {unknown: error case must not reset handler} -body {
+    namespace eval foo {
+	namespace unknown ok
+	catch {namespace unknown {{}{}{}}}
+	namespace unknown
+    }
+} -cleanup {
+    namespace delete foo
+} -result ok
     
 # cleanup
 catch {rename cmd1 {}}
-- 
cgit v0.12