Tcl Source Code

static int
StringRplcCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
	return TCL_ERROR;
    }

	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */
	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;









	if (first < 0) {
	    first = 0;
	}
	if (last > end) {
	    last = end;
	}





	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);

	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    triml = TclTrim(string1, length1, string2, length2, &trimr);


    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
    return TCL_OK;
}

/*

	if (fromIdx == 0 && toIdx == endIdx) {
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}















	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,





















		toIdx - fromIdx + 1, value3Ptr, TCL_STRING_IN_PLACE);







































	if (objResultPtr == value3Ptr) {
	    /* See [Bug 82e7f67325] */
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim1 = TclTrim(string1, length, string2, length2, &trim2);





    createTrimmedString:
	/*
	 * Careful here; trim set often contains non-ASCII characters so we
	 * take care when printing. [Bug 971cb4f1db]
	 */

#ifdef TCL_COMPILE_DEBUG

			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclTrim(const char *bytes, int numBytes,
			    const char *trim, int numTrim, int *trimRight);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);

			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE int	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int start);
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int first, int count, Tcl_Obj *insertPtr,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReverse(Tcl_Obj *objPtr, int flags);

/* Flag values for the [string] ensemble functions. */

#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)

    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
{
    int waitStatus;
    Tcl_Obj *errorStrings[5];
    const char *msg;

    pid = Tcl_WaitPid(pid, &waitStatus, options);
    if (pid == 0) {
	/*
	 * No change.
	 */
	
	return TCL_PROCESS_UNCHANGED;
    }

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"
#include "tclStringRep.h"

#include "assert.h"
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,

	}
	/* Pass 2. Reverse all the bytes. */
	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
    }

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReplace --
 *
 *	Implements the inner engine of the [string replace] command.
 *
 *	The result is a concatenation of a prefix from objPtr, characters
 *	0 through first-1, the insertPtr string value, and a suffix from
 *	objPtr, characters from first + count to the end. The effect is
 *	as if the inner substring of characters first through first+count-1
 *	are removed and replaced with insertPtr.
 *	If insertPtr is NULL, it is treated as an empty string.
 *	When passed the flag TCL_STRING_IN_PLACE, this routine will try
 *	to do the work within objPtr, so long as no sharing forbids it.
 *	Without that request, or as needed, a new Tcl value will be allocated
 *	to be the result.
 *
 * Results:
 *	A Tcl value that is the result of the substring replacement.
 *	May return NULL in case of an error. When NULL is returned and
 *	interp is non-NULL, error information is left in interp
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    int first,			/* First index to replace */
    int count,			/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;

    /* Caller is expected to pass sensible arguments */
    assert ( count >= 0 ) ;
    assert ( first >= 0 ) ;

    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is like that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

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

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;

	    result = Tcl_NewByteArrayObj(NULL, numBytes - count);/* PANIC? */
	    TclAppendBytesToByteArray(result, bytes, first);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    int newBytes;
	    unsigned char *iBytes
		    = Tcl_GetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

	    if (newBytes > INT_MAX - (numBytes - count)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%d bytes) exceeded",
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */
	    TclAppendBytesToByteArray(result, bytes, first);	
	    TclAppendBytesToByteArray(result, iBytes, newBytes);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}

	/* Flow through to try other approaches below */
    }

    /*
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

    /* The traditional implementation... */
    {
	int numChars;
	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */
	
	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}
	if (first + count < numChars) {
	    Tcl_AppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *
 *	Populate the Unicode internal rep with the Unicode form of its string

    return (char) ch;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * UtfWellFormedEnd --
 *	Checks the end of utf string is malformed, if yes - wraps bytes
 *	to the given buffer (as well-formed NTS string).  The buffer
 *	argument should be initialized by the caller and ready to use.
 *
 * Results:
 *	The bytes with well-formed end of the string.
 *
 * Side effects:
 *	Buffer (DString) may be allocated, so must be released.
 *
 *----------------------------------------------------------------------
 */

static inline const char*
UtfWellFormedEnd(
    Tcl_DString *buffer,	/* Buffer used to hold well-formed string. */
    const char *bytes,		/* Pointer to the beginning of the string. */
    int length)			/* Length of the string. */
{
    const char *l = bytes + length;
    const char *p = Tcl_UtfPrev(l, bytes);

    if (Tcl_UtfCharComplete(p, l - p)) {
	return bytes;
    }
    /* 
     * Malformed utf-8 end, be sure we've NTS to safe compare of end-character,
     * avoid segfault by access violation out of range.
     */
    Tcl_DStringAppend(buffer, bytes, length);
    return Tcl_DStringValue(buffer);
}
/*
 *----------------------------------------------------------------------
 *
 * TclTrimRight --
 *	Takes two counted strings in the Tcl encoding.  Conceptually

 *	finds the sub string (offset) to trim from the right side of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static inline int
TrimRight(
    const char *bytes,		/* String to be trimmed... */
    int numBytes,		/* ...and its length in bytes */
    const char *trim,		/* String of trim characters... */
    int numTrim)		/* ...and its length in bytes */
{
    const char *p = bytes + numBytes;
    int pInc;
    Tcl_UniChar ch1 = 0, ch2 = 0;













    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	const char *q = trim;
	int bytesLeft = numTrim;

	    p += pInc;
	    break;
	}
    } while (p > bytes);

    return numBytes - (p - bytes);
}

