Tcl Source Code

					Tcl_Obj *keyPtr);
static Tcl_NRPostProc		FinalizeDictUpdate;
static Tcl_NRPostProc		FinalizeDictWith;
static Tcl_ObjCmdProc		DictForNRCmd;
static Tcl_ObjCmdProc		DictMapNRCmd;
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;
static Tcl_ObjTypeLengthProc    DictAsListLength;
/* static Tcl_ObjTypeIndexProc     DictAsListIndex; Needs rewrite */

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },

				 * dictionary. Used for doing traversal of the
				 * entries in the order that they are
				 * created. */
    ChainEntry *entryChainTail;	/* Other end of linked list of all entries in
				 * the dictionary. Used for doing traversal of
				 * the entries in the order that they are
				 * created. */
    size_t epoch; 	/* Epoch counter */
    size_t refCount;		/* Reference counter (see above) */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {
    "dict",
    FreeDictInternalRep,	/* freeIntRepProc */
    DupDictInternalRep,		/* dupIntRepProc */
    UpdateStringOfDict,		/* updateStringProc */
    SetDictFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(		/* Extended type for AbstractLists */
    DictAsListLength,		/* return "list" length of dict value w/o
				 * shimmering */
    NULL,			/* return key or value at "list" index
				 * location.  (keysare at even indicies,
				 * values at odd indicies) */
    NULL,
    NULL,
    NULL,
    NULL,
    NULL,
    NULL)
};

#define DictSetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
        Tcl_ObjInternalRep ir;                                               \
        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
        ir.twoPtrValue.ptr2 = NULL;                                     \
        Tcl_StoreInternalRep((objPtr), &tclDictType, &ir);                   \
    } while (0)

#define DictGetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
        const Tcl_ObjInternalRep *irPtr;                                     \
        irPtr = TclFetchInternalRep((objPtr), &tclDictType);                \
        (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;          \
    } while (0)

/*
 * The type of the specially adapted version of the Tcl_Obj*-containing hash
 * table defined in the tclObj.c code. This version differs in that it
 * allocates a bit more space in each hash entry in order to hold the pointers
 * used to keep the hash entries in a linked list.

DictSizeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int result;
	Tcl_Size size;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }
    result = Tcl_DictObjSize(interp, objv[1], &size);
    if (result == TCL_OK) {

Tcl_Command
TclInitDictCmd(
    Tcl_Interp *interp)
{
    return TclMakeEnsemble(interp, "dict", implementationMap);
}

/*
 *----------------------------------------------------------------------
 *
 * DictAsListLength --
 *
 *   Compute the length of a list as if the dict value were converted to a
 *   list.
 *
 *   Note: the list length may not match the dict size * 2.  This occurs when
 *   there are duplicate keys in the original string representation.
 *
 * Side Effects --
 *
 *   The intent is to have no side effects.
 */

static Tcl_Size
DictAsListLength(
    Tcl_Obj *objPtr)
{
    Tcl_Size estCount, length, llen;
    const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
    Tcl_Obj *elemPtr;

    /*
     * Allocate enough space to hold a (Tcl_Obj *) for each
     * (possible) list element.
     */

    estCount = TclMaxListLength(nextElem, length, &limit);
    estCount += (estCount == 0); /* Smallest list struct holds 1
				  * element. */
    elemPtr = Tcl_NewObj();

    llen = 0;

    while (nextElem < limit) {
	const char *elemStart;
	char *check;
	Tcl_Size elemSize;
	int literal;

	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
		&elemStart, &nextElem, &elemSize, &literal)) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (elemStart == limit) {
	    break;
	}

	TclInvalidateStringRep(elemPtr);
	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
		elemSize);
	if (elemSize && check == NULL) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (!literal) {
	    Tcl_InitStringRep(elemPtr, NULL,
		    TclCopyAndCollapse(elemSize, elemStart, check));
	}
	llen++;
    }
    Tcl_DecrRefCount(elemPtr);
    return llen;
}


/*
 *----------------------------------------------------------------------
 *
 * DictAsListIndex --
 *
 *   Return the key or value at the given "list" index, i.e., as if the string
 *   value where treated as a list. The intent is to support this list
 *   operation w/o causing the Obj value to shimmer into a List.
 *
 * Side Effects --
 *
 *   The intent is to have no side effects.
 *
 */
#if 0 /* Needs rewrite */
static int
DictAsListIndex(
    Tcl_Interp *interp,
    struct Tcl_Obj *objPtr,
    Tcl_Size index,
    Tcl_Obj** elemObjPtr)
{
    Tcl_Size /*estCount,*/ length, llen;
    const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
    Tcl_Obj *elemPtr;

    /*
     * Compute limit of the list string
     */

    TclMaxListLength(nextElem, length, &limit);
    elemPtr = Tcl_NewObj();

    llen = 0;

    /*
     * parse out each element until reaching the "index"th element.
     * Sure this is slow, but shimmering is slower.
     */
    while (nextElem < limit) {
	const char *elemStart;
	char *check;
	Tcl_Size elemSize;
	int literal;

	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
		&elemStart, &nextElem, &elemSize, &literal)) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (elemStart == limit) {
	    break;
	}

	TclInvalidateStringRep(elemPtr);
	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
		elemSize);
	if (elemSize && check == NULL) {
	    Tcl_DecrRefCount(elemPtr);
	    if (interp) {
		// Need error message here
	    }
	    return TCL_ERROR;
	}
	if (!literal) {
	    Tcl_InitStringRep(elemPtr, NULL,
		    TclCopyAndCollapse(elemSize, elemStart, check));
	}
	if (llen == index) {
	    *elemObjPtr = elemPtr;
	    return TCL_OK;
	}
	llen++;
    }

    /*
     * Index is beyond end of list - return empty
     */
    Tcl_InitStringRep(elemPtr, NULL, 0);
    *elemObjPtr = elemPtr;
    return TCL_OK;
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    }}
} -returnCodes error -result {key "d" not known in dictionary}
test dict-3.16 {dict/list shimmering - Bug 3004007} testobj {
    set l [list p 1 p 2 q 3]
    dict get $l q
    list $l [testobj objtype $l]
} {{p 1 p 2 q 3} dict}
test dict-3.17 {dict/list shimmering - Bug 3004007} testobj {
    set l [list p 1 p 2 q 3]
    dict get $l q
    list [llength $l] [testobj objtype $l]
} {6 dict}

test dict-4.1 {dict replace command} {
    dict replace {a b c d}
} {a b c d}
test dict-4.2 {dict replace command} {
    dict replace {a b c d} e f
} {a b c d e f}