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)
{
    const char *string;
    char *s;
    const char *elemStart, *nextElem;
    int lenRemain, length, elemSize, result, isNew;
    const 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);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
	    }
	    return TCL_ERROR;
	}

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

	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 = 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) {
	    if (interp != NULL) {
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
	    }
	    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(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) {
	    if (interp != NULL) {
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
	    }
	    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(elemSize + 1);
	if (literal) {
	    memcpy(s, 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);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
    TclDecrRefCount(keyPtr);
    result = TCL_ERROR;

  errorExit:



    DeleteChainTable(dict);
    ckfree(dict);
    return result;
}

/*
 *----------------------------------------------------------------------

 */

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    const char *string;
    char *s;
    const char *elemStart, *nextElem;
    int lenRemain, length, estCount, elemSize, i, j, result;
    const char *limit;		/* Points just after string's last byte. */
    register const char *p;
    register Tcl_Obj **elemPtrs;
    register Tcl_Obj *elemPtr;
    List *listRepPtr;


    /*
     * Dictionaries are a special case; they have a string representation such
     * that *all* valid dictionaries are valid lists. Hence we can convert
     * more directly. Only do this when there's no existing string rep; if
     * there is, it is the string rep that's authoritative (because it could
     * describe duplicate keys).

	/*
	 * Populate the list representation.
	 */

	elemPtrs = &listRepPtr->elements;
	Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
	i = 0;
	while (!done) {
	    elemPtrs[i++] = keyPtr;
	    elemPtrs[i++] = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}

	/*
	 * Swap the representations.
	 */

	goto commitRepresentation;
    }

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

    string = TclGetStringFromObj(objPtr, &length);

    /*
     * Parse the string into separate string objects, and create a List
     * structure that points to the element string objects. 
     *
     * First, allocate enough space to hold a (Tcl_Obj *) for each
     * (possible) list element.
     */

    estCount = TclMaxListLength(string, length, &limit);
    estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
    listRepPtr = AttemptNewList(interp, estCount, NULL);
    if (listRepPtr == NULL) {
	return TCL_ERROR;
    }
    elemPtrs = &listRepPtr->elements;

    /* Each iteration, parse and store a list element */
    for (p=string, lenRemain=length, i=0;
	    lenRemain > 0;
	    p=nextElem, lenRemain=limit-nextElem, i++) {

	int literal;

	result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
		&elemSize, &literal);
	if (result != TCL_OK) {
	    for (j = 0;  j < i;  j++) {
		elemPtr = elemPtrs[j];
		Tcl_DecrRefCount(elemPtr);
	    }
	    ckfree(listRepPtr);
	    if (interp != NULL) {
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
	    }
	    return result;
	}
	if (elemStart >= limit) {
	    break;
	}
	if (i > estCount) {
	    Tcl_Panic("SetListFromAny: bad size estimate for list");
	}

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

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


	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);

	}

	TclNewObj(elemPtr);
	elemPtr->bytes = s;
	elemPtr->length = elemSize;
	elemPtrs[i] = elemPtr;
	Tcl_IncrRefCount(elemPtr);	/* Since list now holds ref to it. */
    }

    listRepPtr->elemCount = i;


    /*
     * 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.
     */

  commitRepresentation:
    TclFreeIntRep(objPtr);
    ListSetIntRep(objPtr, listRepPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

 *	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.

	argv[i] = p;
	if (literal) {
	    memcpy(p, element, (size_t) elSize);
	    p += elSize;
	    *p = 0;
	    p++;
	} else {
	    TclCopyAndCollapse(elSize, element, p);
	    p += elSize+1;
	}
    }

    argv[i] = NULL;
    *argvPtr = argv;
    *argcPtr = i;
    return TCL_OK;

    list [catch join msg] $msg $errorCode
} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
test join-2.2 {join errors} {
    list [catch {join a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
test join-2.3 {join errors} {
    list [catch {join "a \{ c" 111} msg] $msg $errorCode
} {1 {unmatched open brace in list} {TCL VALUE LIST}}

test join-3.1 {joinString is binary ok} {
  string length [join {a b c} a\0b]
} 9
test join-3.2 {join is binary ok} {
  string length [join "a\0b a\0b a\0b"]
} 11

        lappend res [TestOp $op 5.0 1]
        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend res [TestOp $op 1 5.0]
        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
    }
    foreach op {in ni} {
        lappend res [TestOp $op 5 "a b \{ c"]
        lappend exp "unmatched open brace in list TCL VALUE LIST"
    }
    lappend res [TestOp % 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
    lappend res [TestOp % 9838923468297346238478737647637375 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
    lappend res [TestOp / 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"