aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README.namespaces191
-rw-r--r--auto.def4
-rw-r--r--examples/dns.tcl63
-rw-r--r--jim-namespace.c333
-rw-r--r--jim.c365
-rw-r--r--jim.h11
-rw-r--r--nshelper.tcl124
-rw-r--r--tests/alias.test2
-rw-r--r--tests/namespace.test493
-rw-r--r--utf8.h2
10 files changed, 1475 insertions, 113 deletions
diff --git a/README.namespaces b/README.namespaces
new file mode 100644
index 0000000..e08d68e
--- /dev/null
+++ b/README.namespaces
@@ -0,0 +1,191 @@
+Lightweight Namespaces for Jim Tcl
+==================================
+
+There are two broad requirements for namespace support in Jim Tcl.
+
+1. To allow code from multiple sources while reducing the chance of name clashes
+2. To simplify porting existing Tcl code which uses namespaces
+
+This proposal addresses both of these requirements, with the following
+additional requirements imposed by Jim Tcl.
+
+3. Support for namespaces should be optional, with the space and time overhead
+ when namespaces are disabled as close to zero as possible.
+4. The implementation should be small and reasonably efficient.
+
+To further expand on requirement (2), the goal is not to be able to run
+any Tcl scripts using namespaces with no changes. Rather, scripts
+which use namespaces in a straightforward manner, should be easily
+ported with changes which are compatible with Tcl.
+
+Implicit namespaces
+-------------------
+Rather than supporting explicit namespaces as Tcl does, Jim Tcl
+supports implicit namespaces. Any procedure or variable which
+is defined with a name containing ::, is implicitly scoped within
+a namespace.
+
+For example, the following procedure and variable are created
+in the namespace 'test'
+
+proc ::test::myproc {} {
+ puts "I am in namespace [namespace current]"
+}
+set ::test::myvar 3
+
+This approach allows much of the existing variable and command
+resolution machinery to be used with little change. It also means
+that it is possible to simply define a namespace-scoped variable
+or procedure without first creating the namespace, and similarly,
+namespaces "disappear" when all variables and procedures defined
+with the namespace scope are deleted.
+
+Namespaces, procedures and call frames
+--------------------------------------
+When namespace support is enabled (at build time), each procedure has an associated
+namespace (based on the procedure name). When the procedure is evaluated,
+the namespace for the created call frame is set to the namespace associated
+with the procedure.
+
+Command resolution is based on the namespace of the current call frame.
+An unscoped command name will first be looked up in the current namespace,
+and then in the global namespace.
+
+This also means that commands which do not create a call frame (such as commands
+implemented in C) do not have an associated namespace.
+
+Similarly to Tcl, namespace eval introduces a temporary, anonymous
+call frame with the associated namespace. For example, the following
+will return "::test,1".
+
+namespace eval test {
+ puts [namespace current],[info level]
+}
+
+Variable resolution
+-------------------
+The variable command in Jim Tcl has the same syntax as Tcl, but is closer in behaviour to the global command.
+The variable command creates a link from a local variable to a namespace variable, possibly initialising it.
+
+For example, the following procedure uses 'variable' to initialse and access myvar.
+
+proc ::test::myproc {} {
+ variable myvar 4
+ incr myvar
+}
+
+Note that there is no automatic resolution of namespace variables.
+For example, the following will *not* work.
+
+namespace eval ::test {
+ variable myvar 4
+}
+namespace eval ::test {
+ # This will increment a local variable, not ::test::myvar
+ incr myvar
+}
+
+And similarly, the following will only access local variables
+
+set x 3
+namespace eval ::test {
+ # This will incremement a local variable, not ::x
+ incr x
+ # This will also increment a local variable
+ incr abc::def
+}
+
+In the same way that variable resolution does not "fall back" to
+global variables, it also does not "fall back" to namespace variables.
+
+This approach allows name resolution to be simpler and more efficient
+since it uses the same variable linking mechanism as upvar/global
+and it allows namespaces to be implicit. It also solves the "creative
+writing" problem where a variable may be created in an unintentional
+scope.
+
+The namespace command
+---------------------
+Currently, the following namespace commands are supported.
+
+* current - returns the current, fully-qualified namespace
+* eval - evaluates a script in a namespace (introduces a call frame)
+* qualifiers, tail, parent - note that these do not check for existence
+* code, inscope - implemented
+* delete - deletes all variables and commands with the namespace prefix
+* which - implemented
+* upvar - implemented
+
+namespace children, exists, path
+--------------------------------
+With implicit namespaces, the namespace exists and namespace children commands
+are expensive to implement and are of limited use. Checking the existence
+of a namespace can be better done by checking for the existence of a known procedure
+or variable in the namespace.
+
+Command resolution is always done by first looking in the namespace and then
+at the global scope, so namespace path is not required.
+
+namespace ensemble
+------------------
+The namespace ensemble command is not currently supported. A future version
+of Jim Tcl will have a general-purpose ensemble creation and manipulation
+mechanism and namespace ensemble will be implemented in terms of that mechanism.
+
+namespace import, export, forget, origin
+----------------------------------------
+Since Jim Tcl namespaces are implicit, there is no location to store export patterns.
+Therefore the namespace export command is a dummy command which does nothing.
+All procedures in a namespace are considered to be exported.
+
+The namespace import command works by creating aliases to the target namespace
+procedures.
+
+namespace forget is not implemented.
+
+namespace origin understands aliases created by namespace import
+and can return the original command.
+
+namespace unknown
+-----------------
+If an undefined command is invoked, the "unknown" command is invoked.
+The same namespace resolution rules apply for the unknown command.
+This means that in the following example, test::unknown will be invoked
+for the missing command rather than the global ::unknown.
+
+proc unknown {args} {
+ puts "global unknown"
+}
+
+proc test::unknown {args} {
+ puts "test unknown"
+}
+
+namespace eval test {
+ bogus
+}
+
+This approach requires no special support and provides enough flexibility that
+the namespace unknown command is not implemented.
+
+Porting namespace code from Tcl to Jim Tcl
+------------------------------------------
+For most code, the following changes will be sufficient to port code.
+
+1. Canonicalise namespace names. For example, ::ns:: should be written
+ as ::ns or ns as appropriate, and excess colons should be removed.
+ For example ::ns:::blah should be written as ::ns::blah
+ (Note that the only "excess colon" case supported is ::::abc
+ in order to support [namespace current]::abc in the global namespace)
+
+2. The variable command should be used within namespace eval to link
+ to namespace variables, and access to variables in other namespaces
+ should be fully qualified
+
+Changes in the core Jim Tcl
+---------------------------
+Previously Jim Tcl performed no scoping of command names. i.e. The
+::format command was considered different from the format command.
+
+Even if namespace support is disabled, the command resolution will
+recognised global scoping of commands and treat these as identical.
diff --git a/auto.def b/auto.def
index 2c62136..6652fe0 100644
--- a/auto.def
+++ b/auto.def
@@ -197,6 +197,8 @@ dict set extdb attrs {
history {}
load { static }
mk { cpp optional }
+ namespace { static }
+ nshelper { tcl optional }
oo { tcl }
pack {}
package { static }
@@ -226,10 +228,12 @@ dict set extdb info {
glob { dep readdir }
load { check {[have-feature dlopen-compat] || [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen }
mk { check {[check-metakit]} libdep lib_mk }
+ namespace { dep nshelper }
posix { check {[have-feature waitpid]} }
readdir { check {[have-feature opendir]} }
readline { check {[cc-check-function-in-lib readline readline]} }
rlprompt { dep readline }
+ tree { dep oo }
sdl { check {[cc-check-function-in-lib SDL_SetVideoMode SDL] && [cc-check-function-in-lib rectangleRGBA SDL_gfx]}
libdep {lib_SDL_SetVideoMode lib_rectangleRGBA}
}
diff --git a/examples/dns.tcl b/examples/dns.tcl
index a40d44a..8146027 100644
--- a/examples/dns.tcl
+++ b/examples/dns.tcl
@@ -42,12 +42,7 @@
# $Id: dns.tcl,v 1.36 2008/11/22 12:28:54 mic42 Exp $
package require binary
-
-# Poor-man's variable for Jim Tcl
-# Links a global variable, ::ns::var to a local variable, var
-proc variable {ns var} {
- catch {uplevel 1 [list upvar #0 ${ns}::$var $var]}
-}
+package require namespace
set dns::version 1.3.3
set dns::rcsid {$Id: dns.tcl,v 1.36 2008/11/22 12:28:54 mic42 Exp $}
@@ -81,8 +76,8 @@ if {![info exists dns::uid]} {
# to be set. With no options, returns a list of all current settings.
#
proc dns::configure {args} {
- variable dns options
- variable dns log
+ variable options
+ variable log
if {[llength $args] < 1} {
set r {}
@@ -169,9 +164,9 @@ proc dns::configure {args} {
# to be used to obtain any further information about this query.
#
proc dns::resolve {query args} {
- variable dns uid
- variable dns options
- variable dns log
+ variable uid
+ variable options
+ variable log
# get a guaranteed unique and non-present token id.
set id [incr uid]
@@ -427,7 +422,7 @@ proc dns::dump {args} {
}
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
set result {}
@@ -467,11 +462,11 @@ proc dns::DumpMessage {data} {
#
proc dns::BuildMessage {token} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
- variable dns types
- variable dns classes
- variable dns options
+ variable types
+ variable classes
+ variable options
if {! [info exists types($state(-type))] } {
return -code error "invalid DNS query type"
@@ -564,8 +559,8 @@ proc dns::PackString {text} {
# eg: PackRecord name wiki.tcl.tk type MX class IN rdata {10 mail.example.com}
#
proc dns::PackRecord {args} {
- variable dns types
- variable dns classes
+ variable types
+ variable classes
array set rr {name "" type A class IN ttl 0 rdlength 0 rdata ""}
array set rr $args
set data [dns::PackName $rr(name)]
@@ -626,7 +621,7 @@ proc dns::PackRecord {args} {
#
proc dns::TcpTransmit {token} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
# setup the timeout
@@ -646,7 +641,7 @@ proc dns::TcpTransmit {token} {
}
proc dns::TcpConnected {token s} {
- variable dns $token
+ variable $token
upvar 0 $token state
fileevent $s writable {}
@@ -681,7 +676,7 @@ proc dns::TcpConnected {token s} {
#
proc dns::UdpTransmit {token} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
# setup the timeout
@@ -710,7 +705,7 @@ proc dns::UdpTransmit {token} {
#
proc dns::Finish {token {errormsg ""}} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
global errorInfo errorCode
@@ -740,7 +735,7 @@ proc dns::Finish {token {errormsg ""}} {
#
proc dns::Eof {token} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
set state(status) eof
dns::Finish $token
@@ -753,7 +748,7 @@ proc dns::Eof {token} {
#
proc dns::Receive {token} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
binary scan $state(reply) SS id flags
@@ -781,9 +776,9 @@ proc dns::Receive {token} {
# file event handler for tcp socket. Wait for the reply data.
#
proc dns::TcpEvent {token} {
- variable dns log
+ variable log
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
set s $state(sock)
@@ -838,7 +833,7 @@ proc dns::TcpEvent {token} {
# file event handler for udp sockets.
proc dns::UdpEvent {token} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
set s $state(sock)
@@ -859,7 +854,7 @@ proc dns::UdpEvent {token} {
proc dns::Flags {token {varname {}}} {
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
if {$varname != {}} {
@@ -888,9 +883,9 @@ proc dns::Flags {token {varname {}}} {
# Decode a DNS packet (either query or response).
#
proc dns::Decode {token args} {
- variable dns log
+ variable log
# FRINK: nocheck
- variable dns $token
+ variable $token
upvar 0 $token state
array set opts {-rdata 0 -query 0}
@@ -988,8 +983,8 @@ proc dns::KeyOf {&array value {default {}}} {
# 12 of a message but may be of variable length.
#
proc dns::ReadQuestion {nitems data indexvar} {
- variable dns types
- variable dns classes
+ variable types
+ variable classes
upvar $indexvar index
set result {}
@@ -1017,8 +1012,8 @@ proc dns::ReadQuestion {nitems data indexvar} {
# Read an answer section from a DNS message.
#
proc dns::ReadAnswer {nitems data indexvar {raw 0}} {
- variable dns types
- variable dns classes
+ variable types
+ variable classes
upvar $indexvar index
set result {}
diff --git a/jim-namespace.c b/jim-namespace.c
new file mode 100644
index 0000000..9b606c7
--- /dev/null
+++ b/jim-namespace.c
@@ -0,0 +1,333 @@
+/*
+ * Support for namespaces in jim
+ *
+ * (c) 2011 Steve Bennett <steveb@workware.net.au>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
+ * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * The views and conclusions contained in the software and documentation
+ * are those of the authors and should not be interpreted as representing
+ * official policies, either expressed or implied, of the Jim Tcl Project.
+ *
+ * Based on code originally from Tcl 6.7:
+ *
+ * Copyright 1987-1991 Regents of the University of California
+ * Permission to use, copy, modify, and distribute this
+ * software and its documentation for any purpose and without
+ * fee is hereby granted, provided that the above copyright
+ * notice appear in all copies. The University of California
+ * makes no representations about the suitability of this
+ * software for any purpose. It is provided "as is" without
+ * express or implied warranty.
+ */
+
+#include <limits.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <assert.h>
+
+#include "jim.h"
+#include "jimautoconf.h"
+#include "jim-subcmd.h"
+
+/* -----------------------------------------------------------------------------
+ * Namespace support
+ * ---------------------------------------------------------------------------*/
+
+/**
+ * nsObj is a canonical namespace name (.e.g. "" for root, "abc" for ::abc)
+ *
+ * The given name is appended to the namespace name to produce a complete canonical name.
+ *
+ * e.g. "" "abc" => abc
+ * "" "::abc" => abc
+ * "" "abc::def" => abc::def
+ * "abc" "def" => abc::def
+ * "abc" "::def" => def
+ *
+ */
+Jim_Obj *JimCanonicalNamespace(Jim_Interp *interp, Jim_Obj *nsObj, Jim_Obj *nameObj)
+{
+ Jim_Obj *objPtr;
+ const char *name = Jim_String(nameObj);
+ assert(nameObj->refCount != 0);
+ assert(nsObj->refCount != 0);
+ if (name[0] == ':' && name[1] == ':') {
+ /* Absolute namespace */
+ while (*++name == ':') {
+ }
+ return Jim_NewStringObj(interp, name, -1);
+ }
+ if (Jim_Length(nsObj) == 0) {
+ /* Relative to the global namespace */
+ return nameObj;
+ }
+ /* Relative to non-global namespace */
+ objPtr = Jim_DuplicateObj(interp, nsObj);
+ Jim_AppendString(interp, objPtr, "::", 2);
+ Jim_AppendObj(interp, objPtr, nameObj);
+ return objPtr;
+}
+
+int Jim_CreateNamespaceVariable(Jim_Interp *interp, Jim_Obj *varNameObj, Jim_Obj *targetNameObj)
+{
+ int rc;
+ Jim_IncrRefCount(varNameObj);
+
+ /* push non-namespace vars if in namespace eval? */
+ rc = Jim_SetVariableLink(interp, varNameObj, targetNameObj, interp->topFramePtr);
+
+ Jim_DecrRefCount(interp, varNameObj);
+
+ return rc;
+}
+
+/**
+ * Returns the parent of the given namespace.
+ *
+ * ::bob::tom => ::bob
+ * bob::tom => bob
+ * ::bob => ::
+ * bob => ""
+ * :: => ""
+ * "" => ""
+ */
+Jim_Obj *Jim_NamespaceQualifiers(Jim_Interp *interp, Jim_Obj *ns)
+{
+ const char *name = Jim_String(ns);
+ const char *pt = strrchr(name, ':');
+ if (pt && pt != name && pt[-1] == ':') {
+ return Jim_NewStringObj(interp, name, pt - name - 1);
+ }
+ else {
+ return interp->emptyObj;
+ }
+}
+
+Jim_Obj *Jim_NamespaceTail(Jim_Interp *interp, Jim_Obj *ns)
+{
+ const char *name = Jim_String(ns);
+ const char *pt = strrchr(name, ':');
+ if (pt && pt != name && pt[-1] == ':') {
+ return Jim_NewStringObj(interp, pt + 1, -1);
+ }
+ else {
+ return ns;
+ }
+}
+
+static Jim_Obj *JimNamespaceCurrent(Jim_Interp *interp)
+{
+ Jim_Obj *objPtr = Jim_NewStringObj(interp, "::", 2);
+ Jim_AppendObj(interp, objPtr, interp->framePtr->nsObj);
+ return objPtr;
+}
+
+static int JimVariableCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+ int retcode = JIM_OK;
+
+ if (argc > 3) {
+ Jim_WrongNumArgs(interp, 1, argv, "name ?value?");
+ return JIM_ERR;
+ }
+ if (argc > 1) {
+ Jim_Obj *targetNameObj;
+ Jim_Obj *localNameObj;
+
+#if 0
+ /* XXX should we give an error on dict sugar syntax? */
+ if (JimValidName(interp, "variable", argv[1]) != JIM_OK) {
+ return JIM_ERR;
+ }
+#endif
+
+ targetNameObj = JimCanonicalNamespace(interp, interp->framePtr->nsObj, argv[1]);
+
+ localNameObj = Jim_NamespaceTail(interp, argv[1]);
+ Jim_IncrRefCount(localNameObj);
+ if (interp->framePtr->level != 0 || Jim_Length(interp->framePtr->nsObj) != 0) {
+ Jim_CreateNamespaceVariable(interp, localNameObj, targetNameObj);
+ }
+
+ /* Set the variable via the local name */
+ if (argc > 2) {
+ retcode = Jim_SetVariable(interp, localNameObj, argv[2]);
+ }
+ Jim_DecrRefCount(interp, localNameObj);
+ }
+ return retcode;
+}
+
+/* XXX: Temporary */
+static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
+{
+ Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
+
+ Jim_AppendString(interp, prefixObj, " ", 1);
+ Jim_AppendString(interp, prefixObj, subcmd, -1);
+
+ return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
+}
+
+static int JimNamespaceCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+ Jim_Obj *nsObj;
+ Jim_Obj *objPtr;
+ int option;
+ static const char * const options[] = {
+ "eval", "current", "canonical", "qualifiers", "parent", "tail", "delete",
+ "origin", "code", "inscope", "import", "export",
+ "which", "upvar", NULL
+ };
+ enum
+ {
+ OPT_EVAL, OPT_CURRENT, OPT_CANONICAL, OPT_QUALIFIERS, OPT_PARENT, OPT_TAIL, OPT_DELETE,
+ OPT_ORIGIN, OPT_CODE, OPT_INSCOPE, OPT_IMPORT, OPT_EXPORT,
+ OPT_WHICH, OPT_UPVAR,
+ };
+
+ if (argc < 2) {
+ Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arg ...?");
+ return JIM_ERR;
+ }
+
+ if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
+ return JIM_ERR;
+ }
+
+ switch (option) {
+ case OPT_EVAL:
+ if (argc < 4) {
+ Jim_WrongNumArgs(interp, 2, argv, "name arg ?arg...?");
+ return JIM_ERR;
+ }
+ if (argc == 4) {
+ objPtr = argv[3];
+ }
+ else {
+ objPtr = Jim_ConcatObj(interp, argc - 3, argv + 3);
+ }
+
+ nsObj = JimCanonicalNamespace(interp, interp->framePtr->nsObj, argv[2]);
+ return Jim_EvalNamespace(interp, objPtr, nsObj);
+
+ case OPT_CURRENT:
+ if (argc != 2) {
+ Jim_WrongNumArgs(interp, 2, argv, "");
+ return JIM_ERR;
+ }
+ Jim_SetResult(interp, JimNamespaceCurrent(interp));
+ return JIM_OK;
+
+ case OPT_CANONICAL:
+ if (argc > 4) {
+ Jim_WrongNumArgs(interp, 2, argv, "?current? ?name?");
+ return JIM_ERR;
+ }
+ if (argc == 2) {
+ Jim_SetResult(interp, interp->framePtr->nsObj);
+ }
+ else if (argc == 3) {
+ Jim_SetResult(interp, JimCanonicalNamespace(interp, interp->framePtr->nsObj, argv[2]));
+ }
+ else {
+ Jim_SetResult(interp, JimCanonicalNamespace(interp, argv[2], argv[3]));
+ }
+ return JIM_OK;
+
+ case OPT_QUALIFIERS:
+ if (argc != 3) {
+ Jim_WrongNumArgs(interp, 2, argv, "string");
+ return JIM_ERR;
+ }
+ Jim_SetResult(interp, Jim_NamespaceQualifiers(interp, argv[2]));
+ return JIM_OK;
+
+ case OPT_EXPORT:
+ return JIM_OK;
+
+ case OPT_TAIL:
+ if (argc != 3) {
+ Jim_WrongNumArgs(interp, 2, argv, "string");
+ return JIM_ERR;
+ }
+ Jim_SetResult(interp, Jim_NamespaceTail(interp, argv[2]));
+ return JIM_OK;
+
+ case OPT_PARENT:
+ if (argc != 2 && argc != 3) {
+ Jim_WrongNumArgs(interp, 2, argv, "?name?");
+ return JIM_ERR;
+ }
+ else {
+ const char *name;
+
+ if (argc == 3) {
+ objPtr = argv[2];
+ }
+ else {
+ objPtr = interp->framePtr->nsObj;
+ }
+ if (Jim_Length(objPtr) == 0 || Jim_CompareStringImmediate(interp, objPtr, "::")) {
+ return JIM_OK;
+ }
+ objPtr = Jim_NamespaceQualifiers(interp, objPtr);
+
+ name = Jim_String(objPtr);
+
+ if (name[0] != ':' || name[1] != ':') {
+ /* Make it fully scoped */
+ Jim_SetResultString(interp, "::", 2);
+ Jim_AppendObj(interp, Jim_GetResult(interp), objPtr);
+ Jim_IncrRefCount(objPtr);
+ Jim_DecrRefCount(interp, objPtr);
+ }
+ else {
+ Jim_SetResult(interp, objPtr);
+ }
+ }
+ return JIM_OK;
+ }
+
+ /* Implemented as a Tcl helper proc.
+ * Note that calling a proc will change the current namespace,
+ * so helper procs must call [uplevel namespace canon] to get the callers
+ * namespace.
+ */
+ return Jim_EvalEnsemble(interp, "namespace", options[option], argc - 2, argv + 2);
+}
+
+int Jim_namespaceInit(Jim_Interp *interp)
+{
+ if (Jim_PackageProvide(interp, "namespace", "1.0", JIM_ERRMSG))
+ return JIM_ERR;
+
+ Jim_CreateCommand(interp, "namespace", JimNamespaceCmd, NULL, NULL);
+ Jim_CreateCommand(interp, "variable", JimVariableCmd, NULL, NULL);
+ return JIM_OK;
+}
+
diff --git a/jim.c b/jim.c
index 299a9a1..e108b9d 100644
--- a/jim.c
+++ b/jim.c
@@ -235,7 +235,6 @@ first:
/* Glob-style pattern matching. */
/* Note: string *must* be valid UTF-8 sequences
- * slen is a char length, not byte counts.
*/
static int JimGlobMatch(const char *pattern, const char *string, int nocase)
{
@@ -1476,8 +1475,10 @@ static int JimParseVar(struct JimParserCtx *pc)
while (1) {
/* Skip double colon, but not single colon! */
if (pc->p[0] == ':' && pc->p[1] == ':') {
- pc->p += 2;
- pc->len -= 2;
+ while (*pc->p == ':') {
+ pc->p++;
+ pc->len--;
+ }
continue;
}
/* Note that any char >= 0x80 must be part of a utf-8 char.
@@ -3523,6 +3524,7 @@ static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
if (cmdPtr->isproc) {
Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
+ Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
if (cmdPtr->u.proc.staticVars) {
Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
Jim_Free(cmdPtr->u.proc.staticVars);
@@ -3584,6 +3586,38 @@ static const Jim_HashTableType JimCommandsHashTableType = {
/* ------------------------- Commands related functions --------------------- */
+#ifdef jim_ext_namespace
+/**
+ * Qualifies 'name' with the current namespace if necessary and
+ * returns the "unscoped" name (that is, without the leading ::).
+ * The object stored in *objPtrPtr should be decremented after use.
+ */
+static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
+{
+ Jim_Obj *objPtr = interp->emptyObj;
+
+ if (name[0] == ':' && name[1] == ':') {
+ /* This command is being defined in the global namespace */
+ while (*++name == ':') {
+ }
+ }
+ else if (Jim_Length(interp->framePtr->nsObj)) {
+ /* This command is being defined in a non-global namespace */
+ objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
+ Jim_AppendStrings(interp, objPtr, "::", name, NULL);
+ name = Jim_String(objPtr);
+ }
+ Jim_IncrRefCount(objPtr);
+ *objPtrPtr = objPtr;
+ return name;
+}
+ #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
+#else
+ /* We can be more efficient in the no-namespace case */
+ #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
+ #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
+#endif
+
static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
{
/* It may already exist, so we try to delete the old one.
@@ -3700,14 +3734,36 @@ static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Ob
return JIM_OK;
}
-static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
+static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
+{
+#ifdef jim_ext_namespace
+ if (cmdPtr->isproc) {
+ /* XXX: Really need JimNamespaceSplit() */
+ const char *pt = strrchr(cmdname, ':');
+ if (pt && pt != cmdname && pt[-1] == ':') {
+ Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
+ cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
+ Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
+
+ if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
+ /* This commands shadows a global command, so a proc epoch update is required */
+ Jim_InterpIncrProcEpoch(interp);
+ }
+ }
+ }
+#endif
+}
+
+static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdNameObj,
Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr)
{
Jim_Cmd *cmdPtr;
int argListLen;
int i;
+ Jim_Obj *qualifiedCmdNameObj;
+ const char *cmdname;
- if (JimValidName(interp, "procedure", cmdName) != JIM_OK) {
+ if (JimValidName(interp, "procedure", cmdNameObj) != JIM_OK) {
return JIM_ERR;
}
@@ -3723,8 +3779,10 @@ static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
cmdPtr->u.proc.argsPos = -1;
cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
+ cmdPtr->u.proc.nsObj = interp->emptyObj;
Jim_IncrRefCount(argListObjPtr);
Jim_IncrRefCount(bodyObjPtr);
+ Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
/* Create the statics hash table. */
if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
@@ -3745,7 +3803,9 @@ static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
len = Jim_ListLength(interp, argPtr);
if (len == 0) {
Jim_SetResultString(interp, "procedure has argument with no name", -1);
- goto err;
+err:
+ JimDecrCmdRefCount(interp, cmdPtr);
+ return JIM_ERR;
}
if (len > 2) {
Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
@@ -3785,72 +3845,106 @@ static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
}
/* Add the new command */
- JimCreateCommand(interp, Jim_String(cmdName), cmdPtr);
+ cmdname = JimQualifyName(interp, Jim_String(cmdNameObj), &qualifiedCmdNameObj);
+
+ JimCreateCommand(interp, cmdname, cmdPtr);
+
+ /* Calculate and set the namespace for this proc */
+ JimUpdateProcNamespace(interp, cmdPtr, cmdname);
+
+ JimFreeQualifiedName(interp, qualifiedCmdNameObj);
/* Unlike Tcl, set the name of the proc as the result */
- Jim_SetResult(interp, cmdName);
+ Jim_SetResult(interp, cmdNameObj);
return JIM_OK;
-
- err:
- if (cmdPtr->u.proc.staticVars) {
- Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
- }
- Jim_Free(cmdPtr->u.proc.staticVars);
- Jim_DecrRefCount(interp, argListObjPtr);
- Jim_DecrRefCount(interp, bodyObjPtr);
- Jim_Free(cmdPtr);
- return JIM_ERR;
}
-int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
+int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
{
- if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
- return JIM_ERR;
- Jim_InterpIncrProcEpoch(interp);
- return JIM_OK;
+ int ret = JIM_OK;
+ Jim_Obj *qualifiedNameObj;
+ const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
+
+ if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
+ Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
+ ret = JIM_ERR;
+ }
+ else {
+ Jim_InterpIncrProcEpoch(interp);
+ }
+
+ JimFreeQualifiedName(interp, qualifiedNameObj);
+
+ return ret;
}
int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
{
+ int ret = JIM_ERR;
Jim_HashEntry *he;
+ Jim_Cmd *cmdPtr;
+ Jim_Obj *qualifiedOldNameObj;
+ Jim_Obj *qualifiedNewNameObj;
+ const char *fqold;
+ const char *fqnew;
- /* Does it exist? */
- he = Jim_FindHashEntry(&interp->commands, oldName);
- if (he == NULL) {
- Jim_SetResultFormatted(interp, "can't %s \"%s\": command doesn't exist",
- newName[0] ? "rename" : "delete", oldName);
- return JIM_ERR;
+ if (newName[0] == 0) {
+ return Jim_DeleteCommand(interp, oldName);
}
- if (newName[0] == '\0') /* Delete! */
- return Jim_DeleteCommand(interp, oldName);
+ fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
+ fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
- /* rename */
- if (Jim_FindHashEntry(&interp->commands, newName)) {
+ /* Does it exist? */
+ he = Jim_FindHashEntry(&interp->commands, fqold);
+ if (he == NULL) {
+ Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
+ }
+ else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
- return JIM_ERR;
}
+ else {
+ /* Add the new name first */
+ cmdPtr = he->u.val;
+ JimIncrCmdRefCount(cmdPtr);
+ JimUpdateProcNamespace(interp, cmdPtr, fqnew);
+ Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
- /* Add the new name first */
- JimIncrCmdRefCount(he->u.val);
- Jim_AddHashEntry(&interp->commands, newName, he->u.val);
+ /* Now remove the old name */
+ Jim_DeleteHashEntry(&interp->commands, fqold);
- /* Now remove the old name */
- Jim_DeleteHashEntry(&interp->commands, oldName);
+ /* Increment the epoch */
+ Jim_InterpIncrProcEpoch(interp);
- /* Increment the epoch */
- Jim_InterpIncrProcEpoch(interp);
- return JIM_OK;
+ ret = JIM_OK;
+ }
+
+ JimFreeQualifiedName(interp, qualifiedOldNameObj);
+ JimFreeQualifiedName(interp, qualifiedNewNameObj);
+
+ return ret;
}
/* -----------------------------------------------------------------------------
* Command object
* ---------------------------------------------------------------------------*/
+static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
+{
+ Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
+}
+
+static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
+{
+ dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
+ dupPtr->typePtr = srcPtr->typePtr;
+ Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
+}
+
static const Jim_ObjType commandObjType = {
"command",
- NULL,
- NULL,
+ FreeCommandInternalRep,
+ DupCommandInternalRep,
NULL,
JIM_TYPE_REFERENCES,
};
@@ -3867,26 +3961,62 @@ Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
{
Jim_Cmd *cmd;
+ /* In order to be valid, the proc epoch must match and
+ * the lookup must have occurred in the same namespace
+ */
if (objPtr->typePtr != &commandObjType ||
- objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) {
-
+ objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
+#ifdef jim_ext_namespace
+ || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
+#endif
+ ) {
/* Not cached or out of date, so lookup */
- Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, Jim_String(objPtr));
+
+ /* Do we need to try the local namespace? */
+ const char *name = Jim_String(objPtr);
+ Jim_HashEntry *he;
+
+ if (name[0] == ':' && name[1] == ':') {
+ while (*++name == ':') {
+ }
+ }
+#ifdef jim_ext_namespace
+ else if (Jim_Length(interp->framePtr->nsObj)) {
+ /* This command is being defined in a non-global namespace */
+ Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
+ Jim_AppendStrings(interp, nameObj, "::", name, NULL);
+ he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
+ Jim_FreeNewObj(interp, nameObj);
+ if (he) {
+ goto found;
+ }
+ }
+#endif
+
+ /* Lookup in the global namespace */
+ he = Jim_FindHashEntry(&interp->commands, name);
if (he == NULL) {
if (flags & JIM_ERRMSG) {
Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
}
return NULL;
}
+#ifdef jim_ext_namespace
+found:
+#endif
+ cmd = (Jim_Cmd *)he->u.val;
/* Free the old internal repr and set the new one. */
Jim_FreeIntRep(interp, objPtr);
objPtr->typePtr = &commandObjType;
objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
- objPtr->internalRep.cmdValue.cmdPtr = (void *)he->u.val;
+ objPtr->internalRep.cmdValue.cmdPtr = cmd;
+ objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
+ Jim_IncrRefCount(interp->framePtr->nsObj);
+ }
+ else {
+ cmd = objPtr->internalRep.cmdValue.cmdPtr;
}
-
- cmd = objPtr->internalRep.cmdValue.cmdPtr;
while (cmd->u.proc.upcall) {
cmd = cmd->prevCmd;
}
@@ -3971,8 +4101,9 @@ static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
}
if (varName[0] == ':' && varName[1] == ':') {
+ while (*++varName == ':') {
+ }
global = 1;
- varName += 2;
framePtr = interp->topFramePtr;
}
else {
@@ -3982,12 +4113,14 @@ static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
/* Resolve this name in the variables hash table */
he = Jim_FindHashEntry(&framePtr->vars, varName);
- if (he == NULL && !global && framePtr->staticVars) {
- /* Try with static vars. */
- he = Jim_FindHashEntry(framePtr->staticVars, varName);
- }
if (he == NULL) {
- return JIM_ERR;
+ if (!global && framePtr->staticVars) {
+ /* Try with static vars. */
+ he = Jim_FindHashEntry(framePtr->staticVars, varName);
+ }
+ if (he == NULL) {
+ return JIM_ERR;
+ }
}
/* Free the old internal repr and set the new one. */
@@ -4018,8 +4151,9 @@ static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_O
name = Jim_String(nameObjPtr);
if (name[0] == ':' && name[1] == ':') {
+ while (*++name == ':') {
+ }
framePtr = interp->topFramePtr;
- name += 2;
global = 1;
}
else {
@@ -4155,8 +4289,9 @@ int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
varName = Jim_String(nameObjPtr);
if (varName[0] == ':' && varName[1] == ':') {
+ while (*++varName == ':') {
+ }
/* Linking a global var does nothing */
- varName += 2;
framePtr = interp->topFramePtr;
}
else {
@@ -4165,7 +4300,9 @@ int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
targetName = Jim_String(targetNameObjPtr);
if (targetName[0] == ':' && targetName[1] == ':') {
- targetNameObjPtr = Jim_NewStringObj(interp, targetName + 2, -1);
+ while (*++targetName == ':') {
+ }
+ targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
targetCallFrame = interp->topFramePtr;
}
Jim_IncrRefCount(targetNameObjPtr);
@@ -4383,7 +4520,7 @@ static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjP
SetDictSubstFromAny(interp, objPtr);
err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
- &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_ERRMSG);
+ &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
if (err == JIM_OK) {
/* Don't keep an extra ref to the result */
@@ -4545,7 +4682,7 @@ static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
* CallFrame
* ---------------------------------------------------------------------------*/
-static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent)
+static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
{
Jim_CallFrame *cf;
@@ -4569,6 +4706,8 @@ static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *pare
cf->staticVars = NULL;
cf->localCommands = NULL;
+ cf->nsObj = nsObj;
+ Jim_IncrRefCount(nsObj);
if (cf->vars.table == NULL)
Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
return cf;
@@ -4588,8 +4727,11 @@ static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
Jim_HashEntry *he;
+ Jim_Obj *fqObjName;
+
+ const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
- he = Jim_FindHashEntry(&interp->commands, Jim_String(cmdNameObj));
+ he = Jim_FindHashEntry(&interp->commands, fqname);
if (he) {
Jim_Cmd *cmd = he->u.val;
@@ -4604,11 +4746,12 @@ static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
he->u.val = prevCmd;
}
else {
- Jim_DeleteHashEntry(&interp->commands, Jim_String(cmdNameObj));
+ Jim_DeleteHashEntry(&interp->commands, fqname);
Jim_InterpIncrProcEpoch(interp);
}
}
Jim_DecrRefCount(interp, cmdNameObj);
+ JimFreeQualifiedName(interp, fqObjName);
}
Jim_FreeStack(localCommands);
Jim_Free(localCommands);
@@ -4625,6 +4768,7 @@ static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
Jim_DecrRefCount(interp, cf->procArgsObjPtr);
if (cf->procBodyObjPtr)
Jim_DecrRefCount(interp, cf->procBodyObjPtr);
+ Jim_DecrRefCount(interp, cf->nsObj);
if (!(flags & JIM_FCF_NOHT))
Jim_FreeHashTable(&cf->vars);
else {
@@ -5095,10 +5239,10 @@ Jim_Interp *Jim_CreateInterp(void)
#endif
Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
- i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL);
i->emptyObj = Jim_NewEmptyStringObj(i);
i->trueObj = Jim_NewIntObj(i, 1);
i->falseObj = Jim_NewIntObj(i, 0);
+ i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
i->errorFileNameObj = i->emptyObj;
i->result = i->emptyObj;
i->stackTrace = Jim_NewListObj(i, NULL, 0);
@@ -5168,8 +5312,14 @@ void Jim_FreeInterp(Jim_Interp *i)
while (objPtr) {
const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
- printf("%p (%d) %-10s: '%.20s'" JIM_NL,
- (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
+ if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
+ printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
+ (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
+ }
+ else {
+ printf("%p (%d) %-10s: '%s'" JIM_NL,
+ (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
+ }
if (objPtr->typePtr == &sourceObjType) {
printf("FILE %s LINE %d" JIM_NL,
Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
@@ -6751,7 +6901,7 @@ int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
if (objPtr == NULL) {
- if (newObjPtr == NULL && (flags & JIM_ERRMSG)) {
+ if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
/* Cannot remove a key from non existing var */
return JIM_ERR;
}
@@ -6774,7 +6924,7 @@ int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
if (i == keyc - 1) {
/* Last key: Note that error on unset with missing last key is OK */
if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
- if (newObjPtr || (flags & JIM_ERRMSG)) {
+ if (newObjPtr || (flags & JIM_MUSTEXIST)) {
goto err;
}
}
@@ -10271,6 +10421,50 @@ static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cm
Jim_FreeNewObj(interp, argmsg);
}
+#ifdef jim_ext_namespace
+/*
+ * [namespace eval]
+ */
+int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
+{
+ Jim_CallFrame *callFramePtr;
+ int retcode;
+
+ /* Create a new callframe */
+ callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
+ callFramePtr->argv = &interp->emptyObj;
+ callFramePtr->argc = 0;
+ callFramePtr->procArgsObjPtr = NULL;
+ callFramePtr->procBodyObjPtr = scriptObj;
+ callFramePtr->staticVars = NULL;
+ callFramePtr->fileNameObj = interp->emptyObj;
+ callFramePtr->line = 0;
+ Jim_IncrRefCount(scriptObj);
+ interp->framePtr = callFramePtr;
+
+ /* Check if there are too nested calls */
+ if (interp->framePtr->level == interp->maxCallFrameDepth) {
+ Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
+ retcode = JIM_ERR;
+ }
+ else {
+ /* Eval the body */
+ retcode = Jim_EvalObj(interp, scriptObj);
+ }
+
+ /* Destroy the callframe */
+ interp->framePtr = interp->framePtr->parent;
+ if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
+ JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
+ }
+ else {
+ JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
+ }
+
+ return retcode;
+}
+#endif
+
/* Call a procedure implemented in Tcl.
* It's possible to speed-up a lot this function, currently
* the callframes are not cached, but allocated and
@@ -10300,7 +10494,7 @@ static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj
}
/* Create a new callframe */
- callFramePtr = JimCreateCallFrame(interp, interp->framePtr);
+ callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
callFramePtr->argv = argv;
callFramePtr->argc = argc;
callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
@@ -12640,7 +12834,8 @@ static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
Jim_IncrRefCount(prefixListObj);
newname = Jim_String(argv[1]);
if (newname[0] == ':' && newname[1] == ':') {
- newname += 2;
+ while (*++newname == ':') {
+ }
}
Jim_SetResult(interp, argv[1]);
@@ -12679,8 +12874,7 @@ static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
if (retcode == 0) {
Jim_Obj *cmdNameObj = Jim_GetResult(interp);
- if (Jim_FindHashEntry(&interp->commands, Jim_String(cmdNameObj)) == NULL) {
- Jim_SetResultFormatted(interp, "not a command: \"%#s\"", cmdNameObj);
+ if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
return JIM_ERR;
}
if (interp->framePtr->localCommands == NULL) {
@@ -13454,8 +13648,6 @@ static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
/* [rename] */
static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
- const char *oldName, *newName;
-
if (argc != 3) {
Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
return JIM_ERR;
@@ -13465,9 +13657,7 @@ static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a
return JIM_ERR;
}
- oldName = Jim_String(argv[1]);
- newName = Jim_String(argv[2]);
- return Jim_RenameCommand(interp, oldName, newName);
+ return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
}
#define JIM_DICTMATCH_VALUES 0x0001
@@ -13694,6 +13884,7 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
int cmd;
Jim_Obj *objPtr;
int mode = 0;
+ int nons = 0;
static const char * const commands[] = {
"body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
@@ -13712,6 +13903,12 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
return JIM_ERR;
}
+ if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
+ /* This is for internal use only */
+ argc--;
+ argv++;
+ nons = 1;
+ }
if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
!= JIM_OK) {
return JIM_ERR;
@@ -13759,6 +13956,13 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
return JIM_ERR;
}
+#ifdef jim_ext_namespace
+ if (!nons) {
+ if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
+ return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
+ }
+ }
+#endif
Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
break;
@@ -13772,6 +13976,13 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
return JIM_ERR;
}
+#ifdef jim_ext_namespace
+ if (!nons) {
+ if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
+ return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
+ }
+ }
+#endif
Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
break;
diff --git a/jim.h b/jim.h
index 5a8b7b2..0204090 100644
--- a/jim.h
+++ b/jim.h
@@ -149,6 +149,10 @@ extern "C" {
#define JIM_ERRMSG 1 /* set an error message in the interpreter. */
#define JIM_UNSHARED 4 /* Flag to Jim_GetVariable() */
+#define JIM_MUSTEXIST 8 /* Flag to Jim_SetDictKeysVector() - fail if non-existent */
+
+/* Internal flags */
+#define JIM_GLOBAL_ONLY 0x100
/* Flags for Jim_SubstObj() */
#define JIM_SUBST_NOVAR 1 /* don't perform variables substitutions */
@@ -309,6 +313,7 @@ typedef struct Jim_Obj {
/* Command object */
struct {
unsigned long procEpoch; /* for caching */
+ struct Jim_Obj *nsObj;
struct Jim_Cmd *cmdPtr;
} cmdValue;
/* List object */
@@ -438,6 +443,7 @@ typedef struct Jim_CallFrame {
Jim_Obj *procArgsObjPtr; /* arglist object of the running procedure */
Jim_Obj *procBodyObjPtr; /* body object of the running procedure */
struct Jim_CallFrame *next; /* Callframes are in a linked list */
+ Jim_Obj *nsObj; /* Namespace for this proc call frame */
Jim_Obj *fileNameObj; /* file and line of caller of this proc (if available) */
int line;
Jim_Stack *localCommands; /* commands to be destroyed when the call frame is destroyed */
@@ -490,6 +496,7 @@ typedef struct Jim_Cmd {
Jim_Obj *nameObjPtr; /* Name of this arg */
Jim_Obj *defaultObjPtr; /* Default value, (or rename for $args) */
} *arglist;
+ Jim_Obj *nsObj; /* Namespace for this proc */
} proc;
} u;
} Jim_Cmd;
@@ -645,6 +652,7 @@ JIM_EXPORT int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listObj);
JIM_EXPORT int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix,
int objc, Jim_Obj *const *objv);
#define Jim_EvalPrefix(i, p, oc, ov) Jim_EvalObjPrefix((i), Jim_NewStringObj((i), (p), -1), (oc), (ov))
+JIM_EXPORT int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj);
JIM_EXPORT int Jim_SubstObj (Jim_Interp *interp, Jim_Obj *substObjPtr,
Jim_Obj **resObjPtrPtr, int flags);
@@ -758,6 +766,9 @@ JIM_EXPORT int Jim_SetVariableStrWithStr (Jim_Interp *interp,
JIM_EXPORT int Jim_SetVariableLink (Jim_Interp *interp,
Jim_Obj *nameObjPtr, Jim_Obj *targetNameObjPtr,
Jim_CallFrame *targetCallFrame);
+JIM_EXPORT int Jim_CreateNamespaceVariable(Jim_Interp *interp,
+ Jim_Obj *varNameObj, Jim_Obj *targetNameObj);
+JIM_EXPORT int Jim_DiscardNamespaceVars(Jim_Interp *interp);
JIM_EXPORT Jim_Obj * Jim_GetVariable (Jim_Interp *interp,
Jim_Obj *nameObjPtr, int flags);
JIM_EXPORT Jim_Obj * Jim_GetGlobalVariable (Jim_Interp *interp,
diff --git a/nshelper.tcl b/nshelper.tcl
new file mode 100644
index 0000000..c91973f
--- /dev/null
+++ b/nshelper.tcl
@@ -0,0 +1,124 @@
+proc {namespace delete} {args} {
+ foreach name $args {
+ if {$name ni {:: ""}} {
+ set name [uplevel 1 [list ::namespace canon $name]]
+ foreach i [info commands ${name}::*] { rename $i "" }
+ uplevel #0 [list unset {*}[info globals ${name}::*]]
+ }
+ }
+}
+
+proc {namespace origin} {name} {
+ set nscanon [uplevel 1 [list ::namespace canon $name]]
+ if {[exists -alias $nscanon]} {
+ tailcall {namespace origin} [info alias $nscanon]
+ }
+ if {[exists -command $nscanon]} {
+ return ::$nscanon
+ }
+ if {[exists -command $name]} {
+ return ::$name
+ }
+
+ return -code error "invalid command name \"$name\""
+}
+
+proc {namespace which} {{type -command} name} {
+ set nsname ::[uplevel 1 [list ::namespace canon $name]]
+ if {$type eq "-variable"} {
+ return $nsname
+ }
+ if {$type eq "-command"} {
+ if {[exists -command $nsname]} {
+ return $nsname
+ } elseif {[exists -command ::$name]} {
+ return ::$name
+ }
+ return ""
+ }
+ return -code error {wrong # args: should be "namespace which ?-command? ?-variable? name"}
+}
+
+
+proc {namespace code} {arg} {
+ if {[string first "::namespace inscope " $arg] == 0} {
+ # Already scoped
+ return $arg
+ }
+ list ::namespace inscope [uplevel 1 ::namespace current] $arg
+}
+
+proc {namespace inscope} {name arg args} {
+ tailcall namespace eval $name $arg $args
+}
+
+proc {namespace import} {args} {
+ set current [uplevel 1 ::namespace canon]
+
+ foreach pattern $args {
+ foreach cmd [info commands [namespace canon $current $pattern]] {
+ alias ${current}::[namespace tail $cmd] $cmd
+ }
+ }
+}
+
+# namespace-aware info commands: procs, channels, globals, locals, vars
+proc {namespace info} {cmd {pattern *}} {
+ set current [uplevel 1 ::namespace canon]
+ # Now we may need to strip $pattern
+ if {[string first :: $pattern] == 0} {
+ set global 1
+ set prefix ::
+ } else {
+ set global 0
+ set clen [string length $current]
+ incr clen 2
+ }
+ set fqp [namespace canon $current $pattern]
+ switch -glob -- $cmd {
+ co* - p* {
+ if {$global} {
+ set result [info $cmd $fqp]
+ } else {
+ # Add commands in the current namespace
+ set r {}
+ foreach c [info $cmd $fqp] {
+ dict set r [string range $c $clen end] 1
+ }
+ if {[string match co* $cmd]} {
+ # Now in the global namespace
+ foreach c [info -nons commands $pattern] {
+ dict set r $c 1
+ }
+ }
+ set result [dict keys $r]
+ }
+ }
+ ch* {
+ set result [info channels $pattern]
+ }
+ v* {
+ #puts "uplevel #0 info gvars $fqp"
+ set result [uplevel #0 info -nons vars $fqp]
+ }
+ g* {
+ set result [info globals $fqp]
+ }
+ l* {
+ set result [uplevel 1 info -nons locals $pattern]
+ }
+ }
+ if {$global} {
+ set result [lmap p $result { set p $prefix$p }]
+ }
+ return $result
+}
+
+proc {namespace upvar} {ns args} {
+ set nscanon ::[uplevel 1 [list ::namespace canon $ns]]
+ set script [list upvar 0]
+ foreach {other local} $args {
+ lappend script ${nscanon}::$other $local
+ }
+ tailcall {*}$script
+}
diff --git a/tests/alias.test b/tests/alias.test
index 9e866a2..b1774fd 100644
--- a/tests/alias.test
+++ b/tests/alias.test
@@ -121,7 +121,7 @@ test local-1.7 "check no reference procs" {
test local-1.8 "local on non-existent command" {
list [catch {local set x blah} msg] $msg
-} {1 {not a command: "blah"}}
+} {1 {invalid command name "blah"}}
test local-1.9 "local on existing proc" {
proc x {} {
diff --git a/tests/namespace.test b/tests/namespace.test
new file mode 100644
index 0000000..5707cf8
--- /dev/null
+++ b/tests/namespace.test
@@ -0,0 +1,493 @@
+source [file dirname [info script]]/testing.tcl
+needs cmd namespace
+
+test namespace-1.1 {usage for "namespace" command} -body {
+ namespace
+} -returnCodes error -match glob -result {wrong # args: should be *}
+
+test namespace-1.2 {global namespace's name is "::" or {}} {
+ list [namespace current] [namespace eval {} {namespace current}] [namespace eval :: {namespace current}]
+} {:: :: ::}
+
+test namespace-1.3 {usage for "namespace eval"} -body {
+ namespace eval
+} -returnCodes error -match glob -result {wrong # args: should be "namespace eval *"}
+
+test namespace-1.5 {access a new namespace} {
+ namespace eval ns1 { namespace current }
+} {::ns1}
+
+test namespace-1.7 {usage for "namespace eval"} -body {
+ namespace eval ns1
+} -returnCodes error -match glob -result {wrong # args: should be "namespace eval *"}
+
+test namespace-1.8 {command "namespace eval" concatenates args} {
+ namespace eval ns1 namespace current
+} {::ns1}
+
+test namespace-1.9 {simple namespace elements} {
+ namespace eval ns1 {
+ variable v1 1
+ proc p1 {a} {variable v1; list $a $v1}
+ p1 3
+ }
+} {3 1}
+
+test namespace-1.10 {commands in a namespace} {
+ namespace eval ns1 {
+ info commands [namespace current]::*
+ }
+} {::ns1::p1}
+
+test namespace-1.11 {variables in a namespace} {
+ namespace eval ns1 {
+ info vars [namespace current]::*
+ }
+} {::ns1::v1}
+
+test namespace-1.12 {global vars are separate from locals vars} {
+ set v1 2
+ list [ns1::p1 123] [set ns1::v1] [set ::v1]
+} {{123 1} 1 2}
+
+test namespace-1.13 {add to an existing namespace} {
+ namespace eval ns1 {
+ variable v2 22
+ proc p2 {script} {variable v2; eval $script}
+ p2 {return $v2}
+ }
+} 22
+
+test namespace-1.14 {commands in a namespace} {
+ lsort [namespace eval ns1 {info commands [namespace current]::*}]
+} {::ns1::p1 ::ns1::p2}
+
+test namespace-1.15 {variables in a namespace} {
+ lsort [namespace eval ns1 {info vars [namespace current]::*}]
+} {::ns1::v1 ::ns1::v2}
+
+# Tcl produces fully scoped names here
+test namespace-1.16 {variables in a namespace} jim {
+ lsort [info vars ns1::*]
+} {ns1::v1 ns1::v2}
+
+test namespace-1.17 {commands in a namespace are hidden} -body {
+ v2 {return 3}
+} -returnCodes error -result {invalid command name "v2"}
+
+test namespace-1.18 {using namespace qualifiers} {
+ ns1::p2 {return 44}
+} 44
+
+test namespace-1.19 {using absolute namespace qualifiers} {
+ ::ns1::p2 {return 55}
+} 55
+
+test namespace-1.20 {variables in a namespace are hidden} -body {
+ set v2
+} -returnCodes error -result {can't read "v2": no such variable}
+
+test namespace-1.21 {using namespace qualifiers} {
+ list $ns1::v1 $ns1::v2
+} {1 22}
+
+test namespace-1.22 {using absolute namespace qualifiers} {
+ list $::ns1::v1 $::ns1::v2
+} {1 22}
+
+test namespace-1.23 {variables can be accessed within a namespace} {
+ ns1::p2 {
+ variable v1
+ variable v2
+ list $v1 $v2
+ }
+} {1 22}
+
+test namespace-1.24 {setting global variables} {
+ ns1::p2 {
+ variable v1
+ set v1 new
+ }
+ namespace eval ns1 {
+ variable v1
+ variable v2
+ list $v1 $v2
+ }
+} {new 22}
+
+test namespace-1.25 {qualified variables don't need a global declaration} {
+ namespace eval ns2 { variable x 456 }
+ set cmd {set ::ns2::x}
+ ns1::p2 "$cmd some-value"
+ set ::ns2::x
+} {some-value}
+
+test namespace-1.26 {namespace qualifiers are okay after $'s} {
+ namespace eval ns1 { variable x; variable y; set x 12; set y 34 }
+ set cmd {list $::ns1::x $::ns1::y}
+ list [ns1::p2 $cmd] [eval $cmd]
+} {{12 34} {12 34}}
+
+test namespace-1.27 {can create commands with null names} {
+ proc ns1:: {args} {return $args}
+ ns1:: x
+} {x}
+
+unset -nocomplain ns1::x ns1::y
+
+# -----------------------------------------------------------------------
+# TEST: using "info" in namespace contexts
+# -----------------------------------------------------------------------
+test namespace-2.1 {querying: info commands} {
+ lsort [ns1::p2 {info commands [namespace current]::*}]
+} {::ns1:: ::ns1::p1 ::ns1::p2}
+
+test namespace-2.2 {querying: info procs} {
+ lsort [ns1::p2 {info procs}]
+} {{} p1 p2}
+
+# Tcl produces fully scoped names here
+test namespace-2.3 {querying: info vars} jim {
+ lsort [info vars ns1::*]
+} {ns1::v1 ns1::v2}
+
+test namespace-2.4 {querying: info vars} {
+ lsort [ns1::p2 {info vars [namespace current]::*}]
+} {::ns1::v1 ::ns1::v2}
+
+test namespace-2.5 {querying: info locals} {
+ lsort [ns1::p2 {info locals}]
+} {script}
+
+test namespace-2.6 {querying: info exists} {
+ ns1::p2 {info exists v1}
+} {0}
+
+test namespace-2.7 {querying: info exists} {
+ ns1::p2 {info exists v2}
+} {1}
+
+test namespace-2.8 {querying: info args} {
+ info args ns1::p2
+} {script}
+
+test namespace-2.9 {querying: info body} {
+ string trim [info body ns1::p1]
+} {variable v1; list $a $v1}
+
+# -----------------------------------------------------------------------
+# TEST: namespace qualifiers, namespace tail
+# -----------------------------------------------------------------------
+test namespace-3.1 {usage for "namespace qualifiers"} {
+ list [catch "namespace qualifiers" msg] $msg
+} {1 {wrong # args: should be "namespace qualifiers string"}}
+
+test namespace-3.2 {querying: namespace qualifiers} {
+ list [namespace qualifiers ""] \
+ [namespace qualifiers ::] \
+ [namespace qualifiers x] \
+ [namespace qualifiers ::x] \
+ [namespace qualifiers foo::x] \
+ [namespace qualifiers ::foo::bar::xyz]
+} {{} {} {} {} foo ::foo::bar}
+
+test namespace-3.3 {usage for "namespace tail"} {
+ list [catch "namespace tail" msg] $msg
+} {1 {wrong # args: should be "namespace tail string"}}
+
+test namespace-3.4 {querying: namespace tail} {
+ list [namespace tail ""] \
+ [namespace tail ::] \
+ [namespace tail x] \
+ [namespace tail ::x] \
+ [namespace tail foo::x] \
+ [namespace tail ::foo::bar::xyz]
+} {{} {} x x x xyz}
+
+# -----------------------------------------------------------------------
+# TEST: namespace hierarchy
+# -----------------------------------------------------------------------
+test namespace-5.1 {define nested namespaces} {
+ set test_ns_var_global "var in ::"
+ proc test_ns_cmd_global {} {return "cmd in ::"}
+ namespace eval nsh1 {
+ set test_ns_var_hier1 "particular to hier1"
+ proc test_ns_cmd_hier1 {} {return "particular to hier1"}
+ proc test_ns_show {} {return "[namespace current]: 1"}
+ namespace eval nsh2 {
+ set test_ns_var_hier2 "particular to hier2"
+ proc test_ns_cmd_hier2 {} {return "particular to hier2"}
+ proc test_ns_show {} {return "[namespace current]: 2"}
+ namespace eval nsh3a {}
+ namespace eval nsh3b {}
+ }
+ namespace eval nsh2a {}
+ namespace eval nsh2b {}
+ }
+} {}
+
+test namespace-5.2 {namespaces can be nested} {
+ list [namespace eval nsh1 {namespace current}] \
+ [namespace eval nsh1 {
+ namespace eval nsh2 {namespace current}
+ }]
+} {::nsh1 ::nsh1::nsh2}
+
+test namespace-5.3 {namespace qualifiers work in namespace command} {
+ list [namespace eval ::nsh1 {namespace current}] \
+ [namespace eval nsh1::nsh2 {namespace current}] \
+ [namespace eval ::nsh1::nsh2 {namespace current}]
+} {::nsh1 ::nsh1::nsh2 ::nsh1::nsh2}
+
+test namespace-5.4 {nested namespaces can access global namespace} {
+ list [namespace eval nsh1 {set ::test_ns_var_global}] \
+ [namespace eval nsh1 {test_ns_cmd_global}] \
+ [namespace eval nsh1::nsh2 {set ::test_ns_var_global}] \
+ [namespace eval nsh1::nsh2 {test_ns_cmd_global}]
+} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
+
+test namespace-5.6 {commands in different namespaces don't conflict} {
+ list [nsh1::test_ns_show] \
+ [nsh1::nsh2::test_ns_show]
+} {{::nsh1: 1} {::nsh1::nsh2: 2}}
+test namespace-5.7 {nested namespaces don't see variables in parent} {
+ set cmd {
+ namespace eval nsh1::nsh2 {set test_ns_var_hier1}
+ }
+ list [catch $cmd msg] $msg
+} {1 {can't read "test_ns_var_hier1": no such variable}}
+test namespace-5.8 {nested namespaces don't see commands in parent} {
+ set cmd {
+ namespace eval nsh1::nsh2 {test_ns_cmd_hier1}
+ }
+ list [catch $cmd msg] $msg
+} {1 {invalid command name "test_ns_cmd_hier1"}}
+
+test namespace-5.18 {usage for "namespace parent"} {
+ list [catch {namespace parent x y} msg] $msg
+} {1 {wrong # args: should be "namespace parent ?name?"}}
+
+test namespace-5.20 {querying namespace parent} {
+ list [namespace eval :: {namespace parent}] \
+ [namespace eval nsh1 {namespace parent}] \
+ [namespace eval nsh1::nsh2 {namespace parent}] \
+ [namespace eval nsh1::nsh2::nsh3a {namespace parent}] \
+} {{} :: ::nsh1 ::nsh1::nsh2}
+
+test namespace-5.21 {querying namespace parent for explicit namespace} {
+ list [namespace parent ::] \
+ [namespace parent nsh1] \
+ [namespace parent nsh1::nsh2] \
+ [namespace parent nsh1::nsh2::nsh3a]
+} {{} :: ::nsh1 ::nsh1::nsh2}
+
+# -----------------------------------------------------------------------
+# TEST: name resolution and caching
+# -----------------------------------------------------------------------
+test namespace-6.1 {relative ns names only looked up in current ns} {
+ namespace eval tns1 {}
+ namespace eval tns2 {}
+ namespace eval tns2::test_ns_cache3 {}
+ set trigger {
+ namespace eval tns2 {namespace current}
+ }
+ set trigger2 {
+ namespace eval tns2::test_ns_cache3 {namespace current}
+ }
+ list [namespace eval tns1 $trigger] \
+ [namespace eval tns1 $trigger2]
+} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
+test namespace-6.2 {relative ns names only looked up in current ns} {
+ namespace eval tns1::tns2 {}
+ list [namespace eval tns1 $trigger] \
+ [namespace eval tns1 $trigger2]
+} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
+test namespace-6.3 {relative ns names only looked up in current ns} {
+ namespace eval tns1::tns2::test_ns_cache3 {}
+ list [namespace eval tns1 $trigger] \
+ [namespace eval tns1 $trigger2]
+} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
+test namespace-6.4 {relative ns names only looked up in current ns} {
+ namespace delete tns1::tns2
+ list [namespace eval tns1 $trigger] \
+ [namespace eval tns1 $trigger2]
+} {::tns1::tns2 ::tns1::tns2::test_ns_cache3}
+
+test namespace-6.5 {define test commands} {
+ proc testcmd {} {
+ return "global version"
+ }
+ namespace eval tns1 {
+ proc trigger {} {
+ testcmd
+ }
+ }
+ tns1::trigger
+} {global version}
+
+test namespace-6.6 {one-level check for command shadowing} {
+ proc tns1::testcmd {} {
+ return "cache1 version"
+ }
+ tns1::trigger
+} {cache1 version}
+
+test namespace-6.7 {renaming commands changes command epoch} {
+ namespace eval tns1 {
+ rename testcmd testcmd_new
+ }
+ tns1::trigger
+} {global version}
+test namespace-6.8 {renaming back handles shadowing} {
+ namespace eval tns1 {
+ rename testcmd_new testcmd
+ }
+ tns1::trigger
+} {cache1 version}
+test namespace-6.9 {deleting commands changes command epoch} {
+ namespace eval tns1 {
+ rename testcmd ""
+ }
+ tns1::trigger
+} {global version}
+test namespace-6.10 {define test namespaces} {
+ namespace eval tns2 {
+ proc testcmd {} {
+ return "global cache2 version"
+ }
+ }
+ namespace eval tns1 {
+ proc trigger {} {
+ tns2::testcmd
+ }
+ }
+ namespace eval tns1::tns2 {
+ proc trigger {} {
+ testcmd
+ }
+ }
+ list [tns1::trigger] [tns1::tns2::trigger]
+} {{global cache2 version} {global version}}
+
+test namespace-6.11 {commands affect all parent namespaces} {
+ proc tns1::tns2::testcmd {} {
+ return "cache2 version"
+ }
+ list [tns1::trigger] [tns1::tns2::trigger]
+} {{cache2 version} {cache2 version}}
+
+# -----------------------------------------------------------------------
+# TEST: uplevel/upvar across namespace boundaries
+# -----------------------------------------------------------------------
+# Note that Tcl behaves a little differently for uplevel and upvar
+
+test namespace-7.1 {uplevel in namespace eval} jim {
+ set x 66
+ namespace eval uns1 {
+ variable y 55
+ set x 33
+ uplevel 1 set x
+ }
+} {66}
+
+test namespace-7.2 {upvar in ns proc} jim {
+ proc uns1::getvar {v} {
+ variable y
+ upvar $v var
+ list $var $y
+ }
+ uns1::getvar x
+} {66 55}
+
+# -----------------------------------------------------------------------
+# TEST: scoped values
+# -----------------------------------------------------------------------
+test namespace-10.1 {define namespace for scope test} {
+ namespace eval ins1 {
+ variable x "x-value"
+ proc show {args} {
+ return "show: $args"
+ }
+ proc do {args} {
+ return [eval $args]
+ }
+ list [set x] [show test]
+ }
+} {x-value {show: test}}
+
+test namespace-10.2 {command "namespace code" requires one argument} {
+ list [catch {namespace code} msg] $msg
+} {1 {wrong # args: should be "namespace code arg"}}
+
+test namespace-10.3 {command "namespace code" requires one argument} {
+ list [catch {namespace code first "second arg" third} msg] $msg
+} {1 {wrong # args: should be "namespace code arg"}}
+
+test namespace-10.4 {command "namespace code" gets current namesp context} {
+ namespace eval ins1 {
+ namespace code {"1 2 3" "4 5" 6}
+ }
+} {::namespace inscope ::ins1 {"1 2 3" "4 5" 6}}
+
+test namespace-10.5 {with one arg, first "scope" sticks} {
+ set sval [namespace eval ins1 {namespace code {one two}}]
+ namespace code $sval
+} {::namespace inscope ::ins1 {one two}}
+
+test namespace-10.6 {with many args, each "scope" adds new args} {
+ set sval [namespace eval ins1 {namespace code {one two}}]
+ namespace code "$sval three"
+} {::namespace inscope ::ins1 {one two} three}
+
+test namespace-10.7 {scoped commands work with eval} {
+ set cref [namespace eval ins1 {namespace code show}]
+ list [eval $cref "a" "b c" "d e f"]
+} {{show: a b c d e f}}
+
+test namespace-10.8 {scoped commands execute in namespace context} {
+ set cref [namespace eval ins1 {
+ namespace code {variable x; set x "some new value"}
+ }]
+ list [set ins1::x] [eval $cref] [set ins1::x]
+} {x-value {some new value} {some new value}}
+
+test namespace-11.1 {command caching} {
+ proc cmd1 {} { return global }
+ set result {}
+ namespace eval ns1 {
+ proc cmd1 {} { return ns1 }
+ proc cmd2 {} {
+ uplevel 1 cmd1
+ }
+ lappend ::result [cmd2]
+ }
+ lappend result [ns1::cmd2]
+} {ns1 global}
+
+foreach cmd [info commands test_ns_*] {
+ rename $cmd ""
+}
+
+catch {rename cmd {}}
+catch {rename cmd1 {}}
+catch {rename cmd2 {}}
+catch {rename ncmd {}}
+catch {rename ncmd1 {}}
+catch {rename ncmd2 {}}
+catch {unset cref}
+catch {unset trigger}
+catch {unset trigger2}
+catch {unset sval}
+catch {unset msg}
+catch {unset x}
+catch {unset test_ns_var_global}
+catch {unset cmd}
+catch {eval namespace delete [namespace children :: test_ns_*]}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/utf8.h b/utf8.h
index 2a3ce01..71fd6ff 100644
--- a/utf8.h
+++ b/utf8.h
@@ -15,7 +15,7 @@
/**
* Converts the given unicode codepoint (0 - 0x1fffff) to utf-8
* and stores the result at 'p'.
- *
+ *
* Returns the number of utf-8 characters (up to MAX_UTF8_LEN).
*/
int utf8_fromunicode(char *p, unsigned uc);
generated by cgit v1.1 at 2024-09-17 20:14:37 +0000