Tcl Source Code

    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	1},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
    {"lunset",		Tcl_LunsetObjCmd,	NULL,			NULL,	1},
    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},
    {"regsub",		Tcl_RegsubObjCmd,	NULL,			NULL,	1},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	1},
    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	1},
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	1},

    if (objc == 4) {
	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
    } else {
	finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
		objv[objc-1]);
    }

    /*
     * If substitution has failed, bail out.
     */

    if (finalValuePtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Finally, update the variable so that traces fire.
     */

    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
	    TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(finalValuePtr);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Return the new value of the variable as the interpreter result.
     */

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LunsetObjCmd --
 *
 *	This procedure is invoked to process the "lunset" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LunsetObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */

    /*
     * Check parameter count.
     */

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

    /*
     * Look up the list variable's value.
     */

    listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
	    TCL_LEAVE_ERR_MSG);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Substitute the value in the value. Return either the value or else an
     * unshared copy of it.
     */

    if (objc == 3) {
	finalValuePtr = TclLsetList(interp, listPtr, objv[2], NULL);
    } else {
	finalValuePtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
    }

    /*
     * If substitution has failed, bail out.
     */

    if (finalValuePtr == NULL) {
	return TCL_ERROR;

    int refCount;
    int maxElemCount;		/* Total number of element array slots. */
    int elemCount;		/* Current number of list elements. */
    int canonicalFlag;		/* Set if the string representation was
				 * derived from the list representation. May
				 * be ignored if there is no string rep at
				 * all.*/
    char *holes;
    Tcl_Obj *elements;		/* First list element; the struct is grown to
				 * accomodate all elements. */
} List;

