Tcl Source Code

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

	* generic/tclParse.c (TclParseBackslash): Correct trunction checks in
	* tests/parse.test:	\x and \u substitutions.  [Bug 3200987]

2011-01-26  Donal K. Fellows  <[email protected]>

2011-03-06  Don Porter  <[email protected]>

	* generic/tclBasic.c:	More replacements of Tcl_UtfBackslash() calls
	* generic/tclCompile.c:	with TclParseBackslash() where possible.
	* generic/tclParse.c:
	* generic/tclUtil.c:

	* generic/tclUtil.c (TclFindElement):	Guard escape sequence scans
	to not overrun the string end.  [Bug 3192636]

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

	* generic/tclParse.c (TclParseBackslash): Correct trunction checks in
	* tests/parse.test:	\x and \u substitutions.  [Bug 3200987]

2011-01-26  Donal K. Fellows  <[email protected]>

 * Flag values passed to Tcl_ConvertElement.
 * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
 *	use backslash quoting instead.
 * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
 *	is safe to leave the hash unquoted when the element is not the first
 *	element of a list, and this flag can be used by the caller to indicate
 *	that condition.
 * (Careful! If you change these flag values be sure to change the definitions
 * at the front of tclUtil.c).
 */

#define TCL_DONT_USE_BRACES	1
#define TCL_DONT_QUOTE_HASH	8

/*
 * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow

 * Flag values passed to Tcl_ConvertElement.
 * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
 *	use backslash quoting instead.
 * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
 *	is safe to leave the hash unquoted when the element is not the first
 *	element of a list, and this flag can be used by the caller to indicate
 *	that condition.


 */

#define TCL_DONT_USE_BRACES	1
#define TCL_DONT_QUOTE_HASH	8

/*
 * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow

				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    int line,			/* The line the script starts on. */
    int*  clNextOuter,       /* Information about an outer context for */
    CONST char* outerScript) /* continuation line data. This is set only in
			      * EvalTokensStandard(), to properly handle
			      * [...]-nested commands. The 'outerScript'
			      * refers to the most-outer script containing the
			      * embedded command, which is refered to by
			      * 'script'. The 'clNextOuter' refers to the
			      * current entry in the table of continuation
			      * lines in this "master script", and the
			      * character offsets are relative to the
................................................................................
     int* line;
     int** clNextPtrPtr;
     int loc;
{
    /*
     * Track the invisible continuation lines embedded in a script, if
     * any. Here they are just spaces (already). They were removed by
     * EvalTokensStandard() via Tcl_UtfBackslash().
     *
     * *clNextPtrPtr         <=> We have continuation lines to track.
     * **clNextPtrPtr >= 0   <=> We are not beyond the last possible location.
     * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
     */

    while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) {

				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    int line,			/* The line the script starts on. */
    int*  clNextOuter,       /* Information about an outer context for */
    CONST char* outerScript) /* continuation line data. This is set only in
			      * TclSubstTokens(), to properly handle
			      * [...]-nested commands. The 'outerScript'
			      * refers to the most-outer script containing the
			      * embedded command, which is refered to by
			      * 'script'. The 'clNextOuter' refers to the
			      * current entry in the table of continuation
			      * lines in this "master script", and the
			      * character offsets are relative to the
................................................................................
     int* line;
     int** clNextPtrPtr;
     int loc;
{
    /*
     * Track the invisible continuation lines embedded in a script, if
     * any. Here they are just spaces (already). They were removed by
     * TclSubstTokens() via TclParseBackslash().
     *
     * *clNextPtrPtr         <=> We have continuation lines to track.
     * **clNextPtrPtr >= 0   <=> We are not beyond the last possible location.
     * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
     */

    while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) {

		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[TCL_UTF_MAX];
		int length = Tcl_UtfBackslash(tokenPtr->start, NULL, utfBuf);

		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

	default:
	    if (tempPtr != NULL) {
		Tcl_DecrRefCount(tempPtr);
................................................................................
     * For the handling of continuation lines in literals we first check if
     * this is actually a literal. For if not we can forego the additional
     * processing. Otherwise we pre-allocate a small table to store the
     * locations of all continuation lines we find in this literal, if
     * any. The table is extended if needed.
     *
     * Note: Different to the equivalent code in function
     * 'EvalTokensStandard()' (see file "tclBasic.c") we do not seem to need
     * the 'adjust' variable. We also do not seem to need code which merges
     * continuation line information of multiple words which concat'd at
     * runtime. Either that or I have not managed to find a test case for
     * these two possibilities yet. It might be a difference between compile-
     * versus runtime processing.
     */

................................................................................
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
	    break;

	case TCL_TOKEN_BS:
	    length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer);

	    Tcl_DStringAppend(&textBuffer, buffer, length);

	    /*
	     * If the backslash sequence we found is in a literal, and
	     * represented a continuation line, we compute and store its
	     * location (as char offset to the beginning of the _result_
	     * script). We may have to extend the table of locations.

		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[TCL_UTF_MAX];
		int length = TclParseBackslash(tokenPtr->start,
			tokenPtr->size, NULL, utfBuf);
		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

	default:
	    if (tempPtr != NULL) {
		Tcl_DecrRefCount(tempPtr);
................................................................................
     * For the handling of continuation lines in literals we first check if
     * this is actually a literal. For if not we can forego the additional
     * processing. Otherwise we pre-allocate a small table to store the
     * locations of all continuation lines we find in this literal, if
     * any. The table is extended if needed.
     *
     * Note: Different to the equivalent code in function
     * 'TclSubstTokens()' (see file "tclParse.c") we do not seem to need
     * the 'adjust' variable. We also do not seem to need code which merges
     * continuation line information of multiple words which concat'd at
     * runtime. Either that or I have not managed to find a test case for
     * these two possibilities yet. It might be a difference between compile-
     * versus runtime processing.
     */

................................................................................
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
	    break;

	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buffer);
	    Tcl_DStringAppend(&textBuffer, buffer, length);

	    /*
	     * If the backslash sequence we found is in a literal, and
	     * represented a continuation line, we compute and store its
	     * location (as char offset to the beginning of the _result_
	     * script). We may have to extend the table of locations.

 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.
 */

