/TCL/src/commands/NamespaceCmd.cs
C# | 3674 lines | 1648 code | 560 blank | 1466 comment | 432 complexity | f366282c31d27bc290d1b7945940f83f MD5 | raw file
Large files files are truncated, but you can click here to view the full file
- #undef DEBUG
- /*
- * NamespaceCmd.java
- *
- * Copyright (c) 1993-1997 Lucent Technologies.
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 1999 Moses DeJong
- *
- * Originally implemented by
- * Michael J. McLennan
- * Bell Labs Innovations for Lucent Technologies
- * mmclennan@lucent.com
- *
- * See the file "license.terms" for information on usage and
- * redistribution of this file, and for a DISCLAIMER OF ALL
- * WARRANTIES.
- *
- * Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart
- *
- * RCS @(#) $Id: NamespaceCmd.java,v 1.12 2001/05/05 22:38:13 mdejong Exp $
- */
- using System;
- using System.Collections;
- using System.Text;
- namespace tcl.lang
- {
- /// <summary> This class implements the built-in "namespace" command in Tcl.
- /// See the user documentation for details on what it does.
- /// </summary>
- public class NamespaceCmd : InternalRep, Command
- {
- // Flag passed to getNamespaceForQualName to indicate that it should
- // search for a namespace rather than a command or variable inside a
- // namespace. Note that this flag's value must not conflict with the values
- // of TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, or TCL.VarFlag.CREATE_NS_IF_UNKNOWN.
- // Initial size of stack allocated space for tail list - used when resetting
- // shadowed command references in the functin: TclResetShadowedCmdRefs.
- //private static final int NUM_TRAIL_ELEMS = 5;
- // Count of the number of namespaces created. This value is used as a
- // unique id for each namespace.
- private static long numNsCreated = 0;
- private static Object nsMutex;
- //
- // Flags used to represent the status of a namespace:
- //
- // NS_DYING - 1 means deleteNamespace has been called to delete the
- // namespace but there are still active call frames on the Tcl
- // stack that refer to the namespace. When the last call frame
- // referring to it has been popped, it's variables and command
- // will be destroyed and it will be marked "dead" (NS_DEAD).
- // The namespace can no longer be looked up by name.
- // NS_DEAD - 1 means deleteNamespace has been called to delete the
- // namespace and no call frames still refer to it. Its
- // variables and command have already been destroyed. This bit
- // allows the namespace resolution code to recognize that the
- // namespace is "deleted". When the last namespaceName object
- // in any byte code code unit that refers to the namespace has
- // been freed (i.e., when the namespace's refCount is 0), the
- // namespace's storage will be freed.
- internal const int NS_DYING = 0x01;
- internal const int NS_DEAD = 0x02;
- // Flag passed to getNamespaceForQualName to have it create all namespace
- // components of a namespace-qualified name that cannot be found. The new
- // namespaces are created within their specified parent. Note that this
- // flag's value must not conflict with the values of the flags
- // TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, and TCL.VarFlag.FIND_ONLY_NS
- // internal const int TCL.VarFlag.CREATE_NS_IF_UNKNOWN = 0x800;
- // This value corresponds to the Tcl_Obj.otherValuePtr pointer used
- // in the C version of Tcl 8.1. Use it to keep track of a ResolvedNsName.
- private ResolvedNsName otherValue = null;
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetCurrentNamespace -> getCurrentNamespace
- *
- * Returns a reference to an interpreter's currently active namespace.
- *
- * Results:
- * Returns a reference to the interpreter's current namespace.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- internal static Namespace getCurrentNamespace( Interp interp )
- {
- if ( interp.varFrame != null )
- {
- return interp.varFrame.ns;
- }
- else
- {
- return interp.globalNs;
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetGlobalNamespace -> getGlobalNamespace
- *
- * Returns a reference to an interpreter's global :: namespace.
- *
- * Results:
- * Returns a reference to the specified interpreter's global namespace.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- internal static Namespace getGlobalNamespace( Interp interp )
- {
- return interp.globalNs;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_PushCallFrame -> pushCallFrame
- *
- * Pushes a new call frame onto the interpreter's Tcl call stack.
- * Called when executing a Tcl procedure or a "namespace eval" or
- * "namespace inscope" command.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Modifies the interpreter's Tcl call stack.
- *
- *----------------------------------------------------------------------
- */
- internal static void pushCallFrame( Interp interp, CallFrame frame, Namespace namespace_Renamed, bool isProcCallFrame )
- // If true, the frame represents a
- // called Tcl procedure and may have local
- // vars. Vars will ordinarily be looked up
- // in the frame. If new variables are
- // created, they will be created in the
- // frame. If false, the frame is for a
- // "namespace eval" or "namespace inscope"
- // command and var references are treated
- // as references to namespace variables.
- {
- Namespace ns;
- if ( namespace_Renamed == null )
- {
- ns = getCurrentNamespace( interp );
- }
- else
- {
- ns = namespace_Renamed;
- if ( ( ns.flags & NS_DEAD ) != 0 )
- {
- throw new TclRuntimeError( "Trying to push call frame for dead namespace" );
- }
- }
- ns.activationCount++;
- frame.ns = ns;
- frame.isProcCallFrame = isProcCallFrame;
- frame.objv = null;
- frame.caller = interp.frame;
- frame.callerVar = interp.varFrame;
- if ( interp.varFrame != null )
- {
- frame.level = ( interp.varFrame.level + 1 );
- }
- else
- {
- frame.level = 1;
- }
- // FIXME : does Jacl need a procPtr in the CallFrame class?
- //frame.procPtr = null; // no called procedure
- frame.varTable = null; // and no local variables
- // Compiled locals are not part of Jacl's CallFrame
- // Push the new call frame onto the interpreter's stack of procedure
- // call frames making it the current frame.
- interp.frame = frame;
- interp.varFrame = frame;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_PopCallFrame -> popCallFrame
- *
- * Removes a call frame from the Tcl call stack for the interpreter.
- * Called to remove a frame previously pushed by Tcl_PushCallFrame.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Modifies the call stack of the interpreter. Resets various fields of
- * the popped call frame. If a namespace has been deleted and
- * has no more activations on the call stack, the namespace is
- * destroyed.
- *
- *----------------------------------------------------------------------
- */
- internal static void popCallFrame( Interp interp )
- {
- CallFrame frame = interp.frame;
- int saveErrFlag;
- Namespace ns;
- // It's important to remove the call frame from the interpreter's stack
- // of call frames before deleting local variables, so that traces
- // invoked by the variable deletion don't see the partially-deleted
- // frame.
- interp.frame = frame.caller;
- interp.varFrame = frame.callerVar;
- // Delete the local variables. As a hack, we save then restore the
- // ERR_IN_PROGRESS flag in the interpreter. The problem is that there
- // could be unset traces on the variables, which cause scripts to be
- // evaluated. This will clear the ERR_IN_PROGRESS flag, losing stack
- // trace information if the procedure was exiting with an error. The
- // code below preserves the flag. Unfortunately, that isn't really
- // enough: we really should preserve the errorInfo variable too
- // (otherwise a nested error in the trace script will trash errorInfo).
- // What's really needed is a general-purpose mechanism for saving and
- // restoring interpreter state.
- saveErrFlag = ( interp.flags & Parser.ERR_IN_PROGRESS );
- if ( frame.varTable != null )
- {
- Var.deleteVars( interp, frame.varTable );
- frame.varTable = null;
- }
- interp.flags |= saveErrFlag;
- // Decrement the namespace's count of active call frames. If the
- // namespace is "dying" and there are no more active call frames,
- // call Tcl_DeleteNamespace to destroy it.
- ns = frame.ns;
- ns.activationCount--;
- if ( ( ( ns.flags & NS_DYING ) != 0 ) && ( ns.activationCount == 0 ) )
- {
- deleteNamespace( ns );
- }
- frame.ns = null;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateNamespace --
- *
- * Creates a new namespace with the given name. If there is no
- * active namespace (i.e., the interpreter is being initialized),
- * the global :: namespace is created and returned.
- *
- * Results:
- * Returns a reference to the new namespace if successful. If the
- * namespace already exists or if another error occurs, this routine
- * returns null, along with an error message in the interpreter's
- * result object.
- *
- * Side effects:
- * If the name contains "::" qualifiers and a parent namespace does
- * not already exist, it is automatically created.
- *
- *----------------------------------------------------------------------
- */
- internal static Namespace createNamespace( Interp interp, string name, DeleteProc deleteProc )
- {
- Namespace ns, ancestor;
- Namespace parent;
- Namespace globalNs = getGlobalNamespace( interp );
- string simpleName;
- StringBuilder buffer1, buffer2;
- // If there is no active namespace, the interpreter is being
- // initialized.
- if ( ( globalNs == null ) && ( interp.varFrame == null ) )
- {
- // Treat this namespace as the global namespace, and avoid
- // looking for a parent.
- parent = null;
- simpleName = "";
- }
- else if ( name.Length == 0 )
- {
- /*
- TclObject tobj = interp.getResult();
- // FIXME : is there a test case to check this error result?
- TclString.append(tobj,
- "can't create namespace \"\": only global namespace can have empty name");
- */
- // FIXME : is there a test case to check this error result?
- interp.setResult( "can't create namespace \"\": only global namespace can have empty name" );
- return null;
- }
- else
- {
- // Find the parent for the new namespace.
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] parentArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- string[] simpleArr = new string[1];
- getNamespaceForQualName( interp, name, null, ( TCL.VarFlag.CREATE_NS_IF_UNKNOWN | TCL.VarFlag.LEAVE_ERR_MSG ), parentArr, dummyArr, dummyArr, simpleArr );
- // Get the values out of the arrays!
- parent = parentArr[0];
- simpleName = simpleArr[0];
- // If the unqualified name at the end is empty, there were trailing
- // "::"s after the namespace's name which we ignore. The new
- // namespace was already (recursively) created and is referenced
- // by parent.
- if ( simpleName.Length == 0 )
- {
- return parent;
- }
- // Check for a bad namespace name and make sure that the name
- // does not already exist in the parent namespace.
- if ( parent.childTable[simpleName] != null )
- {
- /*
- TclObject tobj = interp.getResult();
- // FIXME : is there a test case to check this error result?
- TclString.append(tobj,
- "can't create namespace \"" + name + "\": already exists");
- */
- // FIXME : is there a test case to check this error result?
- interp.setResult( "can't create namespace \"" + name + "\": already exists" );
- return null;
- }
- }
- // Create the new namespace and root it in its parent. Increment the
- // count of namespaces created.
- ns = new Namespace();
- ns.name = simpleName;
- ns.fullName = null; // set below
- //ns.clientData = clientData;
- ns.deleteProc = deleteProc;
- ns.parent = parent;
- ns.childTable = new Hashtable();
- lock ( nsMutex )
- {
- numNsCreated++;
- ns.nsId = numNsCreated;
- }
- ns.interp = interp;
- ns.flags = 0;
- ns.activationCount = 0;
- // FIXME : there was a problem with the refcount because
- // when the namespace was deleted the refocount was 0.
- // We avoid this by just using a refcount of 1 for now.
- // We can do ignore the refCount because GC will reclaim mem.
- //ns.refCount = 0;
- ns.refCount = 1;
- ns.cmdTable = new Hashtable();
- ns.varTable = new Hashtable();
- ns.exportArray = null;
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = 0;
- // Jacl does not use these tcl compiler specific members
- //ns.cmdRefEpoch = 0;
- //ns.resolverEpoch = 0;
- ns.resolver = null;
- if ( parent != null )
- {
- SupportClass.PutElement( parent.childTable, simpleName, ns );
- }
- // Build the fully qualified name for this namespace.
- buffer1 = new StringBuilder();
- buffer2 = new StringBuilder();
- for ( ancestor = ns; ancestor != null; ancestor = ancestor.parent )
- {
- if ( ancestor != globalNs )
- {
- buffer1.Append( "::" );
- buffer1.Append( ancestor.name );
- }
- buffer1.Append( buffer2 );
- buffer2.Length = 0;
- buffer2.Append( buffer1 );
- buffer1.Length = 0;
- }
- name = buffer2.ToString();
- ns.fullName = name;
- // Return a reference to the new namespace.
- return ns;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteNamespace -> deleteNamespace
- *
- * Deletes a namespace and all of the commands, variables, and other
- * namespaces within it.
- *
- * Results:
- * None.
- *
- * Side effects:
- * When a namespace is deleted, it is automatically removed as a
- * child of its parent namespace. Also, all its commands, variables
- * and child namespaces are deleted.
- *
- *----------------------------------------------------------------------
- */
- internal static void deleteNamespace( Namespace namespace_Renamed )
- {
- Namespace ns = namespace_Renamed;
- Interp interp = ns.interp;
- Namespace globalNs = getGlobalNamespace( interp );
- // If the namespace is on the call frame stack, it is marked as "dying"
- // (NS_DYING is OR'd into its flags): the namespace can't be looked up
- // by name but its commands and variables are still usable by those
- // active call frames. When all active call frames referring to the
- // namespace have been popped from the Tcl stack, popCallFrame will
- // call this procedure again to delete everything in the namespace.
- // If no nsName objects refer to the namespace (i.e., if its refCount
- // is zero), its commands and variables are deleted and the storage for
- // its namespace structure is freed. Otherwise, if its refCount is
- // nonzero, the namespace's commands and variables are deleted but the
- // structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
- // flags to allow the namespace resolution code to recognize that the
- // namespace is "deleted".
- if ( ns.activationCount > 0 )
- {
- ns.flags |= NS_DYING;
- if ( ns.parent != null )
- {
- ns.parent.childTable.Remove( ns.name );
- }
- ns.parent = null;
- }
- else
- {
- // Delete the namespace and everything in it. If this is the global
- // namespace, then clear it but don't free its storage unless the
- // interpreter is being torn down.
- teardownNamespace( ns );
- if ( ( ns != globalNs ) || ( ( interp.flags & Parser.DELETED ) != 0 ) )
- {
- // If this is the global namespace, then it may have residual
- // "errorInfo" and "errorCode" variables for errors that
- // occurred while it was being torn down. Try to clear the
- // variable list one last time.
- Var.deleteVars( ns.interp, ns.varTable );
- ns.childTable.Clear();
- ns.cmdTable.Clear();
- // If the reference count is 0, then discard the namespace.
- // Otherwise, mark it as "dead" so that it can't be used.
- if ( ns.refCount == 0 )
- {
- free( ns );
- }
- else
- {
- ns.flags |= NS_DEAD;
- }
- }
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * TclTeardownNamespace -> teardownNamespace
- *
- * Used internally to dismantle and unlink a namespace when it is
- * deleted. Divorces the namespace from its parent, and deletes all
- * commands, variables, and child namespaces.
- *
- * This is kept separate from Tcl_DeleteNamespace so that the global
- * namespace can be handled specially. Global variables like
- * "errorInfo" and "errorCode" need to remain intact while other
- * namespaces and commands are torn down, in case any errors occur.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes this namespace from its parent's child namespace hashtable.
- * Deletes all commands, variables and namespaces in this namespace.
- * If this is the global namespace, the "errorInfo" and "errorCode"
- * variables are left alone and deleted later.
- *
- *----------------------------------------------------------------------
- */
- internal static void teardownNamespace( Namespace ns )
- {
- Interp interp = ns.interp;
- IEnumerator search;
- Namespace globalNs = getGlobalNamespace( interp );
- int i;
- // Start by destroying the namespace's variable table,
- // since variables might trigger traces.
- if ( ns == globalNs )
- {
- // This is the global namespace, so be careful to preserve the
- // "errorInfo" and "errorCode" variables. These might be needed
- // later on if errors occur while deleting commands. We are careful
- // to destroy and recreate the "errorInfo" and "errorCode"
- // variables, in case they had any traces on them.
- string errorInfoStr, errorCodeStr;
- try
- {
- errorInfoStr = interp.getVar( "errorInfo", TCL.VarFlag.GLOBAL_ONLY ).ToString();
- }
- catch ( TclException e )
- {
- errorInfoStr = null;
- }
- try
- {
- errorCodeStr = interp.getVar( "errorCode", TCL.VarFlag.GLOBAL_ONLY ).ToString();
- }
- catch ( TclException e )
- {
- errorCodeStr = null;
- }
- Var.deleteVars( interp, ns.varTable );
- if ( (System.Object)errorInfoStr != null )
- {
- try
- {
- interp.setVar( "errorInfo", errorInfoStr, TCL.VarFlag.GLOBAL_ONLY );
- }
- catch ( TclException e )
- {
- // ignore an exception while setting this var
- }
- }
- if ( (System.Object)errorCodeStr != null )
- {
- try
- {
- interp.setVar( "errorCode", errorCodeStr, TCL.VarFlag.GLOBAL_ONLY );
- }
- catch ( TclException e )
- {
- // ignore an exception while setting this var
- }
- }
- }
- else
- {
- // Variable table should be cleared.
- Var.deleteVars( interp, ns.varTable );
- }
- // Remove the namespace from its parent's child hashtable.
- if ( ns.parent != null )
- {
- ns.parent.childTable.Remove( ns.name );
- }
- ns.parent = null;
- // Delete all the child namespaces.
- //
- // BE CAREFUL: When each child is deleted, it will divorce
- // itself from its parent. You can't traverse a hash table
- // properly if its elements are being deleted. We use only
- // the Tcl_FirstHashEntry function to be safe.
- foreach ( Namespace childNs in new ArrayList( ns.childTable.Values ) )
- {
- deleteNamespace( childNs );
- }
- // Delete all commands in this namespace. Be careful when traversing the
- // hash table: when each command is deleted, it removes itself from the
- // command table.
- // FIXME : double check that using an enumeration for a hashtable
- // that changes is ok in Java! Also call deleteCommand... correctly!
- foreach ( WrappedCommand cmd in new ArrayList( ns.cmdTable.Values ) )
- {
- interp.deleteCommandFromToken( cmd );
- }
- ns.cmdTable.Clear();
- // Free the namespace's export pattern array.
- if ( ns.exportArray != null )
- {
- ns.exportArray = null;
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = 0;
- }
- // Callback invoked when namespace is deleted
- if ( ns.deleteProc != null )
- {
- ns.deleteProc.delete();
- }
- ns.deleteProc = null;
- // Reset the namespace's id field to ensure that this namespace won't
- // be interpreted as valid by, e.g., the cache validation code for
- // cached command references in Tcl_GetCommandFromObj.
- ns.nsId = 0;
- }
- /*
- *----------------------------------------------------------------------
- *
- * NamespaceFree -> free
- *
- * Called after a namespace has been deleted, when its
- * reference count reaches 0. Frees the data structure
- * representing the namespace.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- internal static void free( Namespace ns )
- {
- // Most of the namespace's contents are freed when the namespace is
- // deleted by Tcl_DeleteNamespace. All that remains is to free its names
- // (for error messages), and the structure itself.
- ns.name = null;
- ns.fullName = null;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Export -> exportList
- *
- * Makes all the commands matching a pattern available to later be
- * imported from the namespace specified by namespace (or the
- * current namespace if namespace is null). The specified pattern is
- * appended onto the namespace's export pattern list, which is
- * optionally cleared beforehand.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Appends the export pattern onto the namespace's export list.
- * Optionally reset the namespace's export pattern list.
- *
- *----------------------------------------------------------------------
- */
- internal static void exportList( Interp interp, Namespace namespace_Renamed, string pattern, bool resetListFirst )
- {
- int INIT_EXPORT_PATTERNS = 5;
- Namespace ns, exportNs;
- Namespace currNs = getCurrentNamespace( interp );
- string simplePattern, patternCpy;
- int neededElems, len, i;
- // If the specified namespace is null, use the current namespace.
- if ( namespace_Renamed == null )
- {
- ns = currNs;
- }
- else
- {
- ns = namespace_Renamed;
- }
- // If resetListFirst is true (nonzero), clear the namespace's export
- // pattern list.
- if ( resetListFirst )
- {
- if ( ns.exportArray != null )
- {
- for ( i = 0; i < ns.numExportPatterns; i++ )
- {
- ns.exportArray[i] = null;
- }
- ns.exportArray = null;
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = 0;
- }
- }
- // Check that the pattern doesn't have namespace qualifiers.
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] exportNsArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- string[] simplePatternArr = new string[1];
- getNamespaceForQualName( interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, exportNsArr, dummyArr, dummyArr, simplePatternArr );
- // get the values out of the arrays
- exportNs = exportNsArr[0];
- simplePattern = simplePatternArr[0];
- if ( ( exportNs != ns ) || ( pattern.CompareTo( simplePattern ) != 0 ) )
- {
- throw new TclException( interp, "invalid export pattern \"" + pattern + "\": pattern can't specify a namespace" );
- }
- // Make sure there is room in the namespace's pattern array for the
- // new pattern.
- neededElems = ns.numExportPatterns + 1;
- if ( ns.exportArray == null )
- {
- ns.exportArray = new string[INIT_EXPORT_PATTERNS];
- ns.numExportPatterns = 0;
- ns.maxExportPatterns = INIT_EXPORT_PATTERNS;
- }
- else if ( neededElems > ns.maxExportPatterns )
- {
- int numNewElems = 2 * ns.maxExportPatterns;
- string[] newArray = new string[numNewElems];
- Array.Copy( (System.Array)ns.exportArray, 0, (System.Array)newArray, 0, ns.numExportPatterns );
- ns.exportArray = newArray;
- ns.maxExportPatterns = numNewElems;
- }
- // Add the pattern to the namespace's array of export patterns.
- ns.exportArray[ns.numExportPatterns] = pattern;
- ns.numExportPatterns++;
- return;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendExportList -> appendExportList
- *
- * Appends onto the argument object the list of export patterns for the
- * specified namespace.
- *
- * Results:
- * The method will return when successful; in this case the object
- * referenced by obj has each export pattern appended to it. If an
- * error occurs, an exception and the interpreter's result
- * holds an error message.
- *
- * Side effects:
- * If necessary, the object referenced by obj is converted into
- * a list object.
- *
- *----------------------------------------------------------------------
- */
- internal static void appendExportList( Interp interp, Namespace namespace_Renamed, TclObject obj )
- {
- Namespace ns;
- int i;
- // If the specified namespace is null, use the current namespace.
- if ( namespace_Renamed == null )
- {
- ns = getCurrentNamespace( interp );
- }
- else
- {
- ns = namespace_Renamed;
- }
- // Append the export pattern list onto objPtr.
- for ( i = 0; i < ns.numExportPatterns; i++ )
- {
- TclList.append( interp, obj, TclString.newInstance( ns.exportArray[i] ) );
- }
- return;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Import -> importList
- *
- * Imports all of the commands matching a pattern into the namespace
- * specified by namespace (or the current namespace if namespace
- * is null). This is done by creating a new command (the "imported
- * command") that points to the real command in its original namespace.
- *
- * If matching commands are on the autoload path but haven't been
- * loaded yet, this command forces them to be loaded, then creates
- * the links to them.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Creates new commands in the importing namespace. These indirect
- * calls back to the real command and are deleted if the real commands
- * are deleted.
- *
- *----------------------------------------------------------------------
- */
- internal static void importList( Interp interp, Namespace namespace_Renamed, string pattern, bool allowOverwrite )
- {
- Namespace ns, importNs;
- Namespace currNs = getCurrentNamespace( interp );
- string simplePattern, cmdName;
- IEnumerator search;
- WrappedCommand cmd, realCmd;
- ImportRef ref_Renamed;
- WrappedCommand autoCmd, importedCmd;
- ImportedCmdData data;
- bool wasExported;
- int i, result;
- // If the specified namespace is null, use the current namespace.
- if ( namespace_Renamed == null )
- {
- ns = currNs;
- }
- else
- {
- ns = namespace_Renamed;
- }
- // First, invoke the "auto_import" command with the pattern
- // being imported. This command is part of the Tcl library.
- // It looks for imported commands in autoloaded libraries and
- // loads them in. That way, they will be found when we try
- // to create links below.
- autoCmd = findCommand( interp, "auto_import", null, TCL.VarFlag.GLOBAL_ONLY );
- if ( autoCmd != null )
- {
- TclObject[] objv = new TclObject[2];
- objv[0] = TclString.newInstance( "auto_import" );
- objv[0].preserve();
- objv[1] = TclString.newInstance( pattern );
- objv[1].preserve();
- cmd = autoCmd;
- try
- {
- // Invoke the command with the arguments
- cmd.cmd.cmdProc( interp, objv );
- }
- finally
- {
- objv[0].release();
- objv[1].release();
- }
- interp.resetResult();
- }
- // From the pattern, find the namespace from which we are importing
- // and get the simple pattern (no namespace qualifiers or ::'s) at
- // the end.
- if ( pattern.Length == 0 )
- {
- throw new TclException( interp, "empty import pattern" );
- }
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] importNsArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- string[] simplePatternArr = new string[1];
- getNamespaceForQualName( interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, importNsArr, dummyArr, dummyArr, simplePatternArr );
- importNs = importNsArr[0];
- simplePattern = simplePatternArr[0];
- if ( importNs == null )
- {
- throw new TclException( interp, "unknown namespace in import pattern \"" + pattern + "\"" );
- }
- if ( importNs == ns )
- {
- if ( (System.Object)pattern == (System.Object)simplePattern )
- {
- throw new TclException( interp, "no namespace specified in import pattern \"" + pattern + "\"" );
- }
- else
- {
- throw new TclException( interp, "import pattern \"" + pattern + "\" tries to import from namespace \"" + importNs.name + "\" into itself" );
- }
- }
- // Scan through the command table in the source namespace and look for
- // exported commands that match the string pattern. Create an "imported
- // command" in the current namespace for each imported command; these
- // commands redirect their invocations to the "real" command.
- for ( search = importNs.cmdTable.Keys.GetEnumerator(); search.MoveNext(); )
- {
- cmdName = ( (string)search.Current );
- if ( Util.stringMatch( cmdName, simplePattern ) )
- {
- // The command cmdName in the source namespace matches the
- // pattern. Check whether it was exported. If it wasn't,
- // we ignore it.
- wasExported = false;
- for ( i = 0; i < importNs.numExportPatterns; i++ )
- {
- if ( Util.stringMatch( cmdName, importNs.exportArray[i] ) )
- {
- wasExported = true;
- break;
- }
- }
- if ( !wasExported )
- {
- continue;
- }
- // Unless there is a name clash, create an imported command
- // in the current namespace that refers to cmdPtr.
- if ( ( ns.cmdTable[cmdName] == null ) || allowOverwrite )
- {
- // Create the imported command and its client data.
- // To create the new command in the current namespace,
- // generate a fully qualified name for it.
- StringBuilder ds;
- ds = new StringBuilder();
- ds.Append( ns.fullName );
- if ( ns != interp.globalNs )
- {
- ds.Append( "::" );
- }
- ds.Append( cmdName );
- // Check whether creating the new imported command in the
- // current namespace would create a cycle of imported->real
- // command references that also would destroy an existing
- // "real" command already in the current namespace.
- cmd = (WrappedCommand)importNs.cmdTable[cmdName];
- if ( cmd.cmd is ImportedCmdData )
- {
- // This is actually an imported command, find
- // the real command it references
- realCmd = getOriginalCommand( cmd );
- if ( ( realCmd != null ) && ( realCmd.ns == currNs ) && ( currNs.cmdTable[cmdName] != null ) )
- {
- throw new TclException( interp, "import pattern \"" + pattern + "\" would create a loop containing command \"" + ds.ToString() + "\"" );
- }
- }
- data = new ImportedCmdData();
- // Create the imported command inside the interp
- interp.createCommand( ds.ToString(), data );
- // Lookup in the namespace for the new WrappedCommand
- importedCmd = findCommand( interp, ds.ToString(), ns, ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.LEAVE_ERR_MSG ) );
- data.realCmd = cmd;
- data.self = importedCmd;
- // Create an ImportRef structure describing this new import
- // command and add it to the import ref list in the "real"
- // command.
- ref_Renamed = new ImportRef();
- ref_Renamed.importedCmd = importedCmd;
- ref_Renamed.next = cmd.importRef;
- cmd.importRef = ref_Renamed;
- }
- else
- {
- throw new TclException( interp, "can't import command \"" + cmdName + "\": already exists" );
- }
- }
- }
- return;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_ForgetImport -> forgetImport
- *
- * Deletes previously imported commands. Given a pattern that may
- * include the name of an exporting namespace, this procedure first
- * finds all matching exported commands. It then looks in the namespace
- * specified by namespace for any corresponding previously imported
- * commands, which it deletes. If namespace is null, commands are
- * deleted from the current namespace.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * May delete commands.
- *
- *----------------------------------------------------------------------
- */
- internal static void forgetImport( Interp interp, Namespace namespace_Renamed, string pattern )
- {
- Namespace ns, importNs, actualCtx;
- string simplePattern, cmdName;
- IEnumerator search;
- WrappedCommand cmd;
- // If the specified namespace is null, use the current namespace.
- if ( namespace_Renamed == null )
- {
- ns = getCurrentNamespace( interp );
- }
- else
- {
- ns = namespace_Renamed;
- }
- // From the pattern, find the namespace from which we are importing
- // and get the simple pattern (no namespace qualifiers or ::'s) at
- // the end.
- // Java does not support passing an address so we pass
- // an array of size 1 and then assign arr[0] to the value
- Namespace[] importNsArr = new Namespace[1];
- Namespace[] dummyArr = new Namespace[1];
- Namespace[] actualCtxArr = new Namespace[1];
- string[] simplePatternArr = new string[1];
- getNamespaceForQualName( interp, pattern, ns, TCL.VarFlag.LEAVE_ERR_MSG, importNsArr, dummyArr, actualCtxArr, simplePatternArr );
- // get the values out of the arrays
- importNs = importNsArr[0];
- actualCtx = actualCtxArr[0];
- simplePattern = simplePatternArr[0];
- // FIXME : the above call passes TCL.VarFlag.LEAVE_ERR_MSG, but
- // it seems like this will be a problem when exception is raised!
- if ( importNs == null )
- {
- throw new TclException( interp, "unknown namespace in namespace forget pattern \"" + pattern + "\"" );
- }
- // Scan through the command table in the source namespace and look for
- // exported commands that match the string pattern. If the current
- // namespace has an imported command that refers to one of those real
- // commands, delete it.
- for ( search = importNs.cmdTable.Keys.GetEnumerator(); search.MoveNext(); )
- {
- cmdName = ( (string)search.Current );
- if ( Util.stringMatch( cmdName, simplePattern ) )
- {
- cmd = (WrappedCommand)ns.cmdTable[cmdName];
- if ( cmd != null )
- {
- // cmd of same name in current namespace
- if ( cmd.cmd is ImportedCmdData )
- {
- interp.deleteCommandFromToken( cmd );
- }
- }
- }
- }
- return;
- }
- /*
- *----------------------------------------------------------------------
- *
- * TclGetOriginalCommand -> getOriginalCommand
- *
- * An imported command is created in a namespace when a "real" command
- * is imported from another namespace. If the specified command is an
- * imported command, this procedure returns the original command it
- * refers to.
- *
- * Results:
- * If the command was imported into a sequence of namespaces a, b,...,n
- * where each successive namespace just imports the command from the
- * previous namespace, this procedure returns the Tcl_Command token in
- * the first namespace, a. Otherwise, if the specified command is not
- * an imported command, the procedure returns null.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- internal static WrappedCommand getOriginalCommand( WrappedCommand command )
- {
- WrappedCommand cmd = command;
- ImportedCmdData data;
- if ( !( cmd.cmd is ImportedCmdData ) )
- {
- return null;
- }
- while ( cmd.cmd is ImportedCmdData )
- {
- data = (ImportedCmdData)cmd.cmd;
- cmd = data.realCmd;
- }
- return cmd;
- }
- /*
- *----------------------------------------------------------------------
- *
- * InvokeImportedCmd -> invokeImportedCmd
- *
- * Invoked by Tcl whenever the user calls an imported command that
- * was created by Tcl_Import. Finds the "real" command (in another
- * namespace), and passes control to it.
- *
- * Results:
- * Returns if successful, raises TclException if something goes wrong.
- *
- * Side effects:
- * Returns a result in the interpreter's result object. If anything
- * goes wrong, the result object is set to an error message.
- *
- *----------------------------------------------------------------------
- */
- internal static void invokeImportedCmd( Interp interp, ImportedCmdData data, TclObject[] objv )
- {
- WrappedCommand realCmd = data.realCmd;
- realCmd.cmd.cmdProc( interp, objv );
- }
- /*
- *----------------------------------------------------------------------
- *
- * DeleteImportedCmd -> deleteImportedCmd
- *
- * Invoked by Tcl whenever an imported command is deleted. The "real"
- * command keeps a list of all the imported commands that refer to it,
- * so those imported commands can be deleted when the real command is
- * deleted. This procedure removes the imported command reference from
- * the real command's list, and frees up the memory associated with
- * the imported command.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Removes the imported command from the real command's import list.
- *
- *----------------------------------------------------------------------
- */
- internal static void deleteImportedCmd( ImportedCmdData data )
- // The data object for this imported command
- {
- WrappedCommand realCmd = data.realCmd;
- WrappedCommand self = data.self;
- ImportRef ref_Renamed, prev;
- prev = null;
- for ( ref_Renamed = realCmd.importRef; ref_Renamed != null; ref_Renamed = ref_Renamed.next )
- {
- if ( ref_Renamed.importedCmd == self )
- {
- // Remove ref from real command's list of imported commands
- // that refer to it.
- if ( prev == null )
- {
- // ref is first in list
- realCmd.importRef = ref_Renamed.next;
- }
- else
- {
- prev.next = ref_Renamed.next;
- }
- ref_Renamed = null;
- data = null;
- return;
- }
- prev = ref_Renamed;
- }
- throw new TclRuntimeError( "DeleteImportedCmd: did not find cmd in real cmd's list of import references" );
- }
- /*
- *----------------------------------------------------------------------
- *
- * TclGetNamespaceForQualName -> getNamespaceForQualName
- *
- * Given a qualified name specifying a command, variable, or namespace,
- * and a namespace in which to resolve the name, this procedure returns
- * a pointer to the namespace that contains the item. A qualified name
- * consists of the "simple" name of an item qualified by the names of
- * an arbitrary number of containing namespace separated by "::"s. If
- * the qualified name starts with "::", it is interpreted absolutely
- * from the global namespace. Otherwise, it is interpreted relative to
- * the namespace specified by cxtNsPtr if it is non-null. If cxtNsPtr
- * is null, the name is interpreted relative to the current namespace.
- *
- * A relative name like "foo::bar::x" can be found starting in either
- * the current namespace or in the global namespace. So each search
- * usually follows two tracks, and two possible namespaces are
- * returned. If the procedure sets either nsPtrPtr[0] or altNsPtrPtr[0] to
- * null, then that path failed.
- *
- * If "flags" contains TCL.VarFlag.GLOBAL_ONLY, the relative qualified name is
- * sought only in the global :: namespace. The alternate search
- * (also) starting from the global namespace is ignored and
- * altNsPtrPtr[0] is set null.
- *
- * If "flags" contains TCL.VarFlag.NAMESPACE_ONLY, the relative qualified
- * name is sought only in the namespace specified by cxtNsPtr. The
- * alternate search starting from the global namespace is ignored and
- * altNsPtrPtr[0] is set null. If both TCL.VarFlag.GLOBAL_ONLY and
- * TCL.VarFlag.NAMESPACE_ONLY are specified, TCL.VarFlag.GLOBAL_ONLY is ignored and
- * the search starts from the namespace specified by cxtNsPtr.
- *
- * If "flags" contains TCL.VarFlag.CREATE_NS_IF_UNKNOWN, all namespace
- * components of the qualified name that cannot be found are
- * automatically created within their specified parent. This makes sure
- * that functions like Tcl_CreateCommand always succeed. There is no
- * alternate search path, so altNsPtrPtr[0] is set null.
- *
- * If "flags" contains TCL.VarFlag.FIND_ONLY_NS, the qualified name is treated as a
- * reference to a namespace, and the entire qualified name is
- * followed. If the name is relative, the namespace is looked up only
- * in the current namespace. A pointer to the namespace is stored in
- * nsPtrPtr[0] and null is stored in simpleNamePtr[0]. Otherwise, if
- * TCL.VarFlag.FIND_ONLY_NS is not specified, only the leading components are
- * treated as namespace names, and a pointer to the simple name of the
- * final component is stored in simpleNamePtr[0].
- *
- * Results:
- * It sets nsPtrPtr[0] and altNsPtrPtr[0] to point to the two possible
- * namespaces which represent the last (containing) namespace in the
- * qualified name. If the procedure sets either nsPtrPtr[0] or altNsPtrPtr[0]
- * to null, then the search along that path failed. The procedure also
- * stores a pointer to the simple name of the final component in
- * simpleNamePtr[0]. If the qualified name is "::" or was treated as a
- * namespace reference (TCL.VarFlag.FIND_ONLY_NS), the procedure stores a pointer
- * to the namespace in nsPtrPtr[0], null in altNsPtrPtr[0], and sets
- * simpleNamePtr[0] to an empty string.
- *
- * If there is an error, this procedure returns TCL_ERROR. If "flags"
- * contains TCL_LEAVE_ERR_MSG, an error message is returned in the
- * interpreter's result object. Otherwise, the interpreter's result
- * object is left unchanged.
- *
- * actualCxtPtrPtr[0] is set to the actual context namespace. It is
- * set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
- * is null, it is set to the current namespace context.
- *
- * Side effects:
- * If "flags" contains TCL.VarFlag.CREATE_NS_IF_UNKNOWN, new namespaces may be
- * created.
- *
- *----------------------------------------------------------------------
- */
- internal static void getNamespaceForQualName( Interp interp, string qualName, Namespace cxtNsPtr, TCL.VarFlag flags, Namespace[] nsPtrPtr, Namespace[] altNsPtrPtr, Namespace[] actualCxtPtrPtr, string[] simpleNamePtr )
- {
- // FIXME : remove extra method call checks when we are sure this works!
- if ( true )
- {
- // check invariants
- if ( ( nsPtrPtr == null ) || ( nsPtrPtr.Length != 1 ) )
- {
- throw new System.SystemException( "nsPtrPtr " + nsPtrPtr );
- }
- if ( ( altNsPtrPtr == null ) || ( altNsPtrPtr.Length != 1 ) )
- {
- throw new System.SystemException( "altNsPtrPtr " + altNsPtrPtr );
- }
- if ( ( actualCxtPtrPtr == null ) || ( actualCxtPtrPtr.Length != 1 ) )
- {
- throw new System.SystemException( "actualCxtPtrPtr " + actualCxtPtrPtr );
- }
- if ( ( simpleNamePtr == null ) || ( simpleNamePtr.Length != 1 ) )
- {
- throw new System.SystemException( "simpleNamePtr " + simpleNamePtr );
- }
- }
- Namespace ns = cxtNsPtr;
- Namespace altNs;
- Namespace globalNs = getGlobalNamespace( interp );
- Namespace entryNs;
- string start, end;
- string nsName;
- int len;
- int start_ind, end_ind, name_len;
- // Determine the context namespace ns in which to start the primary
- // search. If TCL.VarFlag.NAMESPACE_ONLY or TCL.VarFlag.FIND_ONLY_NS was specified, search
- // from the current namespace. If the qualName name starts with a "::"
- // or TCL.VarFlag.GLOBAL_ONLY was specified, search from the global
- // namespace. Otherwise, use the given namespace given in cxtNsPtr, or
- // if that is null, use the current namespace context. Note that we
- // always treat two or more adjacent ":"s as a namespace separator.
- if ( ( flags & ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.FIND_ONLY_NS ) ) != 0 )
- {
- ns = getCurrentNamespace( interp );
- }
- else if ( ( flags & TCL.VarFlag.GLOBAL_ONLY ) != 0 )
- {
- ns = globalNs;
- }
- else if ( ns == null )
- {
- if ( interp.varFrame != null )
- {
- ns = interp.varFrame.ns;
- }
- else
- {
- ns = interp.globalNs;
- }
- }
- start_ind = 0;
- name_len = qualName.Length;
- if ( ( name_len >= 2 ) && ( qualName[0] == ':' ) && ( qualName[1] == ':' ) )
- {
- start_ind = 2; // skip over the initial ::
- while ( ( start_ind < name_len ) && ( qualName[start_ind] == ':' ) )
- {
- start_ind++; // skip over a subsequent :
- }
- ns = globalNs;
- if ( start_ind >= name_len )
- {
- // qualName is just two or more ":"s
- nsPtrPtr[0] = globalNs;
- altNsPtrPtr[0] = null;
- actualCxtPtrPtr[0] = globalNs;
- simpleNamePtr[0] = ""; // points to empty string
- return;
- }
- }
- actualCxtPtrPtr[0] = ns;
- // Start an alternate search path starting with the global namespace.
- // However, if the starting context is the global namespace, or if the
- // flag is set to search only the namespace cxtNs, ignore the
- // alternate search path.
- altNs = globalNs;
- if ( ( ns == globalNs ) || ( ( flags & ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.FIND_ONLY_NS ) ) != 0 ) )
- {
- altNs = null;
- }
- // Loop to resolve each namespace qualifier in qualName.
- end_ind = start_ind;
- while ( start_ind < name_len )
- {
- // Find the next namespace qualifier (i.e., a name ending in "::")
- // or the end of the qualified name (i.e., a name ending in "\0").
- …
Large files files are truncated, but you can click here to view the full file