Tcl Source Code

Check-in [ea441b300e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:First draft of bug fix.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-3293874
Files: files | file ages | folders
SHA1: ea441b300ea07139013e7666f2d0e186b2e468f4
User & Date: dgp 2011-05-11 20:33:14
Context
2011-05-11
20:42
Oops! check-in: 434596e345 user: dgp tags: bug-3293874
20:33
First draft of bug fix. check-in: ea441b300e user: dgp tags: bug-3293874
2011-05-10
17:22
New internal routines TclScanElement() and TclConvertElement(). Rewritten guts of machinery to produ... check-in: 7720fbb825 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclListObj.c.

9
10
11
12
13
14
15




16
17
18
19
20
21
22
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#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);







>
>
>
>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifndef TCL_GROWTH_MIN_ALLOC
#define TCL_GROWTH_MIN_ALLOC 1024
#endif

/*
 * 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);
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	This function appends the objects in the list referenced by
 *	elemListPtr to the list object referenced by listPtr. If listPtr is
 *	not already a list object, an attempt will be made to convert it to
 *	one.
 *
 * Results:
 *	The return value is normally TCL_OK. If listPtr or elemListPtr do not
 *	refer to list objects and they can not be converted to one, TCL_ERROR
 *	is returned and an error message is left in the interpreter's result
 *	if interp is not NULL.
 *
 * Side effects:
 *	The reference counts of the elements in elemListPtr are incremented
 *	since the list now refers to them. listPtr and elemListPtr are
 *	converted, if necessary, to list objects. Also, appending the new
 *	elements may cause listObj's array of element pointers to grow.
 *	listPtr's old string representation, if any, is invalidated.







|
|
<
<



|
|
<







482
483
484
485
486
487
488
489
490


491
492
493
494
495

496
497
498
499
500
501
502
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	This function appends the elements in the list value referenced by
 *	elemListPtr to the list value referenced by listPtr.


 *
 * Results:
 *	The return value is normally TCL_OK. If listPtr or elemListPtr do not
 *	refer to list values, TCL_ERROR is returned and an error message is
 *	left in the interpreter's result if interp is not NULL.

 *
 * Side effects:
 *	The reference counts of the elements in elemListPtr are incremented
 *	since the list now refers to them. listPtr and elemListPtr are
 *	converted, if necessary, to list objects. Also, appending the new
 *	elements may cause listObj's array of element pointers to grow.
 *	listPtr's old string representation, if any, is invalidated.
512
513
514
515
516
517
518

519
520
521
522

523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
    int listLen, objc, result;
    Tcl_Obj **objv;

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


    result = TclListObjLength(interp, listPtr, &listLen);
    if (result != TCL_OK) {
	return result;
    }


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

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

    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *







>




>











|







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
    int listLen, objc, result;
    Tcl_Obj **objv;

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

/*
    result = TclListObjLength(interp, listPtr, &listLen);
    if (result != TCL_OK) {
	return result;
    }
*/

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

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

    return Tcl_ListObjReplace(interp, listPtr, /*listLen*/LIST_MAX, 0, objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
563
564
565
566
567
568
569



570
571
572
573
574
575
576

int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,		/* List object to append objPtr to. */
    Tcl_Obj *objPtr)		/* Object to append to listPtr's list. */
{



    register List *listRepPtr;
    register Tcl_Obj **elemPtrs;
    int numElems, numRequired, newMax, newSize, i;

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







>
>
>







566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582

int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,		/* List object to append objPtr to. */
    Tcl_Obj *objPtr)		/* Object to append to listPtr's list. */
{
#if 1
    return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, 1, &objPtr);
#else
    register List *listRepPtr;
    register Tcl_Obj **elemPtrs;
    int numElems, numRequired, newMax, newSize, i;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
    }
641
642
643
644
645
646
647

648
649
650
651
652
653
654
    /*
     * Invalidate any old string representation since the list's internal
     * representation has changed.
     */

    Tcl_InvalidateStringRep(listPtr);
    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *







>







647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
    /*
     * Invalidate any old string representation since the list's internal
     * representation has changed.
     */

    Tcl_InvalidateStringRep(listPtr);
    return TCL_OK;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
894
895
896
897
898
899
900









901
902
903


904
905
906
907
908
909
910

	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;








>
>
>
>
>
>
>
>
>
|
|
|
>
>







901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928

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

	listRepPtr = AttemptNewList(NULL, newMax, NULL);
	if (listRepPtr == NULL) {
	    unsigned int limit = LIST_MAX - numRequired;
	    unsigned int extra = numRequired - listRepPtr->elemCount
		    + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_Obj *);
	    int growth = (int) ((extra > limit) ? limit : extra);

	    listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
	    if (listRepPtr == NULL) {
		listRepPtr = AttemptNewList(interp, numRequired, NULL);
		if (listRepPtr == NULL) {
		    return TCL_ERROR;
		}
	    }
	}

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

	elemPtrs = &listRepPtr->elements;

Changes to generic/tclUtil.c.

1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
	int listc;

	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    /*
	     * Tcl_ListObjAppendList could be used here, but this saves us a
	     * bit of type checking (since we've already done it). Use of
	     * INT_MAX tells us to always put the new stuff on the end. It
	     * will be set right in Tcl_ListObjReplace.
	     * Note that all objs at this point are either lists or have an
	     * empty string rep.
	     */

	    objPtr = objv[i];
	    if (objPtr->bytes && objPtr->length == 0) {
		continue;
	    }
	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
	    if (listc) {
		if (resPtr) {
		    Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv);
		} else {
		    resPtr = TclListObjCopy(NULL, objPtr);
		}
	    }
	}
	if (!resPtr) {
	    resPtr = Tcl_NewObj();







|












|







1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
	int listc;

	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    /*
	     * Tcl_ListObjAppendList could be used here, but this saves us a
	     * bit of type checking (since we've already done it). Use of
	     * LIST_MAX tells us to always put the new stuff on the end. It
	     * will be set right in Tcl_ListObjReplace.
	     * Note that all objs at this point are either lists or have an
	     * empty string rep.
	     */

	    objPtr = objv[i];
	    if (objPtr->bytes && objPtr->length == 0) {
		continue;
	    }
	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
	    if (listc) {
		if (resPtr) {
		    Tcl_ListObjReplace(NULL, resPtr, LIST_MAX, 0, listc, listv);
		} else {
		    resPtr = TclListObjCopy(NULL, objPtr);
		}
	    }
	}
	if (!resPtr) {
	    resPtr = Tcl_NewObj();