* doc/namespace.n:

	* tests/namespace.test:
	* generic/tclNamesp.c (Tcl_NamespaceObjCmd): added 'namespace
	exists' command. [Bug: 4665]

3 files changed, 94 insertions, 14 deletions

diff --git a/doc/namespace.n b/doc/namespace.n
index dea7265..31b3c79 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -1,11 +1,12 @@
 '\"
 '\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
 '\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: namespace.n,v 1.5 2000/02/10 10:21:02 hobbs Exp $
+'\" RCS: @(#) $Id: namespace.n,v 1.6 2000/05/11 00:17:29 hobbs Exp $
 '\" 
 .so man.macros
 .TH namespace n 8.0 Tcl "Tcl Built-In Commands"
@@ -100,6 +101,10 @@ If \fInamespace\fR has leading namespace qualifiers
 and any leading namespaces do not exist,
 they are automatically created.
 .TP
+\fBnamespace exists\fR \fInamespace\fR
+Returns \fB1\fR if \fInamespace\fR is a valid namespace in the current
+context, returns \fB0\fR otherwise.
+.TP
 \fBnamespace export \fR?\-\fBclear\fR? ?\fIpattern pattern ...\fR?
 Specifies which commands are exported from a namespace.
 The exported commands are those that can be later imported
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 43b074c..e4454e6 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,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.17 2000/03/27 22:18:56 hobbs Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.18 2000/05/11 00:17:29 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -104,6 +104,9 @@ static int		NamespaceDeleteCmd _ANSI_ARGS_((
 static int		NamespaceEvalCmd _ANSI_ARGS_((
 			    ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]));
+static int		NamespaceExistsCmd _ANSI_ARGS_((
+			    ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
 static int		NamespaceExportCmd _ANSI_ARGS_((
 			    ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]));
@@ -2409,6 +2412,7 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
  *	    namespace current
  *	    namespace delete ?name name...?
  *	    namespace eval name arg ?arg...?
+ *	    namespace exists name
  *	    namespace export ?-clear? ?pattern pattern...?
  *	    namespace forget ?pattern pattern...?
  *	    namespace import ?-force? ?pattern pattern...?
@@ -2443,15 +2447,16 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
     register Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     static char *subCmds[] = {
-            "children", "code", "current", "delete",
-	    "eval", "export", "forget", "import",
-	    "inscope", "origin", "parent", "qualifiers",
-	    "tail", "which", (char *) NULL};
+	"children", "code", "current", "delete",
+	"eval", "exists", "export", "forget", "import",
+	"inscope", "origin", "parent", "qualifiers",
+	"tail", "which", (char *) NULL
+    };
     enum NSSubCmdIdx {
-	    NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
-	    NSEvalIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
-	    NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
-	    NSTailIdx, NSWhichIdx
+	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
+	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
+	NSTailIdx, NSWhichIdx
     };
     int index, result;
 
@@ -2486,6 +2491,9 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
         case NSEvalIdx:
 	    result = NamespaceEvalCmd(clientData, interp, objc, objv);
             break;
+        case NSExistsIdx:
+	    result = NamespaceExistsCmd(clientData, interp, objc, objv);
+            break;
         case NSExportIdx:
 	    result = NamespaceExportCmd(clientData, interp, objc, objv);
             break;
@@ -2951,6 +2959,53 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * NamespaceExistsCmd --
+ *
+ *	Invoked to implement the "namespace exists" command that returns 
+ *	true if the given namespace currently exists, and false otherwise.
+ *	Handles the following syntax:
+ *
+ *	    namespace exists name
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If anything
+ *	goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceExistsCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Tcl_Namespace *namespacePtr;
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "name");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Check whether the given namespace exists
+     */
+
+    if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NamespaceExportCmd --
  *
  *	Invoked to implement the "namespace export" command that specifies
diff --git a/tests/namespace.test b/tests/namespace.test
index 26eda2d..da884eb 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -6,12 +6,12 @@
 # errors. No output means no errors were found.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 by Scriptics Corporation.
 #
 # 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.12 2000/04/10 17:19:02 ericm Exp $
+# RCS: @(#) $Id: namespace.test,v 1.13 2000/05/11 00:17:29 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -641,7 +641,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
 } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
 test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
     list [catch {namespace wombat {}} msg] $msg
-} {1 {bad option "wombat": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+} {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
 test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
     namespace ch :: test_ns_*
 } {}
@@ -737,7 +737,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} {
 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
 test namespace-25.2 {NamespaceEvalCmd, bad args} {
     list [catch {namespace test_ns_1} msg] $msg
-} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
 catch {unset v}
 test namespace-25.3 {NamespaceEvalCmd, new namespace} {
     set v 123
@@ -1094,6 +1094,26 @@ test namespace-38.1 {UpdateStringOfNsName} {
          [namespace eval {} {namespace current}]
 } {:: ::}
 
+test namespace-39.1 {NamespaceExistsCmd} {
+    catch {eval namespace delete [namespace children :: test_ns_*]}
+    namespace eval ::test_ns_z::test_me { variable foo }
+    list [namespace exists ::] \
+	    [namespace exists ::bogus_namespace] \
+	    [namespace exists ::test_ns_z] \
+	    [namespace exists test_ns_z] \
+	    [namespace exists ::test_ns_z::foo] \
+	    [namespace exists ::test_ns_z::test_me] \
+	    [namespace eval ::test_ns_z { namespace exists ::test_me }] \
+	    [namespace eval ::test_ns_z { namespace exists test_me }] \
+	    [namespace exists :::::test_ns_z]
+} {1 0 1 1 0 1 0 1 1}
+test namespace-39.2 {NamespaceExistsCmd error} {
+    list [catch {namespace exists} msg] $msg
+} {1 {wrong # args: should be "namespace exists name"}}
+test namespace-39.3 {NamespaceExistsCmd error} {
+    list [catch {namespace exists a b} msg] $msg
+} {1 {wrong # args: should be "namespace exists name"}}
+
 # cleanup
 catch {rename cmd1 {}}
 catch {unset l}