Merge trunk.

Convert Tcl_UntraceVar to macro, calling Tcl_UntraceVar2 in stead. No change of functionality.

9 files changed, 47 insertions, 91 deletions

diff --git a/ChangeLog b/ChangeLog
index d282c5a..d8c23f6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2013-02-20  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclNamesp.c:	[Bug 3605447] Make sure the -clear option
+	* tests/namespace.test:	to [namespace export] always clears, whether
+	or not new export patterns are specified.
+
 2013-02-20  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tclWinDde.c: [Bug 3605401]: Compiler error with latest mingw-w64
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 68c67af..3a924de 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -918,10 +918,11 @@ declare 254 {
     int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
 	    int flags)
 }
-declare 255 {
-    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
-	    Tcl_VarTraceProc *proc, ClientData clientData)
-}
+# Removed in 9.0:
+#declare 255 {
+#    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
+#	    Tcl_VarTraceProc *proc, ClientData clientData)
+#}
 declare 256 {
     void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
 	    const char *part2, int flags, Tcl_VarTraceProc *proc,
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 5a50ba2..5f48d7e 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -702,11 +702,7 @@ TCLAPI int		Tcl_UnregisterChannel(Tcl_Interp *interp,
 /* 254 */
 TCLAPI int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
 				const char *part2, int flags);
-/* 255 */
-TCLAPI void		Tcl_UntraceVar(Tcl_Interp *interp,
-				const char *varName, int flags,
-				Tcl_VarTraceProc *proc,
-				ClientData clientData);
+/* Slot 255 is reserved */
 /* 256 */
 TCLAPI void		Tcl_UntraceVar2(Tcl_Interp *interp,
 				const char *part1, const char *part2,
@@ -2023,7 +2019,7 @@ typedef struct TclStubs {
     int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
     void (*reserved253)(void);
     int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
-    void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
+    void (*reserved255)(void);
     void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
     void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
     int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
@@ -2920,8 +2916,7 @@ extern const TclStubs *tclStubsPtr;
 /* Slot 253 is reserved */
 #define Tcl_UnsetVar2 \
 	(tclStubsPtr->tcl_UnsetVar2) /* 254 */
-#define Tcl_UntraceVar \
-	(tclStubsPtr->tcl_UntraceVar) /* 255 */
+/* Slot 255 is reserved */
 #define Tcl_UntraceVar2 \
 	(tclStubsPtr->tcl_UntraceVar2) /* 256 */
 #define Tcl_UpdateLinkedVar \
@@ -3735,6 +3730,8 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
 	Tcl_GetVar2(interp, varName, NULL, flags)
 #define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
 	Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
+#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
+	Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
 
 /*
  * Deprecated Tcl procedures:
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 85100cb..ebd7a73 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1420,7 +1420,7 @@ Tcl_VwaitObjCmd(
 	    break;
 	}
     }
-    Tcl_UntraceVar(interp, nameString,
+    Tcl_UntraceVar2(interp, nameString, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    VwaitVarProc, &done);
 
diff --git a/generic/tclLink.c b/generic/tclLink.c
index b5e540b..2146097 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -176,7 +176,7 @@ Tcl_UnlinkVar(
     if (linkPtr == NULL) {
 	return;
     }
-    Tcl_UntraceVar(interp, varName,
+    Tcl_UntraceVar2(interp, varName, NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    LinkTraceProc, linkPtr);
     Tcl_DecrRefCount(linkPtr->varName);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 43bed5e..3a00b64 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -697,8 +697,7 @@ Tcl_CreateNamespace(
 	 * Find the parent for the new namespace.
 	 */
 
-	TclGetNamespaceForQualName(interp, name, NULL,
-		/*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+	TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN,
 		&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
 
 	/*
@@ -1330,8 +1329,7 @@ Tcl_Export(
      * Check that the pattern doesn't have namespace qualifiers.
      */
 
-    TclGetNamespaceForQualName(interp, pattern, nsPtr,
-	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
 	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
@@ -1545,8 +1543,7 @@ Tcl_Import(
 	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
 	return TCL_ERROR;
     }
-    TclGetNamespaceForQualName(interp, pattern, nsPtr,
-	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
 	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (importNsPtr == NULL) {
@@ -1791,8 +1788,7 @@ Tcl_ForgetImport(
      * simple pattern.
      */
 
-    TclGetNamespaceForQualName(interp, pattern, nsPtr,
-	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
+    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
 	    &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (sourceNsPtr == NULL) {
@@ -3435,10 +3431,7 @@ NamespaceExportCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    const char *pattern, *string;
-    int resetListFirst = 0;
-    int firstArg, patternCt, i, result;
+    int firstArg, i;
 
     if (objc < 1) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
@@ -3446,42 +3439,27 @@ NamespaceExportCmd(
     }
 
     /*
-     * Process the optional "-clear" argument.
+     * If no pattern arguments are given, and "-clear" isn't specified, return
+     * the namespace's current export pattern list.
      */
 
-    firstArg = 1;
-    if (firstArg < objc) {
-	string = TclGetString(objv[firstArg]);
-	if (strcmp(string, "-clear") == 0) {
-	    resetListFirst = 1;
-	    firstArg++;
-	}
+    if (objc == 1) {
+	Tcl_Obj *listPtr = Tcl_NewObj();
+
+	(void) Tcl_AppendExportList(interp, NULL, listPtr);
+	Tcl_SetObjResult(interp, listPtr);
+	return TCL_OK;
     }
 
     /*
-     * If no pattern arguments are given, and "-clear" isn't specified, return
-     * the namespace's current export pattern list.
+     * Process the optional "-clear" argument.
      */
 
-    patternCt = objc - firstArg;
-    if (patternCt == 0) {
-	if (firstArg > 1) {
-	    return TCL_OK;
-	} else {
-	    /*
-	     * Create list with export patterns.
-	     */
-
-	    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
-
-	    result = Tcl_AppendExportList(interp, (Tcl_Namespace *) currNsPtr,
-		    listPtr);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    Tcl_SetObjResult(interp, listPtr);
-	    return TCL_OK;
-	}
+    firstArg = 1;
+    if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) {
+	Tcl_Export(interp, NULL, "::", 1);
+	Tcl_ResetResult(interp);
+	firstArg++;
     }
 
     /*
@@ -3489,9 +3467,7 @@ NamespaceExportCmd(
      */
 
     for (i = firstArg;  i < objc;  i++) {
-	pattern = TclGetString(objv[i]);
-	result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
-		((i == firstArg)? resetListFirst : 0));
+	int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0);
 	if (result != TCL_OK) {
 	    return result;
 	}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 53a1ee6..c7a60e5 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -915,7 +915,7 @@ const TclStubs tclStubs = {
     Tcl_UnregisterChannel, /* 252 */
     0, /* 253 */
     Tcl_UnsetVar2, /* 254 */
-    Tcl_UntraceVar, /* 255 */
+    0, /* 255 */
     Tcl_UntraceVar2, /* 256 */
     Tcl_UpdateLinkedVar, /* 257 */
     Tcl_UpVar, /* 258 */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 6fa6c7d..c48234f 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -2801,38 +2801,6 @@ DisposeTraceResult(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UntraceVar --
- *
- *	Remove a previously-created trace for a variable.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	If there exists a trace for the variable given by varName with the
- *	given flags, proc, and clientData, then that trace is removed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_UntraceVar(
-    Tcl_Interp *interp,		/* Interpreter containing variable. */
-    const char *varName,	/* Name of variable; may end with "(index)" to
-				 * signify an array reference. */
-    int flags,			/* OR-ed collection of bits describing current
-				 * trace, including any of TCL_TRACE_READS,
-				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
-				 * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
-    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
-    ClientData clientData)	/* Arbitrary argument to pass to proc. */
-{
-    Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_UntraceVar2 --
  *
  *	Remove a previously-created trace for a variable.
diff --git a/tests/namespace.test b/tests/namespace.test
index 1d46bf0..f6688f1 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1111,6 +1111,14 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
     }
     list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
 } [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
+test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
+    catch {namespace delete foo}
+    namespace eval foo {
+	namespace export x
+	namespace export -clear
+    }
+    list [namespace eval foo namespace export] [namespace delete foo]
+} {{} {}}
 
 test namespace-27.1 {NamespaceForgetCmd, no args} {
     catch {namespace delete {*}[namespace children :: test_ns_*]}