#define LIST_MAX \
	(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
#define LIST_SIZE(numElems) \

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LunsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclNamespaceEnsembleCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_OpenObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,

 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static void
SetMaxElemCount(
    List *listRepPtr,
    int newSize)
{
    int t;

    if (listRepPtr->holes != NULL) {
	listRepPtr->holes =
		(char *) ckrealloc(listRepPtr->holes, sizeof(char) * newSize);
	for (t = listRepPtr->maxElemCount; t < newSize; t++) {
	    listRepPtr->holes[t] = 0;
	}
    }
    listRepPtr->maxElemCount = newSize;
}

static void
InitHoles(
    List *listRepPtr)
{
    int t;

    if (listRepPtr->holes == NULL) {
	listRepPtr->holes =
		(char *) ckalloc(sizeof(char) * listRepPtr->maxElemCount);
	for (t = 0; t < listRepPtr->maxElemCount; t++) {
	    listRepPtr->holes[t] = 0;
	}
    }
}

static List *
NewListIntRep(
    int objc,
    Tcl_Obj *const objv[],
    int p)
{

	}
	return NULL;
    }

    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;
    listRepPtr->maxElemCount = objc;
    listRepPtr->holes = NULL;

    if (objv) {
	Tcl_Obj **elemPtrs;
	int i;

	listRepPtr->elemCount = objc;
	elemPtrs = &listRepPtr->elements;

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    register Tcl_Obj *listPtr,	/* List object to append elements to. */
    Tcl_Obj *elemListPtr)	/* List obj with elements to append. */
{
    int listLen, objc, result, i;
    Tcl_Obj **objv;
    List *listRepPtr, *elemListRepPtr;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
    }

    /*
     * Pull the elements to append from elemListPtr.
     */

    if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
	return TCL_ERROR;
    }

    /*
     * Insert the new elements starting after the lists's last element.
     * Delete zero existing elements.
     */

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    listLen = listRepPtr->maxElemCount;
    result = Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
    if (result != TCL_OK) {
	return result;
    }

    
    elemListRepPtr = (List *) elemListPtr->internalRep.twoPtrValue.ptr1;
    if (elemListRepPtr->holes != NULL) {
	listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
	InitHoles(listRepPtr);
	for (i = 0; i < objc; i++) {
	    listRepPtr->holes[listLen + i] = elemListRepPtr->holes[i];
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *

	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    SetMaxElemCount(listRepPtr, attempt);
	    needGrow = 0;
	}
    }
    if (isShared || needGrow) {
	Tcl_Obj **dst, **src = &listRepPtr->elements;

	/*

	    }
	}

	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	listRepPtr->refCount++;

	elemPtrs = &listRepPtr->elements;

	if (oldListRepPtr->holes != NULL) {
	    listRepPtr->holes =
		    (char *) ckalloc(sizeof(char) * listRepPtr->maxElemCount);
	    for (i=0; i < first; i++) {
		listRepPtr->holes[i] = oldListRepPtr->holes[i];
	    }
	    for (i=first; i < first + objc; i++) {
		listRepPtr->holes[i] = 0;
	    }
	    for (i = first + count, j = first + objc;
		    j < numRequired; i++, j++) {
		listRepPtr->holes[j] = oldListRepPtr->holes[i];
	    }
	}

	if (isShared) {
	    /*
	     * The old struct will remain in place; need new refCounts for the
	     * new List struct references. Copy over only the surviving
	     * elements.
	     */

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     */

    if (indexCount == 0) {
	if (valuePtr == NULL) {
	    TclNewObj(valuePtr);
	}

	Tcl_IncrRefCount(valuePtr);
	return valuePtr;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:

    Tcl_Obj *valuePtr)		/* Tcl object to store in the designated list
				 * element. */
{
    List *listRepPtr;		/* Internal representation of the list being
				 * modified. */
    Tcl_Obj **elemPtrs;		/* Pointers to elements of the list. */
    int elemCount;		/* Number of elements in the list. */
    int hole = 0;

    /*
     * Ensure that the listPtr parameter designates an unshared list.
     */

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");

	}

	listRepPtr->refCount--;

	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
    }
    elemPtrs = &listRepPtr->elements;

    if (valuePtr == NULL) {
	hole = 1;
	TclNewObj(valuePtr);
    }
    if (hole || listRepPtr->holes != NULL) {
	InitHoles(listRepPtr);
	listRepPtr->holes[index] = hole;
    }

    /*
     * Add a reference to the new list element.
     */

    Tcl_IncrRefCount(valuePtr);

    if (--listRepPtr->refCount <= 0) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	if (listRepPtr->holes != NULL) {
	    ckfree((char *) listRepPtr->holes);
	}
	ckfree(listRepPtr);
    }

    listPtr->internalRep.twoPtrValue.ptr1 = NULL;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
    listPtr->typePtr = NULL;
}

	flagPtr = ckalloc(numElems * sizeof(int));
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	if (listRepPtr->holes != NULL && listRepPtr->holes[i] != 0) {
	    listPtr->length += 8;
	} else {
	    bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	}
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    listPtr->length = bytesNeeded - 1;
    listPtr->bytes = ckalloc(bytesNeeded);
    dst = listPtr->bytes;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	if (listRepPtr->holes != NULL && listRepPtr->holes[i] != 0) {
	    strcpy(dst, "{*}{{}}");
	    dst += 7;
	} else {
	    dst += TclConvertElement(elem, length, dst,
		    flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
	}
	*dst++ = ' ';
    }
    listPtr->bytes[listPtr->length] = '\0';

    if (flagPtr != localFlags) {
	ckfree(flagPtr);
    }

	openBraces = 1;
	p++;
    } else if (*p == '"') {
	inQuotes = 1;
	p++;
    }
    elemStart = p;

    /* Special case for special NULL token */
    if (openBraces && *p == '*' && strncmp(p, "*}{{}}", 6) == 0) {
	if (((p+6) >= limit) || isspace(UCHAR(*(p+6)))) {/* INTL: ISO space. */
	    elemStart = p + 4;
	    size = 0;
	    p += 6;
	    /* if (bracePtr != 0) { */
	    /*     *bracePtr = 2; */
	    /* } */
	    goto done;
	}
    }

    /*
     * Find element's end (a space, close brace, or the end of the string).
     */

    while (p < limit) {
	switch (*p) {

Tcl_ConcatObj(
    int objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{
    int i, elemLength, needSpace = 0, bytesNeeded = 0;
    const char *element;
    Tcl_Obj *objPtr, *resPtr;
    List *listRepPtr;

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}

test list-4.1 {Bug 3173086} {
    string is list "{[list \\\\\}]}"
} 1
test list-4.1 {null elements, parse literal} {
    set apa {a b {*}{{}} d}
    lindex $apa 2
} {}

test list-4.2 {null elements, parse literal} {
    set apa {a b {*}{{}} d}
    lindex $apa 3
} {d}

test list-4.3 {null elements, lappend preserves} {
    set apa {a b {*}{{}} d}
    lappend apa x
} {a b {*}{{}} d x}

test list-4.4 {null elements, lappend preserves} {
    set apa {a b {*}{{}} d}
    lappend apa x y z
    lindex $apa 2
} {}

test list-4.5 {null elements, lrange destroys} {
    set apa {a b {*}{{}} d}
    lrange $apa 0 end
} {a b {} d}

test list-4.6 {null elements, eval safe, pure list} {
    set apa {list b {*}{{}} d}
    lappend apa e
    eval $apa
} {b {} d e}

test list-4.7 {null elements, eval safe, string} {
    set apa {list b {*}{{}} d}
    lappend apa e
    eval " $apa x"
} {b {} d e x}

test list-4.8 {null elements, concat safe, pure list} {
    set apa {a b {*}{{}} d}
    lappend apa e
    set bepa {f {*}{{}} g}
    lappend bepa h
    concat $apa $bepa
} {a b {*}{{}} d e f {*}{{}} g h}

test list-4.9 {null elements, concat safe, string} {
    set apa {a b {*}{{}} d}
    set bepa {f {*}{{}} g}
    concat $apa $bepa
} {a b {*}{{}} d f {*}{{}} g}

test list-4.10 {null elements, lset preserves} {
    set apa {a b {*}{{}} d e}
    lset apa 3 x
    list $apa [lindex $apa 2]
} {{a b {*}{{}} x e} {}}

test list-4.11 {null elements, lset overwrites} {
    set apa {a b {*}{{}} d e}
    lset apa 2 x
    list $apa [lindex $apa 2]
} {{a b x d e} x}

test list-4.12 {null elements, nested lset overwrites} {
    set apa {g h {*}{{}} {a b {*}{{}} d e}}
    lset apa 3 2 x
    list $apa [lindex $apa 3 2]
} {{g h {*}{{}} {a b x d e}} x}

test list-4.13 {null elements, nested lset preserves} {
    set apa {g h {*}{{}} {a b {*}{{}} d e}}
    lset apa 3 3 x
    list $apa [lindex $apa 3 3]
} {{g h {*}{{}} {a b {*}{{}} x e}} x}

test list-5.1 {lunset} {
    set apa {a b c d e}
    lunset apa 3
    list $apa [lindex $apa 3]
} {{a b c {*}{{}} e} {}}

test list-5.2 {lunset, nested} {
    set apa {a b c {d e f g} h}
    lunset apa 3 2
    list $apa [lindex $apa 3 2]
} {{a b c {d e {*}{{}} g} h} {}}

# cleanup
::tcltest::cleanupTests
return