typedef struct ThreadSpecificData {
    Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj
			       * generated by a call to the function
			       * EvalTokensStandard() from a literal text
			       * where bs+nl sequences occured in it, if
			       * any. I.e. this table keeps track of
			       * invisible/stripped continuation lines. Its
			       * keys are Tcl_Obj pointers, the values are
			       * ContLineLoc pointers.  See the file
			       * tclCompile.h for the definition of this
			       * structure, and for references to all related

 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.
 */

typedef struct ThreadSpecificData {
    Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj
			       * generated by a call to the function
			       * TclSubstTokens() from a literal text
			       * where bs+nl sequences occured in it, if
			       * any. I.e. this table keeps track of
			       * invisible/stripped continuation lines. Its
			       * keys are Tcl_Obj pointers, the values are
			       * ContLineLoc pointers.  See the file
			       * tclCompile.h for the definition of this
			       * structure, and for references to all related

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    append = tokenPtr->start;
	    appendByteLength = tokenPtr->size;
	    break;

	case TCL_TOKEN_BS:
	    appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL,
		    utfCharBytes);
	    append = utfCharBytes;
	    /*
	     * If the backslash sequence we found is in a literal, and
	     * represented a continuation line, we compute and store its
	     * location (as char offset to the beginning of the _result_
	     * script). We may have to extend the table of locations.
	     *

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    append = tokenPtr->start;
	    appendByteLength = tokenPtr->size;
	    break;

	case TCL_TOKEN_BS:
	    appendByteLength = TclParseBackslash(tokenPtr->start,
		    tokenPtr->size, NULL, utfCharBytes);
	    append = utfCharBytes;
	    /*
	     * If the backslash sequence we found is in a literal, and
	     * represented a continuation line, we compute and store its
	     * location (as char offset to the beginning of the _result_
	     * script). We may have to extend the table of locations.
	     *

 */

static ProcessGlobalValue executableName = {
    0, 0, NULL, NULL, NULL, NULL, NULL
};

/*
 * The following values are used in the flags returned by Tcl_ScanElement and
 * used by Tcl_ConvertElement. The values TCL_DONT_USE_BRACES and
 * TCL_DONT_QUOTE_HASH are defined in tcl.h; make sure neither value overlaps
 * with any of the values below.
 *
 * TCL_DONT_USE_BRACES -	1 means the string mustn't be enclosed in
 *				braces (e.g. it contains unmatched braces, or


 *				ends in a backslash character, or user just
 *				doesn't want braces); handle all special
 *				characters by adding backslashes.

 * USE_BRACES -			1 means the string contains a special
 *				character that can be handled simply by
 *				enclosing the entire argument in braces.
 * TCL_DONT_QUOTE_HASH -	1 means the caller insists that a leading hash
 * 				character ('#') should *not* be quoted. This
 * 				is appropriate when the caller can guarantee
 * 				the element is not the first element of a
 * 				list, so [eval] cannot mis-parse the element
 * 				as a comment.






































 */

#define USE_BRACES		2






/*
 * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
 * access the precision to be used for double formatting.
 */

static Tcl_ThreadDataKey precisionKey;
................................................................................

	    /*
	     * Backslash: skip over everything up to the end of the backslash
	     * sequence.
	     */

	case '\\':
	    Tcl_UtfBackslash(p, &numChars, NULL);
	    p += (numChars - 1);
	    break;

	    /*
	     * Space: ignore if element is in braces or quotes; otherwise
	     * terminate element.
	     */
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCopyAndCollapse --
 *
 *	Copy a string and eliminate any backslashes that aren't in braces.
 *
 * Results:
 *	Count characters get copied from src to dst. Along the way, if
 *	backslash sequences are found outside braces, the backslashes are
 *	eliminated in the copy. After scanning count chars from source, a null
 *	character is placed at the end of dst. Returns the number of
 *	characters that got copied.

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclCopyAndCollapse(
    int count,			/* Number of characters to copy from src. */
    CONST char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    register char c;
    int numRead;
    int newCount = 0;
    int backslashCount;

    for (c = *src;  count > 0;  src++, c = *src, count--) {


	if (c == '\\') {
	    backslashCount = Tcl_UtfBackslash(src, &numRead, dst);



	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead-1;
	    count -= numRead-1;
	} else {
	    *dst = c;
	    dst++;
	    newCount++;


	}
    }
    *dst = 0;
    return newCount;
}
 
/*
................................................................................
 *	needed by Tcl_ConvertCountedElement when doing the actual conversion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#define COMPAT 1

#define CONVERT_NONE	0
#define CONVERT_BRACE	2
#define CONVERT_ESCAPE	4
#define CONVERT_SAFE	16
#define CONVERT_MASK	(CONVERT_BRACE | CONVERT_ESCAPE)


int
Tcl_ScanCountedElement(
    CONST char *string,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in string, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    int flags = CONVERT_SAFE;
    int numBytes = TclScanElement(string, length, &flags);

    *flagPtr = flags;
    return numBytes;
}

int
................................................................................
	bytesNeeded += extra;
	if ((*string == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
	    bytesNeeded++;
	}
	*flagPtr = CONVERT_ESCAPE;
	goto overflowCheck;
    }
    if (*flagPtr & CONVERT_SAFE) {
	if (extra < 2) {
	    extra = 2;
	}

	*flagPtr |= TCL_DONT_USE_BRACES;
    }
    if (forbidNone) {
#if COMPAT
	if (preferEscape && !preferBrace) {
	    bytesNeeded += (extra - braceCount);
	    if ((*string == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {

 */

static ProcessGlobalValue executableName = {
    0, 0, NULL, NULL, NULL, NULL, NULL
};

/*
 * The following values are used in the flags arguments of Tcl*Scan*Element and
 * Tcl*Convert*Element. The values TCL_DONT_USE_BRACES and TCL_DONT_QUOTE_HASH
 * are defined in tcl.h, like so:

 *
#define TCL_DONT_USE_BRACES     1

#define TCL_DONT_QUOTE_HASH     8
 *
 * Those are public flag bits which callers of the public routines
 * Tcl_Convert*Element() can use to indicate:

 *
 * TCL_DONT_USE_BRACES -	1 means the caller is insisting that brace
 *				quoting not be used when converting the list
 *				element.
 * TCL_DONT_QUOTE_HASH -	1 means the caller insists that a leading hash
 * 				character ('#') should *not* be quoted. This
 * 				is appropriate when the caller can guarantee
 * 				the element is not the first element of a
 * 				list, so [eval] cannot mis-parse the element
 * 				as a comment.
 *
 * The remaining values which can be carried by the flags of these routines
 * are for internal use only.  Make sure they do not overlap with the public
 * values above.
 *
 * The Tcl*Scan*Element() routines make a determination which of 4 modes of
 * conversion is most appropriate for Tcl*Convert*Element() to perform, and
 * sets two bits of the flags value to indicate the mode selected.
 *
 * CONVERT_NONE		The element needs no quoting.  Its literal string
 *			is suitable as is.
 * CONVERT_BRACE	The conversion should be enclosing the literal string
 *			in braces.
 * CONVERT_ESCAPE	The conversion should be using backslashes to escape
 *			any characters in the string that require it.
 * CONVERT_MASK		A mask value used to extract the conversion mode from
 *			the flags argument.
 *			Also indicates a strange conversion mode where all
 *			special characters are escaped with backslashes 
 *			*except for braces*.  This is a strange and unnecessary
 *			case, but it's part of the historical way in which
 *			lists have been formatted in Tcl.  To experiment with
 *			removing this case, set the value of COMPAT to 0.
 *
 * One last flag value is used only by callers of TclScanElement().  The flag
 * value produced by a call to Tcl*Scan*Element() will never leave this bit
 * set.
 *
 * CONVERT_ANY		The caller of TclScanElement() declares it can make
 *			no promise about what public flags will be passed to
 *			the matching call of TclConvertElement().  As such,
 *			TclScanElement() has to determine the worst case
 *			destination buffer length over all possibilities, and
 *			in other cases this means an overestimate of the
 *			required size.
 *
 * For more details, see the comments on the Tcl*Scan*Element and 
 * Tcl*Convert*Element routines.
 */

#define COMPAT 1
#define CONVERT_NONE	0
#define CONVERT_BRACE	2
#define CONVERT_ESCAPE	4
#define CONVERT_MASK	(CONVERT_BRACE | CONVERT_ESCAPE)
#define CONVERT_ANY	16

/*
 * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
 * access the precision to be used for double formatting.
 */

static Tcl_ThreadDataKey precisionKey;
................................................................................

	    /*
	     * Backslash: skip over everything up to the end of the backslash
	     * sequence.
	     */

	case '\\':
	    TclParseBackslash(p, limit - p, &numChars, NULL);
	    p += (numChars - 1);
	    break;

	    /*
	     * Space: ignore if element is in braces or quotes; otherwise
	     * terminate element.
	     */
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCopyAndCollapse --
 *
 *	Copy a string and substitute all backslash escape sequences
 *
 * Results:
 *	Count bytes get copied from src to dst. Along the way, backslash
 *	sequences are substituted in the copy.  After scanning count bytes

 *	from src, a null character is placed at the end of dst.  Returns

 *	the number of bytes that got written to dst.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclCopyAndCollapse(
    int count,			/* Number of byte to copy from src. */
    CONST char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{


    int newCount = 0;



    while (count > 0) {
	char c = *src;
	if (c == '\\') {

	    int numRead;
	    int backslashCount = TclParseBackslash(src, count, &numRead, dst);

	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
	    *dst = c;
	    dst++;
	    newCount++;
	    src++;
	    count--;
	}
    }
    *dst = 0;
    return newCount;
}
 
/*
................................................................................
 *	needed by Tcl_ConvertCountedElement when doing the actual conversion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */










int
Tcl_ScanCountedElement(
    CONST char *string,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in string, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    int flags = CONVERT_ANY;
    int numBytes = TclScanElement(string, length, &flags);

    *flagPtr = flags;
    return numBytes;
}

int
................................................................................
	bytesNeeded += extra;
	if ((*string == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
	    bytesNeeded++;
	}
	*flagPtr = CONVERT_ESCAPE;
	goto overflowCheck;
    }
    if (*flagPtr & CONVERT_ANY) {
	if (extra < 2) {
	    extra = 2;
	}
	*flagPtr &= ~CONVERT_ANY;
	*flagPtr |= TCL_DONT_USE_BRACES;
    }
    if (forbidNone) {
#if COMPAT
	if (preferEscape && !preferBrace) {
	    bytesNeeded += (extra - braceCount);
	    if ((*string == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {