diff options
| -rw-r--r-- | doc/namespace.n | 7 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 73 | ||||
| -rw-r--r-- | tests/namespace.test | 28 |
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} |