int
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
{
    int res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    Tcl_DStringInit(&bytesBuf);
    Tcl_DStringInit(&trimBuf);
    bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
    trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);

    res = TrimRight(bytes, numBytes, trim, numTrim);
    if (res > numBytes) {
	res = numBytes;
    }

    Tcl_DStringFree(&bytesBuf);
    Tcl_DStringFree(&trimBuf);

    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrimLeft --
 *
 *	Takes two counted strings in the Tcl encoding.  Conceptually
 *	finds the sub string (offset) to trim from the left side of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the start of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static inline int
TrimLeft(
    const char *bytes,		/* String to be trimmed... */
    int numBytes,		/* ...and its length in bytes */
    const char *trim,		/* String of trim characters... */
    int numTrim)		/* ...and its length in bytes */
{
    const char *p = bytes;
	Tcl_UniChar ch1 = 0, ch2 = 0;













    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	int pInc = TclUtfToUniChar(p, &ch1);
	const char *q = trim;

	     */

	    break;
	}

	p += pInc;
	numBytes -= pInc;
    } while (numBytes > 0);

    return p - bytes;
}

int
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
{
    int res;
    Tcl_DString bytesBuf, trimBuf;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    Tcl_DStringInit(&bytesBuf);
    Tcl_DStringInit(&trimBuf);
    bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
    trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);

    res = TrimLeft(bytes, numBytes, trim, numTrim);
    if (res > numBytes) {
	res = numBytes;
    }

    Tcl_DStringFree(&bytesBuf);
    Tcl_DStringFree(&trimBuf);

    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrim --
 *	Finds the sub string (offset) to trim from both sides of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the start of the string
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
    const char *trim,	/* String of trim characters... */
    int numTrim,	/* ...and its length in bytes */
    int *trimRight)		/* Offset from the end of the string. */
{
    int trimLeft;
    Tcl_DString bytesBuf, trimBuf;

    *trimRight = 0;
    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    Tcl_DStringInit(&bytesBuf);
    Tcl_DStringInit(&trimBuf);
    bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
    trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);

    trimLeft = TrimLeft(bytes, numBytes, trim, numTrim);
    if (trimLeft > numBytes) {
	trimLeft = numBytes;
    }
    numBytes -= trimLeft;
    /* have to trim yet (first char was already verified within TrimLeft) */
    if (numBytes > 1) {
	bytes += trimLeft;
	*trimRight = TrimRight(bytes, numBytes, trim, numTrim);
	if (*trimRight > numBytes) {
	    *trimRight = numBytes;
	}
    }

    Tcl_DStringFree(&bytesBuf);
    Tcl_DStringFree(&trimBuf);

    return trimLeft;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Concat --
 *
 *	Concatenate a set of strings into a single large string.

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = ckalloc((unsigned) (bytesNeeded + argc));

    for (p = result, i = 0;  i < argc;  i++) {
	int triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);


	/* Trim away the leading/trailing whitespace. */


	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;



	/* Do not permit trimming to expose a final backslash character. */




	elemLength += trimr && (element[elemLength - 1] == '\\');


	/*
	 * If we're left with empty element after trimming, do nothing.
	 */

	if (elemLength == 0) {
	    continue;

     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	int triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);


	/* Trim away the leading/trailing whitespace. */


	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;



	/* Do not permit trimming to expose a final backslash character. */




	elemLength += trimr && (element[elemLength - 1] == '\\');


	/*
	 * If we're left with empty element after trimming, do nothing.
	 */

	if (elemLength == 0) {
	    continue;