Tcl Source Code

2011-08-27  Don Porter  <[email protected]>

	* generic/tclStringObj.c:  [RFE 3396731] Revise the [string reverse]
	* tests/string.test:	implementation to operate on the representation
	that comes in, avoid conversion to other reps.

2011-08-23  Don Porter  <[email protected]>

	* generic/tclIORChan.c:	[Bug 3396948] Leak of ReflectedChannelMap.





2011-08-19  Don Porter  <[email protected]>

	* generic/tclIORTrans.c: [Bugs 3393279, 3393280] ReflectClose(.) is
	missing Tcl_EventuallyFree() calls at some of its exits.

	* generic/tclIO.c: [Bugs 3394654, 3393276] Revise FlushChannel() to
	account for the possibility that the ChanWrite() call might recycle

 *	argument with modifications done in place.
 *
 * Side effects:
 *	May allocate a new Tcl_Obj.
 *
 *---------------------------------------------------------------------------
 */

void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    int count)		/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count - 1;
    if (to == from) {
	/* Reversing in place */
	while (to < src) {
	    unsigned char c = *src;
	    *src-- = *to;
	    *to++ = c;
	}
    }  else {
	while (src >= from) {
	    *to++ = *src--;
	}
    }
}

void
ReverseUniChars(
    Tcl_UniChar *to,		/* Copy Tcl_UniChars into here... */
    Tcl_UniChar *from,		/* ...from here... */
    unsigned int count)		/* Until this many are copied, */
				/* reversing as you go. */
{
    Tcl_UniChar *src = from + count - 1;
    if (to == from) {
	/* Reversing in place */
	from += count - 1;
	while (to < src) {
	    Tcl_UniChar c = *src;
	    *src-- = *to;
	    *to++ = c;
	}
    }  else {
	while (src >= from) {
	    *to++ = *src--;
	}
    }
}

Tcl_Obj *
TclStringObjReverse(
    Tcl_Obj *objPtr)
{
    String *stringPtr;



    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);





	if (Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);








	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;

    }


    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);


	if (Tcl_IsShared(objPtr)) {
	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    Tcl_UniChar ch = 0;
	    objPtr = Tcl_NewUnicodeObj(&ch, 1);

	    Tcl_SetObjLength(objPtr, stringPtr->numChars);

	}
	ReverseUniChars(Tcl_GetUnicode(objPtr), from, stringPtr->numChars);
    }


    if (objPtr->bytes) {
	int numChars = stringPtr->numChars;
	int numBytes = objPtr->length;


	char *to, *from = objPtr->bytes;



	if (Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewObj();




	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;







	if (numChars < numBytes) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * represented by objPtr->bytes and we need Pass 1 just in case,
	     * or numChars >= 0 and we know we have fewer chars than bytes,
	     * so we know there's a multibyte character needing Pass 1.
	     *
	     * Pass 1. Reverse the bytes of each multi-byte character.
	     */
	    int charCount = 0;


	    int bytesLeft = numBytes;







	    while (bytesLeft) {
		/*
		 * NOTE: We know that the from buffer is NUL-terminated.
		 * It's part of the contract for objPtr->bytes values.
		 * Thus, we can skip calling Tcl_UtfCharComplete() here.
		 */
		Tcl_UniChar ch = 0;


		int bytesInChar = Tcl_UtfToUniChar(from, &ch);











		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);

		to += bytesInChar;



		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;

	    }

	    from = to = objPtr->bytes;
	    stringPtr->numChars = charCount;
	}
	/* Pass 2. Reverse all the bytes. */
	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);

    }





    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *

    set x \ubeef
    set y \udead
    string is ascii [string reverse $x$y]
} 0
test string-24.13 {string reverse command - pure Unicode string} {
    string reverse [string range \ubeef\udead\ubeef\udead\ubeef\udead 1 5]
} \udead\ubeef\udead\ubeef\udead
test string-24.14 {string reverse command - pure bytearray} {
    binary scan [string reverse [binary format H* 010203]] H* x
    set x
} 030201
test string-24.15 {string reverse command - pure bytearray} {
    binary scan [tcl::string::reverse [binary format H* 010203]] H* x
    set x
} 030201

test string-25.1 {string is list} {
    string is list {a b c}
} 1
test string-25.2 {string is list} {
    string is list "a \{b c"
} 0