2007-09-09  Don Porter  <dgp@users.sourceforge.net>



















	* generic/tclCompCmds.c:	Use the new INST_REVERSE instruction
	* tests/mathop.test:	to correct the compiled versions of math
	operator commands.  [Bug 1724437].

	* generic/tclCompile.c:	New bytecode instruction INST_REVERSE to
	* generic/tclCompile.h:	reverse the order of N items at the top of

	running at level 0 should change (iPtr->varFramePtr == NULL) to
	(iPtr->varFramePtr == iPtr->rootFramePtr).

2006-10-23  Don Porter  <dgp@users.sourceforge.net>

	* README:		Bump version number to 8.5a6
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf-2.59

 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005-2007 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.331 2007/09/09 16:51:19 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>

    case INST_NSUPVAR:
	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);

	{
	    Tcl_Namespace *nsPtr, *savedNsPtr;

	    result = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr);
	    if ((result == TCL_OK) && nsPtr) {
		/*
		 * Locate the other variable.
		 */

		savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
		iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
		otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
			(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
			/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
		iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
		if (otherPtr) {
		    result = TCL_OK;
		    goto doLinkVars;
		}
	    }
	    if (!nsPtr) {
		/*
		 * The namespace does not exist, leave an error message.
		 */

		Tcl_SetObjResult(interp, Tcl_Format(NULL,
			"namespace \"%s\" does not exist", 1,&OBJ_UNDER_TOS));
	    }
	    result = TCL_ERROR;
	    goto checkForCatch;
	}

    doLinkVars:

	/*

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.333 2007/08/23 00:27:15 das Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options

MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE Tcl_ObjType tclIntType;
MODULE_SCOPE Tcl_ObjType tclListType;
MODULE_SCOPE Tcl_ObjType tclDictType;
MODULE_SCOPE Tcl_ObjType tclProcBodyType;
MODULE_SCOPE Tcl_ObjType tclStringType;
MODULE_SCOPE Tcl_ObjType tclArraySearchType;
MODULE_SCOPE Tcl_ObjType tclNsNameType;
MODULE_SCOPE Tcl_ObjType tclEnsembleCmdType;
#ifndef NO_WIDE_TYPE
MODULE_SCOPE Tcl_ObjType tclWideIntType;
#endif
MODULE_SCOPE Tcl_ObjType tclRegexpType;

/*

 *	TIP#112 ensemble machinery.
 *
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2002-2005 Donal K. Fellows.
 * Copyright (c) 2006 Neil Madden.

 *
 * 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.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.148 2007/08/03 13:51:40 dkf Exp $
 */

#include "tclInt.h"

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.

 * This structure contains a cached pointer to a namespace that is the result
 * of resolving the namespace's name in some other namespace. It is the
 * internal representation for a nsName object. It contains the pointer along
 * with some information that is used to check the cached pointer's validity.
 */

