Fix [Bug 1017022] by factorizing out the ensemble lookup code and fixing once.

3 files changed, 109 insertions, 28 deletions

diff --git a/ChangeLog b/ChangeLog
index 3a923e3..7f14a65 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-08-27  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclNamesp.c (FindEnsemble): Factor out the code to
+	convert a command name into an ensemble configuration and add
+	support for ignoring [namespace import] link chains. [Bug 1017022]
+
 2004-08-27  Daniel Steffen  <das@users.sourceforge.net>
 
 	* unix/Makefile.in: added customization of default module path roots
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index d1da5ae..2365a22 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,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.45 2004/08/25 21:28:26 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.46 2004/08/27 09:07:06 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -229,6 +229,8 @@ static int		NamespaceWhichCmd _ANSI_ARGS_((
 static int		SetNsNameFromAny _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Obj *objPtr));
 static void		UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));
+static EnsembleConfig *	FindEnsemble _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *cmdNameObj, int flags));
 static int		NsEnsembleImplementationCmd _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]));
@@ -4421,42 +4423,24 @@ NamespaceEnsembleCmd(dummy, interp, objc, objv)
 	return TCL_OK;
     }
 
-    case ENS_EXISTS: {
-	Command *cmdPtr;
-	int flag;
-
+    case ENS_EXISTS:
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
 	    return TCL_ERROR;
 	}
-	cmdPtr = (Command *)
-		Tcl_FindCommand(interp, TclGetString(objv[3]), 0, 0);
-	flag = (cmdPtr != NULL &&
-		cmdPtr->objProc == NsEnsembleImplementationCmd);
-	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), flag);
+	Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+		FindEnsemble(interp, objv[3], 0) != NULL);
 	return TCL_OK;
-    }
-
-    case ENS_CONFIG: {
-	char *cmdName;
-	Command *cmdPtr;
 
+    case ENS_CONFIG:
 	if (objc < 4 || (objc != 5 && objc & 1)) {
 	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname ?opt? ?value? ...");
 	    return TCL_ERROR;
 	}
-	cmdName = TclGetString(objv[3]);
-	cmdPtr = (Command *)
-		Tcl_FindCommand(interp, cmdName, 0, TCL_LEAVE_ERR_MSG);
-	if (cmdPtr == NULL) {
+	ensemblePtr = FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
+	if (ensemblePtr == NULL) {
 	    return TCL_ERROR;
 	}
-	if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-            Tcl_AppendResult(interp, cmdName, " is not an ensemble command",
-		    NULL);
-            return TCL_ERROR;
-        }
-	ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
 
 	if (objc == 5) {
 	    if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
@@ -4722,7 +4706,6 @@ NamespaceEnsembleCmd(dummy, interp, objc, objv)
 	    ensemblePtr->nsPtr->exportLookupEpoch++;
 	    return TCL_OK;
 	}
-    }
 
     default:
 	Tcl_Panic("unexpected ensemble command");
@@ -4733,6 +4716,59 @@ NamespaceEnsembleCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * FindEnsemble --
+ *
+ *	Given a command name, get the ensemble configuration structure
+ *	for it, allowing for [namespace import]s. [Bug 1017022]
+ *
+ * Results:
+ *	A pointer to the config struct, or NULL if the command either
+ *	does not exist or is not an ensemble.
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static EnsembleConfig *
+FindEnsemble(interp, cmdNameObj, flags)
+    Tcl_Interp *interp;			/* Where to do the lookup, and where
+					 * to write the errors if
+					 * TCL_LEAVE_ERR_MSG is set in the
+					 * flags. */
+    Tcl_Obj *cmdNameObj;		/* Name of command to look up. */
+    int flags;				/* Either 0 or TCL_LEAVE_ERR_MSG; other
+					 * flags are probably not useful. */
+{
+    Command *cmdPtr;
+
+    cmdPtr = (Command *)
+	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
+    if (cmdPtr == NULL) {
+	return NULL;
+    }
+    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	/*
+	 * Reuse existing infrastructure for following import link
+	 * chains rather than duplicating it.
+	 */
+	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+
+	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+	    if (flags & TCL_LEAVE_ERR_MSG) {
+		Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
+			"\" is not an ensemble command", NULL);
+	    }
+	    return NULL;
+	}
+    }
+    return (EnsembleConfig *) cmdPtr->objClientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NsEnsembleImplementationCmd --
  *
  *	Implements an ensemble of commands (being those exported by a
diff --git a/tests/namespace.test b/tests/namespace.test
index 0235d74..19c62ae 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.31 2004/08/25 21:37:29 dkf Exp $
+# RCS: @(#) $Id: namespace.test,v 1.32 2004/08/27 09:07:06 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1649,7 +1649,8 @@ test namespace-47.6 {ensemble: unknown handler} {
     while parsing result of ensemble unknown subcommand handler
     invoked from within
 "foo bar"}}
-test namespace-47.7 {ensemble: unknown handler and namespace import} {
+
+test namespace-48.1 {ensembles and namespace import: unknown handler} {
     namespace eval foo {
 	namespace export bar
 	namespace ensemble create -command bar -unknown ::foo::u -subcomm x
@@ -1675,6 +1676,40 @@ test namespace-47.7 {ensemble: unknown handler and namespace import} {
     namespace delete foo
     set result
 } {1 {bar is not an ensemble command} XXX 123 ::foo::bar {y 456} YYY 456}
+test namespace-48.2 {ensembles and namespace import: exists} {
+    namespace eval foo {
+	namespace ensemble create -command ::foo::bar
+	namespace export bar
+    }
+    set result     [namespace ensemble exist foo::bar]
+    lappend result [namespace ensemble exist bar]
+    namespace import foo::bar
+    lappend result [namespace ensemble exist bar]
+    rename foo::bar foo::bar2
+    lappend result [namespace ensemble exist bar] \
+	    [namespace ensemble exist spong]
+    rename bar spong
+    lappend result [namespace ensemble exist bar] \
+	    [namespace ensemble exist spong]
+    rename foo::bar2 {}
+    lappend result [namespace ensemble exist spong]
+    namespace delete foo
+    set result
+} {1 0 1 1 0 0 1 0}
+test namespace-48.3 {ensembles and namespace import: config} {
+    catch {rename spong {}}
+    namespace eval foo {
+	namespace ensemble create -command ::foo::bar
+	namespace export bar boo
+	proc boo {} {}
+    }
+    namespace import foo::bar foo::boo
+    set result [namespace ensemble config bar -namespace]
+    lappend result [catch {namespace ensemble config boo} msg] $msg
+    lappend result [catch {namespace ensemble config spong} msg] $msg
+    namespace delete foo
+    set result
+} {::foo 1 {boo is not an ensemble command} 1 {invalid command name "spong"}}
 
 # cleanup
 catch {rename cmd1 {}}
@@ -1684,3 +1719,7 @@ catch {unset trigger}
 namespace delete {expand}[namespace children :: test_ns_*]
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End: