Tcl Source Code

2011-04-21  Don Porter  <[email protected]>

	* generic/tclCmdIL.c:	Limits on list length were too strict.
	* generic/tclInt.h:	Revised panics to errors where possible.
	* generic/tclListObj.c:
	* tests/lrepeat.test:

	* generic/tclCompile.c:	Make sure SetFooFromAny routines react
	* generic/tclIO.c:	reasonably when passed a NULL interp.
	* generic/tclIndexObj.c:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
     */

    objc -= 2;
    objv += 2;


    /* Final sanity check. Do not exceed limits on max list length. */






    if (elementCount && objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
        Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;





    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.
     */

    listPtr = Tcl_NewListObj(totalElems, NULL);

				 * derived from the list representation. May
				 * be ignored if there is no string rep at
				 * all.*/
    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 *)))

/*
 * Macro used to get the elements of a list object.
 */

#define ListRepPtr(listPtr) \
    ((List *) (listPtr)->internalRep.twoPtrValue.ptr1)

#include "tclInt.h"

/*
 * Prototypes for functions defined later in this file:
 */

static List *		AttemptNewList(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static List *		NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeListInternalRep(Tcl_Obj *listPtr);
static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfList(Tcl_Obj *listPtr);

/*
 * The structure below defines the list Tcl object type by means of functions

};

/*
 *----------------------------------------------------------------------
 *
 * NewListIntRep --
 *
 *	Creates a list internal rep with space for objc elements.  objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize list internal rep to have
 *	0 elements, with space to add objc more.  Flag value "p" indicates
 *	how to behave on failure.
 *
 * Results:
 *	A new List struct with refCount 0 is returned. If some failure
 *	prevents this then if p=0, NULL is returned and otherwise the
 *	routine panics.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

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

    if (objc <= 0) {
	Tcl_Panic("NewListIntRep: expects postive element count");
    }

    /*
     * First check to see if we'd overflow and try to allocate an object
     * larger than our memory allocator allows. Note that this is actually a
     * fairly small value when you're on a serious 64-bit machine, but that
     * requires API changes to fix. See [Bug 219196] for a discussion.
     */

    if ((size_t)objc > LIST_MAX) {
	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj*)));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
	}
	return NULL;
    }

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

	    Tcl_IncrRefCount(elemPtrs[i]);
	}
    } else {
	listRepPtr->elemCount = 0;
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * AttemptNewList --
 *
 *	Creates a list internal rep with space for objc elements.  objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize list internal rep to have
 *	0 elements, with space to add objc more.  
 *
 * Results:
 *	A new List struct with refCount 0 is returned. If some failure
 *	prevents this then NULL is returned, and an error message is left
 *	in the interp result, unless interp is NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static List *
AttemptNewList(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
    List *listRepPtr = NewListIntRep(objc, objv, 0);

    if (interp != NULL && listRepPtr == NULL) {
	if (objc > LIST_MAX) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "list creation failed: unable to alloc %u bytes",
		    sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
	}
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *
 *	This function is normally called when not debugging: i.e., when

	return listPtr;
    }

    /*
     * Create the internal rep.
     */

    listRepPtr = NewListIntRep(objc, objv, 1);




    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;

	return listPtr;
    }

    /*
     * Create the internal rep.
     */

    listRepPtr = NewListIntRep(objc, objv, 1);




    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;

    /*
     * Set the object's type to "list" and initialize the internal rep.
     * However, if there are no elements to put in the list, just give the
     * object an empty string rep and a NULL type.
     */

    if (objc > 0) {
	listRepPtr = NewListIntRep(objc, objv, 1);



	objPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	objPtr->typePtr = &tclListType;
	listRepPtr->refCount++;
    } else {
	objPtr->bytes = tclEmptyStringRep;
	objPtr->length = 0;

	newSize = 0;
    }

    if (listRepPtr->refCount > 1) {
	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldElems;

	listRepPtr = AttemptNewList(interp, newMax, NULL);
	if (listRepPtr == NULL) {
	    return TCL_ERROR;
	}
	oldElems = &oldListRepPtr->elements;
	elemPtrs = &listRepPtr->elements;
	for (i=0; i<numElems; i++) {
	    elemPtrs[i] = oldElems[i];
	    Tcl_IncrRefCount(elemPtrs[i]);
	}

	if (numRequired > listRepPtr->maxElemCount){
	    newMax = 2 * numRequired;
	} else {
	    newMax = listRepPtr->maxElemCount;
	}

	listRepPtr = AttemptNewList(interp, newMax, NULL);
	if (listRepPtr == NULL) {
	    return TCL_ERROR;
	}

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

	elemPtrs = &listRepPtr->elements;

     */

    if (listRepPtr->refCount > 1) {
	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldElemPtrs = elemPtrs;
	int i;

	listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
	if (listRepPtr == NULL) {
	    return TCL_ERROR;
	}
	listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;
	elemPtrs = &listRepPtr->elements;
	for (i=0; i < elemCount; i++) {
	    elemPtrs[i] = oldElemPtrs[i];
	    Tcl_IncrRefCount(elemPtrs[i]);
	}

	 * the reverse back to a dictionary) are both order-preserving. Also
	 * note that since we know we've got a valid dictionary (by
	 * representation) we also know that fetching the size of the
	 * dictionary or iterating over it will not fail.
	 */

	Tcl_DictObjSize(NULL, objPtr, &size);
	listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
	if (!listRepPtr) {






	    return TCL_ERROR;
	}
	listRepPtr->elemCount = 2 * size;

	/*
	 * Populate the list representation.
	 */

    /*
     * Allocate a new List structure with enough room for "estCount" elements.
     * Each element is a pointer to a Tcl_Obj with the appropriate string rep.
     * The initial "estCount" elements are set using the corresponding "argv"
     * strings.
     */

    listRepPtr = AttemptNewList(interp, estCount, NULL);
    if (listRepPtr == NULL) {





	return TCL_ERROR;
    }
    elemPtrs = &listRepPtr->elements;

    for (p=string, lenRemain=length, i=0;
	    lenRemain > 0;
	    p=nextElem, lenRemain=limit-nextElem, i++) {

    -body {
	lrepeat 0 a b c
    }
    -result {}
}
test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
     lrepeat 0x10000000 a b c d e f g h
} -returnCodes error -match glob -result *

## Okay
test lrepeat-2.1 {normal cases} {
    lrepeat 10 a
} {a a a a a a a a a a}
test lrepeat-2.2 {normal cases} {
    lrepeat 3 [lrepeat 3 0]