typedef struct ResolvedNsName {
    Namespace *nsPtr;		/* A cached namespace pointer. */
    long nsId;			/* nsPtr's unique namespace id. Used to verify
				 * that nsPtr is still valid (e.g., it's
				 * possible that the namespace was deleted and
				 * a new one created at the same address). */
    Namespace *refNsPtr;	/* Points to the namespace containing the
				 * reference (not the namespace that contains
				 * the referenced namespace). NULL if the name
				 * is fully qualified.*/

    int refCount;		/* Reference count: 1 for each nsName object
				 * that has a pointer to this ResolvedNsName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedNsName;

static char *		EstablishErrorCodeTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);


static int		InvokeImportedCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceChildrenCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceCurrentCmd(ClientData dummy,

			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceUnknownCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfNsName(Tcl_Obj *objPtr);
static int		NsEnsembleImplementationCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int		NsEnsembleStringOrder(const void *strPtr1,
			    const void *strPtr2);
static void		DeleteEnsembleConfig(ClientData clientData);
static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,

/*
 * This structure defines a Tcl object type that contains a namespace
 * reference. It is used in commands that take the name of a namespace as an
 * argument. The namespace reference is resolved, and the result in cached in
 * the object.
 */

Tcl_ObjType tclNsNameType = {
    "nsName",			/* the type's name */
    FreeNsNameInternalRep,	/* freeIntRepProc */
    DupNsNameInternalRep,	/* dupIntRepProc */
    UpdateStringOfNsName,	/* updateStringProc */
    SetNsNameFromAny		/* setFromAnyProc */
};

/*
 * This structure defines a Tcl object type that contains a reference to an
 * ensemble subcommand (e.g. the "length" in [string length ab]). It is used
 * to cache the mapping between the subcommand itself and the real command

    register CallFrame *framePtr = (CallFrame *) callFramePtr;
    register Namespace *nsPtr;

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else {
	nsPtr = (Namespace *) namespacePtr;









	if (nsPtr->flags & NS_DEAD) {
	    Tcl_Panic("Trying to push call frame for dead namespace");
	    /*NOTREACHED*/
	}
    }

    nsPtr->activationCount++;

	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
		    || !(realNsPtr->flags & (NS_DEAD|NS_DYING))) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * Next, check along the path.
	 */

	for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
	    pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
	    if (pathNsPtr == NULL) {
		continue;
	    }
	    (void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & (NS_DEAD|NS_DYING))) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * If we've still not found the command, look in the global namespace
	 * as a last resort.
	 */

	if (cmdPtr == NULL) {
	    (void) TclGetNamespaceForQualName(interp, name, NULL,
		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & (NS_DEAD|NS_DYING))) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    } else {

 * TclGetNamespaceFromObj --
 *
 *	Gets the namespace specified by the name in a Tcl_Obj.
 *
 * Results:
 *	Returns TCL_OK if the namespace was resolved successfully, and stores
 *	a pointer to the namespace in the location specified by nsPtrPtr. If
 *	the namespace can't be found, the function stores NULL in *nsPtrPtr
 *	and returns TCL_OK. If anything else goes wrong, this function returns
 *	TCL_ERROR.
 *
 * Side effects:
 *	May update the internal representation for the object, caching the
 *	namespace reference. The next time this function is called, the
 *	namespace value can be found quickly.
 *
 *	If anything goes wrong, an error message is left in the interpreter's
 *	result object.
 *
 *----------------------------------------------------------------------
 */

int
TclGetNamespaceFromObj(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_Obj *objPtr,		/* The object to be resolved as the name of a
				 * namespace. */
    Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
{























    ResolvedNsName *resPtr;
    Namespace *nsPtr;
    int result = TCL_OK;

    /*
     * Get the internal representation, converting to a namespace type if
     * needed. The internal representation is a ResolvedNsName that points to
     * the actual namespace.
     *
     * Check the context namespace of the resolved symbol to make sure that it
     * is fresh. Note that we verify that the namespace id of the context
     * namespace is the same as the one we cached; this insures that the
     * namespace wasn't deleted and a new one created at the same address.
     * Note that fully qualified names have a NULL refNsPtr, these checks
     * needn't be made.
     *
     * If any check fails, then force another conversion to the command type,
     * to discard the old rep and create a new one.
     */

    resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
    if ((objPtr->typePtr != &tclNsNameType)
	    || (resPtr == NULL)
	    || (resPtr->refNsPtr &&
		    (resPtr->refNsPtr != (Namespace *) TclGetCurrentNamespace(interp)))
	    || (nsPtr = resPtr->nsPtr, nsPtr->flags & NS_DEAD)
	    || (interp != nsPtr->interp)
	    || (resPtr->nsId != nsPtr->nsId)) {


	result = tclNsNameType.setFromAnyProc(interp, objPtr);


	resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;

	if ((result == TCL_OK) && resPtr) {
	    nsPtr = resPtr->nsPtr;
	    if (nsPtr && (nsPtr->flags & NS_DEAD)) {
		nsPtr = NULL;
	    }
	} else {
	    nsPtr = NULL;
	}
    }

    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NamespaceObjCmd --
 *

    if (objc == 2) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else if ((objc == 3) || (objc == 4)) {
	if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (namespacePtr == NULL) {
	    Tcl_AppendResult(interp, "unknown namespace \"",
		    TclGetString(objv[2]),
		    "\" in namespace children command", NULL);
	    return TCL_ERROR;
	}
	nsPtr = (Namespace *) namespacePtr;
    } else {
	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
	return TCL_ERROR;
    }

    /*

    }

    /*
     * Try to resolve the namespace reference, caching the result in the
     * namespace object along the way.
     */

    result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * If the namespace wasn't found, try to create it.
     */

    if (namespacePtr == NULL) {
	char *name = TclGetString(objv[2]);
	namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL,
		NULL);
	if (namespacePtr == NULL) {
	    return TCL_ERROR;
	}
    }

    Tcl_Namespace *namespacePtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "name");
	return TCL_ERROR;
    }

    /*
     * Check whether the given namespace exists
     */

    if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(namespacePtr != NULL));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceExportCmd --

     * Resolve the namespace reference.
     */

    result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (namespacePtr == NULL) {
	Tcl_AppendResult(interp, "unknown namespace \"", TclGetString(objv[2]),
		"\" in inscope namespace command", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the specified namespace the current namespace.
     */

    framePtrPtr = &framePtr;		/* This is needed to satisfy GCC's
					 * strict aliasing rules. */

    if (objc == 2) {
	nsPtr = TclGetCurrentNamespace(interp);
    } else if (objc == 3) {
	result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr);
	if (result != TCL_OK) {
	    return result;
	}
	if (nsPtr == NULL) {
	    Tcl_AppendResult(interp, "unknown namespace \"",
		    TclGetString(objv[2]),
		    "\" in namespace parent command", NULL);
	    return TCL_ERROR;
	}
    } else {
	Tcl_WrongNumArgs(interp, 2, objv, "?name?");
	return TCL_ERROR;
    }

    /*
     * Report the parent of the specified namespace.

		TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc);

	for (i=0 ; i<nsObjc ; i++) {
	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
		    &namespaceList[i]) != TCL_OK) {
		goto badNamespace;
	    }
	    if (namespaceList[i] == NULL) {
		Tcl_AppendResult(interp, "unknown namespace \"",
			TclGetString(nsObjv[i]), "\"", NULL);
		goto badNamespace;
	    }
	}
    }

    /*
     * Now we have the list of valid namespaces, install it as the path.
     */

	return TCL_ERROR;
    }

    result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    if (nsPtr == NULL) {
	/*
	 * The namespace does not exist, leave an error message.
	 */
	Tcl_SetObjResult(interp, Tcl_Format(NULL,
		"namespace \"%s\" does not exist", 1, objv+2));
	return TCL_ERROR;
    }

    objc -= 3;
    objv += 3;

    for (; objc>0 ; objc-=2, objv+=2) {
	/*
	 * Locate the other variable

    Namespace *nsPtr;

    /*
     * Decrement the reference count of the namespace. If there are no more
     * references, free it up.
     */

    if (resNamePtr != NULL) {
	resNamePtr->refCount--;
	if (resNamePtr->refCount == 0) {

	    /*
	     * Decrement the reference count for the cached namespace. If the
	     * namespace is dead, and there are no more references to it, free
	     * it.
	     */

	    nsPtr = resNamePtr->nsPtr;
	    nsPtr->refCount--;
	    if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
		NamespaceFree(nsPtr);
	    }
	    ckfree((char *) resNamePtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupNsNameInternalRep --

    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
	    srcPtr->internalRep.twoPtrValue.ptr1;

    copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr;
    if (resNamePtr != NULL) {
	resNamePtr->refCount++;
    }
    copyPtr->typePtr = &tclNsNameType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetNsNameFromAny --
 *

static int
SetNsNameFromAny(
    Tcl_Interp *interp,		/* Points to the namespace in which to resolve
				 * name. Also used for error reporting if not
				 * NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    char *name;
    const char *dummy;
    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
    register ResolvedNsName *resNamePtr;

    /*
     * Look for the namespace "name" in the current namespace. If there is an
     * error parsing the (possibly qualified) name, return an error. If the
     * namespace isn't found, we convert the object to an nsName object with a
     * NULL ResolvedNsName* internal rep.
     */

    name = TclGetString(objPtr);
    TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     *
     * Free the old internalRep before setting the new one. Do this after
     * getting the string rep to allow the conversion code (in particular,
     * Tcl_GetStringFromObj) to use that old internalRep.
     */

    if (nsPtr) {
	nsPtr->refCount++;
	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	if ((objPtr->typePtr == &tclNsNameType)
		&& resNamePtr && (resNamePtr->refCount == 1)) {
	    /*
	     * Reuse the old ResolvedNsName struct instead of freeing it
	     */

	    Namespace *oldNsPtr = resNamePtr->nsPtr;
	    if ((--oldNsPtr->refCount == 0) && (oldNsPtr->flags & NS_DEAD)) {
		NamespaceFree(oldNsPtr);
	    }
	} else {
	    TclFreeIntRep(objPtr);
	    resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
	    resNamePtr->refCount = 1;
	    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr;
	    objPtr->typePtr = &tclNsNameType;
	}
	resNamePtr->nsPtr = nsPtr;
	resNamePtr->nsId = nsPtr->nsId;
	if ((*name++ == ':') && (*name == ':')) {
	    resNamePtr->refNsPtr = NULL;
	} else {
	    resNamePtr->refNsPtr =
		(Namespace *) TclGetCurrentNamespace(interp);
	}
    } else {
	TclFreeIntRep(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) NULL;
	objPtr->typePtr = &tclNsNameType;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfNsName --
 *
 *	Updates the string representation for a nsName object. Note: This
 *	function does not free an existing old string rep so storage will be
 *	lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a copy of the fully qualified namespace
 *	name.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfNsName(
    register Tcl_Obj *objPtr)	/* nsName object with string rep to update. */
{
    ResolvedNsName *resNamePtr =
	    (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
    char *name = "";
    int length = 0;

    if ((resNamePtr != NULL)
	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
	register Namespace *nsPtr = resNamePtr->nsPtr;

	if (nsPtr != NULL && !(nsPtr->flags & NS_DEAD)) {
	    name = nsPtr->fullName;
	    length = strlen(name);
	}
    }

    /*
     * The following sets the string rep to an empty string on the heap if the
     * internal rep is NULL.
     */



    if (length == 0) {
	objPtr->bytes = tclEmptyStringRep;
    } else {
	objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
	memcpy(objPtr->bytes, name, (unsigned) length);
	objPtr->bytes[length] = '\0';

    }
    objPtr->length = length;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceEnsembleCmd --
 *

    };
    enum EnsConfigOpts {
	CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
    };
    int index;

    nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_AppendResult(interp,
		    "tried to manipulate ensemble of deleted namespace", NULL);
	}
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
	return TCL_ERROR;
    }

  restartEnsembleParse:
    if (!(ensemblePtr->nsPtr->flags & NS_DEAD)) {
	if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
	    /*
	     * Table of subcommands is still valid; therefore there might be a
	     * valid cache of discovered information which we can reuse. Do
	     * the check here, and if we're still valid, we can jump straight
	     * to the part where we do the invocation of the subcommand.
	     */

 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.133 2007/09/03 01:36:54 das Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"
#include <float.h>

    Tcl_RegisterObjType(&tclEndOffsetType);
    Tcl_RegisterObjType(&tclIntType);
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclArraySearchType);
    Tcl_RegisterObjType(&tclNsNameType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);

    /* For backward compatibility only ... */
    Tcl_RegisterObjType(&oldBooleanType);
#ifndef NO_WIDE_TYPE

/*
 * tclProc.c --
 *
 *	This file contains routines that implement Tcl procedures, including
 *	the "proc" and "uplevel" commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclProc.c,v 1.132 2007/09/07 18:01:36 msofer Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Prototypes for static functions in this file

    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = NULL;
    Tcl_Obj *lambdaPtr, *nsObjPtr, *errPtr;
    int result, isRootEnsemble;
    Command cmd;
    Tcl_Namespace *nsPtr;
    ExtraFrameInfo efi;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");

    nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    if (result != TCL_OK) {
	return result;
    }

    if (nsPtr == NULL) {
	TclNewLiteralStringObj(errPtr, "cannot find namespace \"");
	Tcl_AppendObjToObj(errPtr, nsObjPtr);
	Tcl_AppendToObj(errPtr, "\"", -1);
	Tcl_SetObjResult(interp, errPtr);
	return TCL_ERROR;
    }

    cmd.nsPtr = (Namespace *) nsPtr;

    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 1;
	iPtr->ensembleRewrite.numInsertedObjs = 0;

# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2005-2006 Miguel Sofer
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: apply.test,v 1.10 2007/03/29 19:22:08 msofer Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {[info commands ::apply] eq {}} {
    return
}

} {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name
    (parsing lambda expression "a::b boo")
    invoked from within
"apply $lambda"}}

# Tests for runtime errors in the lambda expression

test apply-3.1 {non-existing namespace} {
    set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
    set res [catch {apply $lambda x} msg]
    list $res $msg
} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
test apply-3.2 {non-existing namespace} {
    namespace eval ::NONEXIST::FOR::SURE {}
    set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
    apply $lambda x
    namespace delete ::NONEXIST
    set res [catch {apply $lambda x} msg]
    list $res $msg
} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
test apply-3.3 {non-existing namespace} {
    set lambda [list x {set x 1} NONEXIST::FOR::SURE]
    set res [catch {apply $lambda x} msg]
    list $res $msg
} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
test apply-3.4 {non-existing namespace} {
    namespace eval ::NONEXIST::FOR::SURE {}
    set lambda [list x {set x 1} NONEXIST::FOR::SURE]
    apply $lambda x
    namespace delete ::NONEXIST
    set res [catch {apply $lambda x} msg]
    list $res $msg
} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}

test apply-4.1 {error in arguments to lambda expression} {
    set lambda [list x {set x 1}]
    set res [catch {apply $lambda} msg]
    list $res $msg
} {1 {wrong # args: should be "apply {x {set x 1}} x"}}
test apply-4.2 {error in arguments to lambda expression} {

# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: namespace-old.test,v 1.11 2006/11/23 15:35:31 dkf Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}

test namespace-old-1.1 {usage for "namespace" command} {

    list [catch $cmd msg] $msg
} {1 {invalid command name "test_ns_cmd_hier1"}}

test namespace-old-5.9 {usage for "namespace children"} {
    list [catch {namespace children test_ns_hier1 y z} msg] $msg
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}

test namespace-old-5.10 {command "namespace children" must get valid namespace} {
    list [catch {namespace children xyzzy} msg] $msg
} {1 {unknown namespace "xyzzy" in namespace children command}}

test namespace-old-5.11 {querying namespace children} {
    lsort [namespace children :: test_ns_hier*]
} {::test_ns_hier1}

test namespace-old-5.12 {querying namespace children} {
    lsort [namespace children test_ns_hier1]

    lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

test namespace-old-5.18 {usage for "namespace parent"} {
    list [catch {namespace parent x y} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}

test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
    list [catch {namespace parent xyzzy} msg] $msg
} {1 {unknown namespace "xyzzy" in namespace parent command}}

test namespace-old-5.20 {querying namespace parent} {
    list [namespace eval :: {namespace parent}] \
        [namespace eval test_ns_hier1 {namespace parent}] \
        [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
        [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

# Functionality covered: this file contains a collection of tests for the
# procedures in tclNamesp.c that implement Tcl's basic support for
# namespaces. Other namespace-related tests appear in variable.test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: namespace.test,v 1.67 2007/06/12 12:34:04 dkf Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

#

    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
    list [namespace children test_ns_1] \
         [namespace delete test_ns_1::test_ns_2] \
         [namespace children test_ns_1] \
         [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
         [info commands test_ns_1::test_ns_2::test_ns_3a::*]
} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1 cmd2
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }

    }
} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
    namespace eval test_ns_1 {
        list $v $test_ns_2::v
    }
} {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval ::test_ns_2 {
        namespace eval bar {}
    }
    namespace eval test_ns_1 {
        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
    }
    set l
} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
    namespace children test_ns_1:::
} {::test_ns_1::test_ns_2}
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
    namespace children :::test_ns_1:::::test_ns_2:::
} {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {

    namespace children ::test_ns_1
} {::test_ns_1::test_ns_2}
test namespace-19.2 {GetNamespaceFromObj, relative name found} {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} {}
test namespace-19.3 {GetNamespaceFromObj, name not found} {
    namespace eval test_ns_1 {
        list [catch {namespace children test_ns_99} msg] $msg
    }
} {1 {unknown namespace "test_ns_99" in namespace children command}}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
    namespace eval test_ns_1 {
        proc foo {} {
            return [namespace children test_ns_2]
        }
        list [catch {namespace children test_ns_99} msg] $msg
    }

test namespace-29.1 {NamespaceInscopeCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace inscope} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
test namespace-29.2 {NamespaceInscopeCmd, bad args} {
    list [catch {namespace inscope ::} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
    list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
test namespace-29.4 {NamespaceInscopeCmd, simple case} {
    namespace eval test_ns_1 {
        variable v 747
        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }

            namespace eval test_ns_3 {}
        }
    }
    list [namespace parent ::] \
         [namespace parent test_ns_1::test_ns_2] \
         [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
} {{} ::test_ns_1 ::test_ns_1}
test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
    list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}

test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace qualifiers} msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}
test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
    list [catch {namespace qualifiers x y} msg] $msg

test namespace-37.1 {SetNsNameFromAny, ns name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
    namespace eval test_ns_1 {
        namespace children ::test_ns_1
    }
} {::test_ns_1::test_ns_2}
test namespace-37.2 {SetNsNameFromAny, ns name not found} {
    namespace eval test_ns_1 {
        list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
    }
} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}

test namespace-38.1 {UpdateStringOfNsName} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
    list [namespace eval {} {namespace current}] \
         [namespace eval {} {namespace current}]
} {:: ::}

    catch {namespace delete ::test_ns_3}
    catch {namespace delete ::test_ns_4}
}
test namespace-51.10 {name resolution path control} -body {
    namespace eval ::test_ns_1 {
	namespace path does::not::exist
    }
} -returnCodes error -result {unknown namespace "does::not::exist"} -cleanup {
    catch {namespace delete ::test_ns_1}
}
test namespace-51.11 {name resolution path control} -body {
    namespace eval ::test_ns_1 {
	proc foo {} {return 1}
    }
    namespace eval ::test_ns_2 {

# Functionality covered: this file contains a collection of tests for the
# procedures in tclObj.c that implement Tcl's basic type support and the
# type managers for the types boolean, double, and integer.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: obj.test,v 1.19 2005/10/08 14:42:54 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	{array search} 
	bytearray
	bytecode
	cmdName
	dict
	end-offset
	nsName
	regexp
	string
    } {
        set first [string first $t [testobj types]]
        set r [expr {$r && ($first != -1)}]
    }
    set result $r

# Commands covered:  'upvar', 'namespace upvar'
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: upvar.test,v 1.14 2006/11/03 00:34:53 hobbs Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint testupvar [llength [info commands testupvar]]

test upvar-NS-1.3 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace upvar test_ns_0 x w
	    set w
	}
    } \
    -result {namespace "test_ns_0" does not exist} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.4 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    proc a {} {
		namespace upvar test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    -result {namespace "test_ns_0" does not exist} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.5 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace eval test_ns_0 {}

	    proc a {} {
		namespace upvar test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    -result {namespace "test_ns_0" does not exist} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}


# cleanup
::tcltest::cleanupTests
return