Tcl Source Code

2011-05-02  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Revised TclFindElement() interface.  The
	* generic/tclDictObj.c:	final argument had been bracePtr, the address
	* generic/tclListObj.c:	of a boolean var, where the caller can be told
	* generic/tclParse.c:	whether or not the parsed list element was
	* generic/tclUtil.c:	enclosed in braces.  In practice, no callers

 */

static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    char *string, *s;
    const char *elemStart, *nextElem;
    int lenRemain, length, elemSize, result, isNew;
    char *limit;		/* Points just after string's last byte. */
    register const char *p;
    register Tcl_Obj *keyPtr, *valuePtr;
    Dict *dict;
    Tcl_HashEntry *hPtr;


    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (objPtr->typePtr == &tclListType) {
	int objc, i;
	Tcl_Obj **objv;


	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc & 1) {
	    if (interp != NULL) {
		Tcl_SetResult(interp, "missing value to go with key",
			TCL_STATIC);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Build the hash of key/value pairs.
	 */

	dict = (Dict *) ckalloc(sizeof(Dict));
	InitChainTable(dict);
	for (i=0 ; i<objc ; i+=2) {
	    /*
	     * Store key and value in the hash table we're building.
	     */

	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);

		/*
		 * Not really a well-formed dictionary as there are duplicate
		 * keys, so better get the string rep here so that we can
		 * convert back.
		 */

		(void) Tcl_GetString(objPtr);

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}

	/*
	 * Share type-setting code with the string-conversion case.
	 */

	goto installHash;
    }

    /*
     * Get the string representation. Make it up-to-date if necessary.
     */

    string = TclGetStringFromObj(objPtr, &length);
    limit = (string + length);

    /*
     * Allocate a new HashTable that has objects for keys and objects for

     * values.
     */

    dict = (Dict *) ckalloc(sizeof(Dict));
    InitChainTable(dict);
    for (p = string, lenRemain = length;
	    lenRemain > 0;
	    p = nextElem, lenRemain = (limit - nextElem)) {
	int literal;

	result = TclFindElement(interp, p, lenRemain,
		&elemStart, &nextElem, &elemSize, &literal);
	if (result != TCL_OK) {
	    goto errorExit;
	}
	if (elemStart >= limit) {
	    break;
	}



	/*
	 * Allocate a Tcl object for the element and initialize it from the
	 * "elemSize" bytes starting at "elemStart".
	 */

	s = ckalloc((unsigned) elemSize + 1);
	if (literal) {
	    memcpy(s, elemStart, (size_t) elemSize);
	    s[elemSize] = 0;
	} else {
	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
	}

	TclNewObj(keyPtr);
        keyPtr->bytes = s;
        keyPtr->length = elemSize;

	p = nextElem;
	lenRemain = (limit - nextElem);
	if (lenRemain <= 0) {
	    goto missingKey;
	}

	result = TclFindElement(interp, p, lenRemain,
		&elemStart, &nextElem, &elemSize, &literal);
	if (result != TCL_OK) {
	    TclDecrRefCount(keyPtr);
	    goto errorExit;
	}
	if (elemStart >= limit) {
	    goto missingKey;
	}

	/*
	 * Allocate a Tcl object for the element and initialize it from the
	 * "elemSize" bytes starting at "elemStart".
	 */

	s = ckalloc((unsigned) elemSize + 1);
	if (literal) {
	    memcpy((void *) s, (void *) elemStart, (size_t) elemSize);
	    s[elemSize] = 0;
	} else {
	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
	}

	TclNewObj(valuePtr);
        valuePtr->bytes = s;

        valuePtr->length = elemSize;

	/*
	 * Store key and value in the hash table we're building.
	 */

	hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	if (!isNew) {
	    Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);

	    TclDecrRefCount(keyPtr);
	    TclDecrRefCount(discardedValue);
	}
	Tcl_SetHashValue(hPtr, valuePtr);
	Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
    }

  installHash:
    /*
     * Free the old internalRep before setting the new one. We do this as late
     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use that old internalRep.
     */

    TclFreeIntRep(objPtr);
    dict->epoch = 0;
    dict->chain = NULL;
    dict->refcount = 1;
    objPtr->internalRep.otherValuePtr = dict;
    objPtr->typePtr = &tclDictType;
    return TCL_OK;

  missingKey:
    if (interp != NULL) {
	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
    }
    TclDecrRefCount(keyPtr);
    result = TCL_ERROR;

  errorExit:
    DeleteChainTable(dict);
    ckfree((char *) dict);
    return result;
}

 *	that's part of the element. If this is the last argument in the list,
 *	then *nextPtr will point just after the last character in the list
 *	(i.e., at the character at list+listLength). If sizePtr is non-NULL,
 *	*sizePtr is filled in with the number of characters in the element. If
 *	the element is in braces, then *elementPtr will point to the character
 *	after the opening brace and *sizePtr will not include either of the
 *	braces. If there isn't an element in the list, *sizePtr will be zero,
 *	and both *elementPtr and *termPtr will point just after the last
 *	character in the list. If literalPtr is non-NULL, *literalPtr is set
 *	to a boolean value indicating whether the substring returned as
 *	the values of **elementPtr and *sizePtr is the literal value of
 *	a list element.  If not, a call to TclCopyAndCollapse() is needed
 *	to produce the actual value of the list element.  Note: this function
 *	does NOT collapse backslash sequences, but uses *literalPtr to tell
 * 	callers when it is required for them to do so.